Estadística en Microcomputadores/Archivos BASIC/ESTAD8
10 ' ESTAD8 - Revision 13/12/88
15 ' -------------------------
20 GOSUB 1000
25 CHAIN "ESTAD"
130 KZ=1 : GOTO 2470
200 ' EST91 Definicion de Variables
205 ' ---------------------------
210 GOSUB 500
215 IF NV=0 THEN 265
220 PRINT
225 GOSUB 730
255 INPUT " Definicion de Nuevas Variables ? (N) = ",A$
260 IF A$<>"S" AND A$<>"s" THEN RETURN
265 PRINT
270 K=0
273 IF KNV=0 THEN KNV=NC
275 WHILE K<=KNV-1
280 K=K+1 : NV=K
290 PRINT " Variable Nro.";K; : INPUT "= ",A$
295 IF LEN(A$)=0 AND K=1 THEN NV=0 : RETURN
300 IF LEN(A$)=0 THEN NV=K-1 : K=KNV : GOTO 320
305 J=VAL(A$)
310 IF J<1 OR J>NC THEN KE=4 : GOSUB 900 : GOTO 290
311 IF K=1 THEN 318
312 FOR M=1 TO K-1
313 IF J=JX(M) THEN PRINT CHR$(7) : PRINT :
INPUT "** VARIABLE REPETIDA",A$ : PRINT : GOTO 290
315 NEXT M
318 JX(K)=J
320 WEND
324 IF KDA=1 THEN JF=0 : KDA=0 : NX=NF : RETURN
325 PRINT
330 INPUT " Variable para Observaciones Agrupadas (No) = ",A$
335 IF LEN(A$)=0 THEN JF=0 : GOTO 350
340 JF=VAL(A$)
345 IF JF<1 OR JF>NC THEN KE=4 : GOSUB 900 : GOTO 330
347 IF JF=0 THEN NX=NF : RETURN
350 KE=0 : NX=0
355 FOR I=1 TO NF
370 ND=1 : IF JF>0 THEN ND=A(I,JF)
372 IF ND=XVF THEN 380
373 IF ND<0 THEN KE=1
375 NX=NX+ND
380 NEXT I
383 IF KE=1 THEN PRINT : PRINT CHR$(7) : PRINT "** VALOR <0 EN VARIABLE";JF; :
INPUT "",A$ : GOTO 325
385 RETURN
390 ' EST92 - Seleccion de Variable
395 ' ----------------------------
400 J=0
405 IF NC=0 OR KVA=1 THEN KVA=0 : GOTO 412
410 GOSUB 500
412 PRINT
415 INPUT " Posicion de Variable a utilizar = ",A$
420 IF LEN(A$)=0 THEN RETURN
425 X=VAL(A$)
430 IF X<1 OR X>NCM THEN KE=4 : GOSUB 900 : GOTO 415
435 IF LEN(TC$(X))=0 OR LEFT$(TC$(X),2)=" " THEN 455
440 PRINT : PRINT " Variable";X;" actual = ",TC$(X)
445 INPUT " Se utiliza ? (N) = ",A$
450 IF A$<>"S" AND A$<>"s" THEN 415
451 PRINT : INPUT " Borrado de Datos existentes ? (N) = ",A$
452 IF A$="S" OR A$="s" THEN FOR I=1 TO NFM : A(I,X)=0 : NEXT I
455 PRINT : PRINT " Nombre de la Variable";X; : INPUT " = ",A$
460 IF LEN(A$)=0 AND TC$(X)<>" " THEN 485
465 IF LEN(A$)=0 OR LEFT$(A$,8)=" " THEN 415
470 TC$(X)=LEFT$(A$,8)
485 IF NC<X THEN NC=X
490 J=X
495 RETURN
500 ' EST93 - Variables en memoria
505 ' ----------------------------
510 PRINT : PRINT " Variables en Memoria" : PRINT
515 I=1
520 FOR LI=1 TO NC
525 IF LEFT$(TC$(LI),2)=" " THEN 540
530 PRINT TAB(15*I-11);LI;"-";TC$(LI);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT LI
545 PRINT
550 RETURN
555 ' EST94 Encabezamiento Pantallas y Resultados
560 ' -------------------------------------------
565 IF DS$="SCRN:" THEN PRINT CHR$(12);
570 PRINT#3,"Proceso : ";TP$;TAB(70);DATE$
575 IF TSP$>"" THEN PRINT#3,TAB(11);TSP$ ELSE PRINT
577 A$=NA$ : IF NF=0 THEN A$="No hay Datos en Memoria"
580 PRINT#3,"Datos : ";A$;" - ";N$
583 IF JF>0 THEN PRINT#3,TAB(11);"Variable para Observaciones Agrupadas = ";
JF;"-";TC$(JF)
585 IF CD$>"" THEN PRINT#3,TAB(11);"Condicion de Seleccion = ";CD$
590 IF NX>0 THEN PRINT#3,TAB(11);"Numero de Observac.: ";
595 IF NX>0 THEN PRINT#3,"Totales =";NX;
597 IF NXX>0 THEN PRINT#3," / Consideradas =";NXX ELSE PRINT#3,
600 KA=1 : KB=79 : GOSUB 695
605 PRINT#3,
610 RETURN
650 ' EST95 Seleccion de Dispositivo de Salida
655 ' ----------------------------------------
660 CLOSE#3 : KS=0 : DS$="SCRN:"
665 PRINT : INPUT "Salida por Impresora/I/ o a un Archivo/Nombre/ (No) = ",A$
670 IF LEN(A$)=0 THEN OPEN DS$ FOR OUTPUT AS #3 : RETURN
673 KS=1 : DS$="LPT1:"
675 IF A$="i" OR A$="I" THEN OPEN DS$ FOR OUTPUT AS#3 : RETURN
680 DS$=A$
685 OPEN DS$+".TXT" FOR APPEND AS #3
690 RETURN
695 ' EST96 Subrayado
700 ' ---------------
705 PRINT#3,TAB(KA);
710 FOR S=KA TO KB : PRINT#3,TAB(S);"-"; : NEXT S : PRINT#3,
715 RETURN
730 ' EST97 - Variables definidas
735 ' ---------------------------
740 I=1
743 IF KX=0 THEN PRINT#3," Variables ya Definidas" : PRINT#3,
745 IF KX=1 THEN PRINT#3," Variables Consideradas" : PRINT#3,
750 FOR K=1 TO NV
755 J=JX(K)
760 PRINT#3,TAB(15*I-11);J;"-";TC$(J);
765 I=I+1 : IF I>5 THEN I=1 : PRINT#3,
770 NEXT K
773 PRINT#3, : PRINT#3, : KX=0
775 RETURN
900 ' EST99 - SUBRUTINA DE MENSAJES
905 ' -----------------------------
910 PRINT CHR$(7) : PRINT
911 IF KE=1 THEN INPUT "** NO HAY DATOS EN MEMORIA ",A$ : KE=0 : RETURN
912 IF KE=2 THEN INPUT "** NUMERO DE VARIABLES NO ADECUADO PARA EL PROCESO ",A$
- KE=0 : RETURN
915 IF KE=3 THEN INPUT "** NUMERO DE OBSERVAC.INSUFICIENTE PARA EL PROCESO ",A$
- KE=0 : RETURN
928 IF KE=9 THEN INPUT "** PROCESO NO ADECUADO A LOS DATOS CONSIDERADOS ",A$ :
KE=0 : RETURN
929 IF KE=4 THEN INPUT "** VARIABLE NO EXISTENTE O SIN DATOS ",A$ :
KE=0 : RETURN
930 IF KE=5 THEN PRINT "** VALOR ERRONEO - Debe ser ";B$ : INPUT " ",A$ :
KE=0 : RETURN
931 IF KE=6 THEN INPUT "** CAPACIDAD INSUFICIENTE DE MEMORIA DE TRABAJO",A$ :
KE=0 : RETURN
934 INPUT "Valor Erroneo ",A$
935 RETURN
936 IF ERR<>53 THEN PRINT CHR$(7) : PRINT
937 IF ERR<>53 THEN KE=KE+1 : IF KE>1 THEN RESUME 948
938 IF ERR=25 OR ERR=57 OR ERR=68 OR ERR=70 OR ERR=71 THEN PRINT "** DISPOSITIVO ";XDDA$;
" NO DISPONIBLE O ERROR E/S"; : INPUT " ",A$ : RESUME NEXT
939 IF ERR=61 THEN PRINT "** DISCO ";XDDA$;" LLENO" : INPUT " ",A$ : RESUME
940 IF ERR=53 THEN KAR=1 : RESUME NEXT
941 IF ERR=62 THEN PRINT "** FIN DE GRABACION O LECTURA EN DISP. ";XDDA$; : INPUT "
",A$ : RESUME NEXT
942 IF ERR=2 OR ERR=22 THEN PRINT "** ERROR DE SINTAXIS EN FUNCION "; : INPUT "O
CONDICION",A$ : RESUME NEXT
943 IF ERR=24 OR ERR=27 THEN INPUT "** PROBLEMA EN IMPRESORA",A$ : RESUME NEXT
944 IF ERR=64 OR ERR=75 OR ERR=76 THEN INPUT "** NOMBRE INCORRECTO ARCHIVO",A$ : RESUME
947 PRINT "Error";ERR;"en linea";ERL :STOP
948 CHAIN"ESTAD"
950 ' EST98 - Descripcion Archivo
952 ' ---------------------------
954 LD=0
956 IF MID$(A$,2,1)<>":" THEN XDDA$=DDA$+":" : GOTO 964
958 B$=LEFT$(A$,1)
960 'IF INSTR("ABCabc",B$)=0 THEN GOSUB 900 : RETURN
962 XDDA$="" : LD=2
964 B$=RIGHT$(A$,4)
966 IF LEFT$(B$,1)<>"." THEN EXT$=XA$ ELSE EXT$="" : LD=LD+4
968 'IF LEN(A$)-LD>8 THEN GOSUB 900
970 KAR=0 : KE=0
972 OPEN XDDA$+A$+EXT$ FOR INPUT AS#1
974 CLOSE#1
978 RETURN
980 ' EST9. - Presentacion Menu
982 ' -------------------------
983 PRINT : ISP=0 : A$=""
984 FOR K=1 TO KL
986 PRINT " ";K;"- ";TF$(K)
988 NEXT K
990 PRINT : PRINT "Opcion Elegida = ";
991 B$=INKEY$ : PRINT B$;
992 IF B$=CHR$(13) THEN 996
993 IF B$=CHR$(27) THEN A$="" : GOTO 996
994 A$=A$+B$ : GOTO 991
996 IF LEN(A$)=0 THEN RETURN
997 ISP=INT(VAL(A$))
998 IF ISP<1 OR ISP>KL THEN PRINT CHR$(7) : GOTO 983
999 RETURN
1000 ' EST8 - Series de Tiempo
1005 ' -----------------------
1010 DEFINT I-N
1015 COMMON ITE,NFM,NCM,A(),TC$(),NC,NF,NX,DDA$,NDE,NV,JX(),P(),DA$,NA$,CD$,
PAR1,PAR2,XVF
1020 ON ERROR GOTO 936
1025 DIM TJ(PAR2+1,PAR2+1),TK(PAR2+1,PAR2+1)
1030 DIM VX(NFM),VY(NFM),TF$(6)
1033 DIM CY(5),TVA$(5),XVA(5),C(20),PX(20),VW(NFM)
1035 DEF FNR(X,K)=INT(10^K*X+.5)/10^K
1036 NDD=NDE-1 : NDF=NDE+1
1037 AD$="." : FOR M=1 TO NDD : AD$=AD$+"#" : NEXT M
1038 AE$="." : FOR M=1 TO NDE : AE$=AE$+"#" : NEXT M
1039 AF$="." : FOR M=1 TO NDF : AF$=AF$+"#" : NEXT M
1040 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1045 WHILE KW=0
1050 TP$="SERIES DE TIEMPO" : TSP$=""
1055 NXX=0
1060 GOSUB 555
1065 PRINT TAB(70);FRE(0)
1070 KE=0
1075 PRINT "PROCESOS"
1080 TF$(1)="Analisis Descriptivo"
1085 TF$(2)="Modelos de Ajuste"
1090 TF$(3)="Modelos Autorregresivos AR(p)"
1095 TF$(4)="Modelos de Descomposicion"
1100 TF$(5)="Manejo de Datos"
1105 KL=5 : GOSUB 980
1110 IF ISP=0 THEN RETURN
1115 IF ISP=5 THEN CHAIN "ESTAD1"
1120 IF NF=0 THEN KE=1 : GOSUB 900 : GOTO 1060
1125 IF ISP=1 THEN 1146
1130 KNV=1 : KDA=1 : GOSUB 200
1135 IF NV=0 THEN RETURN
1137 IF NV<>KNV THEN KE=2 : GOSUB 900 : GOTO 1130
1138 NXX=0 : KA=0
1139 FOR I=1 TO NF
1140 X=A(I,J)
1141 IF X=XVF OR A(I,0)=1 THEN 1144
1142 IF KA=0 THEN KA=1 : II=I
1143 IF KA=1 THEN IJ=I : NXX=NXX+1
1144 NEXT I
1145 IF NXX<3 THEN KE=3 : GOSUB 900 : GOTO 1150
1146 ON ISP GOSUB 1160,2080,3255,3800
1150 WEND
1155 '
1160 ' EST81 - Analisis Descriptivo de Series de Tiempo
1165 ' ------------------------------------------------
1170 WHILE KW=0
1175 TSP$="Analisis Descriptivo"
1180 GOSUB 555
1185 PRINT "PROCESOS"
1190 TF$(1)="Calculo de Coeficientes de Correlacion"
1195 TF$(2)="Suavizamiento"
1200 TF$(3)="Graficacion"
1205 KL=3 : GOSUB 980
1210 IF ISP=0 THEN RETURN
1215 ON ISP GOSUB 1230,1800,5200
1220 WEND
1225 '
1230 ' EST811 - Coeficientes de Correlacion
1235 ' ------------------------------------
1240 TSP$=TSP$ + " - Coeficientes de Correlacion"
1245 WHILE KW=0
1250 GOSUB 555
1255 PRINT "CALCULO DE"
1260 TF$(1)="Coeficientes de Autocorrelacion"
1265 TF$(2)="Coeficientes de Autocorrelacion Parcial"
1270 TF$(3)="Coeficientes de Correlacion Cruzada"
1275 KL=3 : GOSUB 980
1280 IF ISP=0 THEN RETURN
1290 KNV=1 : IF ISP=3 THEN KNV=2
1295 KDA=1 : GOSUB 200
1300 IF NV=0 THEN RETURN
1302 IF NV<>KNV THEN KE=2 : GOSUB 900 : GOTO 1295
1303 J=JX(1) : NXX=0 : KA=0
1304 FOR I=1 TO NF
1305 X=A(I,J) : IF X=XVF OR A(I,0)=1 THEN 1309
1306 IF ISP=3 THEN Y=A(I,JX(2)) : IF Y=XVF THEN 1309
1307 IF KA=0 THEN KA=1 : II=I
1308 IF KA=1 THEN IJ=I : NXX=NXX+1
1309 NEXT I
1310 IF NXX<3 THEN KE=3 : GOSUB 900 : RETURN
1311 GOSUB 555
1312 KM=NXX-2
1313 IF ISP=2 AND KM>PAR2 THEN KM=PAR2
1315 IF ISP<3 THEN INPUT "Nro. de Coeficientes a obtener = ",A$
1320 IF ISP=3 THEN INPUT "Nro. de Periodos de Diferencia = ",A$
1325 IF LEN(A$)=0 THEN RETURN
1327 LC=VAL(A$)
1331 IF LC<1 OR LC>KM THEN KE=5 : B$=">=1 y <="+STR$(KM) : GOSUB 900 :
PRINT : GOTO 1315
1335 PRINT : PRINT TAB(25);"EN PROCESO"
1337 KE=0
1340 ON ISP GOSUB 1535,1610,1720
1343 IF KE=1 THEN 1525
1345 IF ISP>1 THEN 1365
1350 TF=7 : IP=1 : P(1)=NXX-1
1355 FPX=.975 : GOSUB 7710
1360 RR=SQR(1/((NXX-2)/X^2+1))
1365 KS=1
1370 WHILE KS=1
1375 GOSUB 555
1380 PRINT#3, : PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
1383 IF ISP=3 THEN PRINT#3,"2da.VARIABLE = ";JX(2);"- ";TC$(J) : PRINT#3,
1385 PRINT#3,TAB(10);TF$(ISP) : PRINT#3,
1390 PRINT#3,"Difer. Covarianc.";TAB(20);"Coeficiente";
1395 PRINT#3," -1 0 1"
1400 KA=1 : KB=79 : GOSUB 695
1405 KX=1 : IF ISP=3 THEN KX=-LC
1410 FOR L=KX TO LC
1415 IF ISP=1 THEN R=VX(L)/DEX^2
1420 IF ISP=2 THEN R=VX(L)
1425 IF ISP=3 THEN R=VX(L+LC+1)/(DE(1)*DE(2))
1430 FOR M=1 TO 41 : VY(M)=0 : NEXT M
1435 VY(1)=1 : VY(21)=1 : VY(41)=1
1440 X=INT(20*RR+.5)
1445 VY(21+X)=2 : VY(21-X)=2
1450 X=INT(20*R+.5)
1455 VY(21+X)=3
1460 IF ISP=3 THEN XX=VX(L+LC+1) ELSE XX=VX(L)
1465 PRINT#3, L;TAB(10);FNR(XX,3);TAB(22);FNR(R,3);TAB(36);
1470 FOR M=1 TO 41
1475 A$=" "
1480 IF VY(M)=1 THEN A$="."
1485 IF VY(M)=2 THEN A$="I"
1490 IF VY(M)=3 THEN A$="*"
1495 PRINT#3,A$;
1500 NEXT M
1505 PRINT#3,
1510 NEXT L
1515 GOSUB 650
1520 WEND
1525 WEND
1530 '
1535 ' EST813 - Calculo de Coeficientes de Autocorrelacion
1540 ' ----------------------------------------------------
1550 GOSUB 5480
1555 FOR L=0 TO LC
1560 SXY=0
1565 NJ=IJ-L
1570 FOR I=II TO NJ
1575 IS=I+L
1580 SXY=SXY+(A(I,J)-PX)*(A(IS,J)-PX)
1585 NEXT I
1590 VX(L)=SXY/(NXX-L-1)
1595 NEXT L
1600 RETURN
1605 '
1610 ' EST814 - Calculo de Coef. de Autocorr.Parcial
1615 ' ---------------------------------------------
1620 GOSUB 1535
1625 IP=LC
1630 FOR K=1 TO IP
1635 S=0
1640 FOR M=K TO IP
1645 IF K=M THEN TJ(K,M)=1 : GOTO 1665
1650 S=S+1
1655 TJ(K,M)=VX(S)
1660 TJ(M,K)=VX(S)
1665 NEXT M
1670 TJ(K,IP+1)=VX(K)
1675 NEXT K
1685 N=IP : KI=1 : GOSUB 11000 : IP=N
1690 IF KE=1 THEN RETURN
1695 FOR K=1 TO LC
1700 VX(K)=TJ(K,LC+1)
1705 NEXT K
1710 RETURN
1715 '
1720 ' EST815 - Coefic. Correlac.Cruzada
1725 ' ---------------------------------
1730 GOSUB 5825
1735 FOR L=-LC TO LC
1740 IF L>=0 THEN J=JX(1) : JB=JX(2) : PA=PM(1) : PB=PM(2) : S=L
1745 IF L<0 THEN J=JX(2) : JB=JX(1) : PA=PM(2) : PB=PM(1) : S=-L
1750 SXY=0
1755 NJ=IJ-S
1760 FOR I=II TO NJ
1765 IS=I+S
1770 SXY=SXY+(A(I,J)-PA)*(A(IS,JB)-PB)
1775 NEXT I
1780 VX(L+LC+1)=SXY/(NJ-1)
1785 NEXT L
1790 RETURN
1795 '
1800 ' EST812 - Suavizamiento de Series
1805 ' --------------------------------
1806 TSP$="Suavizamiento de Series"
1807 WHILE KW=0
1808 GOSUB 555
1809 PRINT "METODO DE SUAVIZAMIENTO"
1810 TF$(1)="Promedios Moviles"
1811 TF$(2)="Medianas Moviles"
1812 KL=2 : GOSUB 980
1813 IF ISP=0 THEN RETURN
1814 KNV=1 : KDA=1 : GOSUB 200
1815 IF NV=0 THEN RETURN
1817 IF NV<>KNV THEN KE=2 : GOSUB 900 : GOTO 1814
1819 NXX=0 : KA=0
1820 FOR I=1 TO NF
1821 X=A(I,J)
1822 IF X=XVF OR A(I,0)=1 THEN 1825
1823 IF KA=0 THEN KA=1 : II=I
1824 IF KA=1 THEN IJ=I : NXX=NXX+1
1825 NEXT I
1826 IF NXX<3 THEN KE=3 : GOSUB 900 : RETURN
1827 PRINT : INPUT "Nro. de periodos para Suavizamiento = ",A$
1828 IF LEN(A$)=0 THEN RETURN
1830 L=VAL(A$)
1835 IF L<2 OR L>NXX OR L>24 THEN KE=5 : B$=">=2, <=24 o <="+STR$(NXX) :
GOSUB 900 : GOTO 1820
1836 IF ISP=2 THEN 1844
1837 PRINT
1838 FOR M=1 TO L
1839 PRINT " Factor Periodo";M;" (1) "; : INPUT "= ",A$
1840 IF LEN(A$)=0 THEN FOR K=1 TO L : VY(K)=1 : NEXT K : SF=L : M=L : GOTO
1841 VY(M)=VAL(A$) : SF=SF+VY(M)
1842 NEXT M
1843 IF SF<=0 THEN KE=5 : B$="Suma de factores>0" : GOSUB 900 : GOTO 1837
1844 PRINT : PRINT "ALMACENAMIENTO DE VALORES SUAVIZADOS EN MEMORIA DE TRABAJO"
1845 GOSUB 390 : CY(1)=J
1850 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
1855 LM=INT(L/2)
1860 KL=0 : IF (L/2-LM)>0 THEN KL=1
1861 LN=LM
1862 IF KL=0 THEN LN=LM+1
1863 IF KL=0 AND L=2 THEN LN=1
1865 J=JX(1)
1872 KX=0
1873 ON ISP GOSUB 1980,2060
1875 KS=1
1880 WHILE KS=1
1885 GOSUB 555
1890 PRINT#3, : PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
1891 PRINT#3,
1893 PRINT#3," Criterio de Suavizamiento = ";TF$(ISP)
1894 PRINT#3," Numero de Periodos = ";L : PRINT#3,
1895 IF ISP=2 THEN 1900
1896 PRINT#3," Factores de Ponderacion = ";
1897 FOR M=1 TO L
1898 PRINT#3,VY(M);" ";
1899 NEXT M : PRINT#3, : PRINT#3,
1900 KX=0
1905 FOR I=II TO IJ
1910 WHILE KX=0
1915 PRINT#3,"Per.";TAB(6);"Valor x";TAB(20);"Valor Suaviz.";TAB(34);
"Diferencia"
1920 KA=1 : KB=48 : GOSUB 695
1925 IL=6 : KX=1
1930 WEND
1935 X=A(I,J)
1940 PRINT#3,I;TAB(6);X;TAB(20);FNR(VX(I),NDE);TAB(34);FNR(X-VX(I),NDE)
1945 IF CY(1)>0 THEN A(I,CY(1))=VX(I)
1950 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$ : CLS
- KX=0
1955 NEXT I
1960 GOSUB 650
1965 WEND
1970 RETURN
1975 '
1980 ' EST816 - Suavizamiento mediante Promedios Moviles
1985 ' -------------------------------------------------
1988 FOR I=1 TO NF
1989 IF KX=0 THEN VX(I)=A(I,J)
1990 IF KX=1 THEN VX(I)=XVF : VY(I)=XVF
1991 NEXT I
1995 FOR I=II TO IJ
2000 IF I>NXX-L+1 THEN 2035
2005 XX=0
2010 FOR M=0 TO L-1
2015 IF A(I+M,J)=XVF THEN 2025
2020 XX=XX+A(I+M,J)*VY(M+1)
2025 NEXT M
2030 VX(I+LM)=XX/SF
2035 NEXT I
2040 IF KL=1 OR KX=0 THEN RETURN
2045 FOR I=LM+1 TO NF-LM
2050 VX(I)=(VX(I)+VX(I+1))/2
2055 NEXT I
2056 VX(NF-LM+1)=XVF
2057 RETURN
2058 '
2060 ' EST817 - Suavizamiento mediante Medianas Moviles
2061 ' ------------------------------------------------
2062 FOR I=1 TO NF : VX(I)=A(I,J) : NEXT I
2063 FOR I=II TO IJ
2064 IF I>NXX-L+1 THEN 2077
2065 FOR M=1 TO L : VY(M)=A(I+M-1,J) : NEXT M
2066 KA=1
2068 WHILE KA=1
2069 KA=0
2070 FOR M=2 TO L
2071 X=VY(M-1) : IF VY(M)<X THEN VY(M-1)=VY(M) : VY(M)=X : KA=1
2072 NEXT M
2073 WEND
2074 IF KL=1 THEN X=VY(LM+1)
2075 IF KL=0 THEN X=(VY(LM)+VY(LM+1))/2
2076 VX(I+LN)=X
2077 NEXT I
2078 RETURN
2079 '
2080 ' EST82 - Modelos de Ajuste
2082 ' -------------------------
2085 WHILE KW=0
2090 TSP$="Modelos de Ajuste"
2095 GOSUB 555
2100 PRINT "MODELOS"
2105 TF$(1)="Promedios Moviles"
2110 TF$(2)="Ajuste Exponencial"
2115 TF$(3)="Ajuste Exponencial Adaptativo"
2120 TF$(4)="Ajuste Exponencial con Tendencia"
2125 TF$(5)="Ajuste Expon. con Tendencia y Estacionalidad"
2130 KL=5 : GOSUB 980
2135 IF ISP=0 THEN RETURN
2140 IKP=ISP
2143 C$=TF$(IKP)
2145 J=JX(1)
2150 GOSUB 555
2155 PRINT "MODELO = ";C$
2160 IPR=1 : C(1)=0
2165 ON IKP GOSUB 2485,2580,2660,2760,2895
2167 IF C(1)=0 THEN 2090
2170 FOR M=1 TO 2
2172 A$="VALORES ESTIMADOS DE Y" : IF M=2 THEN A$="RESIDUOS" : KVA=1
2173 PRINT : PRINT
2175 PRINT "ALMACENAMIENTO DE ";A$;" EN MEMORIA DE TRABAJO"
2185 GOSUB 390 : CY(M)=J
2190 NEXT M
2197 J=JX(1)
2200 KS=1
2205 WHILE KS=1
2210 GOSUB 555
2215 PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
2220 PRINT#3,"MODELO = ";C$
2225 IF NP=0 THEN 2245
2230 FOR K=1 TO NP
2235 PRINT#3," Parametro";K;" = ";C(K)
2240 NEXT K
2245 PRINT#3,
2250 IPR=2
2255 SER=0 : SEA=0
2260 KX=0
2265 FOR I=II TO IJ
2270 WHILE KX=0
2275 PRINT#3,"Per.";TAB(6);"Valor x";TAB(16);"Estimac.";TAB(26);
"Resid.";
2280 IF NVA=0 THEN 2290
2285 FOR M=1 TO NVA : PRINT#3,TAB(27+10*M);TVA$(M); : NEXT M
2290 PRINT#3,
2295 KA=1 : KB=40+NVA*10 : GOSUB 695
2300 IL=6 : KX=1
2305 WEND
2310 X=A(I,J)
2315 IF I<IE THEN PRINT#3,I;TAB(6);X;TAB(16);" *";TAB(26);" *";: IF I=IE-1 THEN
2355 ELSE PRINT#3, : GOTO 2370
2320 ON IKP GOSUB 2485,2580,2660,2760,2895
2325 ER=X-XES
2330 SER=SER+ER*ER
2335 IF X>0 THEN SEA=SEA+ABS(ER/X)
2340 IF CY(1)>0 THEN A(I,CY(1))=XES
2345 IF CY(2)>0 THEN A(I,CY(2))=ER
2350 PRINT#3,I;TAB(6);X;TAB(16);FNR(XES,NDE);TAB(26);FNR(ER,NDE);
2355 IF NVA=0 THEN 2365
2360 FOR M=1 TO NVA : PRINT#3,TAB(26+10*M);FNR(XVA(M),NDE); : NEXT M
2365 PRINT#3,
2370 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$ :
CLS : KX=0
2375 NEXT I
2380 PRINT#3,
2385 PRINT#3,"Error Cuadratico Medio = ";FNR(SER/(NXX-IE+1),NDE)
2390 PRINT#3,"Error Porcentual Medio = ";FNR(100*SEA/(NXX-IE+1),NDE)
2395 GOSUB 650
2400 WEND
2405 NXF=NF
2410 NXX=NX
2415 KZ=0
2420 WHILE KZ=0
2425 GOSUB 555
2430 PRINT "PROCESOS COMPLEMENTARIOS"
2435 TF$(1)="Prediccion"
2440 TF$(2)="Graficacion"
2445 KL=2 : GOSUB 980
2450 IF ISP>0 THEN 2465
2455 'FOR I=NXX+1 TO nFM : A(I,J)=0 : A(I,CY(1))=0 : NEXT I : NX=NXX:NF=NXF
2460 KZ=1 : GOTO 2470
2465 ON ISP GOSUB 3150,5200
2470 WEND
2475 WEND
2480 '
2485 ' EST821 - Promedios Moviles
2490 ' --------------------------
2495 WHILE IPR=1
2500 PRINT : INPUT "Nro. de Periodos para Promedio = ",A$
2505 IF LEN(A$)=0 THEN RETURN
2510 L=VAL(A$)
2515 IF L<2 OR L>NXX OR L>24 THEN KE=5 : B$=">=2, <=24 o <="+STR$(NXX) :
GOSUB 900 : GOTO 2500
2520 C(1)=L : NP=1 :IE=C(1)+1 : NVA=0
2525 RETURN
2530 WEND
2535 WHILE IPR=2
2540 XES=0
2545 FOR K=I-C(1) TO I-1
2550 XES=XES+A(K,J)
2555 NEXT K
2560 XES=XES/C(1)
2565 RETURN
2570 WEND
2575 '
2580 ' EST822 - Ajuste Exponencial
2585 ' ---------------------------
2590 WHILE IPR=1
2595 PRINT : INPUT "Parametro Alfa = ",A$
2600 IF LEN(A$)=0 THEN RETURN
2605 X=VAL(A$)
2610 IF X<=0 OR X>=1 THEN KE=5 : B$=">0 y <1" : GOSUB 900 : GOTO 2595
2615 C(1)=X : NP=1 : IE=2 : NVA=0
2620 XES=A(1,J)
2625 RETURN
2630 WEND
2635 WHILE IPR=2
2640 XES=C(1)*A(I-1,J)+(1-C(1))*XES
2645 RETURN
2650 WEND
2655 '
2660 ' EST823 - Ajuste Expon. Adaptativo
2665 ' ---------------------------------
2670 WHILE IPR=1
2675 NP=0 : IE=3 : C(1)=1
2680 AL=.2 : BE=.2
2685 XE=0 : XM=0 : XES=A(1,J)
2690 NVA=3 : TVA$(1)="XE" : TVA$(2)="XM" : TVA$(3)="ALFA"
2695 XVA(1)=XE : XVA(2)=XM : XVA(3)=AL
2700 RETURN
2705 WEND
2710 WHILE IPR=2
2715 ER=A(I-1,J)-XES
2720 XES=AL*A(I-1,J)+(1-AL)*XES
2725 XE=BE*ER+(1-BE)*XE
2730 XM=BE*ABS(ER)+(1-BE)*XM
2735 IF I>4 THEN AL=ABS(XE/XM)
2740 XVA(1)=XE : XVA(2)=XM : XVA(3)=AL
2745 RETURN
2750 WEND
2755 '
2760 ' EST824 - Ajuste Expon. con Tendencia
2765 ' ------------------------------------
2770 WHILE IPR=1
2775 PRINT : INPUT "Parametro Alfa = ",A$
2780 IF LEN(A$)=0 THEN RETURN
2785 X=VAL(A$)
2790 IF X<=0 OR X>=1 THEN KE=5 : B$=">0 y <1" : GOSUB 900 : GOTO 2775
2795 C(1)=X : NP=1 : IE=3
2800 SA=C(1)*A(2,J)+(1-C(1))*A(1,J)
2805 SB=C(1)*SA+(1-C(1))*A(1,J)
2810 AA=2*SA-SB
2815 BB=(C(1)/(1-C(1)))*(SA-SB)
2820 NVA=4 : TVA$(1)="S't" : TVA$(2)="St" : TVA$(3)="At" : TVA$(4)="Bt"
2825 XVA(1)=SA : XVA(2)=SB : XVA(3)=AA : XVA(4)=BB
2830 RETURN
2835 WEND
2840 WHILE IPR=2
2845 XES=AA+BB
2850 IF KES=0 THEN X=A(I,J) ELSE X=XES
2855 SA=C(1)*X+(1-C(1))*SA
2860 SB=C(1)*SA+(1-C(1))*SB
2865 AA=2*SA-SB
2870 BB=(C(1)/(1-C(1)))*(SA-SB)
2875 XVA(1)=SA : XVA(2)=SB : XVA(3)=AA : XVA(4)=BB
2880 RETURN
2885 WEND
2890 '
2895 ' EST825 - Ajuste Exponencial con Tendencia y Estacionalidad
2900 ' ----------------------------------------------------------
2905 WHILE IPR=1
2907 PRINT
2910 TF$(1)="Alfa" : TF$(2)="Beta" : TF$(3)="Gama"
2913 FOR M=1 TO 3
2915 PRINT " Parametro ";TF$(M); : INPUT " = ",A$
2920 X=VAL(A$)
2925 IF X<=0 OR X>=1 THEN KE=5 : B$=">0 y <1" : GOSUB 900 : GOTO 2915
2930 C(M)=X
2935 NEXT M
2975 INPUT " Nro.de Periodos de Estacionalidad = ",A$
2980 L=VAL(A$)
2985 IF L<2 OR L>NXX OR L>24 THEN KE=5 : B$=">=2, <=24 o <="+STR$(NXX) :
GOSUB 900 : GOTO 2975
2990 C(4)=L
2995 NP=4 : IE=C(4)+2
3000 SX=0
3005 FOR I=II TO II+C(4)-1
3010 SX=SX+A(I,J)
3015 NEXT I
3020 SA=SX/C(4)
3025 FOR I=II TO II+C(4)-1
3030 VX(I)=A(I,J)/SA
3035 NEXT I
3040 SB=0
3045 X=C(1)*A(C(4)+1,J)/VX(1)+(1-C(1))*(SA+SB)
3050 SB=C(3)*(X-SA)+(1-C(3))*SB
3055 SA=X
3060 VX(1)=C(2)*A(C(4)+1,J)/SA+(1-C(2))*VX(1)
3065 NVA=3 : TVA$(1)="St" : TVA$(2)="Bt" : TVA$(3)="It"
3070 XVA(1)=SA : XVA(2)=SB : XVA(3)=VX(IX)
3075 RETURN
3080 WEND
3085 WHILE IPR=2
3090 XX=I/C(4)
3095 IX=C(4)*(XX-INT(XX))
3100 IF IX=0 THEN IX=C(4)
3105 XES=(SA+SB)*VX(IX)
3110 XX=C(1)*A(I-1,J)/VX(IX)+(1-C(1))*(SA+SB)
3115 SB=C(3)*(XX-SA)+(1-C(3))*SB
3120 SA=XX
3125 VX(IX)=C(2)*A(I-1,J)/SA+(1-C(2))*VX(IX)
3130 XVA(1)=SA : XVA(2)=SB : XVA(3)=VX(IX)
3135 RETURN
3140 WEND
3145 '
3150 ' EST826 - Prediccion
3155 ' --------------------
3160 'FOR I=NXX+1 TO nFM : A(I,J)=0 : A(I,CY(1))=0 : NEXT I : NX=NXX:NF=NXF
3165 PRINT : PRINT "Periodo final de los datos = ";IJ
3170 PRINT : INPUT "Nro. de Periodos a Predecir = ",A$
3175 IF LEN(A$)=0 THEN RETURN
3180 X=INT(VAL(A$))
3185 IF X<1 OR X>NFM-NF THEN KE=5 : B$=">=1 y <="+STR$(NFM-NF) :
GOSUB 900 : GOTO 3170
3190 NFI=IJ+1 : NFT=IJ+X
3195 IPR=2
3197 KS=1
3198 WHILE KS=1
3199 GOSUB 555
3200 PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
3202 PRINT#3,"MODELO = ";C$
3204 PRINT#3, : PRINT#3,"Periodo Prediccion"
3205 KA=1 : KB=20 : GOSUB 695
3210 FOR I=NFI TO NFT
3215 KES=1
3220 ON IKP GOSUB 2485,2580,2660,2760,2895
3225 KES=0
3230 PRINT#3,I,FNR(XES,NDE)
3235 A(I,J)=XES : A(I,CY(1))=XES : 'NX=I :NF=I
3240 NEXT I
3245 GOSUB 650
3247 WEND
3250 RETURN
3253 '
3255 ' EST83 - Modelos Autorregresivos
3260 ' --------------------------------
3265 TSP$="Modelos Autorregresivos A(p)"
3270 WHILE KW=0
3275 GOSUB 555
3280 INPUT "Longitud p modelo AR(p) = ",A$
3285 IF LEN(A$)=0 THEN RETURN
3290 IP=VAL(A$)
3295 IF IP<1 OR IP>5 THEN KE=5 : B$=">=1 y <=5" : GOSUB 900 : GOTO 3280
3300 LC=IP
3305 INPUT "Nro. de Ciclos de Iteracion (10) = ",A$
3310 IF LEN(A$)=0 THEN IC=10 ELSE IC=VAL(A$)
3315 IF IC<1 OR IC>200 THEN KE=5 : B$=">=1 y <=200" : GOSUB 900: GOTO 3305
3320 FOR M=1 TO 2
3325 A$="VALORES ESTIMADOS DE Y" : IF M=2 THEN A$="RESIDUOS" : KVA=1
3330 PRINT : PRINT
3335 PRINT "ALMACENAMIENTO DE ";A$;" EN MEMORIA DE TRABAJO"
3340 GOSUB 390 : CY(M)=J
3345 NEXT M
3347 J=JX(1)
3350 IK=.75
3355 PRINT : PRINT TAB(25);"EN PROCESO"
3360 GOSUB 1535
3365 GOSUB 1610
3367 IF KE=1 THEN RETURN
3370 FOR K=1 TO IP
3375 C(K)=TJ(K,IP+1)
3380 NEXT K
3385 J=JX(1)
3390 S1=1E+30
3395 FOR L=1 TO IC
3400 S=0
3405 SEA=0
3410 FOR I=II+IP TO IJ
3415 F=0 : H1=0
3420 FOR K=1 TO IP
3425 F=F+C(K)*A(I-K,J)
3430 H1=H1+A(I-K,J)^2
3435 NEXT K
3440 H1=SQR(H1)
3445 ER=A(I,J)-F
3450 FOR K=1 TO IP
3455 C(K)=C(K)+2*IK*(ER/H1)*A(I-K,J)/H1
3460 NEXT K
3465 S=S+ER^2
3470 IF A(I,J)>0 THEN SEA=SEA+ABS(ER/A(I,J))
3475 NEXT I
3480 IF S>S1 THEN FOR K=1 TO IP : C(K)=PX(K) : NEXT K : SER=S1 : GOTO 3505
3485 IF (S1-S)/S<.01 THEN SER=S : GOTO 3505
3490 S1=S
3495 FOR K=1 TO IP : PX(K)=C(K) : NEXT K
3500 NEXT L
3505 KS=1
3510 WHILE KS=1
3515 GOSUB 555
3516 PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
3517 PRINT#3,"MODELO = ";C$
3520 PRINT#3,"Nro. Parametros modelo AR(p) =";IP
3523 PRINT#3,
3525 PRINT#3,"Nro. Ciclos Iteracion =";IC
3529 PRINT#3,
3530 PRINT#3,"Valores Parametros " : PRINT#3,
3535 FOR K=1 TO IP
3540 PRINT#3," Parametro";K;"= ";C(K)
3545 NEXT K
3550 PRINT#3,
3555 PRINT#3,"Error Cuadratico Medio = ";FNR(SER/(NXX-IP-1),NDE)
3560 PRINT#3,"Error Porcentual Medio = ";FNR(100*SEA/(NXX-IP-1),NDE)
3565 GOSUB 650
3570 WEND
3575 KZ=0
3580 WHILE KZ=0
3585 GOSUB 555
3590 PRINT "PROCESOS COMPLEMENTARIOS"
3595 TF$(1)="Prediccion"
3600 TF$(2)="Graficacion"
3605 KL=2 : GOSUB 980
3610 IF ISP=0 THEN KZ=1 : GOTO 3625
3615 ON ISP GOSUB 3635,5200
3625 WEND
3630 WEND
3633 '
3635 ' EST831 - Prediccion
3640 ' -------------------
3645 PRINT : PRINT "Periodo final de los datos = ";IJ
3650 PRINT : INPUT "Nro. de Periodos a Predecir = ",A$
3655 IF LEN(A$)=0 THEN RETURN
3660 X=INT(VAL(A$))
3665 IF X<1 THEN KE=5 : B$=">=1" : GOSUB 900 : GOTO 3650
3670 NFI=IJ+1 : NFT=IJ+X
3675 IK=0 : KS=1
3680 WHILE KS=1
3681 GOSUB 555
3682 PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
3683 PRINT#3,"MODELO = ";C$
3690 PRINT#3, : PRINT#3,"Periodo Prediccion"
3695 KA=1 : KB=20 : GOSUB 695
3700 FOR I=NFI TO NFT
3705 IK=IK+1
3720 XES=0
3725 FOR K=1 TO IP
3730 IF I-K<=NXX THEN XX=A(I-K,J)
3733 IF I-K>NXX THEN XX=VX(I-NXX)
3735 XES=XES+C(K)*XX
3740 NEXT K
3753 VX(IK)=XES
3760 PRINT#3,I,FNR(XES,NDE)
3770 NEXT I
3775 GOSUB 650
3777 WEND
3780 RETURN
3785 '
3800 ' EST84 - Modelos de Descomposicion
3805 ' ---------------------------------
3810 TSP$="Modelos de Descomposicion"
3815 WHILE KW=0
3820 GOSUB 555
3825 PRINT "TIPO DE MODELO"
3830 TF$(1)="Multiplicativo"
3835 TF$(2)="Aditivo"
3840 KL=2 : GOSUB 980
3845 IF ISP=0 THEN RETURN
3850 KME=ISP
3855 B$=TF$(KME)
3860 PRINT : INPUT " Nro. de Periodos de Estacionalidad = ",A$
3865 IF LEN(A$)=0 THEN RETURN
3870 L=VAL(A$)
3875 IF L<2 OR L>NXX OR L>24 THEN KE=5 : B$=">=2, <=24 o <="+STR$(NXX) :
GOSUB 900 : GOTO 3860
3880 PRINT
3885 INPUT " Eliminacion de valores Extremos para Estacionalidad ? (N) = ",A$
3890 KVE=0 : IF A$="S" OR A$="s" THEN KVE=1
3895 '
3900 PRINT
3905 PRINT : PRINT "FUNCION DE TENDENCIA"
3910 TF$(1)="Ninguna"
3915 TF$(2)="Estacionaria x=a"
3920 TF$(3)="Lineal x=a+bt"
3925 TF$(4)="Potencial x=at^b"
3930 TF$(5)="Exponencial x=ab^t"
3935 TF$(6)="Logistica x=exp(a+b/t)"
3940 KL=6 : GOSUB 980
3945 IF ISP=0 THEN RETURN
3950 IFT=ISP
3955 C$=TF$(IFT)
3965 TF$(1)="TENDENCIA" : TF$(2)="FUNCION DE TENDENCIA"
3970 TF$(3)="ESTACIONALIDAD" : TF$(4)="ALEATORIEDAD"
3972 TF$(5)="VALORES ESTIMADOS DE Y"
3975 FOR M=1 TO 5
3983 PRINT : PRINT
3985 PRINT "ALMACENAMIENTO DE ";TF$(M);" EN MEMORIA DE TRABAJO"
3987 IF M>1 THEN KVA=1
3990 GOSUB 390 : CY(M)=J
3995 NEXT M
4000 '
4005 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
4010 LM=INT(L/2)
4015 KL=0 : IF (L/2-LM)>0 THEN KL=1
4020 J=JX(1)
4021 FOR M=1 TO L : VY(M)=1 : NEXT M
4022 SF=L : KX=1
4025 GOSUB 1980
4030 '
4035 KE=0
4040 SX=0 : SY=0 : SXX=0 : SXY=0
4045 IF IFT=1 THEN AA=0 : BB=0 : GOTO 4145
4050 FOR I=II TO IJ
4055 Y=VX(I) : X=I
4060 IF Y=XVF THEN 4105
4065 IF IFT<4 THEN 4095
4070 IF Y<=0 THEN KE=1 : GOTO 4105
4075 Y=LOG(Y)
4080 IF IFT=4 THEN X=LOG(X)
4085 IF IFT=6 THEN X=1/X
4095 SX=SX+X : SY=SY+Y
4100 SXX=SXX+X*X : SXY=SXY+X*Y
4105 NEXT I
4110 IF KE=1 THEN PRINT CHR$(7) : PRINT : INPUT "** VALORES DE X<=0",A$ : GOTO 3900
4115 BB=(NXX*SXY-SX*SY)/(NXX*SXX-SX*SX)
4120 IF IFT=2 THEN BB=0
4125 AA=SY/NXX-BB*SX/NXX
4130 IF IFT=4 OR IFT=5 THEN AA=EXP(AA)
4135 IF IFT=5 THEN BB=EXP(BB)
4140 '
4145 FOR I=II TO IJ
4150 IF VX(I)=0 OR VX(I)=XVF THEN 4165
4155 IF KME=1 THEN VY(I)=A(I,J)/VX(I)
4160 IF KME=2 THEN VY(I)=A(I,J)-VX(I)
4165 NEXT I
4170 '
4175 FOR K=1 TO L
4180 N=K : NY=0
4185 XX=0 : XMI=1E+10 : XMA=-1E+10
4190 X=VY(N)
4195 IF X=XVF THEN 4220
4200 IF X<XMI THEN XMI=X
4205 IF X>XMA THEN XMA=X
4210 NY=NY+1
4215 XX=XX+X
4220 N=N+L
4225 IF N<=NF THEN 4190
4230 IF NY>=3 AND KVE=1 THEN XX=XX-XMI-XMA : NY=NY-2
4235 VW(K)=XX/NY
4240 NEXT K
4245 KS=1
4250 WHILE KS=1
4255 GOSUB 555
4260 PRINT#3, : PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
4265 PRINT#3," MODELO = ";B$
4270 PRINT#3," Periodo de Estacionalidad =";L
4275 PRINT#3," Funcion de tendencia = ";C$
4280 PRINT#3," Valores extremos eliminados para Estacionalidad =";KVE
4285 PRINT#3, : PRINT#3,
4290 SER=0 : SEA=0
4295 KX=0
4300 FOR I=II TO IJ
4305 WHILE KX=0
4310 PRINT#3,"Periodo";TAB(10);"Valor x";TAB(19);"Tendencia";TAB(28);
4315 PRINT#3,"Func.Tend.";TAB(40);"Dif.Tend.";TAB(52);"Estacionalidad";
4320 PRINT#3,TAB(60);"Aleatoriedad";TAB(70);"Estimacion"
4325 KA=1 : KB=79 : GOSUB 695
4330 IL=6 : KX=1
4335 WEND
4340 Y=A(I,J)
4345 IF Y=XVF THEN 4435
4350 X=I : GOSUB 4550
4360 KL=I-L*INT(I/L) : IF KL=0 THEN KL=L
4365 IF KME=1 THEN XES=XTE*VW(KL) : XDT=VX(I)/XTE
4370 IF KME=2 THEN XES=XTE+VW(KL) : XDT=VX(I)-XTE
4375 IF VX(I)<>XVF THEN ER=Y-XES : SER=SER+ER*ER
4380 IF Y>0 THEN SEA=SEA+ABS(ER/Y)
4385 IF CY(1)>0 THEN A(I,CY(1))=VX(I)
4390 IF CY(2)>0 THEN A(I,CY(2))=XTE
4395 IF CY(3)>0 THEN A(I,CY(3))=VW(KL)
4400 IF CY(4)>0 THEN A(I,CY(4))=ER
4405 IF CY(5)>0 THEN A(I,CY(5))=XES
4410 IF VX(I)=XVF THEN PRINT#3,TAB(3);I;TAB(10);Y;TAB(20);"*";TAB(32);"*";
TAB(42);"*";TAB(54);"*";TAB(62);"*";TAB(73);"*"
4415 IF VX(I)<>XVF THEN PRINT#3,TAB(3);I;TAB(10);Y;TAB(18);
4420 IF VX(I)<>XVF THEN PRINT#3,FNR(VX(I),NDE-1);TAB(28);FNR(XTE,NDE-1);
TAB(40);FNR(XDT,NDE-1);TAB(52);FNR(VW(KL),NDE-1);
4425 IF VX(I)<>XVF THEN PRINT#3,TAB(60);FNR(ER,NDE-1);TAB(70);
FNR(XES,NDE-1)
4430 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$ :
CLS : KX=0
4435 NEXT I
4440 PRINT#3,
4445 PRINT#3,"Error Cuadratico Medio = ";FNR(SER/NXX,NDE)
4450 PRINT#3,"Error Porcentual Medio = ";FNR(100*SEA/NXX,NDE)
4455 GOSUB 650
4460 WEND
4465 '
4480 KZ=0
4485 WHILE KZ=0
4490 GOSUB 555
4495 PRINT "PROCESOS COMPLEMENTARIOS"
4500 TF$(1)="Prediccion"
4505 TF$(2)="Graficacion"
4510 KL=2 : GOSUB 980
4515 IF ISP>0 THEN 4530
4520 'FOR I=NXX+1 TO FM : A(I,J)=0 : A(I,CY(1))=0 : NEXT I : NX=NXX:NF=NXF
4525 KZ=1 : GOTO 4535
4530 ON ISP GOSUB 4600,5200
4535 WEND
4540 WEND
4545 '
4550 ' EST841 - Calculo Funcion de Tendencia
4555 ' -------------------------------------
4560 IF IFT=1 THEN XTE=VX(X)
4565 IF IFT=2 THEN XTE=AA
4570 IF IFT=3 THEN XTE=AA+BB*X
4575 IF IFT=4 THEN XTE=AA*X^BB
4580 IF IFT=5 THEN XTE=AA*BB^X
4585 IF IFT=6 THEN XTE=EXP(AA+BB/X)
4590 RETURN
4595 '
4600 ' EST842 - Prediccion
4605 ' -------------------
4610 'FOR I=NXX+1 TO FM : A(I,J)=0 : A(I,CY(1))=0 : NEXT I : NX=NXX:NF=NXF
4615 PRINT : PRINT "Periodo final de los datos = ";IJ
4620 PRINT : INPUT "Nro. de Periodos a Predecir = ",A$
4625 IF LEN(A$)=0 THEN RETURN
4630 X=INT(VAL(A$))
4635 IF X<1 THEN KE=5 : B$=">=1" : GOSUB 900 : GOTO 4620
4640 NFI=IJ+1 : NFT=IJ+X
4641 KS=1
4642 WHILE KS=1
4643 GOSUB 555
4644 PRINT#3,"VARIABLE = ";J;"- ";TC$(J) : PRINT#3,
4645 PRINT#3, : PRINT#3,"Periodo Tendencia Estacionalidad x Estimado"
4650 KA=1 : KB=50 : GOSUB 695
4655 FOR I=NFI TO NFT
4660 X=I
4665 GOSUB 4550
4670 KL=I-L*INT(I/L) : IF KL=0 THEN KL=L
4675 IF KME=1 THEN XES=XTE*VW(KL)
4680 IF KME=2 THEN XES=XTE+VW(KL)
4685 PRINT#3,TAB(3);I;TAB(10);FNR(XTE,NDE);TAB(24);FNR(VW(KL),NDE);TAB(38);
FNR(XES,NDE)
4690 A(I,J)=XES : A(I,CY(1))=XES : 'NX=I :NF=I
4695 NEXT I
4700 GOSUB 650
4703 WEND
4705 RETURN
5200 ' EST24 - Graficacion
5205 ' -------------------
5210 TSP$="Graficacion"
5215 WHILE KW=0
5220 GOSUB 555
5225 TF$(1)="Graficacion Normal"
5230 TF$(2)="Graficacion Codificada"
5235 KL=2 : GOSUB 980
5240 IF ISP=0 THEN RETURN
5245 KM=3 : IF ISP=2 THEN KM=1
5250 GOSUB 500
5255 PRINT
5260 FOR Y=1 TO 2
5265 IF Y>1 THEN 5305
5270 INPUT "Variable Independiente = ",A$
5275 IF LEN(A$)=0 THEN RETURN
5280 IF (A$="I" OR A$="i") THEN TG$(0)="Nro.Obs" : XMN(1)=0
- XMX(1)=INT(NF/5+1)*5:DEL(1)=XMX(1)/5:GOTO 5460
5285 KX=VAL(A$)
5290 J=KX : GOSUB 5480
5295 XC=XMI : XD=XMA
5300 TG$(0)=TC$(KX) : GOTO 5380
5305 XC=1E+10 : XD=-1E+10
5310 PRINT
5315 FOR Z=1 TO KM
5320 PRINT "Variable Dependiente";Z;
5325 INPUT " = ",A$
5330 IF LEN(A$)=0 THEN NG=Z-1 : Z=KM : GOTO 5365
5335 NG=Z
5340 JY(Z)=VAL(A$)
5345 J=JY(Z) : GOSUB 5480
5350 IF XMI<XC THEN XC=XMI
5355 IF XMA>XD THEN XD=XMA
5360 TG$(Z)=TC$(JY(Z))
5365 NEXT Z
5370 IF NG=0 THEN RETURN
5375 PRINT
5380 PRINT "(Valores Maximo y Minimo de los Datos = ";XC;"-";XD;")"
5385 INPUT " Valor Minimo = ",A$
5390 IF LEN(A$)=0 THEN RETURN
5395 XMN(Y)=VAL(A$)
5400 INPUT " Valor Maximo = ",A$
5405 IF LEN(A$)=0 THEN RETURN
5410 XMX(Y)=VAL(A$)
5415 INPUT " Intervalo = ",A$
5420 IF LEN(A$)=0 THEN RETURN
5425 DEL(Y)=VAL(A$)
5430 IF ISP=1 THEN GOTO 5460
5435 IF Y=1 THEN 5460
5440 PRINT : INPUT "Variable con Valores codificados (No) = ",A$
5445 IF LEN(A$)=0 THEN ISP=1 : GOTO 5460
5450 IF A$="I" OR A$="i" THEN JV=0 : GOTO 5460
5455 JV=VAL(A$)
5460 NEXT Y
5463 NPG=NF
5465 KA=0
5470 IF NG>0 THEN GOSUB 6745
5475 WEND
5477 '
5480 ' EST211 - Calculo de Valor medio, Desv.Std.,Max.,Min.
5485 ' ----------------------------------------------------
5490 SX=0 : SCX=0 : NXX=0
5495 XMI=1E+10 : XMA=-1E+10
5500 FOR I=1 TO NF
5505 IF A(I,0)=1 THEN 5550
5510 X= A(I,J)
5515 IF X=XVF THEN 5550
5520 IF X<XMI THEN XMI=X
5525 IF X>XMA THEN XMA=X
5530 ND=1 : IF JF>0 THEN ND=A(I,JF)
5535 IF ND=XVF THEN 5550
5540 SX=SX+ND*X : SCX=SCX+ND*X^2
5545 NXX=NXX+ND
5550 NEXT I
5555 IF NXX<2 THEN RETURN
5560 PX=SX/NXX
5565 DEM=SQR((SCX-NXX*PX^2)/NXX)
5570 DEX=SQR((SCX-NXX*PX^2)/(NXX-1))
5575 RETURN
5580 '
5825 ' EST214 - Calculo de Matriz de Covariancias
5830 ' ------------------------------------------
5835 FOR K=1 TO NV
5840 PM(K)=0
5845 FOR L=1 TO K : TI(K,L)=0 :NEXT L
5850 NEXT K
5855 NXX=0
5860 FOR I=1 TO NF
5865 IF A(I,0)=1 THEN 5945
5870 ND=1 : IF JF>0 THEN ND=A(I,JF)
5875 IF ND=XVF THEN 5945
5880 KE=0
5885 FOR K=1 TO NV
5890 XP(K)=A(I,JX(K))
5895 IF XP(K)=XVF THEN KE=1 : K=NV
5900 NEXT K
5905 IF KE=1 THEN 5945
5910 FOR K=1 TO NV
5915 PM(K)=PM(K)+XP(K)*ND
5920 FOR L=1 TO K
5925 TI(K,L)=TI(K,L)+XP(K)*XP(L)*ND
5930 NEXT L
5935 NEXT K
5940 NXX=NXX+ND
5945 NEXT I
5950 IF NXX<2 THEN RETURN
5955 FOR K=1 TO NV
5960 VX(K)=PM(K)
5965 PM(K)=PM(K)/NXX
5970 DE(K)=SQR((TI(K,K)-NXX*PM(K)^2)/(NXX-1))
5975 FOR L=1 TO K
5980 TI(K,L)=(TI(K,L)-NXX*PM(K)*PM(L))/(NXX-1)
5985 TI(L,K)=TI(K,L)
5990 NEXT L,K
5995 RETURN
6000 '
6743 '
6745 ' EST241 - Proceso de Graficacion
6750 ' -------------------------------
6755 DEF FNC(X)=60*(X-XMN(1))/(XMX(1)-XMN(1))
6760 DEF FNF(X)=20*(X-XMN(2))/(XMX(2)-XMN(2))
6765 CLS
6770 X=21-FNF(0) : KC=0
6775 IF X>0 AND X<21 THEN KC=1
6780 FOR I=1 TO 60
6785 IF KC=1 THEN LOCATE X,I+20 : PRINT "."
6790 LOCATE 1,I+20 : PRINT "-"
6795 LOCATE 21,I+20 : PRINT "-"
6800 NEXT I
6805 FOR X=XMN(1) TO XMX(1) STEP DEL(1)
6810 XC=FNC(X)
6815 LOCATE 1,XC+20 : PRINT "+"
6820 LOCATE 21,XC+20 : PRINT "+"
6825 IF X<XMX(1) THEN LOCATE 22,XC+18 : PRINT FNR(X,2)
6830 NEXT X
6835 LOCATE 23,70 : PRINT TG$(0)
6840 X=FNC(0)+20 : KC=0
6845 IF X>20 AND X<80 THEN KC=1
6850 FOR I=1 TO 20
6855 IF KC=1 THEN LOCATE I,X : PRINT "."
6860 LOCATE I,20 : PRINT CHR$(124)
6865 LOCATE I,80 : PRINT CHR$(124)
6870 NEXT I
6875 FOR X=XMN(2) TO XMX(2) STEP DEL(2)
6880 XF=21-FNF(X)
6885 LOCATE XF,20 : PRINT "+"
6890 LOCATE XF,80 : PRINT "+"
6895 LOCATE XF,13 : PRINT FNR(X,2)
6900 NEXT X
6905 TF$(1)="*" : TF$(2)=CHR$( 22) : TF$(3)="x"
6910 IF ISP=2 THEN C$="ABCDEFGHIJKLMNOPQRTSUVWXYZ"
6915 FOR J=1 TO NG
6920 LOCATE 3+3*J,1 : IF ISP=1 THEN PRINT TF$(J)
6925 PRINT TG$(J)
6930 NEXT J
6935 IF ISP=2 THEN PRINT : PRINT : PRINT "Var.Codif=" : PRINT JV;" - ";TC$(JV)
6940 NXX=0
6945 FOR I=1 TO NPG
6950 IF KA=0 THEN IF A(I,0)=1 THEN 7105
6955 IF KX=0 THEN X=I : GOTO 6975
6960 IF KA=0 THEN X=A(I,KX)
6965 IF KA=0 AND X=XVF THEN 7105
6970 IF KA=1 THEN X=TI(I,0)
6975 XC=FNC(X)+20
6980 IF XC<20 OR XC>80 THEN 7100
6985 FOR J=1 TO NG
6990 IF KA=0 THEN Y=A(I,JY(J))
6995 IF KA=0 AND Y=XVF THEN 7105
7000 IF KA=1 THEN Y=TI(I,JY(J))
7005 YF=21-FNF(Y)
7010 IF YF<1 OR YF>21 THEN 7090
7015 FOR XF=YF TO 21
7020 LOCATE XF,XC
7025 A$=TF$(J)
7030 IF ISP=1 THEN 7075
7035 IF JV>0 THEN X=A(I,JV)
7040 IF JV>0 AND X=XVF THEN XF=21 : GOTO 7085
7045 IF JV>0 THEN X=INT(X)
7050 IF JV=0 THEN X=I
7055 IF X<0 THEN A$="-"
7060 IF X>=0 AND X<10 THEN A$=STR$(X)
7065 IF X>=10 AND X<35 THEN A$=MID$(C$,X-9,1)
7070 IF X>35 THEN A$="+"
7075 PRINT A$
7080 IF KB(J)=0 THEN XF=21
7085 NEXT XF
7090 NEXT J
7095 NXX=NXX+1
7100 LOCATE 23,1
7105 NEXT I
7110 LOCATE 24 : INPUT "Enter ",A$
7115 RETURN
7710 ' EST320 - Calculo del valor x para F(x)
7715 '
7725 IP=1 : GOSUB 8060
7730 IF KDI=0 THEN X=XMU : DI=SIG
7732 IF KDI=1 THEN X=INT(XMU) : DI=INT(SIG+1)
7735 GOSUB 8060 : FP=FP-FPX
7740 IF ABS(FP)<=.0001 THEN RETURN
7745 IF FP>0 THEN DI=-DI
7750 MX=0
7755 WHILE MX=0
7760 XY=X : FPY=FP : X=X+DI
7765 GOSUB 8060 : FP=FP-FPX
7770 IF ABS(FP)<=.0001 THEN RETURN
7775 IF DI<0 AND FP<0 THEN XD=X : XE=XY : FPD=FP : FPE=FPY : MX=1
7780 IF DI>0 AND FP>0 THEN XD=XY : XE=X : FPD=FPY : FPE=FP : MX=1
7785 WEND
7787 WHILE KDI=0
7790 WHILE ABS(FPY)>.0001
7795 X=XD-FPD*(XE-XD)/(FPE-FPD)
7805 GOSUB 8060 : FPY=FP-FPX
7810 IF FPY>0 THEN XE=X : FPE=FPY
7815 IF FPY<0 THEN XD=X : FPD=FPY
7820 WEND
7825 RETURN
7830 WEND
7835 WHILE KDI=1
7895 FOR M=XD+1 TO XE
7900 X=M : GOSUB 8060 : FPD=FPD+FD
7905 IF FPD>=0 THEN M=XE
7910 NEXT M
7915 RETURN
7920 WEND
8060 ' EST300 - Llamada a Rutinas Distribuciones
8064 '
8068 ON TF GOSUB 8080,8140,8220,8280,8464,8636,9125,8800,8932,9068,9152,
9252,9360,9568,9680
8072 RETURN
8125 ' EST302 - Distribucion Normal
8130 '
8135 XMU=P(1) : SIG=P(2)
8140 ON IP GOTO 8150,8205,8225
8145 '
8150 U=(X-XMU)/SIG
8155 MXA=0 : IF U<0 THEN U=-U : MXA=1
8160 FD=.39894228#*EXP(-U*U/2)
8165 CA=1/(1+.2316419*U)
8170 FP=FD*CA*(.3193815+CA*(-.3565638+CA*(1.781478+CA*(-1.821256+1.330274*CA))))
8175 IF MXA=0 THEN FP=1-FP
8180 IF FP>1 THEN FP=1
8185 IF FP<0 THEN FP=0
8190 FD=FD/SIG
8195 RETURN
8200 '
8205 IF KSA(1)=1 THEN P(1)=PX
8210 IF KSA(2)=1 THEN P(2)=DEX
8215 RETURN
8220 '
8225 X=SIG*SQR(-2*LOG(RND))*COS(6.283185*RND)+XMU
8230 RETURN
8235 WEND
8970 ' EST306 - Dist.Chi^2
8975 '
8980 K=P(1)
8985 ON IP GOTO 8995,9070,9090
8990 '
8995 XMU=K : SIG=SQR(2*K)
9000 IF X=0 AND K=1 THEN FD=1E+30 : FP=0 : RETURN
9005 IF X=0 AND K=2 THEN FD=.5 : FP=0 : RETURN
9010 IF X<=0 THEN FD=0 : FP=0 : RETURN
9015 XA=X
9020 X=(X/K)^(1/3)
9025 P(1)=1-2/9/K
9030 P(2)=SQR(2/9/K)
9035 GOSUB 8125
9040 XN=(K/2-1) : GOSUB 10655
9045 FD=EXP((K/2-1)*LOG(X)-X/2-.3465735*K-FA)
9050 X=XA : P(1)=K
9055 XMU=K : SIG=SQR(2*K)
9060 RETURN
9065 '
9070 IF KSA(1)=1 THEN P(1)=INT(PX+.5)
9075 IF P(1)<1 THEN P(1)=1
9080 RETURN
9085 '
9090 P(1)=1-2/9/K
9095 P(2)=SQR(2/9/K)
9100 GOSUB 8125
9105 X=(K*X)^3
9110 P(1)=K
9115 RETURN
9120 '
9125 ' EST307 - Distribucion t
9130 '
9135 K=P(1)
9140 ON IP GOTO 9150,9270,9290
9145 '
9150 WHILE K>0 AND K<250
9155 XN=(K-1)/2 : GOSUB 10655 : FD=FA
9160 XN=(K-2)/2 : GOSUB 10655 : FD=FD-FA
9165 FDZ=EXP(FD-.5*LOG(3.14159265#*K)-.5*(K+1)*LOG(1+X*X/K))
9170 'IF X=0 THEN FP=.5 : FD=FDZ : RETURN
9175 XA=X : Y=X*X
9180 XKA=SQR((2/9/K)*Y^(2/3)+2/9)
9185 U=((1-2/9/K)*(Y^(1/3))-7/9)/XKA
9190 X=U : P(1)=0 : P(2)=1 : GOSUB 8125
9195 X=XA : P(1)=K
9200 FP=.5+.5*FP
9205 IF X<0 THEN FP=1-FP
9210 FD=FDZ
9215 K=0
9220 WEND
9225 WHILE K>=250
9230 P(1)=0 : P(2)=1 : GOSUB 8125
9235 P(1)=K : K=0
9240 WEND
9245 K=P(1)
9250 XMU=0
9255 SIG=0 : IF K>2 THEN SIG=SQR(K/(K-2))
9260 RETURN
9265 '
9270 IF KSA(1)=1 THEN P(1)=INT(2*DEX^2/(DEX^2-1)+.5)
9275 IF KSA(1)=1 AND P(1)<3 THEN P(1)=3
9280 RETURN
9285 '
9290 P(1)=0 : P(2)=1 : GOSUB 8125
9295 U=X
9300 P(1)=K
9305 GOSUB 8970
9310 X=U/SQR(X/K)
9315 RETURN
10655 ' EST320 - Calculo de Log(Factorial)
10660 '
10665 WHILE XN>=-.5 AND XN<=4 AND INT(2*XN)=2*XN
10670 IF XN=-.5 THEN FA=.57236494#
10675 IF XN=0 THEN FA=0
10680 IF XN=.5 THEN FA=-.12078224#
10685 IF XN=1 THEN FA=0
10690 IF XN=1.5 THEN FA=.28468287#
10695 IF XN=2 THEN FA=.693147181#
10700 IF XN=2.5 THEN FA=1.2009736#
10705 IF XN=3 THEN FA=1.79175947#
10710 IF XN=3.5 THEN FA=2.45373657#
10715 IF XN=4 THEN FA=3.17805383#
10720 RETURN
10725 WEND
10730 Y=1/(XN*XN)
10735 Y=(XN+.5)*LOG(XN)-XN*(1-Y*(1/12-Y*(1/360-Y*(1/1260-Y/1680))))
10740 FA=Y+.91893853#
10745 RETURN
11000 ' EST611 - Resolucion de Ecuaciones Lineales
11005 ' ------------------------------------------
11010 FOR IP=KI TO N
11015 FOR JP=KI TO N
11020 IF IP<>JP THEN TK(IP,JP)=0 ELSE TK(IP,JP)=1
11025 NEXT JP,IP
11030 FOR IP=KI TO N
11035 FOR JP= IP TO N
11040 IF TJ(IP,JP)<>0 THEN 11055
11045 NEXT JP
11047 PRINT CHR$(7) : PRINT
11050 INPUT "** NO HAY SOLUCION AL SISTEMA DE ECUACIONES LINEALES",A$ :
KE=1: RETURN
11055 IF IP=JP THEN 11080
11060 FOR J=KI TO N+1
11065 X=TJ(IP,J) : TJ(IP,J)=TJ(JP,J) : TJ(JP,J)=X
11070 X=TK(IP,J) : TK(IP,J)=TK(JP,J) : TK(JP,J)=X
11075 NEXT J
11080 PIV=TJ(IP,JP)
11085 FOR J=KI TO N+1
11090 TJ(IP,J)=TJ(IP,J)/PIV
11095 TK(IP,J)=TK(IP,J)/PIV
11100 NEXT J
11105 FOR I=KI TO N
11110 IF I=IP THEN 11140
11115 X=TJ(I,JP)
11120 FOR J=KI TO N+1
11125 TJ(I,J)=TJ(I,J)-X*TJ(IP,J)
11130 TK(I,J)=TK(I,J)-X*TK(IP,J)
11135 NEXT J
11140 NEXT I
11145 NEXT IP
11150 RETURN
11200 '