'********************************************************************
'От Автора:
'Следната програма има за цел да създава таблица/taburot/ с всички атрибути на стандартния ADF тест за 'стационарност, на n на брой изходни променливи. За стартирането и е необходимо в полето Program Arguments да се въведат последователно: 1.максимален брой лагове за които ще определя оптималния в ADF теста/число/
'			       2.брой променливи/число/	
'                                                      3.самите променливи/латиница/- те трябва да се намират в директорията на Eviews!  
' и всичко това със една шпация разтояние.		
'Програмата ще генерира и log израженията на така въведените серии/където е възможно/	       	
'Светослав Петков
'********************************************************************
'====================================================================
'Процедура за оптималния лаг на база AIC criterion
'====================================================================
	SUBROUTINE LAGOPT(string %lag,string %arg)
	FOR !x=0 to !lagl
	freeze(fr2) {%lag}.uroot({%arg},!x)
		IF %arg="n" then !j=0
		ENDIF
		IF %arg="c" then !j=1
		ENDIF
		IF %arg="t" then !j=2
		ENDIF
		
	IF !x=0 then
	!mm=20+!j
	%min=fr2(!mm,5)
	scalar min1={%min}
	!broilag=!x
	ENDIF
	!mn=20+!x+!j
	%kon=fr2(!mn,5)
	scalar kon1={%kon}
	IF min1>kon1 then
	min1=kon1
	!broilag=!x
	ENDIF
	delete fr2
	NEXT

	ENDSUB

'====================================================================
' Поцедура за UNIT ROOT
'====================================================================
SUBROUTINE UROT(string %f,string %ar,scalar !col)
!con=!con+1
!b=0 			'Брояч за WHILE loop
!ur=0			'Брояч за UNITROOT
!sic=0
!br=!br+1
setcell(taburot,!br,1,NAME(!q,!col)+"_"+%ar,"l")

while !b=0
  freeze(fr1) {%f}.uroot({%ar},!broilag)
setcell(taburot,!br,5,fr1(1,5),"c",4)
setcell(taburot,!br,6,fr1(2,5),"c",4)
setcell(taburot,!br,7,fr1(3,5),"c",4)
IF !UR=0 and abs(fr1(1,2))>abs(fr1(3,5)) and abs(fr1(1,2))abs(fr1(3,5)) then !sic=10
	endif
	if abs(fr1(1,2))>abs(fr1(2,5)) then !sic=5
	endif
	if abs(fr1(1,2))>abs(fr1(1,5)) then !sic=1
	endif
ENDIF


if !sic=10 or !sic=5 or !sic=1 then
        setcell(taburot,!br,8,!ur,"C",3.0)
        setcell(taburot,!br,9,!broilag,"C",3.0)
	if !ur=0 then 
	setcell(taburot,!br,2,fr1(1,2),"c",-4)
	endif
	if !ur=1 then
	setcell(taburot,!br,3,fr1(1,2),"c",-4)
	endif
	if !ur=2 then
	setcell(taburot,!br,4,fr1(1,2),"c",-4)
	endif
if  !sic=1 then
setcell(taburot,!br,5,@str(fr1(1,5))+"*","c",6.2)
endif
if  !sic=5 then
setcell(taburot,!br,6,@str(fr1(2,5))+"*","c",6.2)
endif 
if  !sic=10 then
setcell(taburot,!br,7,@str(fr1(3,5))+"*","c",6.2)
endif     

        !b=1
else
	if !ur=0 then 
	setcell(taburot,!br,2,fr1(1,2),"c",-4)
	endif
	if !ur=1 then
	setcell(taburot,!br,3,fr1(1,2),"c",-4)
	endif
	if !ur=2 then
	setcell(taburot,!br,4,fr1(1,2),"c",-4)
	endif
    
     genr d{%f}=d({%f})
     %f="d"+%f
     !ur=!ur+1
   	 endif
delete fr1
wend
endsub

'====================================================================
'Процедура за имената на променливите
'====================================================================
SUBROUTINE NAME(string %dumi,scalar !hh)

GENR %{!i}$=%{!i}

		freeze(f{!i}) %{!i}$

		!c=30
			while @mid(f{!i}(2,2),!c,1)<>"$"
			!c=!c+1
			WEND
		!p=!c-30
		%r=%dumi+@mid(f{!i}(2,2),30,!p)
		setcell(NAME,!i-1,!hh,%r)
delete f{!i}
delete %{!i}$
ENDSUB

'====================================================================
'Създава работните таблици
'====================================================================
SUBROUTINE TABLICI
TABLE((4*!BROI),9) NAME

TABLE((4*!BROI),9) TABUROT
setcell(TABUROT,1,4,"Augmented Dickey Fuller Unit Root Test",25,"c")
setline(TABUROT,2)
SETCOLWIDTH(TABUROT,1,15)
setcell(TABUROT,3,1,"VARIABLE",25,"c")
setcell(TABUROT,3,2,"LEVEL",25,"c")
setcell(TABUROT,3,3,"1-st dif.",25,"c")
setcell(TABUROT,3,4,"2-nd dif.",25,"c")
setcell(TABUROT,3,5,"1% McKin.",25,"c")
setcell(TABUROT,3,6,"5% McKin.",25,"c")
setcell(TABUROT,3,7,"10% McKin.",25,"c")
setcell(TABUROT,3,8,"INTEG.",25,"c")
SETCOLWIDTH(TABUROT,9,4)
setcell(TABUROT,3,9,"LAG",25,"c")
setline(TABUROT,4)
ENDSUB


'Програма за определяне на степен на интегрираност
'====================================================================

WORKFILE s3 m  1985:1 1999:12
!lagl={%0}	'!lagl Променлива за ЛАГОВЕТЕ на UNIT ROOT test
!broi={%1}	'!broi Променлива за брой изследвани променливи
!skp=0
CALL TABLICI 'Създава работните таблици

	FOR !i=2 to !broi+1	'Цикъл за "зареждането" на сериите
	fetch %{!i}
	call name("",1) 'Викане на процедурата за имената на променливите
%toti="%{!i}"
if {%toti}>0 then 
genr log{%toti}=log(%{!i})
!skp=!skp+1
call name("log",2) 'Викане на процедурата за имената на 
endif
	next

!br=5 		'Брояч за Определяне на реда на запис
!con=0

	FOR !i=2 to !broi+1
	%v="%{!i}"
	!Q=!i-1
		FOR %m n c t
		call lagopt(%v,%m)
		call UROT(%v,%m,1)	'Викане на ПРОЦЕДУРАТА-UROOT
 		  %v="%{!i}"
		NEXT
	!br=!br+1

%toti="%{!i}"
if {%toti}>0 then 
%v="log{%toti}"
FOR %m n c t
		call lagopt(%v,%m)
		call UROT(%v,%m,2)	'Викане на ПРОЦЕДУРАТА-UROOT
 		 %v="log{%toti}"
		NEXT
	!br=!br+1
endif
	NEXT
	!br=!br+1
setline(TABUROT,!br)
!br=!br+1
setcell(TABUROT,!br,1,"* McKinnon critical values for rejection of hypothesis of a unit root",25,"c")
'====================================================================
show taburot

    Source: geocities.com/svetlikp