|
APENDICE 5
ARCHIVOS BASIC
5 ' PROGRAMA ESTAD - Revision 17/ 4/89
7 '
8 KEY OFF
9 DEFINT I-N
10 ON ERROR GOTO 936
11 IF ITE>0 THEN 28
15 NFM=150 : NCM=25 : PAR1=20 : PAR2= 10 : DDA$="A"
20 NCI=80 : NDE=3 : XVF=-9999
25 DIM A(NFM,NCM),TC$(NCM),JX(NCM),P(5)
28 COMMON ITE,NFM,NCM,A(),TC$(),NC,NF,NX,DDA$,NDE,NV,JX(),P(),DA$,NA$,CD$,
PAR1,PAR2,XVF
29 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
34 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
35 '
36 WHILE KW=0
37 TP$="PROGRAMA ESTAD" : TSP$="Seleccion de Procesos"
38 GOSUB 555
39 X=CSRLIN : LOCATE 19,1 : KA=1 : KB=79 : GOSUB 695
40 PRINT "PARAMETROS DEL SISTEMA"
41 PRINT TAB( 3);"Disp. Arch. Datos: ";DDA$;
42 PRINT TAB(29);"Nro. Variables :";NCM;
43 PRINT TAB(55);"Nro. Observac. :";NFM
45 PRINT TAB(29);"Parametro Proc.1:";PAR1;
46 PRINT TAB(55);"Parametro Proc.2:";PAR2
47 PRINT TAB(29);"Valor faltante :";XVF;
48 PRINT TAB(55);"Nro.Decimales :";NDE
50 LOCATE X,1
51 PRINT : PRINT "OPCIONES DE PROCESO" : PRINT
55 PRINT " 1 - Manejo de Datos"
60 PRINT " 2 - Analisis Descriptivo de Datos"
65 PRINT " 3 - Distribuciones de Probabilidad"
70 PRINT " 4 - Pruebas Estadisticas"
75 PRINT " 5 - Analisis de Variancia" : LOCATE X+3,43
80 PRINT "6 - Regresion" : LOCATE ,43
85 PRINT "7 - Analisis Multivariado" : LOCATE ,43
90 PRINT "8 - Series de Tiempo" : LOCATE ,43
95 PRINT "9 - Cambio de Parametros" : LOCATE ,42
100 PRINT "10 - Salida del Programa"
105 PRINT : PRINT : INPUT "Opcion Elegida = ", A$
110 ITE=VAL(A$)
112 IF ITE<1 OR ITE>10 THEN PRINT CHR$(7) : GOTO 195
120 IF ITE=1 THEN CHAIN "ESTAD1"
130 IF ITE=2 THEN CHAIN "ESTAD2"
140 IF ITE=3 THEN CHAIN "ESTAD3"
150 IF ITE=4 THEN CHAIN "ESTAD4"
160 IF ITE=5 THEN CHAIN "ESTAD5"
170 IF ITE=6 THEN CHAIN "ESTAD6"
180 IF ITE=7 THEN CHAIN "ESTAD7"
185 IF ITE=8 THEN CHAIN "ESTAD8"
187 IF ITE=9 THEN GOSUB 1000
188 IF ITE=10 THEN PRINT CHR$(12) : END
195 WEND
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$
15 - 321
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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)
15 - 322
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
934 INPUT "Valor Erroneo ",A$
935 RETURN
936 PRINT CHR$(7) : PRINT
937 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
NEXT
940 IF ERR=53 THEN KE=0 : 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
NEXT
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)
15 - 323
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 ' EST9 - Cambio de Parametros
1005 ' ---------------------------
1010 TSP$="Cambio de Parametros"
1015 WHILE KW=0
1017 KMM=0
1020 GOSUB 555
1025 PRINT : PRINT "VALORES ACTUALES DE PARAMETROS" : PRINT
1030 TF$(1)=" 1 - Disposit. Archivo de datos (A,B o C) = " :PRINT TF$(1);DDA$
1035 TF$(2)=" 2 - Numero de Variables (1 a 100) =" : PRINT TF$(2);NCM
1040 TF$(3)=" 3 - Numero de Observaciones (10 a 1000) =" : PRINT TF$(3);NFM
1045 TF$(4)=" 4 - Parametro Proceso 1 (5 a 100) =" :PRINT TF$(4);PAR1
1050 TF$(5)=" 5 - Parametro Proceso 2 (2 a 50) =" :PRINT TF$(5);PAR2
1055 TF$(6)=" 6 - Valor faltante =" : PRINT TF$(6);XVF
1060 TF$(7)=" 7 - Numero de decimales (mayor que 0) =" : PRINT TF$(7);NDE
1070 PRINT : INPUT "Numero de Parametro a modificar = ",A$
1075 IF LEN(A$)=0 AND KME=1 THEN 1160
1077 IF LEN(A$)=0 THEN RETURN
1080 ISP=VAL(A$)
1085 IF ISP<1 OR ISP>7 THEN GOSUB 900 : GOTO 1020
1095 IF KMM=1 OR NC=0 OR (ISP<>2 AND ISP<>3) THEN 1115
1100 PRINT : PRINT "Un cambio en este parametro implica el borrado"
1105 INPUT "de la memoria de trabajo - Se continua ? (N) = ",A$
1110 IF A$<>"S" AND A$<>"s" THEN 1200
1115 PRINT
1120 PRINT TAB(3);TF$(ISP); : INPUT " ",A$
1125 IF LEN(A$)=0 THEN 1200
1130 X=VAL(A$)
1135 ON ISP GOSUB 1305,1340,1352,1360,1380,1400,1415
1150 KME=0
1155 XMEM=4*(NFM*NCM+(PAR1+1)*(PAR2+1))
1160 IF XMEM>40000! THEN PRINT : PRINT "Los valores de los parametros" : PRINT
"exceden la memoria disponible" : INPUT "",A$ : KME=1 : GOTO 1200
1165 IF KMM=0 THEN 1200
1170 ERASE A,TC$,JX
1175 DIM A(NFM,NCM),TC$(NCM),JX(NCM)
1180 DA$="" : NA$="" : NC=0 : NF=0 : NV=0 : NX=0
1200 WEND
1300 '
1305 IF LEN(A$)>1 THEN GOSUB 900 : RETURN
1307 IF INSTR("ABCabc",A$)=0 THEN GOSUB 900 : RETURN
1310 DDA$=A$
1315 RETURN
1335 '
1340 IF X<1 OR X>100 THEN GOSUB 900 : RETURN
1345 NCM=X : KMM=1
1350 RETURN
1351 '
15 - 324
1352 IF X<10 OR X>1000 THEN GOSUB 900 : RETURN
1353 NFM=X : KMM=1
1354 RETURN
1355 '
1360 IF X<5 OR X>100 THEN GOSUB 900 : RETURN
1365 PAR1=INT(X)
1370 RETURN
1375 '
1380 IF X<2 OR X>PAR1 OR X>50 THEN GOSUB 900 : RETURN
1385 PAR2=INT(X)
1390 RETURN
1395 '
1400 XVF=X
1405 RETURN
1410 '
1415 IF X<1 OR X>6 THEN GOSUB 900 : RETURN
1420 NDE=X
1425 RETURN
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
410 IF NC>0 AND KVA=0 THEN GOSUB 500
411 KVA=0
415 PRINT : 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
15 - 325
440 PRINT : PRINT " Variable";X;" actual = ",TC$(X)
445 INPUT " Se utiliza ? (N) = ",A$
450 IF A$<>"S" AND A$<>"s" THEN 415
452 IF KBM=1 THEN FOR I=1 TO NFM : A(I,X)=XVF : NEXT I : KBM=0
455 PRINT : PRINT " Nombre de la Variable";X;" (";TC$(X);")";
457 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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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
15 - 326
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
NEXT
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
NEXT
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
200 ' EST91 Definicion de Variables
205 ' ------------------------------
210 KX=0 : GOSUB 500
215 IF NV=0 THEN 265
220 PRINT : KX=1 : GOSUB 500
255 INPUT " Definicion de Nuevas Variables ? (N) = ",A$
260 IF A$<>"S" AND A$<>"s" THEN RETURN
265 PRINT
270 L=0 : K=0
275 WHILE K<KNV
290 PRINT " Variable Nro.";K+1; : INPUT "= ",A$
15 - 327
300 IF LEN(A$)=0 THEN NV=K : K=KNV : GOTO 320
302 J=VAL(A$)
303 KS=0 : IF J<0 THEN KS=1 : J=-J
304 IF KS=1 AND J<L THEN KE=5 : B$=">"+STR$(L)+" en valor absoluto" :
GOSUB 900 : PRINT : GOTO 290
305 IF KS=0 THEN L=J-1
306 FOR M=L+1 TO J
307 IF M<1 OR M>NC OR TC$(M)=" " THEN KE=4 : GOSUB 900 :
PRINT : GOTO 318
308 IF K=0 THEN 313
309 KE=0
310 FOR N=1 TO K
311 IF M=JX(N) THEN PRINT KE=1 : CHR$(7) : PRINT :
PRINT "** VARIABLE";M;"REPETIDA" : PRINT : N=K
312 NEXT N : IF KE=1 THEN 318
313 K=K+1
314 IF K<=KNV THEN JX(K)=M
315 X=CSRLIN : IF M=L+1 THEN X=X-1
316 IF K<=KNV THEN LOCATE X,1 : PRINT " Variable Nro.";K;"=";M
317 IF K>KNV THEN M=J
318 NEXT M
319 L=J
320 WEND
324 IF KDA=1 THEN JF=0 : KDA=0 : NX=NF : RETURN
330 PRINT : 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 : GOTO
330
385 RETURN
387 '
390 ' EST92 - Seleccion de una Variable
395 ' ---------------------------------
400 J=0
410 IF NC>0 AND KVA=0 THEN KX=0 : GOSUB 500
411 KVA=0
415 PRINT : 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 TC$(X)=" " 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
452 IF KBM=0 THEN FOR I=1 TO NFM : A(I,X)=XVF : NEXT I
453 KBM=0
455 PRINT : PRINT " Nombre de la Variable";X;" (";TC$(X);")";
457 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
497 '
500 ' EST93 - Salida de Variables
505 ' ---------------------------
506 PRINT#3,
507 IF KX=0 THEN PRINT#3," Variables en Memoria" : NVS=NC
510 IF KX=1 THEN PRINT#3," Variables Definidas" : NVS=NV
516 PRINT#3,
518 I=1
15 - 328
522 FOR K=1 TO NVS
526 L=K : IF KX=1 THEN L=JX(K)
530 PRINT#3,TAB(15*I-11);L;"-";TC$(L);
534 I=I+1 : IF I>5 THEN I=1 : PRINT#3,
538 NEXT K
542 PRINT#3, : PRINT#3,
546 RETURN
553 '
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$;" - ";DA$
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 Observaciones: ";
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
620 '
650 ' EST95 Seleccion de Dispositivo de Salida
655 ' ----------------------------------------
660 CLOSE#3 : KS=0 : DS$="SCRN:" : XA$=".TXT"
663 PRINT
665 INPUT "Salida por: Pantalla/P/ Impresora/I/ Archivo/Nombre/ (No) = ",A$
670 IF LEN(A$)=0 THEN OPEN DS$ FOR OUTPUT AS #3 : RETURN
671 KS=1
672 IF A$="p" OR A$="P" THEN OPEN DS$ FOR OUTPUT AS#3 : RETURN
673 DS$="LPT1:"
675 IF A$="i" OR A$="I" THEN OPEN DS$ FOR OUTPUT AS#3 : RETURN
677 KE=0 : GOSUB 950
678 IF KE=1 THEN 665
680 DS$=A$
685 OPEN XDDA$+DS$+EXT$ FOR APPEND AS #3
690 RETURN
693 '
695 ' EST96 Subrayado
700 ' ---------------
710 FOR S=KA TO KB : PRINT#3,TAB(S);"-"; : NEXT S : PRINT#3,
715 RETURN
885 '
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 PRINT "** NUMERO DE OBSERVAC.(";NXX; ")
INSUFICIENTE PARA EL PROCESO " : INPUT "",A$ : KE=0 : RETURN
928 IF KE=4 THEN PRINT "** VARIABLE NO EXISTENTE O SIN DATOS " : KE=0 : RETURN
929 IF KE=5 THEN PRINT "** VALOR ERRONEO - Debe ser ";B$ : KE=0 : RETURN
930 IF KE=6 THEN INPUT "** CAPACIDAD INSUFICIENTE DE MEMORIA DE TRABAJO ",A$ : KE=0 :
RETURN
931 IF KE=9 THEN INPUT "** PROCESO NO ADECUADO A LOS DATOS CONSIDERADOS ",A$ : KE=0 :
RETURN
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
NEXT
940 IF ERR=53 THEN KAR=1 : RESUME NEXT
941 IF ERR=62 THEN PRINT "** FIN IMPREVISTO DE GRABACION O LECTURA EN DISP. "; XDDA$; :
INPUT " ",A$ : RESUME NEXT
15 - 329
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
NEXT
945 IF ERR=7 OR ERR=14 THEN INPUT "** SE EXCEDIO MEMORIA DISPONIBLE"; : INPUT "
",A$ : CHAIN "ESTAD"
947 PRINT "Error";ERR;"en linea";ERL :STOP
948 CHAIN"ESTAD"
949 '
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
979 '
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 = "; : LOCATE ,18,1
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
10 ' ESTAD1 - Revision 19/4/89
15 '
20 GOSUB 1000
25 IF ITE>0 THEN CHAIN "ESTAD"+RIGHT$(STR$(ITE),1)
50 CHAIN "ESTAD"
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
15 - 330
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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$
15 - 331
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
NEXT
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
NEXT
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
15 - 332
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$=INPUT$(1) : 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 ' EST1 - Manejo de Datos
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
1017 ON ERROR GOTO 936
1020 X=2*NFM : IF NCM>X THEN X=NCM
1025 Y=NFM : IF NCM>Y THEN Y=NCM
1030 DIM TCX$(200),TF$(8),VX(X),VY(Y),V(Y),NVC(2),VC(PAR1,2)
1033 DIM ARC$(3),IA(2),IB(2),NFT(2),NCT(2),NIJ(2),NVS(2)
1035 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
1040 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1045 WHILE KW=0
1050 TP$="MANEJO DE DATOS" : TSP$=""
1055 NXX=0
1060 GOSUB 555
1065 PRINT TAB(70);FRE(0)
1070 PRINT "PROCESOS"
1075 TF$(1)="Ingreso y Modificacion de Datos"
1080 TF$(2)="Creacion de Archivo de Datos"
1085 TF$(3)="Lectura de Archivo de Datos"
1090 TF$(4)="Union de Archivos"
1095 TF$(5)="Salida de Datos"
1100 TF$(6)="Seleccion de Datos"
1105 TF$(7)="Transformacion de Datos"
1110 TF$(8)="Cambio de Parametros"
1115 KL=8 : GOSUB 980
1119 IF ISP=0 AND ITE>1 THEN CHAIN "ESTAD"+RIGHT$(STR$(ITE),1)
1120 IF ISP=0 AND ITE=1 THEN CHAIN "ESTAD"
1125 IF (ISP=2 OR ISP=6 OR ISP=7) AND NF=0 THEN KE=1: GOSUB 900 : GOTO 1060
1130 ON ISP GOSUB 1145,2000,2500,3470,4005,4300,4475,7500
1135 WEND
1140 '
1145 ' EST11 - Ingreso de Datos
1150 ' ------------------------
1155 WHILE KW=0
1160 TSP$="Ingreso de Datos"
1165 GOSUB 555
1167 PRINT "PROCESOS"
1170 TF$(1)="Ingreso por Observacion"
1175 TF$(2)="Ingreso por Variable"
1180 TF$(3)="Insercion de Observaciones"
1185 TF$(4)="Eliminacion de Observaciones"
1190 KL=4 : GOSUB 980
1195 IF ISP=0 THEN RETURN
1200 IF ISP>2 OR NC=0 THEN 1215
1205 PRINT : INPUT "Borrado de Memoria de Trabajo ? (N) = ",A$
1210 IF A$="S" OR A$="s" THEN GOSUB 1250
1215 PRINT
1220 PRINT "Descripcion actual de los Datos = ";DA$
1225 INPUT "Nueva Descripcion (Idem) = ",A$
1230 IF LEN(A$)>0 THEN DA$=A$
1235 ON ISP GOSUB 1300,1510,1625,1855
1240 WEND
1245 '
1250 DA$="" : NA$=""
15 - 333
1255 NC=0 : NF=0 :NX=0
1260 FOR J=1 TO NCM
1265 TC$(J)=" "
1270 FOR I=1 TO NFM
1275 A(I,J)=XVF
1280 NEXT I
1285 NEXT J
1290 RETURN
1295 '
1300 ' EST 111 - Ingreso de Datos por Observacion
1305 ' ------------------------------------------
1310 TSP$=TSP$+" - Por Observacion"
1315 GOSUB 555
1320 IF NC>0 THEN GOSUB 500
1325 PRINT : INPUT "Variable Inicial a Ingresar = ",A$
1330 IF LEN(A$)=0 THEN RETURN
1335 JI=VAL(A$)
1340 IF JI<1 OR JI>NCM THEN KE=4 : GOSUB 900 : GOTO 1325
1345 PRINT : INPUT "Variable Final a Ingresar = ",A$
1350 IF LEN(A$)=0 THEN RETURN
1355 JJ=VAL(A$)
1360 IF JJ<JI OR JJ>NCM THEN KE=5 : B$=">="+STR$(JI)+" y <="+STR$(NCM) :
GOSUB 900 : GOTO 1345
1365 IF NC=0 THEN 1380
1370 PRINT : INPUT "Actualizacion Nombres de Variables ? (N) = ",A$
1375 IF A$<>"S" AND A$<>"s" THEN 1415
1380 PRINT
1385 FOR K=JI TO JJ
1390 PRINT " Nombre de la Variable";K;TAB(29);"(";TC$(K);TAB(38);")"; : INPUT " =
",A$
1395 IF LEN(A$)=0 THEN 1405
1400 TC$(K)=LEFT$(A$,8)
1405 NEXT K
1410 IF NC<JJ THEN NC=JJ
1415 WHILE KW=0
1420 PRINT: INPUT "Observacion Inicial a Ingresar = ",A$
1425 IF LEN(A$)=0 THEN RETURN
1430 I=VAL(A$)
1435 IF I<1 OR I>NFM THEN KE=5 : B$=">=1 y <="+STR$(NFM) :
GOSUB 900 : GOTO 1420
1440 WHILE I<=NFM
1445 PRINT: PRINT "Ingreso Observacion";I
1450 FOR J=JI TO JJ
1455 PRINT " ";J;" - ";TC$(J);TAB(18); : INPUT " = ",A$
1460 IF LEN(A$)=0 THEN I=NFM+1 : J=JJ : GOTO 1470
1465 A(I,J)= VAL(A$)
1470 NEXT J
1475 IF I>NF AND I<=NFM THEN NF=I
1480 IF I=NFM THEN PRINT : INPUT "Se alcanzo el Nro. Maximo de Observaciones"
,A$
1485 I=I+1
1490 WEND
1495 NX=NF
1500 WEND
1505 '
1510 ' EST112 - Ingreso de Datos por Variable
1515 ' --------------------------------------
1520 TSP$=TSP$+" - Por Variable"
1525 GOSUB 555
1527 JZ=0
1529 IF NC=0 THEN 1535
1530 GOSUB 500
1531 PRINT : INPUT " Variable de Referencia (No) = ",A$
1532 IF LEN(A$)=0 THEN 1535
1533 JZ=VAL(A$)
1534 IF JZ<1 OR JZ>NC THEN KE=4 : GOSUB 900 : GOTO 1531
1535 WHILE KW=0
1537 KVA=1
1538 GOSUB 390
1540 IF J=0 THEN RETURN
1545 PRINT: INPUT "Observacion Inicial a Ingresar (1) = ",A$
15 - 334
1550 IF LEN(A$)=0 THEN I=1 : GOTO 1565
1555 I=VAL(A$)
1560 IF I<1 OR I>NFM THEN KE=5 : B$=">=1 y <="+STR$(NFM) :
GOSUB 900 : GOTO 1545
1565 PRINT
1570 WHILE I<=NFM
1575 PRINT "Observacion";I;
1577 IF JZ>0 THEN PRINT TAB(17);"/";A(I,JZ);"/";
1578 INPUT " = ",A$
1580 IF LEN(A$)=0 THEN I=NFM+1 : GOTO 1605
1585 A(I,J)= VAL(A$)
1590 IF I>NF THEN NF=I
1595 IF I=NFM THEN PRINT : INPUT "Se alcanzo el Nro. Maximo de Observaciones"
,A$
1600 I=I+1
1605 WEND
1610 NX=NF
1615 WEND
1620 '
1625 ' EST113 - Insercion de Observaciones
1630 ' -----------------------------------
1635 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
1637 TSP$=TSP$+" - Insercion de Observaciones"
1638 GOSUB 555
1640 PRINT "Numero de observaciones en Memoria" : PRINT
1645 PRINT " Existentes = ";NF
1650 PRINT " Maximas Posibles =";NFM
1652 IF NF=NFM THEN INPUT " (No hay lugar en Memoria para la Insercion", A$ : RETURN
1655 PRINT : INPUT "Observacion donde se inicia la Insercion = ",A$
1660 IF LEN(A$)=0 THEN RETURN
1665 II=VAL(A$)
1670 IF II<1 OR II>NF+1 THEN KE=5 : B$=">=1 y <="+STR$(NF+1) :
GOSUB 900 : GOTO 1655
1675 PRINT : INPUT "Numero de Observaciones a Insertar = ",A$
1680 IF LEN(A$)=0 THEN RETURN
1685 NI=VAL(A$)
1690 IF NI<1 OR NI>NFM-NF THEN KE=5 : B$=">=1 y <="+STR$(NFM-NF) :
GOSUB 900 : GOTO 1675
1695 IF II=NF+1 THEN 1750
1700 FOR I=NF TO II STEP -1
1705 FOR J=1 TO NCM
1710 A(I+NI,J)=A(I,J)
1715 NEXT J
1720 NEXT I
1725 FOR I=II TO II+NI-1
1730 FOR J=1 TO NCM
1735 A(I,J)=XVF
1740 NEXT J
1745 NEXT I
1755 IF NC>0 THEN GOSUB 500
1760 PRINT : PRINT "Variable Inicial a Ingresar (1)"; : INPUT " = ",A$
1765 IF LEN(A$)=0 THEN KI=1 : GOTO 1780
1770 KI=VAL(A$)
1775 IF KI<1 OR KI>NCM THEN KE=5 : B$=">=1 y <="+STR$(NCM) :
GOSUB 900 : GOTO 1760
1780 PRINT : PRINT "Variable Final a Ingresar (";NC;")"; : INPUT " = ",A$
1785 IF LEN(A$)=0 THEN KF=NC : GOTO 1800
1790 KF=VAL(A$)
1795 IF KF<1 OR KF>NCM THEN KE=5 : B$=">=1 y <="+STR$(NCM) :
GOSUB 900 : GOTO 1780
1800 I=II
1805 FOR I=II TO II+NI-1
1810 PRINT: PRINT "Ingreso Observacion";I
1815 FOR J=KI TO KF
1820 PRINT " ";J;" - ";TC$(J);TAB(18); : INPUT " = ",A$
1825 IF LEN(A$)=0 THEN J=KF : I=II+NI-1 : GOTO 1835
1830 A(I,J)= VAL(A$)
1835 NEXT J
1840 NEXT I
1843 NF=NF+NI : NX=NF
1844 PRINT : INPUT "Insercion Terminada - Enter ",A$
15 - 335
1845 RETURN
1850 '
1855 ' EST114 - Eliminacion de Observaciones
1860 ' -------------------------------------
1865 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
1867 TSP$=TSP$+" - Eliminacion de Observaciones"
1868 GOSUB 555
1870 PRINT "Numero de Observaciones en Memoria = ";NF
1885 PRINT : INPUT "Observacion Inicial a Eliminar = ",A$
1890 IF LEN(A$)=0 THEN RETURN
1895 II=VAL(A$)
1900 IF II<1 OR II>NF THEN KE=5 : B$=">=1 y <="+STR$(NF) :
GOSUB 900 : GOTO 1885
1905 PRINT : INPUT "Observacion Final a Eliminar = ",A$
1910 IF LEN(A$)=0 THEN RETURN
1915 IJ=VAL(A$)
1920 IF IJ<II OR IJ>NF THEN KE=5 : B$=">="+STR$(II)+"<="+STR$(NF) :
GOSUB 900 : GOTO 1885
1925 PRINT : PRINT "Observaciones a Eliminar ";II;"a";IJ; : INPUT "? (N) = ",A$
1930 IF A$<>"S" AND A$<>"s" THEN 1865
1935 FOR I=IJ+1 TO NF
1940 FOR J=1 TO NCM
1945 A(I-IJ+II,J)=A(I,J)
1950 A(I,J)=XVF
1955 NEXT J
1960 NEXT I
1965 NF=NF-IJ+II-1 : NX=NF
1970 PRINT : INPUT "Eliminacion Terminada - Enter ",A$
1975 RETURN
1980 '
2000 ' EST12 - Creacion de Archivo de Datos
2005 ' ------------------------------------
2010 TSP$="Creacion de Archivo de Datos"
2015 GOSUB 555
2017 PRINT "VARIABLES A GRABAR"
2020 TF$(1)="Todas las Variables"
2025 TF$(2)="Variables Seleccionadas"
2030 KL=2 : GOSUB 980
2035 IF ISP=0 THEN RETURN
2040 WHILE ISP=1
2045 FOR J=1 TO NC : VX(J)=J : NEXT J : NCK=NC
2050 ISP=0
2055 WEND
2060 WHILE ISP=2
2065 NCX=NC
2075 GOSUB 500
2080 PRINT : GOSUB 2405
2085 IF NCK=0 THEN RETURN
2090 ISP=0
2095 WEND
2100 KC=0 : IF CD$="" THEN 2120
2105 PRINT : INPUT "Se considera Condicion de Seleccion ? (N) = ",A$
2110 IF A$="S" OR A$="s" THEN KC=1
2120 NFX=NF : M=1
2125 GOSUB 2390
2155 NZ=0
2160 FOR I=IA(1) TO IB(1)
2165 IF KC=1 AND A(I,0)=1 THEN 2175
2170 NZ=NZ+1
2175 NEXT I
2180 PRINT : PRINT "TIPO DE ARCHIVO A CREAR"
2185 TF$(1)="Archivo ESTAD (.EST)"
2190 TF$(2)="Archivo LOTUS (.PRN)"
2195 TF$(3)="Archivo ASCII (.ASF)"
2200 KL=3 : GOSUB 980
2205 IF ISP=0 THEN RETURN
2210 IF ISP=1 THEN XA$=".EST"
2215 IF ISP=2 THEN XA$=".PRN"
2220 IF ISP=3 THEN XA$=".ASF"
2225 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
2226 PRINT : FILES DDA$+":*"+XA$
15 - 336
2230 IF KAR=1 THEN PRINT " No Existen" : KAR=0
2235 PRINT : INPUT "Nombre del Archivo a Crear = ",A$
2240 IF LEN(A$)=0 THEN RETURN
2245 KE=0
2250 GOSUB 950
2253 XNA$=A$
2255 IF KAR=0 THEN PRINT : INPUT "Archivo Existente - Se Reemplaza ? (N) = ",A$
2260 IF KAR=0 AND (A$<>"S" AND A$<>"s") THEN 2235
2265 IF KE=1 THEN 2235
2267 IF ISP>1 THEN 2275
2269 PRINT : PRINT "Descripcion actual de los Datos = ";DA$
2270 PRINT : INPUT "Nueva Descripcion (Idem) = ",A$
2271 IF LEN(A$)>0 THEN DAX$=A$ ELSE DAX$=DA$
2275 IF ISP=1 THEN 2290
2280 PRINT : INPUT "Nombres de Variables en Primer Registro ? (N) = ",A$
2285 KNM=0 : IF A$="S" OR A$="s" THEN KNM=1
2290 OPEN XDDA$+XNA$+EXT$ FOR OUTPUT AS #1
2295 IF ISP=1 THEN PRINT#1,DAX$ : PRINT#1,NZ,NCK
2300 K=0
2305 FOR J= 1 TO NCK
2310 IF ISP=1 THEN PRINT#1,TC$(VX(J))
2315 IF ISP=2 AND KNM=1 THEN K=K+1:PRINT#1,TAB(14*K-13);CHR$(34);TC$(VX(J));
CHR$(34);
2317 IF ISP=3 AND KNM=1 THEN PRINT#1," ";TC$(VX(J));
2320 NEXT J
2325 IF (ISP=2 OR ISP=3) AND KNM=1 THEN PRINT#1,
2330 IF NF=0 THEN 2380
2335 FOR I=IA(1) TO IB(1)
2340 IF KC=1 AND A(I,0)=1 THEN 2375
2350 FOR J=1 TO NCK
2355 IF (ISP=1 OR ISP=3) THEN PRINT#1,A(I,VX(J));
2360 IF ISP=2 THEN PRINT#1,TAB(14*J-13);A(I,VX(J));
2365 NEXT J
2370 PRINT#1,
2375 NEXT I
2380 CLOSE#1
2382 IF NA$="" THEN NA$=XNA$
2384 PRINT : INPUT "Grabacion Terminada - Enter ",A$
2386 RETURN
2389 '
2390 ' Definicion de Observaciones a Considerar
2392 PRINT : INPUT "Observacion Inicial a Considerar (Todas) = ",A$
2393 IF LEN(A$)=0 THEN IA(M)=1 :IB(M)=NFX : RETURN
2394 IA(M)=VAL(A$)
2395 IF IA(M)<1 OR IA(M)>NFX THEN KE=5 : B$=">=1 y <="+STR$(NFX) :
GOSUB 900 : GOTO 2392
2396 PRINT : PRINT "Observacion Final a Considerar (";NFX;")"; : INPUT " = ",A$
2397 IF LEN(A$)=0 THEN IB(M)=NFX : RETURN
2398 IB(M)=VAL(A$)
2399 IF IB(M)<IA(M) OR IB(M)>NFX THEN KE=5 : B$=">="+STR$(IB(M))+ " y
<="+STR$(NFX) : GOSUB 900 : GOTO 2396
2400 RETURN
2404 '
2405 ' EST121 - Definicion de Variables
2410 ' --------------------------------
2415 L=0 : NCK=0
2420 WHILE KW=0
2425 INPUT " Variable a Seleccionar = ",A$
2430 IF LEN(A$)=0 THEN RETURN
2435 K=VAL(A$) : KS=0 : IF K<0 THEN KS=1 : K=-K
2440 IF K<1 OR K>NCX THEN KE=5 : B$=">=1 y <="+STR$(NCX) :
GOSUB 900 : GOTO 2425
2445 IF KS=1 AND (K<=L OR L=0) THEN KE=5 : B$=">0": GOSUB 900: GOTO 2425
2450 IF KS=0 THEN NCK=NCK+1 : VX(NCK)=K : GOTO 2470
2455 FOR N=L+1 TO K
2460 NCK=NCK+1 : VX(NCK)=N
2465 NEXT N
2470 L=K
2475 WEND
2480 '
2500 ' EST13 - Lectura de Archivo de datos
15 - 337
2505 ' -----------------------------------
2510 TSP$="Lectura de Archivo de Datos
2515 GOSUB 555
2516 IF NC=0 THEN 2519
2517 PRINT : INPUT "Borrado de Memoria de Trabajo ? (N) = ",A$
2518 IF A$="S" OR A$="s" THEN GOSUB 1250
2519 PRINT
2520 PRINT "TIPO DE ARCHIVO A LEER"
2525 TF$(1)="Archivo ESTAD (.EST)"
2530 TF$(2)="Archivo LOTUS (.PRN)"
2535 TF$(3)="Archivo ASCII (.ASF)"
2540 KL=3 : GOSUB 980
2545 IF ISP=0 THEN RETURN
2547 IKP=ISP
2550 IF IKP=1 THEN XA$=".EST"
2555 IF IKP=2 THEN XA$=".PRN"
2560 IF IKP=3 THEN XA$=".ASF"
2565 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
2570 PRINT : FILES DDA$+":*"+XA$
2575 IF KAR=1 THEN PRINT " No Existen" : KAR=0
2580 PRINT: INPUT "Nombre del Archivo a Leer = ",A$
2585 IF LEN(A$)=0 THEN RETURN
2590 KE=0
2595 GOSUB 950
2600 IF KAR=1 THEN PRINT : PRINT CHR$(7) : INPUT "** ARCHIVO NO EXISTENTE",A$ : KAR=0 :
GOTO 2580
2605 IF KE=1 THEN 2580
2610 NA$=A$ : NCK=0
2615 WHILE IKP=1
2617 ARC$(1)=NA$
2620 PRINT : PRINT "ARCHIVO A LEER"
2625 M=1 : GOSUB 3240
2627 IF ISP=0 OR NCK=0 THEN CLOSE#1 : RETURN
2775 IF IB(1)-IA(1)>NFM THEN KE=6 : GOSUB 900 : CLOSE#1 : GOTO 2625
2780 WHILE ISP=1
2795 NC=NCX
2800 FOR J=1 TO NC : TC$(J)=TCX$(J) : NEXT J
2803 IX=0
2805 FOR I=1 TO NFX
2807 KX=0
2810 FOR J=1 TO NC
2815 INPUT#1,X
2816 IF I<IA(1) OR I>IB(1) THEN 2820
2817 IF KX=0 THEN IX=IX+1 : KX=1
2818 A(IX,J)=X
2820 NEXT J
2825 NEXT I
2830 ISP=0
2835 WEND
2840 WHILE ISP=2
2850 FOR J=1 TO NCM : VY(J)=0 : NEXT J
2870 PRINT : PRINT "POSICIONES DE MEMORIA A INGRESAR VARIABLES"
2875 IF NC>0 THEN GOSUB 500
2880 PRINT
2883 KX=0
2885 FOR K=1 TO NCK
2890 J=VX(K)
2895 PRINT " Posicion a ubicar Variable";J;" - ";TCX$(J);TAB(45);
2900 INPUT " = ",A$
2905 IF LEN(A$)=0 THEN 2950
2910 L=VAL(A$)
2915 IF L<1 OR L>NCM THEN KE=5 : B$=">=1 Y <="+STR$(NCM) :
GOSUB 900 : GOTO 2895
2920 IF LEN(TC$(L))=0 OR LEFT$(TC$(L),2)=" " THEN 2940
2925 PRINT : PRINT "Variable";L;" actual = ",TC$(L)
2930 INPUT " Se utiliza ? (N) = ",A$
2935 IF A$<>"S" AND A$<>"s" THEN 2895
2940 TC$(L)=TCX$(J)
2945 VY(J)=L : KX=1
2950 NEXT K
2955 IF KX=0 THEN RETURN
15 - 338
2957 IX=0
2960 FOR I=1 TO NFX
2963 KX=0
2965 FOR J=1 TO NCX
2970 INPUT#1,X
2975 IF I<IA(1) OR I>IB(1) THEN 2995
2980 K=VY(J)
2983 IF KX=0 THEN IX=IX+1 : KX=1
2985 IF K>0 THEN A(IX,K)=X
2990 IF K>NC THEN NC=K
2995 NEXT J
3000 NEXT I
3015 ISP=0
3020 WEND
3022 DA$=DAX$
3023 NF=IB(1)-IA(1)+1 : NX=NF
3025 IKP=0
3030 WEND
3035 WHILE IKP>=2
3040 PRINT : INPUT "Nombre de Variables en Primer Registro ? (N) = ",A$
3045 KNM=0 : NFX=0 : IF A$="S" OR A$="s" THEN KNM=1 : NFX=1
3050 OPEN XDDA$+NA$+EXT$ FOR INPUT AS #1
3055 NCX=0 : KM=0 : C$=""
3060 LINE INPUT#1,A$
3065 IL=LEN(A$) : KX=0
3070 FOR I=1 TO IL
3075 B$=MID$(A$,I,1)
3077 IF B$="," THEN B$=" "
3080 IF KNM=1 AND B$=" " AND KM=1 THEN KM=0: TC$(NCX)=LEFT$(C$,8) :
C$="" : GOTO 3105
3085 IF KNM=0 AND B$=" " AND KM=1 THEN KM=0: A(NFX,NCX)=VAL(C$) :
C$="" : GOTO 3105
3090 IF B$=" " OR B$=CHR$(34) THEN 3105
3095 IF KM=0 THEN KM=1 : IF NCX<NCM THEN NCX=NCX+1 ELSE KX=1
3100 C$=C$+B$
3105 NEXT I
3107 IF KX=1 THEN KE=6 : GOSUB 900 : RETURN
3110 IF C$>"" AND KNM=1 THEN TC$(NCX)=LEFT$(C$,8)
3115 IF C$>"" AND KNM=0 THEN A(NFX,NCX)=VAL(C$)
3120 NC=NCX : N=0
3125 WHILE NOT EOF(1)
3130 INPUT#1,X
3135 IF N<NCX THEN N=N+1 : GOTO 3145
3140 IF N=NCX THEN N=1 : NFX=NFX+1 : IF NFX>NFM THEN KE=6 : GOSUB 900 :
RETURN
3145 A(NFX,N)=X
3185 WEND
3190 NF=NFX : NX=NF
3195 IKP=0
3200 WEND
3205 CLOSE#1
3210 JF=0 : CD$="" : NV=0 : NVC(1)=0 : NVC(2)=0
3215 FOR I=1 TO NF : A(I,0)=0 : NEXT I
3220 FOR I=NC+1 TO NCM : TC$(I)=" " : NEXT I
3225 PRINT : INPUT "Lectura Terminada - Enter ",A$
3230 RETURN
3235 '
3240 ' EST131 - Definicion Datos Archivo a Leer
3245 ' ----------------------------------------
3250 OPEN XDDA$+ARC$(M)+EXT$ FOR INPUT AS #M
3255 LINE INPUT#M,DAX$
3260 INPUT#M,NFX,NCX
3270 FOR J=1 TO NCX
3275 INPUT#M,TCX$(J)
3280 NEXT J
3285 PRINT : PRINT
3287 PRINT "CARACTERISTICAS DEL ARCHIVO" : PRINT
3290 PRINT " NOMBRE = ";ARC$(M);" - ";DAX$ : PRINT
3295 PRINT " Numero de Variables = ";NCX
3300 PRINT " Numero de Observaciones = ";NFX
3305 PRINT
15 - 339
3310 I=1
3315 FOR L=1 TO NCX
3320 IF LEFT$(TCX$(L),2)=" " THEN 3335
3325 PRINT TAB(15*I-11);L;"-";TCX$(L);
3330 I=I+1 : IF I>5 THEN I=1 : PRINT
3335 NEXT L
3339 PRINT : PRINT
3340 PRINT : PRINT "VARIABLES A CONSIDERAR"
3345 TF$(1)="Todas las Variables"
3350 TF$(2)="Variables Seleccionadas"
3355 KL=2 : GOSUB 980
3359 IF ISP=0 THEN CLOSE#M : RETURN
3360 IPC=ISP
3361 WHILE IPC=1
3362 IF NCX>NCM THEN KE=6 : GOSUB 900 : GOTO 3340
3365 NCK=NCX
3369 FOR K=1 TO NCK : VX(K)=K : NEXT K
3370 IF M=1 THEN FOR K=1 TO NCK : VY(K)=VX(K) : NEXT K
3371 IPC=0
3372 WEND
3375 WHILE IPC=2
3385 PRINT : GOSUB 2405
3390 IF NCK=0 THEN RETURN
3395 IF M=1 THEN FOR K=1 TO NCK : VY(K)=VX(K) : NEXT K
3400 IPC=0
3405 WEND
3420 GOSUB 2390
3460 RETURN
3465 '
3470 ' EST14 - Union de Archivos
3475 ' -------------------------
3485 TSP$="Union de Archivos"
3490 GOSUB 555
3493 PRINT " (Solo con Archivos tipo ESTAD)" : PRINT
3495 PRINT "PROCESOS"
3500 TF$(1)="Union por Variables"
3505 TF$(2)="Union por Observaciones"
3510 TF$(3)="Creacion de Subarchivo"
3515 KL=3 : GOSUB 980
3520 IF ISP=0 THEN RETURN
3525 IKP=ISP
3550 PRINT : PRINT "Archivos en Disco ";DDA$
3555 PRINT : FILES DDA$+":*.EST"
3560 IF KAR=1 THEN PRINT " No Existen" : KAR=0
3565 FOR M=1 TO 3
3570 IF M=2 AND IKP=3 THEN ARC$(2)="" : GOTO 3625
3575 IF M<3 THEN PRINT "Nombre del Archivo Fuente Nro.";M;TAB(37);
ELSE PRINT : PRINT "Nombre del Archivo Destino";TAB(37);
3580 INPUT "(.EST) = ",A$
3585 IF LEN(A$)=0 THEN RETURN
3590 KE=0 : XA$=".EST"
3595 GOSUB 950
3597 C$=A$
3600 IF M<3 AND KAR=1 THEN PRINT : PRINT CHR$(7) : INPUT
"** ARCHIVO NO EXISTENTE",A$ : KAR=0 : GOTO 3575
3605 IF M=3 AND KAR=0 THEN PRINT : INPUT
"Archivo Existente - Se Reemplaza ? (N) = ",A$
3610 IF M=3 AND KAR=0 AND (A$<>"S" AND A$<>"s") THEN 3575
3615 IF KE=1 THEN 3575
3620 ARC$(M)=C$
3625 NEXT M
3630 FOR M=1 TO 2
3635 IF ARC$(M)="" THEN 3650
3640 PRINT : PRINT "ARCHIVO FUENTE NRO.";M : PRINT
3645 GOSUB 3240 : CLOSE #M
3647 NIJ(M)=IB(M)-IA(M)+1
3648 NVS(M)=NCK : NFT(M)=NFX : NCT(M)=NCX
3650 NEXT M
3655 IF IKP=1 AND (NVS(1)<>NVS(2)) THEN PRINT CHR$(7) : PRINT : INPUT "**
CANTIDAD DE VARIABLES DIFERENTE EN LOS DOS ARCHIVOS",A$ : GOTO 3550
15 - 340
3660 IF IKP=2 AND (NIJ(1)<>NIJ(2)) THEN PRINT CHR$(7) : PRINT : INPUT "**
CANTIDAD DE OBSERVACIONES DIFERENTE EN LOS DOS ARCHIVOS",A$ : GOTO 3550
3665 CLOSE
3670 PRINT : INPUT "Descripcion de Archivo Destino = ",DAX$
3675 FOR M=1 TO 2
3680 IF IKP=3 AND M=2 THEN 3695
3685 OPEN XDDA$+ARC$(M)+EXT$ FOR INPUT AS #M
3690 INPUT#M,A$,X,Y
3695 NEXT M
3700 NFX=NFT(1) : IF NFX<NFT(2) THEN NFX=NFT(2)
3715 OPEN XDDA$+ARC$(3)+EXT$ FOR OUTPUT AS #3
3720 PRINT#3,DAX$
3725 WHILE IKP=1 OR IKP=3
3730 PRINT#3,NIJ(1)+NIJ(2),NVS(1)
3733 FOR K=1 TO NCT(1) : INPUT#1,TCX$(K) : NEXT K
3734 FOR K=1 TO NCT(2) : INPUT#2,A$ : NEXT K
3735 FOR K=1 TO NVS(1)
3745 PRINT#3,TCX$(VY(K))
3750 NEXT K
3755 FOR I=1 TO NFT(1)
3760 FOR K=1 TO NCT(1)
3765 INPUT#1,V(K)
3767 NEXT K
3770 IF I<IA(1) OR I>IB(1) THEN 3790
3775 FOR K=1 TO NVS(1)
3780 PRINT#3,V(VY(K));
3783 NEXT K
3785 PRINT#3,
3790 NEXT I
3795 IF IKP=3 THEN 3840
3800 FOR I=1 TO NFT(2)
3805 FOR K=1 TO NCT(2)
3810 INPUT#2,V(K)
3812 NEXT K
3815 IF I<IA(2) OR I>IB(2) THEN 3835
3820 FOR K=1 TO NVS(2)
3823 PRINT#3,V(VX(K));
3825 NEXT K
3830 PRINT#3,
3835 NEXT I
3840 IKP=0
3845 WEND
3850 WHILE IKP=2
3855 PRINT#3,NIJ(1),NVS(1)+NVS(2)
3857 FOR K=1 TO NCT(1) : INPUT#1,TCX$(K) : NEXT K
3860 FOR K=1 TO NVS(1)
3870 PRINT#3,TCX$(VY(K))
3875 NEXT K
3877 FOR K=1 TO NCT(2) : INPUT#2,TCX$(K) : NEXT K
3880 FOR K=1 TO NVS(2)
3890 PRINT#3,TCX$(VX(K))
3895 NEXT K
3900 FOR I=1 TO NFX
3905 IF I>NFT(1) THEN 3935
3910 FOR K=1 TO NCT(1)
3915 INPUT#1,V(K)
3917 NEXT K
3920 IF I<IA(1) OR I>IB(1) THEN 3935
3925 FOR K=1 TO NVS(1)
3927 PRINT#3,V(VY(K));
3930 NEXT K
3935 IF I>NFT(2) THEN 3965
3940 FOR K=1 TO NCT(2)
3945 INPUT#2,V(K)
3947 NEXT K
3950 IF I<IA(2) OR I>IB(2) THEN 3970
3953 FOR K=1 TO NVS(2)
3955 PRINT#3,V(VX(K));
3960 NEXT K
3965 PRINT#3,
3970 NEXT I
15 - 341
3975 IKP=0
3980 WEND
3985 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
3990 PRINT : INPUT "Union terminada - Enter ",A$
3995 RETURN
4000 '
4005 ' EST15 - Salida de Datos
4010 ' -----------------------
4015 TSP$="Salida de Datos"
4017 GOSUB 555
4018 XA$=".EST"
4019 PRINT "DATOS EN"
4020 TF$(1)="Memoria de Trabajo"
4021 TF$(2)="Archivo de Datos (.EST)"
4022 KL=2 : GOSUB 980
4023 IF ISP=0 THEN RETURN
4024 IF ISP=1 AND NF=0 THEN KE=1 : GOSUB 900 : RETURN
4025 LA=ISP : XX=LA
4026 WHILE LA=1
4030 NCX=NC : NFX=NF
4035 FOR K=1 TO NC : TCX$(K)=TC$(K) : NEXT K
4040 GOSUB 500 : PRINT : GOSUB 2405
4045 IF NCK=0 THEN RETURN
4050 KC=0 : IF CD$="" THEN 4070
4055 PRINT : INPUT "Se considera Condicion de Seleccion ? (N) = ",A$
4060 IF A$="S" OR A$="s" THEN KC=1
4070 NFX=NF : M=1
4080 GOSUB 2390
4102 LA=0
4103 WEND
4105 WHILE LA=2
4106 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
4107 PRINT : FILES DDA$+":*"+XA$
4108 IF KAR=1 THEN PRINT " No Existen" : KAR=0
4109 PRINT: INPUT "Nombre del Archivo = ",A$
4110 IF LEN(A$)=0 THEN RETURN
4111 KE=0
4112 GOSUB 950
4113 IF KAR=1 THEN PRINT : PRINT CHR$(7) : INPUT "** ARCHIVO NO EXISTENTE" ,A$
: KAR=0 : GOTO 4109
4114 IF KE=1 THEN 4109
4115 M=1 : ARC$(1)=A$
4116 GOSUB 3240 : CLOSE#1
4117 IF ISP=0 OR NCK=0 THEN RETURN
4118 KC=0 : LA=0
4119 WEND
4120 LA=XX
4122 PRINT : PRINT "Salida actual por Pantalla"
4123 GOSUB 650
4125 KS=1
4126 WHILE KS=1
4127 GOSUB 555
4128 KX=0 : KN=0
4129 IF LA=2 THEN PRINT#3,"Archivo de Datos = ";ARC$(1) : PRINT#3,
4130 FOR M=1 TO NCK STEP 6
4132 IF LA=1 THEN 4140
4133 OPEN XDDA$+ARC$(1)+EXT$ FOR INPUT AS #1
4134 LINE INPUT#1,A$ : INPUT#1,X,Y
4135 FOR K=1 TO NCX : INPUT#1,A$ : NEXT K
4140 KM=KN+1 : KN=KM+5
4145 IF KN>NCK THEN KN=NCK
4150 FOR I=1 TO NFX
4152 IF LA=2 THEN FOR K=1 TO NCX : INPUT#1,VY(K) : NEXT K
4153 IF I<IA(1) OR I>IB(1) THEN 4267
4155 WHILE KX=0
4157 N=0
4158 PRINT#3,
4160 FOR K=KM TO KN
4165 J=VX(K) : N=N+1
4170 PRINT#3,TAB(12*N-4);J;
4175 NEXT K
15 - 342
4180 PRINT#3, : PRINT#3,"Obs.";
4183 N=0
4185 FOR K=KM TO KN
4190 J=VX(K) : N=N+1
4195 PRINT#3,TAB(12*N-4);TCX$(J);
4200 NEXT K
4205 PRINT#3,
4210 KA=1 : KB=12*N+7 : GOSUB 695
4215 IL=8 : KX=1
4220 WEND
4225 IF NFX=0 THEN RETURN
4230 IF KC=1 AND A(I,0)=1 THEN 4270
4235 PRINT#3,I;
4237 N=0
4240 FOR K=KM TO KN
4245 J=VX(K) : N=N+1
4247 IF LA=1 THEN X=A(I,J)
4248 IF LA=2 THEN X=VY(J)
4250 PRINT#3,TAB(12*N-4);X;
4255 NEXT K
4260 PRINT#3,
4265 IL=IL+1
4267 IF (IL=22 OR I=NFX) AND DS$="SCRN:" THEN PRINT : INPUT
"Enter (F: fin) ",A$ : KX=0 : IF A$="F" OR A$="f" THEN I=NFX : M=NCK
4270 NEXT I
4273 KX=0
4274 CLOSE#1
4275 NEXT M
4280 GOSUB 650
4285 WEND
4290 RETURN
4295 '
4300 ' EST16 - Seleccion de Datos para procesos
4305 ' ----------------------------------------
4310 TSP$="Seleccion de Datos"
4315 GOSUB 555
4317 PRINT : PRINT "DEFINICION DE CONDICION DE SELECCION" : PRINT
4320 GOSUB 500
4325 IF LEN(CD$)=0 THEN 4360
4327 FOR I=1 TO NFM : A(I,0)=0 : NEXT I
4330 PRINT : PRINT "Condicion de Seleccion existente = ";CD$
4335 PRINT : INPUT " Se Elimina ? (N) = ",A$
4340 IF A$="S" OR A$="s" THEN CD$="" : RETURN
4345 INPUT " Se Modifica ? (N) = ",A$
4350 IF A$<>"S" AND A$<>"s" THEN 4412
4360 'PRINT : PRINT "Condicion a Ingresar = ",CD$
4365 'LOCATE CSRLIN-1,1
4370 PRINT : INPUT "Condicion a Ingresar = ",A$
4375 IF LEN(A$)=0 THEN CD$="" : RETURN
4380 CD$=A$
4385 OPEN DDA$+":xyz.bas" FOR OUTPUT AS #1
4390 PRINT#1,"4460 if not("+CD$+") THEN a(i,0)=1"
4395 CLOSE#1
4400 CHAIN MERGE DDA$+":xyz",4405,ALL
4405 KILL DDA$+":xyz.bas"
4410 ON ERROR GOTO 936
4412 FOR J=1 TO NC : V(J)=A(1,J) : NEXT J : I=1
4413 GOSUB 4460
4414 A(1,0)=0 : KMM=0
4415 L=LEN(CD$)
4416 FOR M=1 TO L-1
4417 A$=MID$(CD$,M,2)
4418 WHILE A$="V(" OR A$="v("
4419 M=M+1 : B$=""
4420 M=M+1
4421 C$=MID$(CD$,M,1)
4422 IF C$<>")" THEN B$=B$+C$ : GOTO 4420
4423 K=VAL(B$) : KMM=0
4424 IF K<1 OR K>NC OR TC$(K)=" " THEN KE=4 :
GOSUB 900 : KMM=1
4426 A$=""
15 - 343
4427 WEND
4428 NEXT M
4429 IF KE=1 OR KMM=1 THEN KE=0 : GOTO 4370
4430 FOR I=1 TO NF
4435 FOR J=1 TO NC : V(J)=A(I,J) : NEXT J
4440 GOSUB 4460
4445 NEXT I
4450 PRINT : INPUT "Seleccion Terminada - Enter ",A$ : GOSUB 1035
4455 ' Funcion de Seleccion
4460 IF NOT(V(5)>=35 AND V(5)<40) THEN A(I,0)=1
4465 RETURN
4470 '
4475 ' EST17 - Transformacion de Datos
4480 ' -------------------------------
4485 WHILE KW=0
4490 TSP$="Transformacion de Datos"
4493 NXX=0
4495 GOSUB 555
4500 PRINT "TRANSFORMACIONES"
4505 TF$(1)="Mediante una Funcion"
4510 TF$(2)="Normalizacion"
4515 TF$(3)="Recodificacion"
4520 TF$(4)="Corrimiento/Diferencias"
4525 TF$(5)="Calculo de Rangos"
4530 TF$(6)="Calculo de Variables Indicatrices"
4535 TF$(7)="Ordenamiento"
4540 KL=7 : GOSUB 980
4545 IF ISP=0 THEN RETURN
4550 TSP$=TSP$+" - "+TF$(ISP)
4555 GOSUB 555
4560 GOSUB 500
4565 IF ISP=1 THEN 4590
4570 PRINT : INPUT "VARIABLE A TRANSFORMAR = ",A$
4575 IF LEN(A$)=0 THEN RETURN
4580 JZ=VAL(A$)
4585 IF JZ<1 OR JZ>NC OR TC$(JZ)=" " THEN KE=4 :
GOSUB 900 : GOTO 4570
4590 IF ISP=6 THEN 4630
4595 PRINT : PRINT "VARIABLE CON VALORES TRANSFORMADOS"
4600 KVA=1 : GOSUB 390
4605 IF J=0 THEN RETURN
4615 KC=0 : IF CD$="" THEN 4630
4620 PRINT : INPUT "Se considera Condicion de Seleccion ? (N) = ",A$
4625 IF A$="S" OR A$="s" THEN KC=1
4630 ON ISP GOSUB 4650,4810,4880,5010,5046,5082,5142
4635 PRINT : INPUT "Transformacion Terminada - Enter ",A$
4640 WEND
4645 '
4650 ' EST171 - Transformacion mediante una Funcion
4655 ' --------------------------------------------
4660 PRINT : PRINT "DEFINICION DE FUNCION DE TRANSFORMACION" : PRINT
4665 GOSUB 500
4670 IF LEN(FU$)=0 THEN 4700
4675 PRINT "Funcion de Transformacion existente = ",FU$
4680 INPUT "Se Modifica ? (N) = ",A$
4685 IF A$<>"S" AND A$<>"s" THEN 4742
4690 'PRINT : PRINT "Funcion a Ingresar = ";FU$
4695 'LOCATE CSRLIN-1,1
4700 PRINT : INPUT "Funcion a Ingresar = ",A$
4705 IF LEN(A$)=0 THEN FU$="" : RETURN
4710 FU$=A$
4715 OPEN DDA$+":xyz.bas" FOR OUTPUT AS #1
4720 PRINT#1,"4795 A(i,j)="+FU$
4725 CLOSE#1
4730 CHAIN MERGE DDA$+":xyz",4735,ALL
4735 KILL DDA$+":xyz.bas"
4740 ON ERROR GOTO 936
4742 FOR K=1 TO NC : V(K)=A(1,K) : VX(K)=0 : NEXT K
4743 XX=A(1,J)
4744 GOSUB 4795
4746 A(1,J)=XX
15 - 344
4748 L=LEN(FU$)
4749 FOR M=1 TO L-1
4750 A$=MID$(FU$,M,2)
4751 WHILE A$="V(" OR A$="v("
4752 M=M+1 : B$=""
4753 M=M+1
4754 C$=MID$(FU$,M,1)
4755 IF C$<>")" THEN B$=B$+C$ : GOTO 4753
4756 K=VAL(B$) : KMM=0
4757 IF K<1 OR K>NC OR TC$(K)=" " THEN KE=4 :
GOSUB 900 : KMM=1
4758 VX(K)=1
4759 A$=""
4760 WEND
4761 NEXT M
4762 IF KE=1 OR KMM=1 THEN KE=0 : GOTO 4700
4763 FOR I=1 TO NF
4764 KMM=0
4765 IF KC=1 AND A(I,0)=1 THEN 4780
4770 FOR K=1 TO NC
4771 V(K)=A(I,K)
4772 IF VX(K)=1 AND V(K)=XVF THEN KMM=1
4773 NEXT K
4775 IF KMM=0 THEN GOSUB 4795 ELSE A(I,J)=XVF
4780 NEXT I
4785 PRINT : INPUT "Transformacion Terminada - Enter ",A$ : GOSUB 1035
4790 ' Funcion de Transformacion
4795 A(I,J)=V(2)+V(3)
4800 RETURN
4805 '
4810 ' EST172 - Normalizacion
4815 ' ----------------------
4820 XX=J : J=JZ
4825 GOSUB 5480
4830 J=XX
4835 IF NXX<2 THEN KE=3 : GOSUB 900 : RETURN
4840 FOR I=1 TO NF
4845 X=A(I,JZ)
4850 IF (KC=1 AND A(I,0)=1) THEN 4865
4855 IF X=XVF THEN A(I,J)=XVF : GOTO 4865
4860 A(I,J)=(X-PX)/DEX
4865 NEXT I
4870 RETURN
4875 '
4880 ' EST173 - Recodificacion de Datos
4885 ' --------------------------------
4890 XX=J : J=JZ
4895 PRINT : PRINT "Ingreso de Intervalos Valores Actuales" : PRINT
4900 K=1 : GOSUB 6010
4905 IF NVC(1)=0 THEN RETURN
4910 J=XX
4915 PRINT
4920 FOR M=0 TO NVC(1)
4925 PRINT "Nuevo valor para x ";
4930 IF M=0 THEN PRINT "< ";VC(M+1,1); : GOTO 4940
4935 IF M=NVC(1) THEN PRINT ">= ";VC(M,1); : GOTO 4940
4937 PRINT ">= ";VC(M,1);" y < ";VC(M+1,1);
4940 INPUT " = ",A$
4945 VC(M,2)=VAL(A$)
4950 NEXT M
4955 FOR I=1 TO NF
4960 X=A(I,JZ)
4965 IF (KC=1 AND A(I,0)=1) THEN 4995
4970 IF X=XVF THEN A(I,J)=XVF : GOTO 4995
4975 A(I,J)=VC(NVC(1),2)
4980 FOR M=1 TO NVC(1)
4985 IF X<VC(M,1) THEN A(I,J)=VC(M-1,2) : M=NVC(1)
4990 NEXT M
4995 NEXT I
5000 RETURN
5005 '
15 - 345
5010 ' EST174 - Corrimiento/Diferencias
5012 ' --------------------------------
5014 PRINT : PRINT "PROCESO"
5015 TF$(1)="Corrimiento"
5016 TF$(2)="Diferencia"
5017 KL=2 : GOSUB 980
5018 IF ISP=0 THEN RETURN
5020 PRINT : INPUT " Numero de Observaciones para Corrim/Difer. = ",A$
5022 IF LEN(A$)=0 THEN RETURN
5024 K=VAL(A$)
5026 IF K<1 OR K>NF-1 THEN KE=5 : B$=">=1 y <="+STR$(NF-1) :
GOSUB 900 : GOTO 5020
5028 FOR I=1 TO NF
5030 IF I<=K THEN A(I,J)=XVF : GOTO 5040
5031 X=A(I-K,JZ)
5032 IF (KC=1 AND A(I-K,0)=1) THEN 5040
5033 IF X=XVF THEN A(I,J)=XVF : GOTO 5040
5034 IF ISP=1 THEN A(I,J)=X
5035 IF ISP=2 THEN Y=A(I,JZ) : IF (KC=1 AND A(I,0)=1) THEN 5040
5036 IF ISP=2 THEN IF Y=XVF THEN A(I,J)=XVF : GOTO 5040
5038 IF ISP=2 THEN A(I,J)=Y-X
5040 NEXT I
5042 RETURN
5044 '
5046 ' EST175 - Calculo de Rangos
5048 ' --------------------------
5050 N=0
5052 FOR I=1 TO NF
5053 X=A(I,JZ)
5054 IF (KC=1 AND A(I,0)=1) THEN 5060
5055 IF X=XVF THEN A(I,J)=XVF : GOTO 5060
5056 N=N+1
5058 VX(N)=X : VY(N)=I
5060 NEXT I
5062 IF N<2 THEN KE=3 : GOSUB 900 : RETURN
5064 XX=J
5066 GOSUB 5188
5068 J=XX
5070 FOR I=1 TO N
5072 IK=VY(I)
5074 A(IK,J)=VX(I+N)
5076 NEXT I
5078 RETURN
5080 '
5082 ' EST176 - Calculo de Variables Indicatrices
5084 ' ------------------------------------------
5086 PRINT : PRINT "Ingreso de Intervalos Valores Actuales" : PRINT
5088 J=JZ
5090 K=1 : GOSUB 6010
5092 IF NVC(1)=0 THEN RETURN
5094 PRINT
5096 NVI=NVC(1)-1
5097 PRINT : PRINT "ALMACENAM. DE VARIABLES INDICAT. EN MEMORIA DE TRABAJO"
5098 FOR K=1 TO NVI
5100 PRINT : PRINT "Variable Indicatriz Nro.";K
5102 IF K>1 THEN KVA=1
5104 GOSUB 390
5108 VX(K)=J
5110 NEXT K
5112 FOR I=1 TO NF
5114 X=A(I,JZ)
5116 KMM=0 : IF (KC=1 AND A(I,0)=1) OR X=XVF THEN KMM=1
5120 KX=0
5122 FOR K=1 TO NVI
5124 J=VX(K)
5126 IF J=0 THEN KX=1 : GOTO 5132
5128 IF KMM=1 THEN A(I,J)=XVF : KX=1 : GOTO 5132
5130 IF X>=VC(K,1) AND X<VC(K+1,1) THEN A(I,J)=1 : KX=1 ELSE A(I,J)=0
5132 NEXT K
5134 IF KX=0 THEN PRINT: PRINT "Observacion Nro.";I;" no se encontro valor"
5136 NEXT I
15 - 346
5138 RETURN
5140 '
5142 ' EST177 - Ordenamiento
5144 ' ---------------------
5146 PRINT : PRINT "TIPO DE ORDENAMIENTO"
5148 TF$(1)="De Menor a Mayor"
5150 TF$(2)="De Mayor a Menor"
5152 KL=2 : GOSUB 980
5154 IF ISP=0 THEN RETURN
5156 N=0
5158 FOR I=1 TO NF
5160 X=A(I,JZ)
5162 IF (KC=1 AND A(I,0)=1) OR X=XVF THEN 5170
5166 IF ISP=2 THEN X=-X
5168 N=N+1 : VX(N)=X : VY(N)=I
5170 NEXT I
5171 IF N<2 THEN KE=3 : GOSUB 900 : RETURN
5172 GOSUB 5226
5174 FOR I=1 TO N
5176 X=VX(I)
5178 IF ISP=2 THEN X=-X
5180 A(I,J)=X
5182 NEXT I
5183 IF N<NF THEN FOR I=N+1 TO NF : A(I,J)=XVF : NEXT I
5184 RETURN
5186 '
5188 ' EST178 - Determinacion de Rangos de un vector de valores
5190 ' --------------------------------------------------------
5192 FOR I=1 TO N : VX(I+N)=0 : NEXT I
5194 FOR I=1 TO N
5196 IF VX(I+N)>0 THEN 5220
5198 NM=0 : NI=0
5200 X=VX(I)
5202 FOR J=1 TO N
5204 IF VX(J)<X THEN NM=NM+1
5206 IF VX(J)=X THEN NI=NI+1 : VX(J+N)=-1
5208 NEXT J
5210 IF NI<=1 THEN VX(I+N)=NM+1 : GOTO 5220
5212 P=NM+(NI+1)*.5
5214 FOR J=1 TO N
5216 IF VX(J+N)=-1 THEN VX(J+N)=P
5218 NEXT J
5220 NEXT I
5222 RETURN
5224 '
5226 ' EST179 - Ordenamiento de un vector de valores
5228 ' ---------------------------------------------
5230 LOG2=INT(LOG(N)*(1!/.69314728#)+.00001)
5232 MM=N
5234 FOR NN=1 TO LOG2
5236 MM=INT(MM/2)
5238 K=N-MM
5240 FOR JJ=1 TO K
5242 I=JJ
5244 L=I+MM
5246 IF VX(L)>=VX(I) THEN 5256
5248 X=VX(I) : VX(I)=VX(L) : VX(L)=X
5250 X=VY(I) : VY(I)=VY(L) : VY(L)=X
5252 I=I-MM
5254 IF I>=1 THEN 5244
5256 NEXT JJ
5258 NEXT NN
5260 RETURN
5262 '
5264 '
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
15 - 347
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 '
6010 ' EST221 - Ingreso de Valores de Clasificacion
6015 ' --------------------------------------------
6020 IF NVC(K)=0 THEN 6050
6025 PRINT : PRINT "Valores Actuales de Clasificacion" : PRINT
6030 FOR M=1 TO NVC(K) : PRINT VC(M,K);" - "; : NEXT M : PRINT
6035 PRINT : INPUT "Ingreso de Nuevos Valores de Clasificacion (S/N) = ";A$
6040 IF A$<>"S" AND A$<>"s" THEN VC(0,K)=VC(1,K) : RETURN
6045 NVC(K)=0
6050 GOSUB 5480
6055 PRINT "(Valores Maximo y Minimo de los Datos = ";XMI;"-";XMA;")"
6060 PRINT
6065 INPUT " Valor de la Variable = ",A$
6070 IF LEN(A$)=0 THEN RETURN
6075 XB=VAL(A$)
6080 IF NVC(K)>0 AND XB<=X THEN GOSUB 900 : GOTO 6065
6085 IF NVC(K)=0 THEN 6125
6090 INPUT " Incremento para obtener Valores intermedios = ",A$
6095 DI=VAL(A$)
6100 IF DI<0 OR DI>XB-X THEN GOSUB 900 : GOTO 6090
6105 WHILE DI>0 AND X+DI<XB
6110 X=X+DI
6115 NVC(K)=NVC(K)+1 : VC(NVC(K),K)=X
6120 WEND
6125 NVC(K)=NVC(K)+1 : VC(NVC(K),K)=XB : X=XB : GOTO 6065
7500 ' EST9 - Cambio de Parametros
7505 ' ---------------------------
7510 TSP$="Cambio de Parametros"
7515 WHILE KW=0
7520 KMM=0
7525 GOSUB 555
7530 PRINT : PRINT "VALORES ACTUALES DE PARAMETROS" : PRINT
7535 TF$(1)=" 1 - Disposit. Archivo de datos (A,B o C) = " :PRINT TF$(1);DDA$
7540 TF$(2)=" 2 - Numero de Variables (1 a 100) =" : PRINT TF$(2);NCM
7545 TF$(3)=" 3 - Numero de Observaciones (10 a 1000) =" : PRINT TF$(3);NFM
7550 TF$(4)=" 4 - Parametro Proceso 1 (5 a 100) =" :PRINT TF$(4);PAR1
7555 TF$(5)=" 5 - Parametro Proceso 2 (2 a 50) =" :PRINT TF$(5);PAR2
7560 TF$(6)=" 6 - Valor faltante =" : PRINT TF$(6);XVF
7565 TF$(7)=" 7 - Numero de decimales (mayor que 0) =" : PRINT TF$(7);NDE
7570 PRINT : INPUT "Numero de Parametro a modificar = ",A$
7575 IF LEN(A$)=0 AND KME=1 THEN 7650
7580 IF LEN(A$)=0 THEN RETURN
7585 ISP=VAL(A$)
7590 IF ISP<1 OR ISP>7 THEN GOSUB 900 : GOTO 7525
7595 IF KMM=1 OR NC=0 OR (ISP<>2 AND ISP<>3) THEN 7615
7600 PRINT : PRINT "Un cambio en este parametro implica el borrado"
7605 INPUT "de la memoria de trabajo - Se continua ? (N) = ",A$
7610 IF A$<>"S" AND A$<>"s" THEN 7675
7615 PRINT
7620 PRINT TAB(3);TF$(ISP); : INPUT " ",A$
7625 IF LEN(A$)=0 THEN 7675
7630 X=VAL(A$)
7635 ON ISP GOSUB 7685,7710,7730,7750,7770,7790,7805
7640 KME=0
7645 XMEM=4*(NFM*NCM+(PAR1+1)*(PAR2+1))
7650 IF XMEM>40000! THEN PRINT : PRINT "Los valores de los parametros" : PRINT
"exceden la memoria disponible" : INPUT "",A$ : KME=1 : GOTO 7675
15 - 348
7655 IF KMM=0 THEN 7675
7660 ERASE A,TC$,JX
7665 DIM A(NFM,NCM),TC$(NCM),JX(NCM)
7670 DA$="" : NA$="" : NC=0 : NF=0 : NV=0 : NX=0
7675 WEND
7680 '
7685 IF LEN(A$)>1 THEN GOSUB 900 : RETURN
7690 IF INSTR("ABCabc",A$)=0 THEN GOSUB 900 : RETURN
7695 DDA$=A$
7700 RETURN
7705 '
7710 IF X<1 OR X>100 THEN GOSUB 900 : RETURN
7715 NCM=X : KMM=1
7720 RETURN
7725 '
7730 IF X<10 OR X>1000 THEN GOSUB 900 : RETURN
7735 NFM=X : KMM=1
7740 RETURN
7745 '
7750 IF X<5 OR X>100 THEN GOSUB 900 : RETURN
7755 PAR1=INT(X)
7760 RETURN
7765 '
7770 IF X<2 OR X>PAR1 OR X>50 THEN GOSUB 900 : RETURN
7775 PAR2=INT(X)
7780 RETURN
7785 '
7790 XVF=X
7795 RETURN
7800 '
7805 IF X<1 OR X>6 THEN GOSUB 900 : RETURN
7810 NDE=X
7815 RETURN
10 ' ESTAD2 - Revision 6/11/88
15 '
21 GOSUB 1000
25 CHAIN "ESTAD"
200 ' EST91 Definicion de Variables
205 ' ---------------------------
210 GOSUB 500
215 IF NV=0 THEN 265
220 PRINT
225 KX=0 : 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
15 - 349
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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 ' ---------------
15 - 350
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
NEXT
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
NEXT
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 = "; : XX=CSRLIN : LOCATE XX,18,1
991 B$=INKEY$ : PRINT B$;
15 - 351
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 ' EST2 - Analisis Descriptivo de Datos
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 VX(NFM),VY(NFM),TF$(7),TG$(NCM),PM(NCM),DE(NCM),MX(2),IJ(2)
1030 DIM TI(PAR1+1,PAR2+1),TJ(PAR1+1,PAR2+1),TK(PAR1+1,PAR2+1)
1032 DIM VC(PAR1,2),NVC(2)
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$="ANALISIS DESCRIPTIVO DE DATOS" : TSP$=""
1053 NXX=0
1055 GOSUB 555
1060 PRINT TAB(70);FRE(0)
1065 PRINT "PROCESOS" : PRINT
1070 TF$(1)="Calculo de Estadisticas Descriptivas"
1075 TF$(2)="Clasificacion de Datos"
1080 TF$(3)="Calculo de Estadisticas de Datos Clasificados"
1085 TF$(4)="Graficacion de datos"
1090 TF$(5)="Manejo de Datos"
1095 KL=5 : GOSUB 980
1100 IF ISP=0 THEN RETURN
1105 IF ISP=5 THEN CHAIN "ESTAD1"
1110 IF NF=0 THEN KE=1 : GOSUB 900 : GOTO 1120
1115 ON ISP GOSUB 1125,1580,2130,5200
1120 WEND
1123 '
1125 ' EST21 - Calculo de Estadisticas Descriptivas
1130 ' --------------------------------------------
1135 TSP$="Calculo de Estadisticas Descriptivas"
1140 GOSUB 555
1141 PRINT " .Para Una Variable se calculan todas las Estadisticas" : PRINT
1142 PRINT " .Para Dos o mas Variables se calculan la Suma, Valor Medio,"
1143 PRINT " Desvio Estandar, Covariancias y Correlaciones"
1145 PRINT
1150 PRINT "DEFINICION DE VARIABLES (1 a";PAR2;")"
1155 KNV=PAR2 : GOSUB 200
1160 IF NV=0 THEN RETURN
1163 IF NV>KNV THEN KE=2 : GOSUB 900 : GOTO 1145
1165 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
1170 '
1175 WHILE NV=1
1180 J=JX(1)
1185 GOSUB 5480
1190 IF NXX<3 THEN KE=3 : KNM=3 : GOSUB 900 : RETURN
1195 GOSUB 5585
1200 KS=1
1205 WHILE KS=1
1210 GOSUB 555
1215 PRINT#3,"VARIABLE = ";J;" - ";TC$(J)
1220 PRINT#3,
1225 PRINT#3," Suma = ";SX
1230 PRINT#3," Valor Medio = ";FNR(PX,NDE)
1235 PRINT#3," Mediana = ";FNR(XMED,NDE)
1240 PRINT#3," Desvio Estandar Observac. = ";FNR(DEM,NDE)
1245 PRINT#3," Desvio Estandar Poblacion = ";FNR(DEX,NDE)
1250 PRINT#3," Valor Minimo / Maximo = ";XMI;" / ";XMA
15 - 352
1255 PRINT#3," Primer / Tercer Cuartil = ";FNR(PC,NDE);" / ";
FNR(TC,NDE)
1260 PRINT#3," Rango / Rango Intercuartil= ";(XMA-XMI);" / ";
FNR(TC-PC,NDE)
1265 PRINT#3," Coeficiente de Asimetria = ";FNR(AS,NDE)
1270 PRINT#3," Coeficiente de Curtosis = ";FNR(CU,NDE)
1280 IF PX>0 THEN
PRINT#3," Coefic.Variac.(Desv/V.Med)= ";FNR(DEX/PX,NDE)
1290 IF DEX>0 THEN
PRINT#3," Rango/Desvio Estd.Poblac. = ";FNR((XMA-XMI)/DEX,NDE)
1295 PRINT : GOSUB 650
1300 WEND
1305 RETURN
1310 WEND
1315 '
1320 WHILE NV>1
1325 GOSUB 5825
1327 IF NXX<3 THEN KE=3 : KNM=3 : GOSUB 900 : RETURN
1328 KS=1
1330 WHILE KS=1
1345 GOSUB 555
1350 PRINT#3, : PRINT#3," Variable Suma Observ.";
" Valor Medio Desvio Estd."
1355 FOR K=1 TO NV
1360 J=JX(K)
1365 KA=3 :KB=66 : GOSUB 695
1370 PRINT#3,TAB(3);J;"-"TC$(J);TAB(21);FNR(VX(K),NDE);TAB(37);
FNR(PM(K),NDE);TAB(53);FNR(DE(K),NDE)
1375 NEXT K
1380 KA=3 :KB=66 : GOSUB 695
1385 GOSUB 650
1390 WEND
1395 '
1400 WHILE KW=0
1405 GOSUB 555
1410 PRINT "RESULTADOS COMPLEMENTARIOS"
1415 TF$(1)="Matriz de Covariancias"
1420 TF$(2)="Matriz de Coeficientes de Correlacion"
1425 TF$(3)="Matriz de Signific.Coefic.Correlacion (%)"
1427 TF$(4)="Archivo con Coeficientes Correlacion"
1430 KL=4 : GOSUB 980
1435 IF ISP=0 THEN RETURN
1438 C$=TF$(ISP)
1440 IF ISP<4 THEN GOSUB 5974
1446 IF ISP=4 THEN KXX=2 : GOSUB 6560
1565 WEND
1570 WEND
1575 '
1580 ' EST22 - Clasificacion de Datos
1585 ' ------------------------------
1590 TSP$="Clasificacion de Datos"
1595 GOSUB 555
1605 PRINT "DEFINICION DE VARIABLES DE CLASIFICACION (1 o 2)"
1610 KNV=2 : GOSUB 200
1615 IF NV=0 THEN RETURN
1620 IF NV>2 THEN KE=2 : GOSUB 900 : GOTO 1595
1625 '
1630 PRINT : PRINT : PRINT "INGRESO VALORES DE CLASIFICACION"
1635 FOR K=1 TO NV
1640 J=JX(K)
1645 PRINT : PRINT " VARIABLE =";J;" - ";TC$(J)
1650 KX=0 : GOSUB 6010
1655 IF NVC(K)=0 THEN RETURN
1660 MX(K)=1
1665 NEXT K
1670 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
1675 '
1680 NVI=NV : KA=0
1685 GOSUB 6140
1690 IF NXX<2 THEN KE=3 : KNM=2 : GOSUB 900 : RETURN
1695 WHILE NVI=1
15 - 353
1700 KS=1 : IL=10
1705 WHILE KS=1
1710 GOSUB 555
1715 PRINT#3, : PRINT#3,"VARIABLE = ";JX(1);"-";TC$(JX(1))
1720 PRINT#3, : PRINT#3,TAB(3);"Valor Nro.Observ. % % Acum.";
1725 PRINT#3,TAB(38);"0%";TAB(57);"50%";TAB(75);"100%"
1730 KA=3 : KB=79 : GOSUB 695
1735 PRINT#3,TAB(38);"I";TAB(58);"I";TAB(78);"I"
1737 Y=0
1740 FOR M=MX(1) TO NVC(1)
1745 IF M=0 AND TI(M,1)=0 THEN 1780
1750 B$=">=" : IF M=0 THEN B$="< "
1755 IF MX(1)=1 THEN B$=" "
1760 X=TI(M,1)*100/NXX
1763 Y=Y+X
1764 PRINT#3,TAB(3);B$;VC(M,1);TAB(15);TI(M,1);TAB(20);
1765 PRINT#3,USING "###"+AD$;X; : PRINT#3,TAB(28);
1766 PRINT#3,USING "###"+AD$;Y;
1768 IF X=0 THEN PRINT#3,TAB(38);"."; : GOTO 1775
1770 PRINT#3,TAB(38);: FOR L=1 TO INT(X/2.5+.5) : PRINT#3,"*";: NEXT L
1775 IF Y>X THEN PRINT#3,TAB(INT(38.5+Y/2.5));"." ELSE PRINT#3,
1778 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN IL=0 : INPUT "",A$
1780 NEXT M
1782 KA=3 : KB=79 : GOSUB 695
1785 GOSUB 650
1790 WEND
1795 NVI=0
1800 WEND
1805 '
1810 WHILE NVI=2
1815 PRINT : PRINT "TABULADOS OPTATIVOS"
1820 TF$(1)="En Numero de Observaciones"
1825 TF$(2)="En Numero de Observaciones (Estimado)"
1830 TF$(3)="En Porcentajes por Total"
1835 TF$(4)="En Porcentajes por Total (Estimados)"
1840 TF$(5)="En Porcentajes por Fila"
1845 TF$(6)="En Porcentajes por Columna"
1850 KL=6 : GOSUB 980
1855 KS=1 : IL=10
1860 IF ISP=0 THEN KS=0 : NVI=0
1865 WHILE KS=1
1870 GOSUB 555
1875 PRINT#3, : PRINT#3,"CLASIFICACION: ";TF$(ISP) : PRINT#3,
1880 KN=-1 : KP=9
1885 FOR L=0 TO NA STEP KP
1890 KM=KN+1 : KN=KM+KP-1
1895 IF KN>NA THEN KN=NA
1900 PRINT#3,TAB(3);"VAR.";JX(1);TAB(7*(KN-KM)/2+10);"VARIABLE";JX(2);"- ";
TC$(JX(2))
1905 PRINT#3,TAB(3);TC$(JX(1));
1910 FOR N=KM TO KN
1915 IF N=NA THEN PRINT#3,TAB(7*(N-KM)+16);"Total" : GOTO 1940
1920 B$=">=" : IF N=0 THEN B$=" <"
1925 IF MX(2)=1 THEN B$=" "
1927 IF N=0 AND TI(MA,N)=0 THEN 1935
1930 PRINT#3,TAB(7*(N-KM)+15);B$;VC(N,2);
1935 NEXT N
1937 PRINT#3,
1940 KA=3 : KB=7*(KN-KM)+21 : GOSUB 695
1945 FOR M=0 TO MA
1950 IF M=0 AND TI(M,NA)=0 THEN 2035
1955 B$=">=" : IF M=0 THEN B$="< "
1960 IF MX(1)=1 THEN B$=" "
1965 IF M<MA THEN PRINT#3,TAB(3);B$;VC(M,1); ELSE GOSUB 695:
PRINT#3,TAB(3);"Total";
1970 FOR N=KM TO KN
1975 IF N=0 AND TI(MA,N)=0 THEN 2030
1980 X=TI(M,N)
1985 IF ISP=2 OR IPC=4 THEN X=TI(MA,N)*TI(M,NA)/NXX
1990 IF ISP=3 AND TI(MA,NA)=0 THEN X=0 : GOTO 2025
1995 IF ISP=3 THEN X=100*X/TI(MA,NA)
15 - 354
2000 IF ISP=4 THEN X=100*X/NXX
2005 IF ISP=5 AND TI(M,NA)=0 THEN X=0 : GOTO 2025
2010 IF ISP=5 THEN X=100*X/TI(M,NA)
2015 IF ISP=6 AND TI(MA,N)=0 THEN X=0 : GOTO 2025
2020 IF ISP=6 THEN X=100*X/TI(MA,N)
2022 A$="#######" : IF ISP>1 THEN A$="#####.#"
2025 PRINT#3,TAB(7*(N-KM)+13); : PRINT#3,USING A$;X;
2030 NEXT N
2032 PRINT#3,
2033 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN IL=0 : INPUT "",A$
2035 NEXT M
2036 KA=3 : KB=7*(KN-KM)+21 : GOSUB 695
2040 IF DS$="SCRN:" AND KN<NA THEN INPUT "Enter",A$ : PRINT#3,
2045 NEXT L
2050 GOSUB 650
2055 WEND
2060 WEND
2065 NVI=NV
2070 KZ=0
2075 WHILE KZ=0
2080 GOSUB 555
2085 PRINT "PROCESOS COMPLEMENTARIOS"
2090 TF$(1)="Verificacion Independencia Clasificacion"
2095 TF$(2)="Grabacion Archivo con Resultados Clasificacion"
2100 KL=2 : GOSUB 980
2105 IF ISP=0 THEN RETURN
2110 KXX=0 : ON ISP GOSUB 6350,6560
2115 WEND
2120 RETURN
2125 '
2130 ' EST23 - Calculo de Estadisticas de Datos Clasificados
2135 ' -----------------------------------------------------
2140 TSP$="Calculo de Estadisticas de Datos Clasificados"
2145 GOSUB 555
2155 PRINT "DEFINICION DE VARIABLES (2 o 3)"
2160 PRINT " Las Estadisticas se calculan para la ultima Variable"
2165 KNV=3 : GOSUB 200
2170 IF NV=0 THEN RETURN
2175 IF NV<2 OR NV>3 THEN KE=2 : GOSUB 900 : GOTO 2145
2185 JE=JX(NV)
2190 NVI=NV-1
2195 PRINT : PRINT : PRINT "INGRESO VALORES DE CLASIFICACION"
2200 FOR K=1 TO NVI
2205 J=JX(K)
2210 PRINT : PRINT " VARIABLE =";J;" - ";TC$(J)
2215 KX=0 : GOSUB 6010
2220 IF NVC(K)=0 THEN RETURN
2222 MX(K)=1
2225 NEXT K
2230 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
2235 '
2240 KA=1
2245 GOSUB 6140
2250 IF NXX<2 THEN KE=3 : KNM=2 : GOSUB 900 : RETURN
2255 KS=1
2260 WHILE KS=1
2265 GOSUB 555
2275 KX=0 : IL=7
2280 FOR N=0 TO NVC(2)+1
2281 IF N=0 AND TI(MA,N)=0 THEN 2435
2282 FOR M=0 TO NVC(1)+1
2283 IF M=0 AND TI(M,NA)=0 THEN 2420
2285 WHILE KX=0
2286 IF NVC(2)=0 THEN 2295
2288 B$=">=" : IF N=0 THEN B$="< "
2289 IF MX(2)=1 THEN B$=" "
2290 IF N<=NVC(2) THEN PRINT#3, : PRINT#3,TAB(3);"VARIABLE";JX(2);"- ";
TC$(JX(2));B$;VC(N,2) : PRINT#3,
2291 IF N>NVC(2) THEN PRINT#3, : PRINT#3,TAB(3);"TOTAL" : PRINT#3,
2295 PRINT#3," VARIABLE";TAB(28);"VARIABLE";JE;"- ";TC$(JE)
2297 PRINT#3,TAB(6);JX(1);"- ";TC$(JX(1));
15 - 355
2315 PRINT#3,TAB(23);"Nro Obs. Suma Obs. Valor Medio Desv.Estd."
2320 KA=6 : KB=69 : GOSUB 695
2325 IL=IL+5 : KX=1
2330 WEND
2360 NXC=TI(M,N)
2375 B$=">=" : IF M=0 THEN B$="< "
2380 IF MX(1)=1 THEN B$=" "
2385 IF M<=NVC(1) THEN PRINT#3,TAB(7);B$;VC(M,1);
ELSE PRINT#3," Total";
2390 CA=0 : IF NXC>0 THEN CA=TJ(M,N)/NXC
2395 CB=0 : IF NXC>1 THEN CB=SQR((TK(M,N)-NXC*CA^2)/(NXC-1))
2400 PRINT#3,TAB(24);NXC;TAB(34);FNR(TJ(M,N),NDE);TAB(47);
FNR(CA,NDE);TAB(58);FNR(CB,NDE)
2405 KA=6 : KB=69 : GOSUB 695 :IL=IL+2
2415 IF IL>21 AND DS$="SCRN:" THEN IL=5 : INPUT "",A$
2420 NEXT M
2425 IF NVC(2)=0 THEN N=1
2430 IF N<NVC(2)+1 AND DS$="SCRN:" THEN KX=0 : IL=7 : INPUT "Enter ",A$
2435 NEXT N
2440 GOSUB 650
2445 WEND
2450 PRINT : INPUT "Creacion Archivo Resultados ? (N) = ",A$
2455 IF A$="S" OR A$="s" THEN KXX=1 : GOSUB 6560
2460 RETURN
2465 '
2600 ' EST179 - Ordenamiento de un vector de valores
2605 ' ---------------------------------------------
2610 KM=INT(LOG(N)*(1!/.69314728#)+.00001)
2615 MM=N
2620 FOR NN=1 TO KM
2625 MM=INT(MM/2)
2630 K=N-MM
2635 FOR JJ=1 TO K
2640 I=JJ
2645 L=I+MM
2650 IF VX(L)>=VX(I) THEN 2675
2655 X=VX(I) : VX(I)=VX(L) : VX(L)=X
2660 X=VY(I) : VY(I)=VY(L) : VY(L)=X
2665 I=I-MM
2670 IF I>=1 THEN 2645
2675 NEXT JJ
2680 NEXT NN
2685 RETURN
2700 '
5200 ' EST24 - Graficacion
5205 ' -------------------
5210 TSP$="Graficacion"
5215 WHILE KW=0
5220 GOSUB 555
5222 PRINT "TIPO DE GRAFICACION"
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 M=1 TO 2
5265 IF M>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 : KX=0 :
XMX(1)=INT(NF/5+1)*5 : DEL(1)=XMX(1)/5 : GOTO 5460
5285 KX=VAL(A$) : J=KX
5288 IF J<1 OR J>NC OR TC$(J)=" " THEN KE=4 : GOSUB 900 :
PRINT : GOTO 5270
5290 GOSUB 5480
5293 IF NXX<1 THEN KE=3 : GOSUB 900 : RETURN
5295 XC=XMI : XD=XMA
5300 TG$(0)=TC$(KX) : GOTO 5380
5305 XC=1E+10 : XD=-1E+10
15 - 356
5310 PRINT
5315 FOR L=1 TO KM
5320 PRINT "Variable Dependiente";L;
5325 INPUT " = ",A$
5330 IF LEN(A$)=0 THEN NG=L-1 : L=KM : GOTO 5365
5335 NG=L
5340 JY(L)=VAL(A$) : J=JY(L)
5343 IF J<1 OR J>NC OR TC$(J)=" " THEN KE=4 : GOSUB 900 :
PRINT : GOTO 5320
5345 GOSUB 5480
5347 IF NXX<1 THEN KE=3 : GOSUB 900 : RETURN
5350 IF XMI<XC THEN XC=XMI
5355 IF XMA>XD THEN XD=XMA
5360 TG$(L)=TC$(JY(L))
5365 NEXT L
5370 IF NG=0 THEN RETURN
5375 PRINT
5377 A$="X" : IF M=2 THEN A$="Y"
5378 PRINT "ROTULACION DEL EJE ";A$
5380 PRINT " (Valores Maximo y Minimo de los Datos = ";XC;"-";XD;")"
5383 PRINT
5385 INPUT " Valor Minimo = ",A$
5390 IF LEN(A$)=0 THEN RETURN
5395 XMN(M)=VAL(A$)
5400 INPUT " Valor Maximo = ",A$
5405 IF LEN(A$)=0 THEN RETURN
5407 XMX(M)=VAL(A$)
5410 IF XMX(M)<=XMN(M) THEN KE=5 : B$=">"+STR$(XMN(M)) :
GOSUB 900 : PRINT : GOTO 5400
5415 INPUT " Intervalo = ",A$
5420 IF LEN(A$)=0 THEN RETURN
5425 DEL(M)=VAL(A$)
5430 IF DEL(M)>(XMX(M)-XMN(M)) THEN KE=5 : B$="<="+
STR$(XMX(M)-XMN(M)) : GOSUB 900 : PRINT : GOTO 5415
5435 IF ISP=1 OR M=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$)
5457 IF JV<1 OR JV>NC OR TC$(JV)=" " THEN KE=4 : GOSUB 900 :
GOTO 5440
5460 NEXT M
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
5510 X= A(I,J)
5515 IF A(I,0)=1 OR 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 '
5585 ' EST212 - Calculo de Mediana, Asimetria y Curtosis
5590 ' -------------------------------------------------
5595 N=0 : SCX=0 : AS=0 : CU=0
5600 FOR I=1 TO NF
15 - 357
5610 X=A(I,J)
5615 IF A(I,0)=1 OR X=XVF THEN 5645
5620 ND=1 : IF JF>0 THEN ND=A(I,JF)
5625 IF ND=XVF THEN 5645
5630 N=N+1 : VX(N)=X : VY(N)=I
5632 SCX=SCX+ND*(X-PX)^2
5635 AS=AS+ND*(X-PX)^3
5640 CU=CU+ND*(X-PX)^4
5645 NEXT I
5650 IF N<3 THEN RETURN
5655 AS=SQR(N)*AS/SCX^(1.5)
5660 CU=N*CU/SCX^2-3
5665 GOSUB 2600
5670 FOR M=1 TO 3
5672 PM(M)=M*(NXX+1)/4
5674 NEXT M
5676 FOR M=1 TO 3
5677 KX=PM(M)
5678 XX=PM(M)-KX
5679 IF JF=0 THEN XA=VX(KX) : XB=VX(KX+1) : GOTO 5686
5680 NXA=0
5681 FOR I=1 TO N
5682 NXA=NXA+A(VY(I),JF)
5683 IF NXA=KX THEN XA=VX(I) : XB=VX(I+1) : I=N
5684 IF NXA>KX THEN XA=VX(I) : XB=VX(I) : I=N
5685 NEXT I
5686 PM(M)=(1-XX)*XA+XX*XB
5687 NEXT M
5688 PC=PM(1) : XMED=PM(2) : TC=PM(3)
5690 RETURN
5727 '
5825 ' EST213 - 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 VX(K)=A(I,JX(K))
5895 IF VX(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)+VX(K)*ND
5920 FOR L=1 TO K
5925 TI(K,L)=TI(K,L)+VX(K)*VX(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)
5962 PM(K)=PM(K)/NXX
5964 DE(K)=SQR((TI(K,K)-NXX*PM(K)^2)/(NXX-1))
5966 FOR L=1 TO K
5968 TI(K,L)=(TI(K,L)-NXX*PM(K)*PM(L))/(NXX-1)
5970 TI(L,K)=TI(K,L)
5971 NEXT L,K
5972 RETURN
5973 '
5974 ' EST214 - Salida Covar. y Coef.Correlac.
5975 ' ---------------------------------------
5976 KS=1 : IL=10
5977 WHILE KS=1
15 - 358
5978 PRINT#3, : PRINT#3, : PRINT#3,C$
5979 PRINT#3, : KN=0 : KP=5 : KES=12 : IF ISP>1 THEN KP=7 : KES=8
5981 FOR M=1 TO NV STEP KP
5982 KM=KN+1 : KN=KM+KP-1
5983 IF KN>NV THEN KN=NV
5984 PRINT#3,"Variable";
5985 FOR K=KM TO KN : PRINT#3,TAB(KES*(K-KM+1)+12);JX(K); : NEXT K
5986 PRINT#3, : PRINT#3,
5987 FOR KT=1 TO KN : KST=KM : IF KT>=KM THEN KST=KT
5988 PRINT#3,TAB(3);JX(KT);TAB(7);"-";TC$(JX(KT));
5989 FOR L=KST TO KN
5990 CA=1 : IF ISP>1 THEN CA=DE(KT)*DE(L)
5991 IF CA>0 THEN X=TI(L,KT)/CA : TJ(L,KT)=X ELSE X=0
5992 IF ISP<3 THEN 5998
5993 IF X>.9999 THEN X=0 : GOTO 5998
5994 X=ABS(X*SQR((NXX-2)/(1-X*X)))
5995 P(1)=NXX-2
5996 IP=1 : GOSUB 8800
5997 X=200*(1-FP)
5998 A$="########"+AE$ : IF ISP=2 THEN A$="###"+AE$
5999 IF ISP=3 THEN A$="###"+AD$
6000 PRINT#3,TAB(KES*(L-KM)+17); : PRINT#3,USING A$;X;
6001 NEXT L
6002 PRINT#3, : IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN IL=0 : INPUT "",A$
6003 NEXT KT
6004 IF KN<NV AND DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$ : PRINT#3,
6005 NEXT M
6006 GOSUB 650
6007 WEND
6008 RETURN
6009 '
6010 ' EST221 - Ingreso de Valores de Clasificacion
6015 ' --------------------------------------------
6017 IJ(1)=PAR1 : IJ(2)=PAR2
6020 IF NVC(K)=0 THEN 6045
6025 PRINT : PRINT " Valores Actuales" : PRINT TAB(4);
6030 FOR M=1 TO NVC(K) : PRINT VC(M,K);" - "; : NEXT M : PRINT
6035 PRINT : INPUT " Ingreso de Nuevos Valores ? (N) = ",A$
6040 IF A$<>"S" AND A$<>"s" THEN VC(0,K)=VC(1,K) : RETURN
6044 NVC(K)=0
6045 KW=0
6046 WHILE KW=0
6047 IF KX=1 THEN 6060
6050 GOSUB 5480
6055 PRINT " (Valores Maximo y Minimo de los Datos = ";XMI;"-";XMA;")"
6060 IF NVC(K)=0 THEN PRINT
6063 KE=0
6064 WHILE KE=0
6065 INPUT " Valor = ",A$
6070 IF LEN(A$)=0 THEN VC(0,K)=VC(1,K) : RETURN
6075 XB=VAL(A$)
6080 IF NVC(K)>0 AND XB<=X THEN KE=5 : B$=">="+STR$(X) :
GOSUB 900 : PRINT : GOTO 6065
6085 IF NVC(K)=0 THEN 6130
6090 INPUT " Incremento para obtener Valores intermedios (No) = ",A$
6091 PRINT
6093 IF LEN(A$)=0 THEN DI=0 : GOTO 6130
6095 DI=VAL(A$)
6100 IF DI<0 OR DI>XB-X THEN KE=5 : B$=">0 y <="+STR$(XB-X) :
GOSUB 900 : PRINT : GOTO 6090
6110 WHILE DI>0 AND X+DI<XB-.000001
6115 X=X+DI
6120 NVC(K)=NVC(K)+1
6121 IF NVC(K)>IJ(K)-1 THEN DI=0 : GOTO 6125
6122 VC(NVC(K),K)=X
6125 WEND
6130 NVC(K)=NVC(K)+1
6131 IF NVC(K)>IJ(K) THEN KE=5 : B$="Numero de Valores <= Parametro2 ("
+STR$(IJ(K))+")" : GOSUB 900 : KE=1 : NVC(K)=0 : GOTO 6133
6132 VC(NVC(K),K)=XB : X=XB
6133 WEND
15 - 359
6135 WEND
6140 ' EST222 - Clasificacion
6145 ' ----------------------
6150 IF NVI=1 THEN NVC(2)=0 : IJ(2)=0
6155 FOR M=0 TO NVC(1)+1
6160 FOR N=0 TO NVC(2)+1
6165 TI(M,N)=0
6170 IF KA>0 THEN TJ(M,N)=0 : TK(M,N)=0
6175 NEXT N,M
6180 NXX=0
6185 FOR I=1 TO NF
6190 IF A(I,0)=1 THEN 6300
6195 ND=1 : IF JF>0 THEN ND=A(I,JF) : IF ND=XVF THEN 6300
6200 IF ND=XVF THEN 6300
6205 KE=0
6210 FOR K=1 TO NVI
6215 VX(K)=A(I,JX(K))
6220 IF VX(K)=XVF THEN KE=1 : K=NV
6225 NEXT K
6230 IF KE=1 THEN 6300
6235 FOR K=1 TO NVI
6240 IJ(K)=NVC(K)
6245 FOR M=1 TO NVC(K)
6250 IF VX(K)<VC(M,K) THEN IJ(K)=M-1 : MX(K)=0 : M=NVC(K)
6255 IF VX(K)=VC(M,K) THEN IJ(K)=M : M=NVC(K)
6260 NEXT M
6265 NEXT K
6270 IF KA=1 THEN X=A(I,JE) : IF X=XVF THEN 6300
6275 TI(IJ(1),IJ(2))=TI(IJ(1),IJ(2))+ND
6280 IF KA=0 THEN 6295
6285 TJ(IJ(1),IJ(2))=TJ(IJ(1),IJ(2))+ND*X
6290 TK(IJ(1),IJ(2))=TK(IJ(1),IJ(2))+ND*X*X
6295 NXX=NXX+ND
6300 NEXT I
6305 MA=NVC(1)+1 : NA=NVC(2)+1
6310 FOR M=0 TO NVC(1)
6315 FOR N=0 TO NVC(2)
6320 TI(M,NA)=TI(M,NA)+TI(M,N)
6325 TI(MA,N)=TI(MA,N)+TI(M,N)
6327 TI(MA,NA)=TI(MA,NA)+TI(M,N)
6328 IF KA=0 THEN 6335
6329 TJ(M,NA)=TJ(M,NA)+TJ(M,N)
6330 TJ(MA,N)=TJ(MA,N)+TJ(M,N)
6331 TJ(MA,NA)=TJ(MA,NA)+TJ(M,N)
6332 TK(M,NA)=TK(M,NA)+TK(M,N)
6333 TK(MA,N)=TK(MA,N)+TK(M,N)
6334 TK(MA,NA)=TK(MA,NA)+TK(M,N)
6335 NEXT N,M
6340 RETURN
6345 '
6350 ' EST223 - Verificacion de Independencia de la Clasificacion
6355 ' ----------------------------------------------------------
6360 CHI=0 : KM=0 : KN=0 : KG=0
6365 NVX=NV
6370 WHILE NVX=1
6375 X=NXX/NVC(1) : KM=NVC(1)
6377 IF X<5 THEN KG=1
6380 FOR M=1 TO NVC(1)
6385 CHI=CHI+(TI(M,1)-X)^2/X
6390 NEXT M
6395 IGL=KM : NVX=0
6400 WEND
6405 WHILE NVX=2
6410 FOR M=0 TO NVC(1)
6415 IF TI(M,NA)=0 THEN 6450
6420 KM=KM+1
6425 FOR N=0 TO NVC(2)
6430 IF TI(MA,N)=0 THEN 6445
6435 X=TI(MA,N)*TI(M,NA)/NXX
6437 IF X<5 THEN KG=1
6440 CHI=CHI+(TI(M,N)-X)^2/X
15 - 360
6445 NEXT N
6450 NEXT M
6455 FOR N=0 TO NVC(2)
6460 IF TI(MA,N)>0 THEN KN=KN+1
6465 NEXT N
6470 IGL=(KM-1)*(KN-1)
6475 NVX=0
6480 WEND
6483 '
6485 KS=1
6490 WHILE KS=1
6495 CLS : PRINT#3,
6497 PRINT#3,"VERIFICACION DE INDEPENDENCIA DE LA CLASIFICACION"
6500 PRINT#3,
6505 PRINT#3," Chi^2 = ";FNR(CHI,NDE)
6510 PRINT#3," Grados de Libertad = ";IGL
6515 IF IGL<1 THEN PRINT#3," Grados de Libertad < 1" : RETURN
6520 P(1)=IGL
6525 IP=1 : X=CHI : GOSUB 8704
6530 PRINT#3,
6535 PRINT#3," Nivel de Significacion de Chi^2 = ";FNR((1-FP)*100,2);"%"
6537 IF KG=1 THEN PRINT#3," (Hay Grupos con Frecuencias Esperadas < 5)"
6540 PRINT : GOSUB 650
6545 WEND
6550 RETURN
6555 '
6560 ' EST224 - Creacion de Archivo con Resultados
6565 ' -------------------------------------------
6570 GOSUB 555
6575 XA$=".EST"
6577 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
6578 PRINT : FILES DDA$+":*"+XA$
6579 IF KAR=1 THEN PRINT " No Existen" : KAR=0
6580 PRINT: PRINT "Nombre del Archivo a Grabar (";DDA$;":---";XA$; : INPUT ") =
",A$
6585 IF LEN(A$)=0 THEN RETURN
6590 KE=0
6595 GOSUB 950
6597 XNA$=A$
6598 IF KAR=0 THEN PRINT : INPUT "Archivo Existente - Se Reemplaza ? (N) = ",A$
6599 IF KAR=0 AND (A$<>"S" AND A$<>"s") THEN 6580
6600 IF KE=1 THEN 6580
6605 OPEN XDDA$+XNA$+EXT$ FOR OUTPUT AS #1
6607 WHILE KXX=0 OR KXX=1
6610 IF KXX=0 THEN PRINT#1,"Resultados Clasificacion"
6615 IF KXX=1 THEN PRINT#1,"Resultados Estadisticas Datos Clasificados"; "
Variable ";TC$(JX(NV))
6620 KM=NVC(1) : IF TI(0,NA)>0 THEN KM=MA
6625 KN=NVC(2) : IF TI(MA,0)>0 THEN KN=NA
6630 PRINT#1,KM*KN,NVI+2+KXX
6635 PRINT#1,TC$(JX(1))
6640 IF NVI=2 THEN PRINT#1,TC$(JX(2))
6645 IF KXX=0 THEN PRINT#1,"NumObs" : PRINT#1,"PorcObs"
6650 IF KXX=1 THEN PRINT#1,"NumObs" : PRINT#1,"ValMed" : PRINT#1,"DesvEst"
6655 FOR M=0 TO NVC(1)
6660 IF M=0 AND TI(M,NA)=0 THEN 6725
6665 XA=VC(M,1) : IF M=0 THEN XA=-1E+10
6670 FOR N=0 TO NVC(2)
6675 IF N=0 AND TI(MA,N)=0 THEN 6720
6680 XB=VC(N,2) : IF N=0 THEN XB=-1E+10
6685 XC=TI(M,N)
6690 IF KXX=0 THEN XD=FNR(100*XC/TI(MA,NA),2)
6695 IF KXX=1 THEN IF XC>0 THEN XD=TJ(M,N)/XC ELSE XD=0
6700 IF KXX=1 THEN IF XC>1 THEN XE=SQR((TK(M,N)-XC*XD^2)/(XC-1))
ELSE XE=0
6705 PRINT#1,XA; : IF NVI=2 THEN PRINT#1,XB;
6710 PRINT#1,XC;XD;
6715 IF KXX=1 THEN PRINT#1,XE ELSE PRINT#1,
6720 NEXT N
6725 NEXT M
6726 KXX=-1
15 - 361
6727 WEND
6728 WHILE KXX=2
6729 PRINT#1,"Coeficientes de Correlacion"
6730 PRINT#1, NV*(NV-1)/2,3
6731 PRINT#1,"Var1" : PRINT#1,"Var2" : PRINT#1,"CoefCorr"
6732 FOR K=1 TO NV-1
6733 FOR L=K+1 TO NV
6734 CA=DE(K)*DE(L)
6735 IF CA>0 THEN X=TI(L,K)/CA ELSE X=0
6736 PRINT#1,K;L;X
6737 NEXT L,K
6738 KXX=0
6739 WEND
6740 CLOSE#1
6741 PRINT : INPUT "Grabacion Terminada - Enter ",A$
6742 RETURN
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)="+" : TF$(3)="x"
6910 IF KTG=2 THEN C$="ABCDEFGHIJKLMNOPQRTSUVWXYZ"
6915 FOR J=1 TO NG
6920 LOCATE 3+3*J,1 : IF KTG=1 THEN PRINT TF$(J)
6925 PRINT TG$(J)
6930 NEXT J
6935 IF KTG=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
15 - 362
7015 FOR XF=YF TO 21
7020 LOCATE XF,XC
7025 A$=TF$(J)
7030 IF KTG=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
7107 IF KB(1)=0 AND KA=0 THEN LOCATE 2 : PRINT "Nro.Observ." : PRINT "
Tot. :";NF : PRINT " Graf.:";NXX
7110 LOCATE 24 : INPUT "Enter ",A$
7115 RETURN
8140 ' EST302 - Dist.Normal
8144 '
8148 XMU=P(1) : SIG=P(2)
8152 ON IP GOTO 8156,8196,8208
8156 U=(X-XMU)/SIG
8160 MXA=0 : IF U<0 THEN U=-U : MXA=1
8164 FD=.39894228#*EXP(-U*U/2)
8168 C=1/(1+.2316419*U)
8172 FP=FD*C*(.3193815+C*(-.3565638+C*(1.781478+C*(-1.821256+1.330274*C))))
8176 IF MXA=0 THEN FP=1-FP
8180 IF FP>1 THEN FP=1
8184 IF FP<0 THEN FP=0
8188 FD=FD/SIG
8192 RETURN
8196 IF KF(1)=1 THEN P(1)=PX
8200 IF KF(2)=1 THEN P(2)=DEX
8204 RETURN
8208 X=SIG*SQR(-2*LOG(RND))*COS(6.283185*RND)+XMU
8212 RETURN
8216 '
8704 ' EST307 - Dist.Chi^2
8708 '
8712 K=P(1)
8716 ON IP GOTO 8720,8768,8780
8720 XMU=K : SIG=SQR(2*K)
8724 IF X=0 AND K=1 THEN FD=1E+30 : FP=0 : RETURN
8728 IF X=0 AND K=2 THEN FD=.5 : FP=0 : RETURN
8732 IF X<=0 THEN FD=0 : FP=0 : RETURN
8736 XA=X : X=(X/K)^(1/3)
8740 P(1)=1-2/9/K : P(2)=SQR(2/9/K)
8744 GOSUB 8140
8748 XN=(K/2-1) : GOSUB 9860
8752 FD=EXP((K/2-1)*LOG(X)-X/2-.3465735*K-FA)
8756 X=XA : P(1)=K
8760 XMU=K : SIG=SQR(2*K)
8764 RETURN
8768 IF KF(1)=1 THEN P(1)=INT(PX+.5)
8772 IF P(1)<1 THEN P(1)=1
8776 RETURN
8780 P(1)=1-2/9/K : P(2)=SQR(2/9/K)
8784 GOSUB 8140
8788 X=(K*X)^3 : P(1)=K
8792 RETURN
8796 '
8800 ' EST308 - Distribucion t
8804 K=P(1)
8808 ON IP GOTO 8812,8896,8908
8812 WHILE K>0 AND K<250
15 - 363
8816 XN=(K-1)/2 : GOSUB 9860 : FD=FA
8820 XN=(K-2)/2 : GOSUB 9860 : FD=FD-FA
8824 FDZ=EXP(FD-.5*LOG(3.14159265#*K)-.5*(K+1)*LOG(1+X*X/K))
8828 'IF X=0 THEN FP=.5 : FD=FDZ : RETURN
8832 XA=X : Y=X*X
8836 XKA=SQR((2/9/K)*Y^(2/3)+2/9)
8840 U=((1-2/9/K)*(Y^(1/3))-7/9)/XKA
8844 X=U : P(1)=0 : P(2)=1 : GOSUB 8140
8848 X=XA : P(1)=K
8852 FP=.5+.5*FP
8856 IF X<0 THEN FP=1-FP
8860 FD=FDZ : K=0
8864 WEND
8868 WHILE K>=250
8872 P(1)=0 : P(2)=1 : GOSUB 8140
8876 P(1)=K : K=0
8880 WEND
8884 K=P(1) : XMU=0
8888 SIG=0 : IF K>2 THEN SIG=SQR(K/(K-2))
8892 RETURN
8896 IF KF(1)=1 THEN P(1)=INT(2*DEX^2/(DEX^2-1)+.5)
8900 IF KF(1)=1 AND P(1)<3 THEN P(1)=3
8904 RETURN
8908 P(1)=0 : P(2)=1 : GOSUB 8140
8912 U=X : P(1)=K
8916 GOSUB 8704
8920 X=U/SQR(X/K)
8924 RETURN
9856 '
9860 ' EST320 - Calculo de Log(Factorial)
9864 '
9868 WHILE XN>=-.5 AND XN<=4 AND INT(2*XN)=2*XN
9872 IF XN=-.5 THEN FA=.57236494#
9876 IF XN=0 THEN FA=0
9880 IF XN=.5 THEN FA=-.12078224#
9884 IF XN=1 THEN FA=0
9888 IF XN=1.5 THEN FA=.28468287#
9892 IF XN=2 THEN FA=.693147181#
9896 IF XN=2.5 THEN FA=1.2009736#
9900 IF XN=3 THEN FA=1.79175947#
9904 IF XN=3.5 THEN FA=2.45373657#
9908 IF XN=4 THEN FA=3.17805383#
9912 RETURN
9916 WEND
9920 Y=1/(XN*XN)
9922 XX=Y*(1/1260-Y/1680)
9924 Y=(XN+.5)*LOG(XN)-XN*(1-Y*(1/12-Y*(1/360-XX)))
9928 FA=Y+.91893853#
9932 RETURN
9999 '
10 ' ESTAD3 - Revision 8/11/88
15 ' -------------------------
20 GOSUB 1000
25 CHAIN "ESTAD"
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
15 - 364
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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.: ";
15 - 365
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
NEXT
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
NEXT
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)
15 - 366
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 ' EST3 - Distribuciones de Probabilidad
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 NVC(2),VC(PAR1+1,1),TI(PAR1+1,PAR2+1)
1027 K=NFM : IF K<20 THEN K=20
1030 DIM VX(15),VY(K),NP(15),TF$(15),TP(5),TG$(5),KF(5)
1035 DIM XMN(2),XMX(2),DEL(2),KB(2),MX(2),JJ(5),JY(2),XP(2),PM(2),DE(2)
1040 DEF FNR(X,K)=INT(10^K*X+.5)/10^K
1041 NDD=NDE-1 : NDF=NDE+1
1042 AD$="." : FOR M=1 TO NDD : AD$=AD$+"#" : NEXT M
1043 AE$="." : FOR M=1 TO NDE : AE$=AE$+"#" : NEXT M
1044 AF$="." : FOR M=1 TO NDF : AF$=AF$+"#" : NEXT M
1045 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1050 WHILE KW=0
1055 TP$="DISTRIBUCIONES DE PROBABILIDAD" : TSP$=""
1060 NXX=0
1065 GOSUB 555
1070 PRINT TAB(70);FRE(0)
1075 PRINT "PROCESOS"
1080 TF$(1)="Calculos con Funciones de Probabilidad"
1085 TF$(2)="Ajuste de Distribuciones"
1090 TF$(3)="Generacion de Valores Aleatorios"
1095 TF$(4)="Manejo de Datos"
1100 KL=4 : GOSUB 980
1105 IF ISP=0 THEN RETURN
1110 IF ISP=4 THEN CHAIN "ESTAD1"
1115 IF ISP=2 AND NF=0 THEN KE=1 : GOSUB 900 : GOTO 1130
1125 ON ISP GOSUB 1140,1780,2445
1130 WEND
1135 '
1140 ' EST31 - Calculo de Funciones de Probabiblidad
1145 ' ---------------------------------------------
1150 WHILE KW=0
1155 TSP$="Calculos con Funciones de Probabilidad"
1160 GOSUB 555
1165 PRINT "PROCESOS"
1170 TF$(1)="Calculo de f(x) y F(x)"
1175 TF$(2)="Calculo de x para Valores de F(x)"
1180 KL=2 : GOSUB 980
1185 IF ISP=0 THEN RETURN
1190 KTP=1 : GOSUB 7250
1195 IF TF=0 THEN RETURN
1200 B$="x" : C$="F(x)" : IF ISP=2 THEN B$="F(x)" : C$="x"
1205 PRINT: PRINT "Valores de ";B$;: INPUT " en Memoria de Trabajo ? (N) = ",A$
15 - 367
1210 KMT=0 : IF A$="S" OR A$="s" THEN KMT=1
1213 IF KMT=1 AND NF=0 THEN KE=1 : GOSUB 900 : RETURN
1215 IF KMT=0 THEN 1255
1220 GOSUB 500
1222 PRINT : PRINT " Variable con valores de ";B$; : INPUT " = ",A$
1225 IF LEN(A$)=0 THEN RETURN
1230 JZ=VAL(A$)
1235 IF JZ<1 OR JZ>NC OR TC$(JZ)=" " THEN KE=4 : GOSUB 900 : GOTO
1222
1237 PRINT
1240 PRINT " Almacenamiento de Valores de ";C$;" en Memoria de Trabajo"
1245 KVA=1 : GOSUB 390
1250 JJ(1)=J
1255 ON ISP GOSUB 1270,1590
1260 WEND
1265 '
1270 ' EST311 - Calculo de f(x) y F(x)
1275 '
1276 'CLS : INPUT "Integracion de f(x) ? (N) = ",A$
1277 'IF A$="S" OR A$="s" THEN GOSUB 9936 : GOTO 1276
1280 IF KMT=1 THEN NPG=NF : GOTO 1310
1285 GOSUB 555 : GOSUB 1555
1290 PRINT : PRINT "INGRESO DE VALORES x"
1295 K=1 : KX=1 : GOSUB 6010
1300 IF NVC(1)=0 THEN RETURN
1305 NPG=NVC(1)
1310 KS=1
1315 WHILE KS=1
1320 GOSUB 555
1325 X=0 : IP=1 : GOSUB 8060
1330 GOSUB 1555
1345 FPA=0 : XMI=1E+10 : XMA=-1E+10 : KX=0
1350 FOR I=1 TO NPG
1351 WHILE KX=0
1352 PRINT#3, : PRINT#3,TAB(3);" x"," f(x)"," p(x)"," F(x)","1-F(x)"
1353 KA=3 : KB=68 : GOSUB 695
1354 IL=4 : KX=1
1355 WEND
1356 IF KMT=0 THEN X=VC(I,1) : GOTO 1365
1360 IF A(I,0)=1 OR A(I,JZ)=XVF THEN FP=XVF : GOTO 1395 ELSE X=A(I,JZ)
1365 IF X<XMI THEN XMI=X
1370 IF X>XMA THEN XMA=X
1375 GOSUB 8060
1380 PRINT#3,TAB(3);X,FNR(FD,NDF),FNR(FP-FPA,NDF),FNR(FP,NDF),FNR(1-FP,NDF)
1385 FPA=FP
1390 IF KMT=0 THEN TI(I,0)=X : TI(I,1)=FD : TI(I,2)=FP
1395 IF KMT=1 AND JJ(1)>0 THEN A(I,JJ(1))=FP
1397 IL=IL+1 : IF IL>22 AND DS$="SCRN:" THEN INPUT "",A$ : KX=0
1400 NEXT I
1405 PRINT#3,
1410 PRINT#3," Probabilidad de Valores > ";XMA;" = ";FNR(1-FP,NDF)
1415 PRINT : GOSUB 650
1420 WEND
1425 '
1430 WHILE KMT=0
1435 GOSUB 555
1440 PRINT : PRINT "PROCESOS COMPLEMENTARIOS"
1445 TF$(1)="Graficacion de f(x) o p(x)"
1450 TF$(2)="Graficacion de F(x)"
1455 TF$(3)="Creacion de Archivo con Resultados"
1460 KL=3 : GOSUB 980
1465 IF ISP=0 THEN RETURN
1475 WHILE ISP=1 OR ISP=2
1477 XX=XMI : KM=0 : GOSUB 1579 : XMN(1)=XX
1478 XX=XMA : KM=1 : GOSUB 1579 : XMX(1)=XX
1480 DEL(1)=(XMX(1)-XMN(1))/5
1485 TG$(0)="x" : NG=1 : KA=1 : KX=1
1490 IF ISP=2 THEN 1525
1495 XMN(2)=0 : XX=0 : KB(1)=1
1500 FOR I=1 TO NPG
1505 IF TI(I,1)>XX THEN XX=TI(I,1)
15 - 368
1510 NEXT I
1515 KM=1 : GOSUB 1579 : XMX(2)=XX: DEL(2)=XMX(2)/5: JY(1)=1: TG$(1)="f(x)"
1520 GOTO 1530
1525 XMN(2)=0 : XMX(2)=1 : DEL(2)=.2 : JY(1)=2 : TG$(1)="F(x)" : KB(1)=0
1530 KTG=1 : GOSUB 6745 : NXX=0 : ISP=0
1535 WEND
1540 IF ISP=3 THEN KXX=0 : GOSUB 7930
1545 WEND
1547 RETURN
1550 '
1555 ' Presentacion Distribucion
1556 '
1557 PRINT#3,
1559 PRINT#3,"DISTRIBUCION = ";TFX$ : PRINT#3,
1560 FOR I=1 TO KP : PRINT#3," Parametro";I;"= ";P(I) : NEXT I
1561 PRINT#3,
1562 PRINT#3," Mu = ";FNR(XMU,NDF),"Sigma = ";FNR(SIG,NDF)
1564 IF KNV=1 THEN RETURN
1565 PRINT#3," Muy = ";FNR(XMUY,NDF),"Sigmay = ";FNR(SIGY,NDF), "Ro =
";FNR(RO,NDF)
1570 PRINT#3, : PRINT#3," Distribucion Condicional de x/y para y = ";Y
1575 PRINT#3," Mu Condic.= ";FNR(XMUC,NDF),"Sig Condic.= ";FNR(SIC,NDF)
1577 RETURN
1578 '
1579 IF XX=0 THEN RETURN
1580 XY=0 : KN=1
1581 IF XX<0 THEN XY=XX : XX=-XX : IF KM=0 THEN KM=1 ELSE KM=0
1582 WHILE XX<5
1583 KN=KN*5 : XX=XX*5
1584 WEND
1585 IF XX-5*INT(XX/5)=0 THEN XX=XX/KN : GOTO 1587
1586 XX=INT(XX/5+KM)*5/KN
1587 IF XY<0 THEN XX=-XX
1588 RETURN
1589 '
1590 ' EST312 - Calculo de x para F(x)
1595 '
1600 IF KMT=1 THEN NPG=NF : GOTO 1630
1605 GOSUB 555 : GOSUB 1555
1610 PRINT : PRINT "INGRESO VALORES DE F(x) (>0 y <1)"
1615 K=1 : KX=1 : GOSUB 6010
1620 IF NVC(1)=0 THEN RETURN
1625 NPG=NVC(1)
1630 KS=1
1635 WHILE KS=1
1640 GOSUB 555
1645 X=0 : IP=1 : GOSUB 8060
1650 GOSUB 1555
1655 KX=0
1665 FOR I=1 TO NPG
1666 WHILE KX=0
1667 PRINT#3, : PRINT#3,TAB(3);" F(x)"," x"
1668 KA=3 : KB=30 : GOSUB 695
1670 IL=4 : KX=1
1671 WEND
1672 IF KMT=0 THEN FPX=VC(I,1) : GOTO 1680
1675 IF A(I,0)=1 OR A(I,JZ)=XVF THEN X=XVF : GOTO 1705 ELSE FPX=A(I,JZ)
1680 PRINT#3,TAB(3);FNR(FPX,NDF),
1685 IF FPX<=0 OR FPX>=1 THEN KE=5: B$=">0 y <1": GOSUB 900 : KE=1 :
GOTO 1710
1690 GOSUB 7710
1695 PRINT#3,FNR(X,NDF)
1700 IF KMT=0 THEN TI(I,0)=FPX : TI(I,1)=X
1705 IF KMT=1 AND JJ(1)>0 THEN A(I,JJ(1))=X
1707 IL=IL+1 : IF IL>22 AND DS$="SCRN:" THEN INPUT "",A$ : KX=0
1710 NEXT I
1712 IF KE=1 THEN PRINT : INPUT "Proceso Interrumpido - Enter",A$ : RETURN
1715 PRINT : GOSUB 650
1720 WEND
1725 WHILE KMT=0
1730 PRINT : PRINT : INPUT "Creacion de Archivo de Resultados ? (N) = ",A$
15 - 369
1735 IF A$="S" OR A$="s" THEN KXX=1 : GOSUB 7930
1740 RETURN
1745 WEND
1750 '
1780 ' EST32 - Ajuste de Distribuciones
1785 ' --------------------------------
1790 WHILE KW=0
1795 TSP$="Ajuste de Distribuciones"
1800 GOSUB 555
1802 KTP=2 : GOSUB 7250
1805 IF TF=0 THEN RETURN
1810 PRINT : PRINT "DEFINICION DE VARIABLES PARA EL PROCESO (";KNV;")"
1815 GOSUB 200
1820 IF NV=0 THEN RETURN
1825 IF NV<>KNV THEN KE=2 : GOSUB 900 : GOTO 1810
1830 PRINT : PRINT "INGRESO VALORES DE CLASIFICACION"
1835 PRINT : PRINT " VARIABLE =";J;" - ";TC$(J)
1840 K=1 : KX=0 : GOSUB 6010
1845 IF NVC(1)=0 THEN RETURN
1847 IF NVC(1)<2 THEN KE=5 : B$="Nro.Valores Clasificacion >=2" : GOSUB 900 :
GOTO 1830
1850 PRINT: PRINT TAB(25);"EN PROCESO"
1855 '
1860 J=JX(1) : MX(1)=1 : NXX=0
1865 FOR M=0 TO NVC(1) : TI(M,1)=0 : NEXT M
1870 FOR I=1 TO NF
1875 IF A(I,0)=1 THEN 1925
1880 ND=1 : IF JF>0 THEN ND=A(I,JF) : IF ND=XVF THEN 1925
1885 X=A(I,J) : IF X=XVF THEN 1925
1890 L=NVC(1)
1895 FOR M=1 TO NVC(1)
1900 IF X<VC(M,1) THEN L=M-1 : MX(1)=0 : M=NVC(1)
1905 IF X=VC(M,1) THEN L=M : M=NVC(1)
1910 NEXT M
1915 TI(L,1)=TI(L,1)+ND
1920 NXX=NXX+ND
1925 NEXT I
1930 IF NXX<3 THEN KE=3 : KNM=3 : GOSUB 900 : RETURN
1935 IF KNV=1 THEN GOSUB 5480
1945 IF TF<>10 THEN 1985
1950 SXY=0 : NSX=0
1955 FOR I=1 TO NF-1
1960 IF A(I,0)=1 THEN 1975
1965 X=A(I,J) : Y=A(I+1,J) : IF X=XVF OR Y=XVF THEN 1975
1970 SXY=SXY+(X-PX)*(Y-PX) : NSX=NSX+1
1975 NEXT I
1980 IF DEX>0 THEN R=SXY/((NSX-1)*DEX*DEX) ELSE R=0
1985 IF KNV<>2 THEN 2005
1990 GOSUB 5825
1995 IF NXX<3 THEN KE=3 : KNM=3 : GOSUB 900 : RETURN
2000 IF DE(1)>0 AND DE(2)>0 THEN R=TI(1,2)/(DE(1)*DE(2)) ELSE R=0
2005 IP=2 : GOSUB 8060
2010 '
2015 KS=1
2020 WHILE KS=1
2025 GOSUB 555 : PRINT#3,
2030 PRINT#3," VARIABLE = ";J;" - ";TC$(J)
2035 PRINT#3," Valor Medio = ";FNR(PX,NDF)
2040 PRINT#3," Desvio Estandar = ";FNR(DEX,NDF)
2045 PRINT#3, : PRINT#3,"Distribucion = ";TF$(TF)
2050 FOR I=1 TO KP
2055 IF KF(I)=1 THEN B$=" (Estimado)" ELSE B$=" (Ingresado)"
2060 IF KF(I)=1 THEN P(I)=FNR(P(I),NDF)
2065 PRINT#3," Parametro";I;" = ";P(I);TAB(30);B$
2070 NEXT I
2075 IF DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$
2080 '
2085 PRINT#3, : PRINT#3,"VERIFICACION BONDAD AJUSTE" : PRINT#3,
2090 CHI=0 : FPA=0 : IGL=-1 : IP=1
2095 PRINT#3,TAB(3);"Intervalo","Frec.Datos(A)","Frec.Teor.(B)","(A-B)^2/B"
2100 KA=3 : KB=58 : GOSUB 695
15 - 370
2103 IL=12 : KG=0
2105 FOR M=1 TO NVC(1)+1
2107 IF M=1 AND MX(1)=1 AND TI(0,1)=0 THEN 2160
2110 IF M<NVC(1)+1 THEN X=VC(M,1)-.00001 : GOSUB 8060 ELSE FP=1
2120 TIT=(FP-FPA)*NXX
2123 IF TIT<5 THEN KG=1
2125 TI(M-1,2)=TIT
2130 FPA=FP
2135 B$=">= " : IF M=1 THEN B$="< "
2140 IF MX(1)=1 THEN B$=" "
2145 IF TIT>0 THEN XA=(TI(M-1,1)-TIT)^2/TIT : IGL=IGL+1 ELSE XA=0
2150 CHI=CHI+XA
2155 PRINT#3,TAB(3);B$;VC(M-1,1),TI(M-1,1),FNR(TIT,NDD),FNR(XA,NDE)
2157 IL=IL+1 : IF IL=23 AND DS$="SCRN:" THEN IL=2 : INPUT "",A$
2160 NEXT M
2165 FOR I=1 TO KP : IGL=IGL-KF(I) : NEXT I
2170 PRINT#3, : PRINT#3," Estadistica Chi^2 = ";FNR(CHI,NDE)
2175 PRINT#3," Grados de Libertad de Chi^2 = ";IGL
2180 IF IGL<1 THEN PRINT#3," Grados de Libertad < 1" : GOTO 2210
2183 IF KG=1 THEN PRINT#3," ( Hay Frecuencias Teoricas < 5 )"
2185 XW=P(1) : XZ=P(2) : P(1)=IGL
2190 X=CHI : GOSUB 8704
2195 P(1)=XW : P(2)=XZ
2200 PRINT#3,
2205 PRINT#3," Nivel de Significacion de Chi^2 = ";FNR((1-FP)*100,2);" %"
2210 PRINT : GOSUB 650
2215 WEND
2220 '
2225 KZ=0 : KST=0
2230 WHILE KZ=0
2235 GOSUB 555
2240 PRINT : PRINT "PROCESOS COMPLEMENTARIOS"
2245 TF$(1)="Graficacion de Ajuste"
2250 TF$(2)="Creacion de Archivo con Resultados"
2255 KL=2 : GOSUB 980
2260 IF ISP=0 THEN KZ=1 : GOTO 2430
2263 IF KST=1 THEN 2325
2264 KST=1
2265 IF MX(1)=1 THEN FOR M=0 TO NVC(1) : TI(M,0)=VC(M,1) : NEXT M : NPG=NVC(1) : GOTO
2305
2270 NPG=NVC(1)-1
2275 FOR M=1 TO NPG
2280 TI(M,0)=(VC(M,1)+VC(M+1,1))/2
2285 NEXT M
2290 IF TI(NVC(1),1)=0 THEN 2305
2295 NPG=NPG+1
2300 TI(NPG,0)=VC(NPG,1)+(VC(NPG-1,1)-VC(NPG-2,1))/2
2305 IF TI(0,1)=0 THEN 2325
2306 FOR M=NPG TO 1 STEP-1
2307 FOR K=0 TO 2
2308 TI(M+1,K)=TI(M,K)
2309 NEXT K,M
2313 NPG=NPG+1
2315 TI(1,0)=VC(1,1)-(VC(2,1)-VC(1,1))/2
2320 TI(1,1)=TI(0,1) : TI(1,2)=TI(0,2)
2325 WHILE ISP=1
2330 NG=2 : KX=1
2335 XMI=1E+10 : XMA=-1E+10
2340 XMN(2)=0 : XX=0
2345 FOR M=1 TO NPG
2350 IF TI(M,0)<XMI THEN XMI=TI(M,0)
2355 IF TI(M,0)>XMA THEN XMA=TI(M,0)
2360 IF TI(M,1)>XX THEN XX=TI(M,1)
2365 IF TI(M,2)>XX THEN XX=TI(M,2)
2370 NEXT M
2375 KM=1 : GOSUB 1579 : XMX(2)=XX
2380 XX=XMI : KM=0 : GOSUB 1579 : XMN(1)=XX
2381 XX=XMA : KM=1 : GOSUB 1579 : XMX(1)=XX
2385 FOR M=1 TO 2
2390 DEL(M)=(XMX(M)-XMN(M))/5
2395 NEXT M
15 - 371
2400 KA=1 : KB(1)=1 : KB(2)=0 : XXX=JX(1) :JY(1)=1 : JY(2)=2
2405 TG$(0)="x" : TG$(1)="Frec.Datos":TG$(2)="Frec.Distrib"
2410 KTG=1 : GOSUB 6745
2415 JX(1)=XXX : NXX=0 : ISP=0
2420 WEND
2425 IF ISP=2 THEN KXX=2 : GOSUB 7930
2430 WEND
2435 WEND
2440 '
2445 ' EST33 - Generacion de Valores Aleatorios
2450 ' ----------------------------------------
2452 WHILE KW=0
2455 TSP$="Generacion de Valores Aleatorios"
2460 GOSUB 555
2465 PRINT : PRINT "OBTENCION DE"
2470 TF$(1)="Valores Aleatorios de una Distribucion"
2475 TF$(2)="Estadisticas Descriptivas de Muestras de una Distrib."
2480 KL=2 : GOSUB 980
2485 IF ISP=0 THEN RETURN
2490 GOSUB 555
2491 KTP=3 : GOSUB 7250
2493 IF TF=0 THEN RETURN
2494 IP=1 : X=0 : GOSUB 8060
2495 PRINT : PRINT : GOSUB 1555
2500 IF ISP=1 THEN NM=1 : GOTO 2530
2505 PRINT : INPUT " Numero de Muestras a Generar = ",A$
2510 IF LEN(A$)=0 THEN RETURN
2515 NM=VAL(A$)
2520 IF NM<1 OR NM>NFM THEN KE=5 : B$=">=1 y <="+STR$(NFM) :
GOSUB 900 : GOTO 2505
2530 PRINT : PRINT "Nro. de Valores a Generar";
2535 IF NM>1 THEN PRINT " en cada muestra";
2540 INPUT " = ",A$
2545 IF LEN(A$)=0 THEN RETURN
2550 NXM=VAL(A$)
2555 KX=1 : IF NM>1 THEN KX=2
2560 IF NXM<KX THEN KE=5 : B$=">="+STR$(KX) : GOSUB 900 : GOTO 2530
2564 LI=INT(10000*RND)
2565 PRINT : PRINT "Definicion de Secuencia Nros.Aleatorios"
2570 PRINT " Entero >-32768 y <32767 (";LI; : INPUT ") = ",A$
2575 IF LEN(A$)=0 THEN 2590
2580 X=VAL(A$)
2585 IF X<=-32768! OR X>=32767 THEN KE=5 : B$=">-32768 y <32767" :
GOSUB 900 : GOTO 2510
2587 LI=X
2590 WHILE NM=1
2600 FOR K=1 TO KNV
2605 A$="X" : IF K=2 THEN A$="Y" : KVA=1
2606 PRINT : PRINT
2607 PRINT "ALMACENAMIENTO DE VALORES DE ";A$;" EN MEMORIA DE TRABAJO"
2615 GOSUB 390 : JJ(K)=J
2620 IF J>0 AND NXM>NFM THEN KE=6 : GOSUB 900 : RETURN
2625 NEXT K
2627 '
2630 KS=1
2635 WHILE KS=1
2640 X=RND(-LI)
2645 GOSUB 555 : GOSUB 1555
2650 PRINT#3,
2655 PRINT#3, : PRINT#3," Nro. Inicial de Secuencia = ";LI : PRINT#3,
2670 KXX=0
2675 FOR I=1 TO NXM
2676 WHILE KXX=0
2677 IF KNV=1 THEN PRINT#3," Nro."," X" : M=33
2678 IF KNV=2 THEN PRINT#3," Nro."," X"," Y" : M=46
2679 KA=3 : KB=M : GOSUB 695
2680 IL=3 : KXX=1
2681 WEND
2682 IP=3 : GOSUB 8060
2695 PRINT#3,TAB(3);I,FNR(X,NDF),
2700 IF KNV=2 THEN PRINT#3,FNR(Y,NDF) ELSE PRINT#3,
15 - 372
2705 IF JJ(1)>0 THEN A(I,JJ(1))=X
2710 IF KNV=2 AND JJ(2)>0 THEN A(I,JJ(2))=Y
2712 IL=IL+1
2713 IF IL>22 AND DS$="SCRN:" THEN INPUT "",A$ : KXX=0
2715 NEXT I
2720 IF JJ(1)>0 AND NF<NXM THEN NF=NXM : NX=NXM
2725 PRINT : GOSUB 650
2730 WEND
2735 NM=0
2740 WEND
2743 '
2745 WHILE NM>1
2750 FOR M=1 TO 5 : KF(M)=0 : JJ(M)=0 : TP(M)=0 : NEXT M
2755 KS=0
2760 WHILE KS=0
2763 GOSUB 555
2765 PRINT : PRINT "ESTADISTICAS A OBTENER PARA CADA MUESTRA"
2770 TF$(1)="Valor Medio" : TG$(1)="ValMed"
2775 TF$(2)="Desvio Estandar" : TG$(2)="DesvEst"
2780 TF$(3)="Estad. t" : TG$(3)="Est. t"
2785 TF$(4)="Estad. Chi2" : TG$(4)="Est.Chi2"
2790 TF$(5)="Estadist. definida por el usuario": TG$(5)="Est.Usu"
2795 KL=5 : GOSUB 980
2800 IF ISP=0 THEN KS=1 : GOTO 2815
2801 IF ISP=5 THEN PRINT : PRINT "Se Ingreso Rutina para Calculo"; : INPUT
" de Estadistica ? (N) = ",A$
2802 IF ISP=5 AND (A$<>"S" OR A$<>"s") THEN KS=1 : GOTO 2815
2803 PRINT : PRINT
2805 PRINT "Almacenamiento de Valores de Estadistica en Memoria de Trabajo"
2810 GOSUB 390 : JJ(ISP)=J : KF(ISP)=1
2815 WEND
2816 '
2817 WHILE KS=1
2818 X=RND(-LI)
2820 GOSUB 555
2821 PRINT#3,"ESTADISTICAS DE MUESTRAS ALEATORIAS" : PRINT#3,
2822 PRINT#3," Cantidad de Valores en cada Muestra = ",NXM : PRINT#3,
2823 PRINT#3," Nro. Inicial de Secuencia = ";LI : PRINT#3,
2824 GOSUB 1555
2825 PRINT#3, : IL=11+KP
2830 IP=1 : X=0 : GOSUB 8060
2835 PRINT#3,TAB(3);"Muestra"; : K=0
2840 FOR M=1 TO 5
2845 IF KF(M)>0 THEN K=K+1 : PRINT#3,TAB(12*K+3);TG$(M);
2850 NEXT M
2855 PRINT#3,
2860 KA=3 : KB=12*(K+1)+2 : GOSUB 695
2865 FOR KI=1 TO NM
2875 SX=0 : SCX=0
2880 FOR I=1 TO NXM
2885 IP=3 : GOSUB 8060
2890 SX=SX+X : SCX=SCX+X*X
2895 NEXT I
2900 PX=SX/NXM : DEX=SQR((SCX-SX*SX/NXM)/(NXM-1))
2905 IF KF(1)>0 THEN TP(1)=PX
2910 IF KF(2)>0 THEN TP(2)=DEX
2915 IF KF(3)>0 THEN TP(3)=(PX-XMU)*SQR(NXM)/DEX
2920 IF KF(4)>0 THEN TP(4)=(NXM-1)*(DEX/SIG)^2
2925 IF KF(5)>0 THEN GOSUB 3010 : TP(5)=Y
2930 FOR M=1 TO 5
2935 J=JJ(M) : IF J>0 THEN A(KI,J)=TP(M)
2937 IF J>0 AND KI>NF THEN NF=KI : NX=KI
2940 NEXT M
2945 PRINT#3,TAB(3);KI;
2950 K=0
2955 FOR M=1 TO 5
2960 IF KF(M)>0 THEN K=K+1 : PRINT#3,TAB(12*K+3);FNR(TP(M),NDF);
2965 NEXT M : PRINT#3,
2970 IL=IL+1
2975 IF IL>22 AND DS$="SCRN:" THEN IL=1 : INPUT"",A$
2980 NEXT KI
15 - 373
2985 PRINT : GOSUB 650
2987 WEND
2988 NM=0
2990 WEND
3000 WEND
3005 '
3010 ' EST331 - Rutina para obtener estadistica definida por el usuario
3015 ' ----------------------------------------------------------------
3020 LI(1,1)=0 : LI(2,1)=.5 : LI(3,1)=1 : LI(4,1)=1.5 : LI(5,1)=2
3025 TI(1,1)=0 : TI(2,1)=0 : TI(3,1)=0 : TI(4,1)=0 : TI(5,1)=0
3030 NI(1)=5 : Y=NI(1)
3035 FOR I=1 TO NXX
3040 FOR M=1 TO NI(1)
3045 IF VX(I)<LI(M,1) THEN Y=M-1 : M=NI(1)
3050 NEXT M
3055 TI(Y,1)=TI(Y,1)+1
3060 NEXT I
3065 FPA=0 : IP=1 : CHI=0
3070 FOR M=1 TO NI(1)+1
3075 IF M<NI(1)+1 THEN X=LI(M,1)-.0001 : GOSUB 8060 ELSE FP=1
3080 IF FP-FPA=0 THEN 3100
3085 TIT=(FP-FPA)*NXX
3090 FPA=FP
3095 CHI=CHI+(TI(M-1,1)-TIT)^2/TIT
3100 NEXT M
3105 Y=CHI
3110 RETURN
3115 '
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
15 - 374
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 '
6010 ' EST221 - Ingreso de Valores de Clasificacion
6015 ' --------------------------------------------
6017 IJ(1)=PAR1 : IJ(2)=PAR2
6020 IF NVC(K)=0 THEN 6045
6025 PRINT : PRINT " Valores Actuales" : PRINT TAB(4);
6030 FOR M=1 TO NVC(K) : PRINT VC(M,K);" - "; : NEXT M : PRINT
6035 PRINT : INPUT " Ingreso de Nuevos Valores ? (N) = ",A$
6040 IF A$<>"S" AND A$<>"s" THEN VC(0,K)=VC(1,K) : RETURN
6044 NVC(K)=0
6045 KW=0
6046 WHILE KW=0
6047 IF KX=1 THEN 6060
6050 GOSUB 5480
6055 PRINT " (Valores Maximo y Minimo de los Datos = ";XMI;"-";XMA;")"
6060 IF NVC(K)=0 THEN PRINT
6063 KE=0
6064 WHILE KE=0
6065 INPUT " Valor = ",A$
6070 IF LEN(A$)=0 THEN VC(0,K)=VC(1,K) : RETURN
6075 XB=VAL(A$)
6080 IF NVC(K)>0 AND XB<=X THEN KE=5 : B$=">="+STR$(X) :
GOSUB 900 : PRINT : GOTO 6065
6085 IF NVC(K)=0 THEN 6130
6090 INPUT " Incremento para obtener Valores intermedios (No) = ",A$
6091 PRINT
6093 IF LEN(A$)=0 THEN DI=0 : GOTO 6130
6095 DI=VAL(A$)
6100 IF DI<0 OR DI>XB-X THEN KE=5 : B$=">0 y <="+STR$(XB-X) :
GOSUB 900 : PRINT : GOTO 6090
6110 WHILE DI>0 AND X+DI<XB-.000001
6115 X=X+DI
6120 NVC(K)=NVC(K)+1
6121 IF NVC(K)>IJ(K)-1 THEN DI=0 : GOTO 6125
6122 VC(NVC(K),K)=X
6125 WEND
6130 NVC(K)=NVC(K)+1
6131 IF NVC(K)>IJ(K) THEN KE=5 : B$="Numero de Valores <= Parametro2 ("
+STR$(IJ(K))+")" : GOSUB 900 : KE=1 : NVC(K)=0 : GOTO 6133
6132 VC(NVC(K),K)=XB : X=XB
6133 WEND
6135 WEND
6136 '
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 "+"
15 - 375
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)="+" : TF$(3)="x"
6910 IF KTG=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 KTG=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 KTG=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
7107 IF KB(1)=0 AND KA=0 THEN LOCATE 2 : PRINT "Nro.Observ." : PRINT "
Tot. :";NF : PRINT " Graf.:";NXX
7110 LOCATE 24 : INPUT "Enter ",A$
7115 RETURN
7120 '
7250 ' EST30 - Seleccion de Distribucion
7255 ' ---------------------------------
7257 TF=0
7260 TG$(1)=">0": TG$(2)="Entero": TG$(3)="<1": TG$(4)=">Par1": TG$(5)=">-1 <1"
7270 TF$(1)="Uniforme (a,b)" : NP(1)=2 : VX(1)=0 :VY(1)=4
7275 TF$(2)="Normal (Mu,Sig)" : NP(2)=2 : VX(2)=0 : VY(2)=1
7280 TF$(3)="Exponencial (Mu)" : NP(3)=1 : VX(3)=1
7285 TF$(4)="Gamma (Alfa,Beta)" : NP(4)=2 : VX(4)=1 : VY(4)=1
15 - 376
7290 TF$(5)="Beta (Alfa,Beta)" : NP(5)=2 : VX(5)=1 : VY(5)=1
7295 TF$(6)="Lognormal (Mu',Sig')" : NP(6)=2 : VX(6)=1 : VY(6)=1
7300 TF$(7)="Chi^2 (k)" : NP(7)=1 : VX(7)=12
7305 TF$(8)="t (k)" : NP(8)=1 : VX(8)=12
7310 TF$(9)="F (k1,k2)" : NP(9)=2 : VX(9)=12 : VY(9)=12
7315 TF$(10)="Normal Autocorrelac.(Mu,Sig,Ro)"
: NP(10)=3 : VX(10)=0 : VY(10)=1
7320 TF$(11)="Normal Bidimens.(Mu1,Sig1,Mu2,Sig2,Ro)"
: NP(11)=5 : VX(11)=0 : VY(11)=1
7325 TF$(12)="Uniforme Discr.(a,b)" : NP(12)=2 : VX(12)=2 : VY(12)=24
7330 TF$(13)="Binomial (n,p)" : NP(13)=2 : VX(13)=12 : VY(13)=13
7335 TF$(14)="Binomial Negat.(r,p)" : NP(14)=2 : VX(14)=12 : VY(14)=13
7340 TF$(15)="Poisson (Mu)" : NP(15)=1 : VX(15)=1
7345 PRINT : PRINT "DISTRIBUCIONES CONTINUAS" : PRINT
7350 FOR K=1 TO 6
7355 PRINT TAB(3);K;"- ";TF$(K);
7360 IF K<6 THEN PRINT TAB(33);K+6;" - ";TF$(K+6) ELSE PRINT
7365 NEXT K
7370 PRINT : PRINT "DISTRIBUCIONES DISCRETAS" : PRINT
7375 FOR K=12 TO 13
7380 PRINT TAB(3);K;"- ";TF$(K);
7385 PRINT TAB(33);K+2;" - ";TF$(K+2) ELSE PRINT
7390 NEXT K
7395 PRINT : PRINT "Distribucion Elegida";
7398 INPUT " = ",A$
7399 IF LEN(A$)=0 THEN RETURN
7400 TF=INT(VAL(A$))
7410 IF TF<1 OR TF>15 THEN PRINT CHR$(7) : GOTO 7395
7412 IF KTP=4 AND (TF=10 OR TF=11) THEN PRINT CHR$(7) : GOTO 7395
7415 TFX$=TF$(TF)
7420 KNV=1 : IF TF=11 THEN KNV=2
7425 KDI=0 : IF TF>=12 THEN KDI=1
7430 KP=NP(TF) : TP(1)=VX(TF) : TP(2)=VY(TF)
7435 IF TF=10 THEN TP(3)=13 : FOR I=1 TO 20 : VY(I)=0 : NEXT I
7440 IF TF=11 THEN TP(3)=0 : TP(4)=1 : TP(5)=15
7445 '
7450 GOSUB 555
7455 PRINT "DISTRIBUCION = ";TF$(TF)
7460 FOR K=1 TO KP
7465 PRINT : PRINT " Parametro";K;
7470 IF TP(K)=0 THEN PRINT : GOTO 7515
7475 PRINT " (";
7480 A$=STR$(TP(K)) : N=LEN(A$)
7485 FOR M=1 TO N
7490 KM=VAL(MID$(A$,M,1))
7495 IF KM=0 THEN 7505
7500 PRINT " ";TG$(KM);
7505 NEXT M
7510 PRINT " )"
7515 KF(K)=0
7520 B$=STR$(FNR(P(K),NDF)) : IF KTP=2 THEN B$="A Estimar"
7525 PRINT " Valor (";B$;")";TAB(25); : INPUT " = ",A$
7530 IF LEN(A$)=0 AND KTP=2 THEN KF(K)=1 : GOTO 7610
7535 IF LEN(A$)=0 AND KTP<>2 THEN X=P(K)
7540 IF LEN(A$)>0 THEN X=VAL(A$)
7545 IF TP(K)=0 THEN 7605
7550 A$=STR$(TP(K))
7555 N=LEN(A$) : KE=0
7560 FOR M=1 TO N
7565 KM=VAL(MID$(A$,M,1))
7570 IF KM=1 AND X<=0 THEN KE=5
7575 IF KM=2 AND X<>INT(X) THEN KE=5
7580 IF KM=3 AND X>=1 THEN KE=5
7585 IF KM=4 AND X<=P(1) THEN KE=5
7590 IF KM=5 AND (X<=-1 OR X>=1) THEN KE=5
7595 NEXT M
7600 IF KE=5 THEN B$=TG$(KM) : GOSUB 900 : PRINT : GOTO 7520
7605 P(K)=X
7610 NEXT K
7615 '
7620 WHILE TF=12 AND KTP=3
15 - 377
7625 P(3)=0 : P(4)=0
7630 PRINT : INPUT " Generacion sin Reposicion ? (N) = ",A$
7635 IF A$="S" OR A$="s" THEN P(3)=1
7640 RETURN
7645 WEND
7650 WHILE TF=11 AND (KTP=1 OR KTP=2)
7655 PRINT : INPUT " Valor de la Variable Y = ",A$
7660 Y=VAL(A$)
7665 RETURN
7670 WEND
7675 WHILE TF=4 AND KTP=2 AND KF(1)=1
7680 PRINT : INPUT " Parametro Alfa Entero ? (N) = ",A$
7685 P(3)=0 : IF A$="S" OR A$="s" THEN P(3)=1
7690 RETURN
7695 WEND
7700 RETURN
7705 '
7710 ' EST320 - Calculo del valor x para F(x)
7715 '
7725 IP=1 : X=0 : 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 KM=0
7755 WHILE KM=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 : KM=1
7780 IF DI>0 AND FP>0 THEN XD=XY : XE=X : FPD=FPY : FPE=FP : KM=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
7925 '
7930 ' EST313 - creacion de Archivos de Resultados
7935 '
7940 GOSUB 555
7945 XA$=".EST"
7950 PRINT: PRINT "Nombre del Archivo a Grabar (";DDA$;":---";XA$; : INPUT ") =
",A$
7955 IF LEN(A$)=0 THEN RETURN
7960 KE=0
7965 GOSUB 950
7966 XNA$=A$
7967 IF KAR=0 THEN PRINT : INPUT "Archivo Existente - Se Reemplaza ? (N) = ",A$
7968 IF KAR=0 AND (A$<>"S" AND A$<>"s") THEN 7950
7970 IF KE=1 THEN 7950
7975 OPEN XDDA$+XNA$+EXT$ FOR OUTPUT AS #1
7980 B$="" : FOR K=1 TO KP : B$=B$+STR$(P(K))+" " : NEXT K
7985 IF KXX=2 THEN PRINT#1,"Ajuste ";
7990 PRINT#1,"Distribucion "+TFX$+" - Parametros = "+B$
7993 N=3 : IF KXX=1 THEN N=2
7995 PRINT#1,NPG,N
8000 IF KXX=1 THEN PRINT#1,"F(x)"
8005 PRINT#1,"Valor x"
15 - 378
8010 IF KXX=0 THEN PRINT#1,"f/p(x)" : PRINT#1,"F(x)"
8015 IF KXX=2 THEN PRINT#1,"FrecExpe" : PRINT#1,"FrecTeor"
8020 FOR I=1 TO NPG
8025 PRINT#1,FNR(TI(I,0),NDF);FNR(TI(I,1),NDF);
8030 IF KXX<>1 THEN PRINT#1,FNR(TI(I,2),NDF) ELSE PRINT#1,
8035 NEXT I
8040 CLOSE#1
8045 PRINT : INPUT "Grabacion Terminada - Enter para continuar",A$
8050 RETURN
8055 '
8060 ' EST300 - Llamada a Rutinas Distribuciones
8064 '
8068 ON TF GOSUB 8080,8140,8220,8280,8464,8636,8704,8800,8932,9068,9152,
9252,9360,9568,9680
8072 RETURN
8076 '
8080 ' EST301 - Dist.Uniforme Continua
8084 '
8088 A=P(1) : B=P(2)
8092 ON IP GOTO 8096,8116,8128
8096 XMU=(A+B)/2 : SIG=(B-A)/3.464102
8100 IF X<A THEN FD=0 : FP=0
8104 IF X>=A AND X<=B THEN FD=1/(B-A) : FP=(X-A)/(B-A)
8108 IF X>B THEN FD=0 : FP=1
8112 RETURN
8116 IF KF(1)=1 THEN P(1)=PX-1.732051*DEX
8120 IF KF(2)=1 THEN P(2)=PX+1.732051*DEX
8122 IF P(2)<=P(1) THEN P(2)=P(1)+.0001
8124 RETURN
8128 X=A+(B-A)*RND
8132 RETURN
8136 '
8140 ' EST302 - Dist.Normal
8144 '
8148 XMU=P(1) : SIG=P(2)
8152 ON IP GOTO 8156,8196,8208
8156 U=(X-XMU)/SIG
8164 FD=.39894228#*EXP(-U*U/2)
8168 C=1/(1+.2316419*ABS(U))
8172 FP=FD*C*(.3193815+C*(-.3565638+C*(1.781478+C*(-1.821256+1.330274*C))))
8176 IF U>0 THEN FP=1-FP
8180 IF FP>1 THEN FP=1
8184 IF FP<0 THEN FP=0
8188 FD=FD/SIG
8192 RETURN
8196 IF KF(1)=1 THEN P(1)=PX
8200 IF KF(2)=1 THEN P(2)=DEX
8201 IF P(2)=0 THEN P(2)=.0001
8204 RETURN
8208 X=SIG*SQR(-2*LOG(RND))*COS(6.283185*RND)+XMU
8212 RETURN
8216 '
8220 ' EST303 - Dist.Exponencial
8224 '
8228 XMU=P(1)
8232 ON IP GOTO 8236,8256,8268
8236 SIG=XMU
8240 IF X<0 THEN FD=0 : FP=0 : RETURN
8244 FD=EXP(-X/XMU)/XMU
8248 FP=1-EXP(-X/XMU)
8252 RETURN
8256 IF KF(1)=1 THEN P(1)=PX
8260 IF P(1)<=0 THEN P(1)=.001
8264 RETURN
8268 X=-XMU*LOG(RND)
8272 RETURN
8276 '
8280 ' EST304 - Dist.Gamma
8284 '
8288 AL=P(1) : BE=P(2)
8292 ON IP GOTO 8296,8348,8376
15 - 379
8296 XMU=AL*BE : SIG=SQR(AL)*BE
8297 IF X=0 AND AL<1 THEN FD=1E+10 : FP=0 : RETURN
8298 IF X=0 AND AL=1 THEN FD=.5 : FP=0 : RETURN
8300 IF X<=0 THEN FD=0 : FP=0 : RETURN
8304 XGA=X : X=X/BE
8308 XN=AL-1 : GOSUB 9860
8312 FD=EXP((AL-1)*LOG(X)-X-FA)/BE
8316 CA=AL : SUM=1/AL : CB=SUM
8320 FOR N=1 TO 100
8324 CA=CA+1 : CB=CB*X/CA : SUM=SUM+CB
8328 IF ABS(CB)<ABS(SUM)*.0001 THEN N=100
8332 NEXT N
8336 FP=SUM*EXP(-X+AL*LOG(X)-FA)
8337 IF FP>1 THEN FP=1
8338 IF FP<0 THEN FP=0
8340 X=XGA
8344 RETURN
8348 IF KF(1)=1 THEN P(1)=(PX/DEX)^2
8352 IF P(1)=0 THEN P(1)=.001
8356 IF KF(1)=1 AND P(3)=1 THEN P(1)=INT(P(1)+.5)
8360 IF P(3)=1 AND P(1)=0 THEN P(1)=1
8364 IF KF(2)=1 THEN P(2)=DEX^2/PX
8368 IF P(2)<=0 THEN P(2)=.001
8372 RETURN
8376 WHILE AL<1
8380 CA=1+AL/2.718282
8384 UA=RND : UB=RND
8388 CB=CA*UA
8392 IF CB>0 THEN 8404
8396 X=CB^(1/AL)
8400 IF UB<=EXP(-X) THEN X=BE*X : RETURN ELSE 8384
8404 X=-LOG((CA-CB)/AL)
8408 IF UB<X^(AL-1) THEN X=BE*X : RETURN ELSE 8384
8412 WEND
8416 IF AL=1 THEN X=-AL*BE*LOG(RND) : RETURN
8420 WHILE AL>1
8422 CS=(2*AL-1)^.5 : CT=AL-1.386294 : CU=AL+1/AL
8424 UA=RND : UB=RND
8428 CA=CS*LOG(UA/(1-UA))
8432 X=AL*EXP(CA)
8436 CB=UA*UA*UB
8440 CC=CT+CU*CA-X
8444 IF CC+2.504077-4.5*CB>=0 THEN X=BE*X : RETURN
8448 IF CC>=LOG(CB) THEN X=BE*X : RETURN
8452 GOTO 8424
8456 WEND
8460 '
8464 ' EST305 - Dist.Beta
8468 '
8472 AL=P(1) : BE=P(2)
8476 ON IP GOTO 8480,8584,8604
8480 XMU=AL/(AL+BE) : SIG=SQR(AL*BE/((AL+BE)^2*(AL+BE+1)))
8484 IF X<0 THEN FD=0 : FP=0 : RETURN
8488 IF X>1 THEN FD=0 : FP=1 : RETURN
8492 XN=(AL-1) : GOSUB 9868 : CA=FA
8496 XN=(BE-1) : GOSUB 9868 : CB=FA
8500 XN=(AL+BE-1) : GOSUB 9868
8504 BT=EXP(CA+CB-FA)
8508 FD=X^(AL-1)*(1-X)^(BE-1)/BT
8512 KA=0
8516 IF X>=(AL+1)/(AL+BE+2) THEN KA=1 : XX=X : X=1-X : Y=BE : BE=AL : AL=Y
8520 CA=1 : CB=1 : CC=1
8524 CD=1-(AL+BE)*X/(AL+1)
8528 FOR L=1 TO 100
8530 LL=2*L
8532 CE=L*(BE-L)*X/((AL-1+LL)*(AL+LL))
8536 CF=CC+CE*CA : CG=CD+CE*CB
8540 CE=-(AL+L)*(AL+BE+L)*X/((AL+LL)*(AL+1+LL))
8544 CH=CF+CE*CC : CI=CG+CE*CD
8548 CA=CF/CI : CB=CG/CI
8552 CJ=CC : CC=CH/CI : CD=1
15 - 380
8556 IF ABS(CC-CJ)<.0001*ABS(CC) THEN L=100
8560 NEXT L
8564 FP=FD*X*(1-X)*CC/AL
8568 IF KA=1 THEN FP=1-FP : X=XX
8572 IF FP<0 THEN FP=0
8576 IF FP>1 THEN FP=1
8580 RETURN
8584 IF KF(1)=1 THEN P(1)=PX*(PX-PX*PX-DEX*DEX)/(DEX*DEX)
8588 IF P(1)<=0 THEN P(1)=.001
8592 IF KF(2)=1 THEN P(2)=P(1)*(1/PX-1)
8596 IF P(2)<=0 THEN P(2)=.001
8600 RETURN
8604 CM=P(1) : CN=P(2)
8608 P(2)=1 : GOSUB 8280
8612 XX=X
8616 P(1)=CN : GOSUB 8280
8620 X=XX/(XX+X)
8624 P(1)=CM : P(2)=CN
8628 RETURN
8632 '
8636 ' EST306 - Dist.Log-normal
8640 '
8644 ON IP GOTO 8648,8676,8692
8648 XMUX=EXP(P(1)+P(2)^2/2)
8652 SIGX=XMUX*SQR(EXP(P(2)^2)-1)
8656 IF X<=0 THEN FD=0 : FP=0 : XMU=XMUX : SIG=SIGX : RETURN
8660 XLN=X : X=LOG(X) : GOSUB 8140
8664 X=XLN : FD=FD/X
8668 XMU=XMUX : SIG=SIGX
8672 RETURN
8676 XA=PX : IF PX<=0 THEN XA=.001
8680 IF KF(1)=1 THEN P(1)=.5*LOG(XA^2/((DEX/XA)^2+1))
8684 IF KF(2)=1 THEN P(2)=SQR(LOG((DEX/XA)^2+1))
8688 RETURN
8692 GOSUB 8140 : X=EXP(X)
8696 RETURN
8700 '
8704 ' EST307 - Dist.Chi^2
8708 '
8712 K=P(1)
8716 ON IP GOTO 8720,8768,8780
8720 XMU=K : SIG=SQR(2*K)
8724 IF X=0 AND K=1 THEN FD=1E+10 : FP=0 : RETURN
8728 IF X=0 AND K=2 THEN FD=.5 : FP=0 : RETURN
8732 IF X<=0 THEN FD=0 : FP=0 : RETURN
8740 P(1)=K/2 : P(2)=2
8744 GOSUB 8280
8748 P(1)=K : P(2)=0
8752 XN=(K/2-1) : GOSUB 9860
8756 FD=EXP((K/2-1)*LOG(X)-X/2-.3465735*K-FA)
8760 XMU=K : SIG=SQR(2*K)
8764 RETURN
8768 IF KF(1)=1 THEN P(1)=INT(PX+.5)
8772 IF P(1)<1 THEN P(1)=1
8776 RETURN
8780 P(1)=K/2 : P(2)=2
8784 GOSUB 8280
8788 P(1)=K : P(2)=0
8792 RETURN
8796 '
8800 ' EST308 - Distribucion t
8804 K=P(1)
8808 ON IP GOTO 8812,8896,8908
8812 WHILE K>0 AND K<250
8816 XN=(K-1)/2 : GOSUB 9860 : FD=FA
8820 XN=(K-2)/2 : GOSUB 9860 : FD=FD-FA
8824 FDZ=EXP(FD-.5*LOG(3.14159265#*K)-.5*(K+1)*LOG(1+X*X/K))
8832 XTE=X : X=K/(K+X*X)
8836 P(1)=K/2 : P(2)=.5
8840 GOSUB 8464
8842 FP=FP/2
15 - 381
8844 IF XTE>0 THEN FP=1-FP
8856 X=XTE : P(1)=K : P(2)=0
8860 FD=FDZ : K=0
8864 WEND
8868 WHILE K>=250
8872 P(1)=0 : P(2)=1 : GOSUB 8140
8876 P(1)=K : K=0
8880 WEND
8884 K=P(1) : XMU=0
8888 SIG=0 : IF K>2 THEN SIG=SQR(K/(K-2))
8892 RETURN
8896 IF KF(1)=1 THEN P(1)=INT(2*DEX^2/(DEX^2-1)+.5)
8900 IF KF(1)=1 AND P(1)<3 THEN P(1)=3
8904 RETURN
8908 P(1)=0 : P(2)=1 : GOSUB 8140
8912 U=X : P(1)=K : P(2)=0
8916 GOSUB 8704
8920 X=U/SQR(X/K)
8924 RETURN
8928 '
8932 ' EST309 - Dist. F
8936 '
8940 KM=P(1) : KN=P(2)
8944 ON IP GOTO 8948,9008,9040
8948 XMUX=0 : SIGX=0
8952 IF KN>2 THEN XMUX=KN/(KN-2)
8956 IF KN>4 THEN SIGX=KN*SQR(2*(KM+KN-2)/(KM*(KN-2)^2*(KN-4)))
8960 IF X<=0 THEN FD=0 : FP=0 : XMU=XMUX : SIG=SIGX : RETURN
8964 XN=(KM+KN-2)/2 : GOSUB 9860 : FDZ=FA
8968 XN=(KM-2)/2 : GOSUB 9860 : FDZ=FDZ-FA
8972 XN=(KN-2)/2 : GOSUB 9860 : FDZ=FDZ-FA
8976 FDZ=FDZ+(KM/2)*LOG(KM/KN)+.5*(KM-2)*LOG(X)-.5*(KM+KN)*LOG(1+KM*X/KN)
8980 FDZ=EXP(FDZ)
8984 XFE=X : X=KN/(KN+KM*X)
8988 P(1)=KN/2 : P(2)=KM/2
8992 GOSUB 8464
8994 FP=1-FP
8996 X=XFE : P(1)=KM : P(2)=KN
9000 FD=FDZ : XMU=XMUX : SIG=SIGX
9004 RETURN
9008 XA=PX : IF XA=1 THEN XA=1.001
9012 N=2*XA/(XA-1)
9016 IF KF(1)=1 THEN P(2)=INT(N+.5)
9020 IF KF(1)=1 AND P(2)<5 THEN P(2)=5
9024 IF KF(2)=0 THEN 9032
9028 P(1)=INT((2*P(2)-4)/(DEX^2*(P(2)-2)^2*(P(2)-4)/P(2)^2-2)+.5)
9032 IF KF(2)=1 AND P(1)<1 THEN P(1)=1
9036 RETURN
9040 GOSUB 8704
9044 XX=X : P(1)=KN
9048 GOSUB 8704
9052 X=XX*KN/(X*KM)
9056 P(1)=KM : P(2)=KN
9060 RETURN
9064 '
9068 ' EST310 - Dist.Normal Autocorr.
9072 '
9076 ON IP GOTO 9080,9088,9104
9080 GOSUB 8140
9084 RETURN
9088 IF KF(1)=1 THEN P(1)=PX
9092 IF KF(2)=1 THEN P(2)=DEX
9096 IF KF(3)=1 THEN P(3)=R
9100 RETURN
9104 L=INT(20*P(3))
9108 K=20-L : X=0
9112 FOR M=1 TO L
9116 IF VY(M+K)=0 THEN VY(M+K)=RND
9120 VY(M)=VY(M+K) : X=X+VY(M)
9124 NEXT M
9128 FOR M=L+1 TO 20
15 - 382
9132 VY(M)=RND : X=X+VY(M)
9136 NEXT M
9140 X=P(2)*(X-10)/1.291+P(1)
9144 RETURN
9148 '
9152 ' EST311 - Dist.Normal Bidimensional
9156 '
9160 XMUX=P(1) : SIGX=P(2)
9162 XMUY=P(3) : SIGY=P(4) : RO=P(5)
9164 ON IP GOTO 9168,9196,9220
9168 XMUC=XMUX+RO*(SIGX/SIGY)*(Y-XMUY)
9172 SIC=SIGX*SQR(1-RO^2)
9176 P(1)=XMUC : P(2)=SIC
9180 GOSUB 8140
9184 P(1)=XMUX: P(2)=SIGX
9188 XMU=XMUX : SIG=SIGX
9192 RETURN
9196 IF KF(1)=1 THEN P(1)=PM(1)
9200 IF KF(2)=1 THEN P(2)=DE(1)
9204 IF KF(3)=1 THEN P(3)=PM(2)
9208 IF KF(4)=1 THEN P(4)=DE(2)
9212 IF KF(5)=1 THEN P(5)=R
9216 RETURN
9220 P(1)=XMUY : P(2)=SIGY
9224 GOSUB 8140 : Y=X
9228 P(1)=XMUX+RO*(SIGX/SIGY)*(X-XMUY)
9232 P(2)=SIGX*SQR(1-RO^2)
9236 GOSUB 8140
9240 P(1)=XMUX : P(2)=SIGX
9244 RETURN
9248 '
9252 ' EST312 - Dist.Uniforme Discreta
9256 '
9260 A=P(1) : B=P(2)
9264 ON IP GOTO 9268,9296,9308
9268 XMU=(A+B)/2 : SIG=SQR((B-A)*(B-A+2)/12)
9272 XX=INT(X)
9276 IF XX<A THEN FD=0 : FP=0
9280 IF XX>=A AND XX<=B THEN FD=1/(B-A+1) : FP=(XX-A+1)/(B-A+1)
9284 IF XX>B THEN FD=0 : FP=1
9288 IF X-XX>0 THEN FD=0
9292 RETURN
9296 IF KF(1)=1 THEN P(1)=INT(XMI+.5)
9300 IF KF(2)=1 THEN P(2)=INT(XMA+.5)
9304 RETURN
9308 WHILE P(3)=0
9312 X=INT((B-A+1)*RND+A)
9316 RETURN
9320 WEND
9324 WHILE P(3)=1
9328 K=P(4)
9332 IF K=0 THEN K=B-A+1 : FOR M=1 TO K : VY(M)=A+M-1 : NEXT M
9336 M=INT(K*RND+1)
9340 X=VY(M) : IF M<K THEN VY(M)=VY(K)
9344 K=K-1 : P(4)=K
9348 RETURN
9352 WEND
9356 '
9360 ' EST313 - Dist.Binomial
9364 '
9368 N=P(1) : PR=P(2)
9372 ON IP GOTO 9376,9484,9504
9376 XMU=N*PR : SIG=SQR(N*PR*(1-PR))
9384 IF X<0 THEN FD=0 : FP=0 : RETURN
9388 IF X>N THEN FD=0 : FP=1 : RETURN
9392 XX=INT(X) : MK=0
9396 IF (PR<=.5 AND XMU>5) OR (PR>.5 AND N*(1-PR)>5) OR N>30 OR X>30 THEN MK=1
9400 WHILE MK=0
9404 XN=N : GOSUB 9860 : CA=FA
9408 FP=0 : CB=1
9412 FOR IX=0 TO XX
15 - 383
9416 IF IX>0 THEN CB=CB*IX
9418 XN=N-IX : GOSUB 9860
9420 FD=CA-LOG(CB)-FA+IX*LOG(PR)+(N-IX)*LOG(1-PR)
9422 FD=EXP(FD)
9424 FP=FP+FD
9428 NEXT IX
9432 IF X-XX>0 THEN FD=0
9436 RETURN
9440 WEND
9444 WHILE MK=1
9448 P(1)=XMU : P(2)=SIG : XA=X : X=XX-.5
9452 GOSUB 8140
9456 XB=FP : X=XX+.5
9460 GOSUB 8140
9464 FD=FP-XB
9468 IF X>XX THEN FD=0
9472 XMU=P(1) : SIG=P(2) : X=XA : P(1)=N : P(2)=PR
9476 RETURN
9480 WEND
9484 IF KF(1)=1 THEN P(1)=INT(PX^2/(PX-DEX^2)+.5)
9488 IF P(1)<1 THEN P(1)=1
9492 IF KF(2)=1 THEN P(2)=(PX-DEX^2)/PX
9496 IF P(2)<=0 THEN P(2)=.001
9500 RETURN
9504 MK=0
9508 IF (PR<=.5 AND MU>5) OR (PR>.5 AND N*(1-PR)>5) OR N>30 THEN MK=1
9512 WHILE MK=0
9516 X=0
9520 FOR K=1 TO N
9524 IF RND<=PR THEN X=X+1
9528 NEXT K
9532 RETURN
9536 WEND
9540 WHILE MK=1
9544 P(1)=N*PR : P(2)=SQR(N*PR*(1-PR))
9548 GOSUB 8140
9552 X=INT(X+.5) : P(1)=N : P(2)=PR
9556 RETURN
9560 WEND
9564 '
9568 ' EST314 - Dist.Binomial negativa
9572 '
9576 R=P(1) : PR=P(2)
9580 ON IP GOTO 9584,9632,9656
9584 XMU=R*(1-PR)/PR
9588 SIG=SQR(R*(1-PR))/PR
9592 IF X<0 THEN FD=0 : FP=0 : RETURN
9596 XX=INT(X)
9600 FP=0 : CA=1
9604 FOR IX=0 TO XX
9608 IF IX>0 THEN CA=CA*(IX+R-1)/IX
9612 FD=CA*PR^R*(1-PR)^IX
9616 FP=FP+FD
9620 NEXT IX
9624 IF X-XX>0 THEN FD=0
9628 RETURN
9632 IF KF(1)=1 THEN P(1)=INT(PX^2/(DEX^2-PX)+.5)
9636 IF P(1)<1 THEN P(1)=1
9640 IF KF(2)=1 THEN P(2)=PX/DEX^2
9644 IF P(2)<=0 THEN P(2)=.001
9648 IF P(2)>=1 THEN P(2)=.999
9652 RETURN
9656 X=0 : Y=0
9660 WHILE Y<R
9664 IF RND<=PR THEN Y=Y+1 ELSE X=X+1
9668 WEND
9672 RETURN
9676 '
9680 ' EST315 - Dist.Poisson
9684 '
9688 XMU=P(1)
15 - 384
9692 ON IP GOTO 9700,9788,9800
9696 '
9700 SIG=SQR(XMU)
9704 IF X<0 THEN FD=0 : FP=0 : RETURN
9708 XX=INT(X)
9712 MK=0 : IF XMU>10 OR X>30 THEN MK=1
9716 WHILE MK=0
9720 CA=EXP(-XMU) : FP=0 : CB=1
9724 FOR IX=0 TO XX
9728 IF IX>0 THEN CB=CB*IX
9732 FD=CA*P(1)^IX/CB : FP=FP+FD
9736 NEXT IX
9740 IF X-XX>0 THEN FD=0
9744 RETURN
9748 WEND
9752 WHILE MK=1
9756 P(2)=SIG : XA=X : X=XX-.5
9760 GOSUB 8140
9764 XB=FP : X=XX+.5
9768 GOSUB 8140
9772 FD=FP-XB : X=XA
9776 IF X>XX THEN FD=0
9780 RETURN
9784 WEND
9788 IF KF(1)=1 THEN P(1)=PX
9792 IF P(1)<=0 THEN P(1)=.001
9796 RETURN
9800 MK=0 : IF XMU>10 THEN MK=1
9804 WHILE MK=0
9808 CA=EXP(-XMU) : X=-1 : XR=1
9812 WHILE CA<=XR
9816 XR=XR*RND : X=X+1
9820 WEND
9824 RETURN
9828 WEND
9832 WHILE MK=1
9836 P(2)=SQR(XMU)
9840 GOSUB 8140
9844 X=INT(X+.5)
9846 IF X<0 THEN X=0
9848 RETURN
9852 WEND
9856 '
9860 ' EST320 - Calculo de Log(Factorial)
9864 '
9868 WHILE XN>=-.5 AND XN<=4 AND INT(2*XN)=2*XN
9872 IF XN=-.5 THEN FA=.57236494#
9876 IF XN=0 THEN FA=0
9880 IF XN=.5 THEN FA=-.12078224#
9884 IF XN=1 THEN FA=0
9888 IF XN=1.5 THEN FA=.28468287#
9892 IF XN=2 THEN FA=.693147181#
9896 IF XN=2.5 THEN FA=1.2009736#
9900 IF XN=3 THEN FA=1.79175947#
9904 IF XN=3.5 THEN FA=2.45373657#
9908 IF XN=4 THEN FA=3.17805383#
9912 RETURN
9916 WEND
9920 Y=1/(XN*XN)
9922 YY=1/360-Y*(1/1260-Y/1680)
9924 Y=(XN+.5)*LOG(XN)-XN*(1-Y*(1/12-Y*YY))
9928 FA=Y+.91893853#
9932 RETURN
9936 ' Calculo de F(x) por integracion de f(x)
9940 '
9944 PRINT : INPUT " x = ",XZ
9948 NIN=10 : FPA=0 : DIF=1
9952 WHILE DIF>.0001
9956 FPZ=0 : DX=XZ/NIN
9960 FOR Z=0 TO NIN
9964 X=Z*XZ/NIN
15 - 385
9968 IP=1 : GOSUB 8060
9972 IF Z>0 THEN FPZ=FPZ+(FD+FDI)*DX/2
9976 FDI=FD
9980 NEXT Z
9984 PRINT FPZ
9988 DIF=ABS((FPZ-FPA)) : NIN=2*NIN : FPA=FPZ
9992 WEND
9996 PRINT "f(x) = ";FD,"F(x) = ";FPZ : INPUT "",A$
9998 RETURN
9999 '
10000 RETURN
10004 '
10 ' ESTAD4 - Revision 30/ 5/89
15 ' -------------------------
20 GOSUB 1000
25 CHAIN "ESTAD"
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)
15 - 386
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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
15 - 387
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
NEXT
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
NEXT
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 ' EST4 - Pruebas Estadisticas
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 TF$(15),VX(2*NFM),NVC(2),VC(PAR1,2),TI(PAR1,2),VY(NFM)
1030 DIM NXV(2),PM(2),DE(2),NP(15),TG$(5),TP(5),KF(5)
1035 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
1040 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1045 WHILE KW=0
1050 TP$="PRUEBAS ESTADISTICAS" : TSP$=""
1055 NXX=0
1060 GOSUB 555
15 - 388
1065 PRINT TAB(70);FRE(0)
1070 PRINT "PROCESOS"
1075 TF$(1)="Pruebas Parametricas"
1080 TF$(2)="Pruebas no Parametricas"
1083 TF$(3)="Calculo de Tamano de Muestras"
1085 TF$(4)="Manejo de Datos"
1090 KL=4 : GOSUB 980
1095 IF ISP=0 THEN RETURN
1100 IKP=ISP
1105 IF ISP=4 THEN CHAIN "ESTAD1"
1110 ON ISP GOSUB 1125,3135,4700
1115 WEND
1120 '
1125 ' EST41 - Pruebas Parametricas
1130 ' ----------------------------
1135 TSP$="Pruebas Parametricas (Poblaciones Normales)"
1140 WHILE KW=0
1145 GOSUB 555
1150 TF$(1)="Mu" : TF$(2)="Sigma"
1155 TF$(3)="Mu1-Mu2 (Indep.)" : TF$(4)="Sigma1/Sigma2"
1160 TF$(5)="Mu1-Mu2 (Relac.)" : TF$(6)="Coef. Correlacion Ro"
1165 PRINT : PRINT "TIPO DE PRUEBA"
1170 PRINT : PRINT " Una Variable"
1175 PRINT " 1 - ";TF$(1)
1180 PRINT " 2 - ";TF$(2)
1185 PRINT : PRINT " Dos Variables Independientes"
1190 PRINT " 3 - ";TF$(3)
1195 PRINT " 4 - ";TF$(4)
1200 PRINT : PRINT " Dos Variables Relacionadas"
1205 PRINT " 5 - ";TF$(5)
1210 PRINT " 6 - ";TF$(6)
1215 PRINT : INPUT "Opcion elegida = ",A$
1220 IF LEN(A$)=0 THEN RETURN
1225 ISP=VAL(A$)
1230 IF ISP<1 OR ISP>6 THEN PRINT CHR$(7) : GOTO 1215
1235 IF ISP<=2 THEN KNV=1 ELSE KNV=2
1240 KTV=1 : IF ISP=3 OR ISP=4 THEN KTV=2
1245 C$=TF$(ISP) : ITP=ISP : GOSUB 555
1250 PRINT : PRINT "PRUEBA SOBRE ";C$
1255 IF MB=0 THEN 1275
1260 GOSUB 2340
1265 PRINT : INPUT "Definicion de nuevas Variables/Estadisticas ? (N) = ",A$
1270 IF A$<>"S" AND A$<>"s" THEN 1305
1275 MB=1
1280 PRINT : INPUT "Ingreso Directo Estadisticas Muestras ? (N) = ",A$
1285 IF A$="S" OR A$="s" THEN MB=2
1290 IF MB=1 AND NF=0 THEN KE=1 : GOSUB 900 : RETURN
1295 GOSUB 1815
1300 IF NXV(1)<2 OR (KNV=2 AND NXV(2)<2) THEN KE=3 : GOSUB 900 : RETURN
1305 IF ITP<>3 THEN 1320
1310 PRINT : INPUT "Variancias Iguales ? (N) = ",A$
1315 MV=0 : IF A$="S" OR A$="s" THEN MV=1
1320 PRINT : INPUT "Calculo de Intervalo de Confianza ? (N) = ",A$
1325 JP=1 : IF A$="S" OR A$="s" THEN JP=3
1330 '
1335 WHILE JP<3
1340 GOSUB 2340
1343 PRINT : PRINT "HIPOTESIS NULA" : PRINT
1345 PRINT " ";C$;
1350 IF ITP=6 THEN XKP=0 : PRINT XKP : GOTO 1415
1355 INPUT " = ",A$
1360 IF LEN(A$)=0 THEN RETURN
1365 XKP=VAL(A$)
1370 IF (ITP=2 OR ITP=4) AND XKP<=0 THEN KE=5 : B$=">0" : GOSUB 900 :
GOTO 1343
1415 ON ITP GOSUB 2415,2525,2640,2815,2935,3045
1420 IP=1 : GOSUB 8060
1425 IF FP>=.5 THEN FPS=1-FP : KH=1
1430 IF FP<.5 THEN FPS=FP : KH=2
1435 FPD=2*FPS
1440 KS=1
15 - 389
1445 WHILE KS=1
1450 GOSUB 555
1455 GOSUB 2340
1460 PRINT#3,
1465 PRINT#3,"PRUEBA SOBRE ";C$
1470 IF ITP=3 AND MV=1 THEN PRINT#3," Variancias Iguales"
1475 IF ITP=3 AND MV=0 THEN PRINT#3," Variancias Desiguales"
1480 PRINT#3,
1485 PRINT#3," Hipotesis Nula"
1490 PRINT#3," ";C$;" = ";XKP
1495 B$=" >" : IF KH=2 THEN B$=" <"
1515 PRINT#3,
1520 PRINT#3," Valor Estadistica de Prueba = ";FNR(X,NDE)
1523 PRINT#3,
1525 PRINT#3," Nivel de Significacion Alfa"
1526 PRINT#3," Hipotesis Alternativa ";C$;B$;XKP;" = ";
FNR(FPS*100,NDE-1);" %"
1527 PRINT#3," Hipotesis Alternativa ";C$;"<>";XKP;" = ";
FNR(FPD*100,NDE-1);" %"
1530 GOSUB 650
1535 WEND
1540 IF ITP=6 THEN 1710
1545 PRINT : PRINT "CALCULO DE RIESGOS BETA"
1550 NVB=0
1555 PRINT : PRINT " Hipotesis Alternativa"
1560 PRINT TAB(6);C$; : INPUT" = ",A$
1565 IF LEN(A$)=0 THEN 1585
1570 NVB=NVB+1
1575 VX(NVB)=VAL(A$)
1580 GOTO 1560
1585 IF NVB=0 THEN 1710
1590 KS=1
1595 WHILE KS=1
1600 PRINT#3, : PRINT#3,"CALCULO DE RIESGOS BETA" : PRINT#3,
1605 PRINT#3,TAB(3);C$;TAB(25);"Beta (%)"
1607 PRINT#3,TAB(20);C$;B$;XKP;TAB(38);C$;"<>";XKP
1610 KA=3 : KB=50 : GOSUB 695
1615 FOR M=1 TO NVB
1620 XKA=VX(M)
1630 IF KH=1 THEN XS=-1E+10 : XT=X
1635 IF KH=2 THEN XS=X : XT=1E+10
1637 JP=2 : ON ITP GOSUB 2415,2525,2640,2815,2935,3045
1638 X=XC : GOSUB 8060 : FPS=FP
1640 X=XD : GOSUB 8060 : FPS=FP-FPS
1641 PRINT#3,TAB(3);XKA,FNR(FPS*100,NDE-1);
1643 IF M>1 THEN 1665
1645 IF ITP=1 OR ITP=3 OR ITP>=5 THEN XT=ABS(X) : XS=-XT : GOTO 1665
1650 FPX=1-FP : XX=X : GOSUB 7710
1655 IF FPX<.5 THEN XS=X : XT=XX
1660 IF FPX>=.5 THEN XS=XX : XT=X
1665 JP=2 : ON ITP GOSUB 2415,2525,2640,2815,2935,3045
1670 X=XC : GOSUB 8060 : FPD=FP
1680 X=XD : GOSUB 8060 : FPD=FP-FPD
1690 PRINT#3,TAB(26);FNR(FPD*100,NDE-1)
1695 NEXT M
1700 GOSUB 650
1705 WEND
1710 PRINT : INPUT "Calculo de Intervalo de Confianza ? (N) = ",A$
1715 JP=4 : IF A$="S" OR A$="s" THEN JP=3
1720 WEND
1725 '
1730 WHILE JP=3
1735 PRINT : INPUT " Nivel de Significacion Alfa en % = ",A$
1740 IF LEN(A$)=0 THEN JP=0 : GOTO 1800
1745 AL=VAL(A$)/100
1750 IF AL<=0 OR AL>=1 THEN KE=5 : B$=">0 y <100" : GOSUB 900 : GOTO 1735
1755 ON ITP GOSUB 2415,2525,2640,2815,2935,3045
1760 KS=1
1765 WHILE KS=1
1770 PRINT#3, : PRINT#3,"Intervalo de Confianza para Alfa = ";100*AL;" %"
1775 PRINT#3,
15 - 390
1780 PRINT#3," ";FNR(XC,NDE);" <= ";C$;" <= ";FNR(XD,NDE)
1785 PRINT#3,
1790 GOSUB 650
1795 WEND
1800 WEND
1805 WEND
1810 '
1815 ' EST400 - Ingreso datos muestras
1820 ' ------------------------------
1825 XX=MB : YY=KTV : KVI=0
1830 NXV(1)=0 : NXV(2)=0 : PM(1)=0 : PM(2)=0 : DE(1)=0 : DE(2)=0
1835 WHILE MB=2
1840 FOR K=1 TO KNV
1845 PRINT : PRINT "Datos Variable";K
1850 IF K=2 AND KTV=1 THEN NXV(2)=NXV(1) : GOTO 1875
1855 INPUT " Numero de Observaciones = ",A$
1860 IF LEN(A$)=0 THEN RETURN
1865 NXV(K)=VAL(A$)
1870 IF NXV(K)<2 THEN KE=5 : B$=">=2" : GOSUB 900 : GOTO 1855
1875 INPUT " Promedio = ",A$
1880 PM(K)=VAL(A$)
1885 INPUT " Desvio Estandar = ",A$
1890 DE(K)=VAL(A$)
1895 IF DE(K)<=0 THEN KE=5 : B$=">0" : GOSUB 900 : GOTO 1885
1900 NEXT K
1905 IF KTV=2 OR KNV=1 THEN 1930
1910 PRINT : INPUT " Coeficiente de Correlacion 1-2 = ",A$
1915 R=VAL(A$)
1920 IF R<=-1 OR R>=1 THEN KE=5 : B$=">-1 y <1" : GOSUB 900 : GOTO 1910
1930 MB=0
1935 WEND
1940 WHILE MB=1
1945 PRINT : PRINT "DEFINICION DE VARIABLES (";KNV;")"
1950 IF KTV<2 THEN 1980
1955 PRINT : INPUT "Muestras en Variables distintas ? (N) = ",A$
1960 KVI=1 : IF A$="S" OR A$="s" THEN KVI=2
1965 IF KVI=1 THEN PRINT
1970 IF KVI=1 THEN PRINT " La primera Variable define las dos muestras"
1975 IF KVI=1 THEN PRINT " y la segunda contiene los valores a considerar"
1980 PRINT : IF IKP=2 OR KVI=2 THEN KDA=1
1985 GOSUB 200
1990 IF IKP=2 THEN JF=0
1995 IF NV=0 THEN RETURN
2000 IF NV<>KNV THEN KE=2 : GOSUB 900 : GOTO 1985
2005 PRINT : PRINT TAB(25);"EN PROCESO"
2010 WHILE KTV=1
2015 GOSUB 5825
2020 IF NXX<2 THEN RETURN
2025 IF KNV=2 THEN R=TI(2,1)/(DE(1)*DE(2))
2030 NXV(1)=NXX : NXV(2)=NXX
2035 KTV=0
2040 WEND
2045 ZZ=KVI
2050 WHILE KTV=2
2055 WHILE KVI=1
2060 JE=JX(2)
2065 J=JX(1)
2070 GOSUB 5480
2075 PRINT : PRINT
2080 PRINT " (Valores Minimo y Maximo Variable";J;" - ";TC$(J);
" = ";XMI;"-";XMA
2085 FOR M=1 TO 2
2090 PRINT : PRINT "Muestra Nro.";M
2095 PRINT " Definida por los siguientes valores"
2100 PRINT " de la Variable ";JX(1);" - ";TC$(JX(1))
2105 INPUT " >= ",A$
2110 IF LEN(A$)=0 THEN RETURN
2115 VC(1,M)=VAL(A$)
2120 INPUT " < ",A$
2125 X=VAL(A$)
15 - 391
2130 IF X<=VC(1,M) THEN KE=5 : B$=">"+STR$(VC(1,M)) :
GOSUB 900 : GOTO 2120
2135 VC(2,M)=X
2140 PM(M)=0 : DE(M)=0
2145 NEXT M
2147 PRINT : PRINT TAB(25);"EN PROCESO"
2150 FOR I=1 TO NF
2155 IF A(I,0)=1 THEN 2195
2160 ND=1 : IF JF>0 THEN ND=A(I,JF)
2165 IF ND=XVF THEN 2195
2170 X=A(I,JE)
2175 Y=A(I,J)
2177 IF X=XVF OR Y=XVF THEN 2195
2180 FOR M=1 TO 2
2185 IF Y>=VC(1,M) AND Y<VC(2,M) THEN NXV(M)=NXV(M)+ND:PM(M)=PM(M)+ND*X :
DE(M)=DE(M)+ND*X*X
2190 NEXT M
2195 NEXT I
2200 KVI=0
2205 WEND
2210 WHILE KVI=2
2215 FOR I=1 TO NF
2220 IF A(I,0)=1 THEN 2195
2225 X=A(I,JX(1)) : IF X=XVF THEN 2245
2230 NXV(1)=NXV(1)+1
2235 PM(1)=PM(1)+X
2240 DE(1)=DE(1)+X*X
2245 X=A(I,JX(2)) : IF X=XVF THEN 2265
2250 NXV(2)=NXV(2)+1
2255 PM(2)=PM(2)+X
2260 DE(2)=DE(2)+X*X
2265 NEXT I
2270 KVI=0
2275 WEND
2285 FOR M=1 TO 2
2290 IF NXV(M)<2 THEN 2305
2295 PM(M)=PM(M)/NXV(M)
2300 DE(M)=SQR((DE(M)-NXV(M)*PM(M)^2)/(NXV(M)-1))
2305 NEXT M
2307 KTV=0
2310 WEND
2315 MB=0
2320 WEND
2325 MB=XX : KTV=YY : KVI=ZZ
2330 RETURN
2335 '
2340 ' EST401 - Presentacion Estadisticas muestras
2345 ' -------------------------------------------
2350 PRINT#3, : PRINT#3,"Estadisticas Muestras" : PRINT#3,
2355 PRINT#3," Variable Nro.Obs. Promedio Desvio Est."
2360 PRINT#3,
2365 FOR K=1 TO KNV
2370 IF MB=1 THEN A$=TC$(JX(K))
2375 IF MB=1 AND KTV=2 AND KVI=1 THEN A$=TC$(JE)
2380 IF MB=2 THEN A$=""
2385 PRINT#3,TAB(3);K;"- ";A$;TAB(19);NXV(K);TAB(27);FNR(PM(K),NDE+1);
TAB(39);FNR(DE(K),NDE+1);
2390 IF KTV=2 AND MB=1 AND KVI=1 THEN PRINT#3,TAB(50);" (";JX(1);"-";
TC$(JX(1));" >=";VC(1,K);" y <";VC(2,K);")" ELSE PRINT#3,
2395 NEXT K
2400 IF KTV=1 AND KNV=2 THEN PRINT#3,TAB(27);"Coefic. Correlac.= ";FNR(R,NDE+1)
2405 RETURN
2410 '
2415 ' EST411 - Prueba sobre Mu
2420 '
2425 P(1)=NXV(1)-1 : TF=8
2430 ZA=SQR(NXV(1))/DE(1)
2440 WHILE JP=1
2445 X=(PM(1)-XKP)*ZA
2450 RETURN
2455 WEND
15 - 392
2460 WHILE JP=2
2465 XL=(XKA-XKP)*ZA
2470 XC=XS-XL : XD=XT-XL
2480 RETURN
2485 WEND
2490 WHILE JP=3
2495 FPX=1-AL/2 : GOSUB 7710
2500 XC=PM(1)-X/ZA
2505 XD=PM(1)+X/ZA
2510 RETURN
2515 WEND
2520 '
2525 ' EST412 - Prueba sobre Sigma
2530 '
2535 P(1)=NXV(1)-1 : TF=7
2540 ZA=(NXV(1)-1)*DE(1)^2
2550 WHILE JP=1
2555 X=ZA/XKP^2
2560 RETURN
2565 WEND
2570 WHILE JP=2
2575 XL=(XKA/XKP)^2
2580 XC=XS/XL : XD=XT/XL
2590 RETURN
2595 WEND
2600 WHILE JP=3
2605 FPX=1-AL/2 : GOSUB 7710
2610 XC=SQR(ZA/X)
2615 FPX=AL/2 : GOSUB 7710
2620 XD=SQR(ZA/X)
2625 RETURN
2630 WEND
2635 '
2640 ' EST413 - Prueba sobre Mu1-Mu2 (Var.Indep.)
2645 '
2650 XX=MV : TF=8
2655 WHILE MV=1
2660 P(1)=NXV(1)+NXV(2)-2
2665 XA=SQR(((NXV(1)-1)*DE(1)^2+(NXV(2)-1)*DE(2)^2)/P(1))
2670 XB=XA*SQR((1/NXV(1))+1/NXV(2))
2675 MV=-1
2680 WEND
2685 WHILE MV=0
2690 XA=DE(1)^2/NXV(1)+DE(2)^2/NXV(2)
2695 P(1)=XA^2/(DE(1)^4/(NXV(1)^2*(NXV(1)-1)+DE(2)^4/(NXV(2)^2*(NXV(2)-1))))
2700 P(1)=INT(P(1)+.5)
2705 XB=SQR(XA)
2710 MV=-1
2715 WEND
2720 MV=XX
2730 WHILE JP=1
2735 X=(PM(1)-PM(2)-XKP)/XB
2740 RETURN
2745 WEND
2750 WHILE JP=2
2755 XL=(XKA-XKP)/XB
2760 XC=XS-XL : XD=XT-XL
2770 RETURN
2775 WEND
2780 WHILE JP=3
2785 FPX=1-AL/2 : GOSUB 7710
2790 XC=PM(1)-PM(2)-X*XB
2795 XD=PM(1)-PM(2)+X*XB
2800 RETURN
2805 WEND
2810 '
2815 ' EST414 - Prueba sobre Sig1/Sig2
2820 '
2825 P(1)=NXV(1)-1
2830 P(2)=NXV(2)-1
2835 TF=9
15 - 393
2840 ZA=(DE(1)/DE(2))^2
2845 WHILE JP=1
2850 X=ZA/XKP^2
2855 RETURN
2860 WEND
2865 WHILE JP=2
2870 XL=(XKA/XKP)^2
2875 XC=XS/XL : XD=XT/XL
2885 RETURN
2890 WEND
2895 WHILE JP=3
2900 FPX=1-AL/2 : GOSUB 7710
2905 XC=ZA/X
2910 FPX=AL/2 : GOSUB 7710
2915 XD=ZA/X
2920 RETURN
2925 WEND
2930 '
2935 ' EST415 - Prueba sobre Mu1-Mu2 (Var.Relac.)
2940 '
2945 P(1)=NXV(1)-1 : TF=8
2950 S=SQR(DE(1)^2+DE(2)^2-2*R*DE(1)*DE(2))
2955 ZA=SQR(NXV(1))/S
2965 WHILE JP=1
2970 X=(PM(1)-PM(2)-XKP)*ZA
2975 RETURN
2980 WEND
2985 WHILE JP=2
2990 XL=(XKA-XKP)/ZA
2995 XC=XS-XL : XD=XT-XL
3005 RETURN
3010 WEND
3015 WHILE JP=3
3020 FPX=1-AL/2 : GOSUB 7710
3025 XC=PM(1)-PM(2)-X/ZA
3030 XD=PM(1)-PM(2)+X/ZA
3035 RETURN
3040 WEND
3043 '
3045 ' EST416 - PRUEBA SOBRE RO
3050 '
3055 P(1)=NXV(1)-2 : TF=8
3060 WHILE JP=1
3065 X=R*SQR((NXV(1)-2)/(1-R*R))
3070 RETURN
3075 WEND
3080 WHILE JP=2
3085 XC=0 : XD=0
3090 RETURN
3095 WEND
3100 WHILE JP=3
3105 FPX=1-AL/2 : GOSUB 7710
3110 XD=SQR(1/((NXV(1)-2)/X^2+1))
3115 XC=-XD
3120 RETURN
3125 WEND
3130 '
3135 ' EST42 - Pruebas no Parametricas
3140 ' -------------------------------
3145 TSP$="Pruebas no Parametricas"
3150 WHILE KW=0
3155 GOSUB 555
3160 TF$(1)="Chi^2" : TF$(2)="Wilcoxon (1)" : TF$(3)="Kolmogorov-Smirnov (1)"
3165 TF$(4)="Mann-Whitney" : TF$(5)="Kolmogorov-Smirnov (2)"
3170 TF$(6)="Wilcoxon (2)" : TF$(7)="Correlacion de Spearman"
3175 PRINT : PRINT "TIPO DE PRUEBA"
3180 PRINT : PRINT " Una Variable"
3185 PRINT " 1 - ";TF$(1)
3190 PRINT " 2 - ";TF$(2)
3195 PRINT " 3 - ";TF$(3)
3200 PRINT : PRINT " Dos Variables Independientes"
15 - 394
3205 PRINT " 4 - ";TF$(4)
3210 PRINT " 5 - ";TF$(5)
3215 PRINT : PRINT " Dos Variables Relacionadas"
3220 PRINT " 6 - ";TF$(6)
3225 PRINT " 7 - ";TF$(7)
3230 PRINT : INPUT "Prueba elegida = ",A$
3235 IF LEN(A$)=0 THEN RETURN
3240 ISP=VAL(A$)
3245 IF ISP<1 OR ISP>7 THEN PRINT CHR$(7) : GOTO 3230
3250 KNV=1 : IF ISP>=4 THEN KNV=2
3255 KTV=1 : IF ISP=4 OR ISP=5 THEN KTV=2
3260 MB=1
3265 C$=TF$(ISP) : GOSUB 555
3270 PRINT : PRINT "PRUEBA : ";C$
3280 IF ISP=1 THEN PRINT : INPUT "Ingreso Directo Datos ? (N) = ",A$
3285 IF ISP=1 THEN IF A$="S" OR A$="s" THEN MB=2 : GOTO 3313
3290 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
3295 GOSUB 1815
3300 IF NV=0 THEN RETURN
3305 IF NXV(1)<2 OR (KNV=2 AND NXV(2)<2) THEN KE=3 : GOSUB 900 : RETURN
3313 B$=""
3315 ON ISP GOSUB 3385,3570,3745,3940,4095,3570,4315
3320 KS=1
3325 WHILE KS=1
3330 GOSUB 555
3335 GOSUB 2340
3340 PRINT#3,
3345 PRINT#3,"PRUEBA : ";C$ : PRINT#3,
3346 PRINT#3,
3347 PRINT#3," Hipotesis Nula"
3348 PRINT#3,TAB(6);D$ : PRINT#3,
3350 PRINT#3," Valor Estadistica de Prueba = ";FNR(X,NDE)
3355 PRINT#3," Nivel de Significacion = ";FNR(FP*100,2);" %"
3360 IF B$>"" THEN PRINT#3,TAB(6);B$
3365 GOSUB 650
3370 WEND
3375 WEND
3380 '
3385 ' EST421 - Prueba de Chi^2
3390 '
3395 NVC(1)=0
3400 PRINT : PRINT "INGRESO FRECUENCIAS DE CLASIFICACION" : PRINT
3405 FOR M=1 TO PAR1
3410 PRINT : INPUT " X>= ",A$
3415 IF LEN(A$)=0 THEN M=PAR1 : GOTO 3495
3420 X=VAL(A$)
3425 IF M>1 AND X<=VC(M-1,1) THEN KE=5 : B$=">"+STR$(VC(M-1,1)) :
GOSUB 900 : GOTO 3525
3430 VC(M,1)=X
3435 IF MB=1 THEN 3465
3440 PRINT " Frecuencia Experimental para X>=";VC(M,1);
3443 INPUT " = ",A$
3445 IF LEN(A$)=0 THEN M=PAR1 : GOTO 3495
3450 X=VAL(A$)
3455 IF X<0 THEN KE=5 : B$=">=0" : GOSUB 900 : PRINT : GOTO 3440
3460 TI(M,1)=X
3465 PRINT " Frecuencia Esperada para X>=";VC(M,1);
3467 INPUT " = ",A$
3470 IF LEN(A$)=0 THEN M=PAR1 : GOTO 3495
3475 X=VAL(A$)
3480 IF X<0 THEN KE=5 : B$=">=0" : GOSUB 900 : PRINT : GOTO 3465
3485 TI(M,0)=X
3490 NVC(1)=NVC(1)+1
3495 NEXT M
3500 IF NVC(1)=0 THEN RETURN
3505 IF MB=1 THEN NVI=1 : KA=0 : GOSUB 6140
3515 IF MB=1 THEN IF NXX<2 THEN KE=3 : GOSUB 900 : RETURN
3520 CHI=0 : IGL=-1
3525 FOR M=1 TO NVC(1)
3530 X=TI(M,0)
3535 IF X>0 THEN CHI=CHI+(TI(M,1)-X)^2/X : IGL=IGL+1
15 - 395
3540 NEXT M
3545 IF IGL<1 THEN X=0 : GOTO 3555
3547 X=CHI : P(1)=IGL
3550 IP=1 : GOSUB 8704 : FP=1-FP
3555 B$="Grados de Libertad ="+STR$(IGL)
3556 IF IGL<1 THEN B$=B$+" ( <1 )"
3557 D$="Distribucion Experimental = Distribucion Definida"
3560 RETURN
3565 '
3570 ' EST422 - Prueba de Wilcoxon
3575 '
3580 IF NV=1 THEN PRINT: PRINT " Hipotesis Nula": INPUT " Mediana = ",A$
3585 IF NV=1 THEN XKP=VAL(A$)
3590 N=0
3595 FOR I=1 TO NF
3600 IF A(I,0)=1 THEN 3630
3605 X=A(I,JX(1)) : IF X=XVF THEN 3630
3610 IF NV=1 THEN X=X-XKP
3615 IF NV=2 THEN Y=A(I,JX(2)) : IF Y=XVF THEN 3630
3620 IF NV=2 THEN X=X-Y
3625 IF X<>0 THEN N=N+1 : VX(N)=X
3630 NEXT I
3635 FOR I=1 TO N
3640 X=VX(I)
3645 IF X>0 THEN VY(I)=1
3650 IF X<0 THEN VY(I)=-1 : VX(I)=-X
3655 NEXT I
3660 GOSUB 4460
3665 SP=0 : SN=0
3670 FOR I=1 TO N
3675 XA=VY(I)
3680 IF XA>0 THEN SP=SP+VX(I+N)
3685 IF XA<0 THEN SN=SN+VX(I+N)
3690 NEXT I
3695 IF SP>0 THEN X=SP
3700 IF SN>0 AND SN<X THEN X=SN
3705 P(1)=N*(N+1)/4
3710 P(2)=SQR(N*(N+1)*(2*N+1)/24)
3715 IP=1 : GOSUB 8140
3720 IF X>P(1) THEN FP=1-FP
3730 IF N<=25 THEN B$="(Valor Aproximado - Nro.de Diferencias no nulas <=25)"
3733 IF NV=1 THEN D$="Mediana Poblacion = "+STR$(XKP)
3734 IF NV=2 THEN D$="Distribucion Variable 1 = Distribucion Variable 2"
3735 RETURN
3740 '
3745 ' EST423 - Prueba de Kolm-Sm. (1 var)
3750 '
3755 IKP=1 : GOSUB 7250
3757 IF TF=0 THEN RETURN
3758 PRINT : PRINT TAB(25);"EN PROCESO"
3760 J=JX(1) : N=0
3770 FOR I=1 TO NF
3775 IF A(I,0)=1 THEN 3795
3780 X=A(I,J) : IF X=XVF THEN 3795
3785 VX(N)=X : VY(I)=I
3790 N=N+1
3795 NEXT I
3800 GOSUB 5730
3805 D=0 : FPA=0
3810 FOR I=1 TO N
3815 FPX=I/N
3820 X=VX(I)
3825 IP=1 : GOSUB 8060
3830 XD=ABS(FP-FPX)
3835 IF XD>D THEN D=XD
3836 XD=ABS(FP-FPA)
3837 IF XD>D THEN D=XD
3838 FPA=FPX
3840 NEXT I
3845 X=D : XX=D*SQR(N)
3850 GOSUB 3870
15 - 396
3855 B$=""
3860 IF N<20 OR KDI=1 THEN B$="(Valor Aprox. - Nro. Obs.<20 o Distrib.Discr.)"
3863 D$="Distrib. Poblacion = Distrib. "+TF$(TF)
3864 FOR M=1 TO NP(TF)
3865 D$=D$+" - Par."+STR$(M)+"="+STR$(P(M))
3866 NEXT M
3868 RETURN
3870 ' Dist KS
3875 CA=-2*XX^2 : CB=2 : FP=0
3890 FOR M=1 TO 100
3895 CC=CB*EXP(CA*M^2)
3900 FP=FP+CC
3905 IF ABS(CC)<.001*FP THEN RETURN
3910 CB=-CB
3920 NEXT M
3925 FP=1
3930 RETURN
3935 '
3940 ' EST424 - Prueba de Mann-Whitney
3945 '
3950 NA=0 : NB=NXV(1)
3955 FOR I=1 TO NF
3960 IF A(I,0)=1 THEN 4015
3965 IF KVI=2 THEN 3995
3970 X=A(I,JE) : Y=A(I,JX(1))
3975 IF X=XVF OR Y=XVF THEN 4015
3980 IF Y>=VC(1,1) AND Y<VC(2,1) THEN NA=NA+1 : VX(NA)=X
3985 IF Y>=VC(1,2) AND Y<VC(2,2) THEN NB=NB+1 : VX(NB)=X
3990 GOTO 4015
3995 X=A(I,JX(1)) : IF X=XVF THEN 4005
4000 NA=NA+1 : VX(NA)=X
4005 X=A(I,JX(2)) : IF X=XVF THEN 4015
4010 NB=NB+1 : VX(NB)=X
4015 NEXT I
4020 N=NB : NB=NB-NA
4025 GOSUB 4460
4030 S=0
4035 FOR I=1 TO NA
4040 S=S+VX(I+N)
4045 NEXT I
4050 X=NA*NB+NA*(NA+1)/2-S
4055 Y=NA*NB-X
4060 IF Y<X THEN X=Y
4065 P(1)=NA*NB/2
4070 P(2)=SQR(NA*NB*(NA+NB+1)/12)
4075 IP=1 : GOSUB 8140
4080 IF NA<=10 OR NB<=10 THEN B$="(Valor Aproximado - Nro.Obs.<=10)"
4083 D$="Distribucion Variable X = Distribucion Variable Y"
4085 RETURN
4090 '
4095 ' EST425 - Prueba de Kolm-Sm. (2 var)
4100 '
4105 NB=0
4110 FOR I=1 TO NF
4115 IF A(I,0)=1 THEN 4145
4120 IF KVI=2 THEN X=A(I,JX(2)) : IF X=XVF THEN 4145
4125 IF KVI=2 THEN NB=NB+1 : VX(NB)=X : GOTO 4145
4130 X=A(I,JE) : Y=A(I,JX(1))
4135 IF X=XVF OR Y=XVF THEN 4145
4140 IF Y>=VC(1,2) AND Y<VC(2,2) THEN NB=NB+1 : VX(NB)=X
4145 NEXT I
4150 N=NB : GOSUB 5730
4155 FOR I=1 TO NB : VX(I+NF)=VX(I) : NEXT I
4160 NA=0
4165 FOR I=1 TO NF
4170 IF A(I,0)=1 THEN 4200
4175 IF KVI=2 THEN X=A(I,JX(2)) : IF X=XVF THEN 4200
4180 IF KVI=2 THEN NA=NA+1 : VX(NA)=X : GOTO 4200
4185 X=A(I,JE) : Y=A(I,JX(1))
4190 IF X=XVF OR Y=XVF THEN 4200
4195 IF Y>=VC(1,1) AND Y<VC(2,1) THEN NA=NA+1 : VX(NA)=X
15 - 397
4200 NEXT I
4205 N=NA : GOSUB 5730
4210 D=0 : NXA=1 : NXB=1
4215 FPA=0 : FPB=0 : FPM=0 : FPN=0
4225 WHILE NXA<=NA AND NXB<=NB
4230 IF VX(NXA)>=VX(NXB+NF) THEN 4260
4235 FPA=NXA/NA
4240 XD=ABS(FPA-FPN)
4245 IF XD>D THEN D=XD
4246 XD=ABS(FPM-FPN)
4247 IF XD>D THEN D=XD
4250 NXA=NXA+1 : FPM=FPA
4255 GOTO 4280
4260 FPB=NXB/NB
4265 XD=ABS(FPB-FPM)
4270 IF XD>D THEN D=XD
4271 XD=ABS(FPN-FPM)
4272 IF XD>D THEN D=XD
4275 NXB=NXB+1 : FPN=FPB
4280 WEND
4285 X=D : XX=SQR(NA*NB/(NA+NB))*D
4290 GOSUB 3870
4300 IF NA<20 OR NB<20 THEN B$="(Valor Aproximado - Nro. Obs.<20)"
4303 D$="Distribucion Variable X = Distribucion Variable Y"
4305 RETURN
4310 '
4315 ' EST427 - Prueba de Correlacion de Spearman
4320 '
4325 FOR K=1 TO 2
4330 N=0
4335 J=JX(K)
4340 FOR I=1 TO NF
4345 IF A(I,0)=1 THEN 4360
4350 X=A(I,JX(1)) : Y=A(I,JX(2)) : IF X=XVF OR Y=XVF THEN 4360
4355 N=N+1 : IF K=1 THEN VX(N)=X ELSE VX(N)=Y
4360 NEXT I
4365 GOSUB 4460
4370 IF K=2 THEN 4390
4375 FOR I=1 TO N
4380 VY(I)=VX(I+N)
4385 NEXT I
4390 NEXT K
4395 S=0
4400 FOR I=1 TO N
4405 S=S+(VY(I)-VX(I+N))^2
4410 NEXT I
4415 R=1-6*S/(N*(N^2-1))
4420 X=R*SQR((N-2)/(1-R*R))
4425 P(1)=N-2
4430 IP=1 : GOSUB 8800
4435 IF FP>=.5 THEN FP=2*(1-FP)
4440 IF FP<.5 THEN FP=2*FP
4445 IF N<=10 THEN B$="( Valor Aproximado - Nro.Observaciones <=10 )"
4447 D$="Coeficiente de Correlacion de Spearman = 0"
4450 RETURN
4455 '
4460 ' EST429 - Determinacion de Rangos de un vector de valores
4465 '
4470 FOR I=1 TO N : VX(I+N)=0 : NEXT I
4475 FOR I=1 TO N
4480 IF VX(I+N)>0 THEN 4540
4485 SM=0 : EQ=0
4490 X=VX(I)
4495 FOR J=1 TO N
4500 IF VX(J)<X THEN SM=SM+1
4505 IF VX(J)=X THEN EQ=EQ+1 : VX(J+N)=-1
4510 NEXT J
4515 IF EQ<=1 THEN VX(I+N)=SM+1 : GOTO 4540
4520 P=SM+(EQ+1)*.5
4525 FOR J=1 TO N
4530 IF VX(J+N)=-1 THEN VX(J+N)=P
15 - 398
4535 NEXT J
4540 NEXT I
4545 RETURN
4550 '
4700 ' EST43 - Tamano de Muestras
4705 ' --------------------------
4710 WHILE KW=0
4715 TSP$="Tamano de Muestra"
4720 GOSUB 555
4723 PRINT "ESTIMACION DE"
4725 TF$(1)="Valor Esperado de una Variable"
4730 TF$(2)="Fraccion respecto al Total"
4735 KL=2 : GOSUB 980
4740 IF ISP=0 THEN RETURN
4745 PRINT : INPUT " Nivel de Significacion Alfa en % (5) = ",A$
4750 IF LEN(A$)=0 THEN AL=.05 ELSE AL=VAL(A$)/100
4760 IF AL<=0 OR AL>=1 THEN KE=5 : B$=">0 y <100" : GOSUB 900 : GOTO
4745
4765 PRINT : INPUT " Tamano de la Poblacion (Infinita) = ",A$
4770 IF LEN(A$)=0 THEN XNP=1E+10 ELSE XNP=VAL(A$)
4775 IF XNP<=0 THEN KE=5 : B$=">0" : GOSUB 900 : GOTO 4765
4780 IF ISP=1 THEN C$="Desvio Estandar" : D$="Valor Esperado"
4783 IF ISP=2 THEN C$="Fraccion" : D$=C$
4785 PRINT : PRINT TAB(4);C$; : INPUT " = ",A$
4790 IF LEN(A$)=0 THEN RETURN
4795 XK=VAL(A$)
4800 IF XK<=0 THEN KE=5 : B$=">0" : GOSUB 900: GOTO 4785
4802 IF ISP=2 AND XK>=1 THEN KE=5 : B$="<1" : GOSUB 900: GOTO 4785
4935 PRINT : PRINT " Tolerancia Admisible en +- sobre ";D$;
4937 INPUT " (A Calcular) = ",A$
4940 KT=0 : IF LEN(A$)=0 THEN KT=1 : GOTO 4960
4945 TOL=VAL(A$)
4950 IF TOL<=0 THEN KE=5 : B$=">0" : GOSUB 900 : GOTO 4935
4955 GOTO 4977
4960 PRINT : INPUT " Tamano de Muestra = ",A$
4965 IF LEN(A$)=0 THEN RETURN
4970 XNM=VAL(A$)
4975 IF XNM<=0 OR XNM>=XNP THEN KE=5 : B$=">0 y <"+STR$(XNP) :
GOSUB 900 : GOTO 4960
4977 TF=8
4978 P(1)=250 : IF KT=1 THEN P(1)=XNM-1
4980 FPX=1-AL/2 : GOSUB 7710
4985 WHILE ISP=1
4987 IF KT=0 THEN XX=(X*XK/TOL)^2 : XNM=INT(XX/(1+XX/XNP)+.5)
4990 IF KT=1 THEN TOL=X*XK*SQR((1-XNM/XNP)/XNM)
5005 ISP=0
5010 WEND
5015 WHILE ISP=2
5017 PQ=XK*(1-XK)
5020 IF KT=0 THEN XX=(X/TOL)^2*PQ : XNM=INT(XX/(1+(XX-1)/XNP)+.5)
5025 IF KT=1 THEN TOL=100*X*SQR((XNM-XNP)*PQ/((XNP-1)*XNM))
5035 ISP=0
5040 WEND
5050 KS=1
5055 WHILE KS=1
5060 GOSUB 555
5061 PRINT#3,"CALCULO TAMANO MUESTRA PARA ESTIMAR ";D$ : PRINT#3,
5062 PRINT#3," Nivel de Significacion Alfa";TAB(43);" = ";100*AL;" %"
5063 A$=STR$(XNP) : IF XNP>=1E+10 THEN A$="Infinita"
5064 PRINT#3," Tamano de la Poblacion";TAB(43);" = ";A$
5066 PRINT#3," ";C$;TAB(43);" = ";XK : PRINT#3,
5068 PRINT#3," Tolerancia Admisible sobre ";D$;TAB(43);" = ";FNR(TOL,NDE+1)
5070 PRINT#3," Tamano de Muestra";TAB(43);" = ";XNM
5080 GOSUB 650
5083 WEND
5095 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
15 - 399
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 '
5727 '
5730 ' EST213 - Ordenamiento de un vector de valores
5735 ' ---------------------------------------------
5740 LOG2=INT(LOG(N)*(1!/.69314728#)+.00001)
5745 MM=N
5750 FOR NN=1 TO LOG2
5755 MM=INT(MM/2)
5760 K=N-MM
5765 FOR JJ=1 TO K
5770 I=JJ
5775 L=I+MM
5780 IF VX(L)>=VX(I) THEN 5805
5785 X=VX(I) : VX(I)=VX(L) : VX(L)=X
5790 X=VY(I) : VY(I)=VY(L) : VY(L)=X
5795 I=I-MM
5800 IF I>=1 THEN 5775
5805 NEXT JJ
5810 NEXT NN
5815 RETURN
5820 '
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
15 - 400
5995 RETURN
6000 '
6140 ' EST222 - Clasificacion
6145 ' ----------------------
6150 IF NVI=1 THEN NVC(2)=0 : IJ(2)=0
6155 FOR M=0 TO NVC(1)+1
6160 FOR N=0 TO NVC(2)+1
6165 TI(M,N)=0
6170 IF KA>0 THEN TJ(M,N)=0 : TK(M,N)=0
6175 NEXT N,M
6180 NXX=0
6185 FOR I=1 TO NF
6190 IF A(I,0)=1 THEN 6300
6195 ND=1 : IF JF>0 THEN ND=A(I,JF)
6200 IF ND=XVF THEN 6300
6205 KE=0
6210 FOR K=1 TO NVI
6215 XP(K)=A(I,JX(K))
6220 IF XP(K)=XVF THEN KE=1 : K=NV
6225 NEXT K
6230 IF KE=1 THEN 6300
6235 FOR K=1 TO NVI
6240 IJ(K)=NVC(K)
6245 FOR M=1 TO NVC(K)
6250 IF XP(K)<VC(M,K) THEN IJ(K)=M-1 : MX(K)=0 : M=NVC(K)
6255 IF XP(K)=VC(M,K) THEN IJ(K)=M : M=NVC(K)
6260 NEXT M
6265 NEXT K
6270 IF KA=1 THEN X=A(I,JE) : IF X=XVF THEN 6300
6275 TI(IJ(1),IJ(2))=TI(IJ(1),IJ(2))+ND
6280 IF KA=0 THEN 6295
6285 TJ(IJ(1),IJ(2))=TJ(IJ(1),IJ(2))+ND*X
6290 TK(IJ(1),IJ(2))=TK(IJ(1),IJ(2))+ND*X*X
6295 NXX=NXX+ND
6300 NEXT I
6305 MA=NVC(1)+1 : NA=NVC(2)+1
6310 FOR M=0 TO NVC(1)
6315 FOR N=0 TO NVC(2)
6320 TI(M,NA)=TI(M,NA)+TI(M,N)
6325 TI(MA,N)=TI(MA,N)+TI(M,N)
6330 TI(MA,NA)=TI(MA,NA)+TI(M,N)
6335 NEXT N,M
6340 RETURN
6345 '
7250 ' EST30 - Seleccion de Distribucion
7255 ' ---------------------------------
7260 TG$(1)=">0": TG$(2)="Entero": TG$(3)="<1": TG$(4)=">Par1": TG$(5)=">-1 <1"
7270 TF$(1)="Uniforme (a,b)" : NP(1)=2 : VX(1)=0 :VY(1)=4
7275 TF$(2)="Normal (Mu,Sig)" : NP(2)=2 : VX(2)=0 : VY(2)=1
7280 TF$(3)="Exponencial (Mu)" : NP(3)=1 : VX(3)=1
7285 TF$(4)="Gamma (Alfa,Beta)" : NP(4)=2 : VX(4)=1 : VY(4)=1
7290 TF$(5)="Beta (Alfa,Beta)" : NP(5)=2 : VX(5)=1 : VY(5)=1
7295 TF$(6)="Lognormal (Mu',Sig')" : NP(6)=2 : VX(6)=1 : VY(6)=1
7300 TF$(7)="Chi^2 (k)" : NP(7)=1 : VX(7)=12
7305 TF$(8)="t (k)" : NP(8)=1 : VX(8)=12
7310 TF$(9)="F (k1,k2)" : NP(9)=2 : VX(9)=12 : VY(9)=12
7315 TF$(10)="Normal Autocorrelac.(Mu,Sig,Ro)"
: NP(10)=3 : VX(10)=0 : VY(10)=1
7320 TF$(11)="Normal Bidimens.(Mu1,Sig1,Mu2,Sig2,Ro)"
: NP(11)=5 : VX(11)=0 : VY(11)=1
7325 TF$(12)="Uniforme Discr.(a,b)" : NP(12)=2 : VX(12)=2 : VY(12)=24
7330 TF$(13)="Binomial (n,p)" : NP(13)=2 : VX(13)=12 : VY(13)=13
7335 TF$(14)="Binomial Negat.(r,p)" : NP(14)=2 : VX(14)=12 : VY(14)=13
7340 TF$(15)="Poisson (Mu)" : NP(15)=1 : VX(15)=1
7345 PRINT : PRINT "DISTRIBUCIONES CONTINUAS" : PRINT
7350 FOR K=1 TO 6
7355 PRINT TAB(3);K;"- ";TF$(K);
7360 IF K<6 THEN PRINT TAB(33);K+6;" - ";TF$(K+6) ELSE PRINT
7365 NEXT K
7370 PRINT : PRINT "DISTRIBUCIONES DISCRETAS" : PRINT
7375 FOR K=12 TO 13
15 - 401
7380 PRINT TAB(3);K;"- ";TF$(K);
7385 PRINT TAB(33);K+2;" - ";TF$(K+2) ELSE PRINT
7390 NEXT K
7395 PRINT : PRINT "Distribucion Elegida";
7397 IF TF>0 THEN PRINT " (";TF;")";
7398 INPUT " = ",A$
7399 IF LEN(A$)=0 AND TF=0 THEN RETURN
7400 IF LEN(A$)>0 THEN TF=INT(VAL(A$))
7410 IF TF<1 OR TF>15 THEN PRINT CHR$(7) : GOTO 7395
7415 TFX$=TF$(TF)
7420 KNV=1 : IF TF=11 THEN KNV=2
7425 KDI=0 : IF TF>11 THEN KDI=1
7430 KP=NP(TF) : TP(1)=VX(TF) : TP(2)=VY(TF)
7435 IF TF=10 THEN TP(3)=13 : FOR I=1 TO 20 : VY(I)=0 : NEXT I
7440 IF TF=11 THEN TP(3)=0 : TP(4)=1 : TP(5)=15
7445 '
7450 GOSUB 555
7455 PRINT "Distribucion = ";TF$(TF)
7460 FOR K=1 TO KP
7465 PRINT : PRINT " Parametro";K;
7470 IF TP(K)=0 THEN PRINT : GOTO 7515
7475 PRINT " (";
7480 A$=STR$(TP(K)) : N=LEN(A$)
7485 FOR M=1 TO N
7490 KM=VAL(MID$(A$,M,1))
7495 IF KM=0 THEN 7505
7500 PRINT " ";TG$(KM);
7505 NEXT M
7510 PRINT " )"
7515 KF(K)=0
7520 B$=STR$(FNR(P(K),NDF)) : IF IKP=2 THEN B$="A Estimar"
7525 PRINT " Valor (";B$;")";TAB(25); : INPUT " = ",A$
7530 IF LEN(A$)=0 AND IKP=2 THEN KF(K)=1 : GOTO 7610
7535 IF LEN(A$)=0 AND IKP<>2 THEN X=P(K)
7540 IF LEN(A$)>0 THEN X=VAL(A$)
7545 IF TP(K)=0 THEN 7605
7550 A$=STR$(TP(K))
7555 N=LEN(A$) : KE=0
7560 FOR M=1 TO N
7565 KM=VAL(MID$(A$,M,1))
7570 IF KM=1 AND X<=0 THEN KE=1
7575 IF KM=2 AND X<>INT(X) THEN KE=1
7580 IF KM=3 AND X>=1 THEN KE=1
7585 IF KM=4 AND X<=P(1) THEN KE=1
7590 IF KM=5 AND (X<=-1 OR X>=1) THEN KE=1
7595 NEXT M
7600 IF KE=1 THEN KE=5 : B$=TG$(KM) : GOSUB 900 : GOTO 7520
7605 P(K)=X
7610 NEXT K
7705 '
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
15 - 402
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
7925 '
8060 ' EST300 - Llamada a Rutinas Distribuciones
8064 '
8068 ON TF GOSUB 8080,8140,8220,8280,8464,8636,8704,8800,8932,9068,9152,
9252,9360,9568,9680
8072 RETURN
8076 '
8080 ' EST301 - Dist.Uniforme Continua
8084 '
8088 A=P(1) : B=P(2)
8096 XMU=(A+B)/2 : SIG=(B-A)/3.464102
8100 IF X<A THEN FD=0 : FP=0
8104 IF X>=A AND X<=B THEN FD=1/(B-A) : FP=(X-A)/(B-A)
8108 IF X>B THEN FD=0 : FP=1
8112 RETURN
8136 '
8140 ' EST302 - Dist.Normal
8144 '
8148 XMU=P(1) : SIG=P(2)
8156 U=(X-XMU)/SIG
8160 MXA=0 : IF U<0 THEN U=-U : MXA=1
8164 FD=.39894228#*EXP(-U*U/2)
8168 C=1/(1+.2316419*U)
8172 FP=FD*C*(.3193815+C*(-.3565638+C*(1.781478+C*(-1.821256+1.330274*C))))
8176 IF MXA=0 THEN FP=1-FP
8180 IF FP>1 THEN FP=1
8184 IF FP<0 THEN FP=0
8188 FD=FD/SIG
8192 RETURN
8216 '
8220 ' EST303 - Dist.Exponencial
8224 '
8228 XMU=P(1)
8236 SIG=XMU
8240 IF X<0 THEN FD=0 : FP=0 : RETURN
8244 FD=EXP(-X/XMU)/XMU
8248 FP=1-EXP(-X/XMU)
8252 RETURN
8276 '
8280 ' EST304 - Dist.Gamma
8284 '
8288 AL=P(1) : BE=P(2)
8296 XMU=AL*BE : SIG=SQR(AL)*BE
8297 IF X=0 AND AL<1 THEN FD=1E+10 : FP=0 : RETURN
8298 IF X=0 AND AL=1 THEN FD=.5 : FP=0 : RETURN
8300 IF X<=0 THEN FD=0 : FP=0 : RETURN
8304 XGA=X : X=X/BE
8308 XN=AL-1 : GOSUB 9860
8312 FD=EXP((AL-1)*LOG(X)-X-FA)/BE
8316 CA=AL : SUM=1/AL : CB=SUM
8320 FOR N=1 TO 100
8324 CA=CA+1 : CB=CB*X/CA : SUM=SUM+CB
8328 IF ABS(CB)<ABS(SUM)*.0001 THEN N=100
8332 NEXT N
8336 FP=SUM*EXP(-X+AL*LOG(X)-FA)
8340 X=XGA
8344 RETURN
8460 '
8464 ' EST305 - Dist.Beta
8468 '
15 - 403
8472 AL=P(1) : BE=P(2)
8480 XMU=AL/(AL+BE) : SIG=SQR(AL*BE/((AL+BE)^2*(AL+BE+1)))
8484 IF X<0 THEN FD=0 : FP=0 : RETURN
8488 IF X>1 THEN FD=0 : FP=1 : RETURN
8492 XN=(AL-1) : GOSUB 9868 : CA=FA
8496 XN=(BE-1) : GOSUB 9868 : CB=FA
8500 XN=(AL+BE-1) : GOSUB 9868
8504 BT=EXP(CA+CB-FA)
8508 FD=X^(AL-1)*(1-X)^(BE-1)/BT
8512 KA=0
8516 IF X>=(AL+1)/(AL+BE+2) THEN KA=1 : XX=X : X=1-X : Y=BE : BE=AL : AL=Y
8520 CA=1 : CB=1 : CC=1
8524 CD=1-(AL+BE)*X/(AL+1)
8528 FOR L=1 TO 100
8530 LL=2*L
8532 CE=L*(BE-L)*X/((AL-1+LL)*(AL+LL))
8536 CF=CC+CE*CA : CG=CD+CE*CB
8540 CE=-(AL+L)*(AL+BE+L)*X/((AL+LL)*(AL+1+LL))
8544 CH=CF+CE*CC : CI=CG+CE*CD
8548 CA=CF/CI : CB=CG/CI
8552 CJ=CC : CC=CH/CI : CD=1
8556 IF ABS(CC-CJ)<.0001*ABS(CC) THEN L=100
8560 NEXT L
8564 FP=FD*X*(1-X)*CC/AL
8568 IF KA=1 THEN FP=1-FP : X=XX
8572 IF FP<0 THEN FP=0
8576 IF FP>1 THEN FP=1
8580 RETURN
8632 '
8636 ' EST306 - Dist.Log-normal
8640 '
8648 XMUX=EXP(P(1)+P(2)^2/2)
8652 SIGX=XMUX*SQR(EXP(P(2)^2)-1)
8656 IF X<=0 THEN FD=0 : FP=0 : XMU=XMUX : SIG=SIGX : RETURN
8660 XLN=X : X=LOG(X) : GOSUB 8140
8664 X=XLN : FD=FD/X
8668 XMU=XMUX : SIG=SIGX
8672 RETURN
8700 '
8704 ' EST307 - Dist.Chi^2
8708 '
8712 K=P(1)
8720 XMU=K : SIG=SQR(2*K)
8724 IF X=0 AND K=1 THEN FD=1E+10 : FP=0 : RETURN
8728 IF X=0 AND K=2 THEN FD=.5 : FP=0 : RETURN
8732 IF X<=0 THEN FD=0 : FP=0 : RETURN
8740 P(1)=K/2 : P(2)=2
8744 GOSUB 8280
8748 P(1)=K
8752 XN=(K/2-1) : GOSUB 9860
8756 FD=EXP((K/2-1)*LOG(X)-X/2-.3465735*K-FA)
8760 XMU=K : SIG=SQR(2*K)
8764 RETURN
8796 '
8800 ' EST308 - Distribucion t
8804 K=P(1)
8812 WHILE K>0 AND K<250
8816 XN=(K-1)/2 : GOSUB 9860 : FD=FA
8820 XN=(K-2)/2 : GOSUB 9860 : FD=FD-FA
8824 FDZ=EXP(FD-.5*LOG(3.14159265#*K)-.5*(K+1)*LOG(1+X*X/K))
8832 XTE=X : X=K/(K+X*X)
8836 P(1)=K/2 : P(2)=.5
8840 GOSUB 8464
8842 FP=FP/2
8844 IF XTE>0 THEN FP=1-FP
8856 X=XTE : P(1)=K : P(2)=0
8860 FD=FDZ : K=0
8864 WEND
8868 WHILE K>=250
8872 P(1)=0 : P(2)=1 : GOSUB 8140
8876 P(1)=K : K=0
15 - 404
8880 WEND
8884 K=P(1) : XMU=0
8888 SIG=0 : IF K>2 THEN SIG=SQR(K/(K-2))
8892 RETURN
8928 '
8932 ' EST309 - Dist. F
8936 '
8940 KM=P(1) : KN=P(2)
8948 XMUX=0 : SIGX=0
8952 IF KN>2 THEN XMUX=KN/(KN-2)
8956 IF KN>4 THEN SIGX=KN*SQR(2*(KM+KN-2)/(KM*(KN-2)^2*(KN-4)))
8960 IF X<=0 THEN FD=0 : FP=0 : XMU=XMUX : SIG=SIGX : RETURN
8964 XN=(KM+KN-2)/2 : GOSUB 9860 : FDZ=FA
8968 XN=(KM-2)/2 : GOSUB 9860 : FDZ=FDZ-FA
8972 XN=(KN-2)/2 : GOSUB 9860 : FDZ=FDZ-FA
8976 FDZ=FDZ+(KM/2)*LOG(KM/KN)+.5*(KM-2)*LOG(X)-.5*(KM+KN)*LOG(1+KM*X/KN)
8980 FDZ=EXP(FDZ)
8984 XFE=X : X=KN/(KN+KM*X)
8988 P(1)=KN/2 : P(2)=KM/2
8992 GOSUB 8464
8994 FP=1-FP
8996 X=XFE : P(1)=KM : P(2)=KN
9000 FD=FDZ : XMU=XMUX : SIG=SIGX
9004 RETURN
9064 '
9252 ' EST312 - Dist.Uniforme Discreta
9256 '
9260 A=P(1) : B=P(2)
9268 XMU=(A+B)/2 : SIG=SQR((B-A)*(B-A+2)/12)
9272 XX=INT(X)
9276 IF XX<A THEN FD=0 : FP=0
9280 IF XX>=A AND XX<=B THEN FD=1/(B-A+1) : FP=(XX-A+1)/(B-A+1)
9284 IF XX>B THEN FD=0 : FP=1
9288 IF X-XX>0 THEN FD=0
9292 RETURN
9356 '
9360 ' EST313 - Dist.Binomial
9364 '
9368 N=P(1) : PR=P(2)
9376 XMU=N*PR : SIG=SQR(N*PR*(1-PR))
9384 IF X<0 THEN FD=0 : FP=0 : RETURN
9388 IF X>N THEN FD=0 : FP=1 : RETURN
9392 XX=INT(X) : MK=0
9396 IF (PR<=.5 AND XMU>5) OR (PR>.5 AND N*(1-PR)>5) OR N>30 OR X>30 THEN MK=1
9400 WHILE MK=0
9404 XN=N : GOSUB 9860 : CA=FA
9408 FP=0 : CB=1
9412 FOR IX=0 TO XX
9416 IF IX>0 THEN CB=CB*IX
9418 XN=N-IX : GOSUB 9860
9420 FD=CA-LOG(CB)-FA+IX*LOG(PR)+(N-IX)*LOG(1-PR)
9422 FD=EXP(FD)
9424 FP=FP+FD
9428 NEXT IX
9432 IF X-XX>0 THEN FD=0
9436 RETURN
9440 WEND
9444 WHILE MK=1
9448 P(1)=XMU : P(2)=SIG : XA=X : X=XX-.5
9452 GOSUB 8140
9456 XB=FP : X=XX+.5
9460 GOSUB 8140
9464 FD=FP-XB
9468 IF X>XX THEN FD=0
9472 XMU=P(1) : SIG=P(2) : X=XA : P(1)=N : P(2)=PR
9476 RETURN
9480 WEND
9564 '
9568 ' EST314 - Dist.Binomial negativa
9572 '
9576 R=P(1) : PR=P(2)
15 - 405
9584 XMU=R*(1-PR)/PR
9588 SIG=SQR(R*(1-PR))/PR
9592 IF X<0 THEN FD=0 : FP=0 : RETURN
9596 XX=INT(X)
9600 FP=0 : CA=1
9604 FOR IX=0 TO XX
9608 IF IX>0 THEN CA=CA*(IX+R-1)/IX
9612 FD=CA*PR^R*(1-PR)^IX
9616 FP=FP+FD
9620 NEXT IX
9624 IF X-XX>0 THEN FD=0
9628 RETURN
9676 '
9680 ' EST315 - Dist.Poisson
9684 '
9688 XMU=P(1)
9696 '
9700 SIG=SQR(XMU)
9704 IF X<0 THEN FD=0 : FP=0 : RETURN
9708 XX=INT(X)
9712 MK=0 : IF XMU>10 OR X>30 THEN MK=1
9716 WHILE MK=0
9720 CA=EXP(-XMU) : FP=0 : CB=1
9724 FOR IX=0 TO XX
9728 IF IX>0 THEN CB=CB*IX
9732 FD=CA*P(1)^IX/CB : FP=FP+FD
9736 NEXT IX
9740 IF X-XX>0 THEN FD=0
9744 RETURN
9748 WEND
9752 WHILE MK=1
9756 P(2)=SIG : XA=X : X=XX-.5
9760 GOSUB 8140
9764 XB=FP : X=XX+.5
9768 GOSUB 8140
9772 FD=FP-XB : X=XA
9776 IF X>XX THEN FD=0
9780 RETURN
9784 WEND
9856 '
9860 ' EST320 - Calculo de Log(Factorial)
9864 '
9868 WHILE XN>=-.5 AND XN<=4 AND INT(2*XN)=2*XN
9872 IF XN=-.5 THEN FA=.57236494#
9876 IF XN=0 THEN FA=0
9880 IF XN=.5 THEN FA=-.12078224#
9884 IF XN=1 THEN FA=0
9888 IF XN=1.5 THEN FA=.28468287#
9892 IF XN=2 THEN FA=.693147181#
9896 IF XN=2.5 THEN FA=1.2009736#
9900 IF XN=3 THEN FA=1.79175947#
9904 IF XN=3.5 THEN FA=2.45373657#
9908 IF XN=4 THEN FA=3.17805383#
9912 RETURN
9916 WEND
9920 Y=1/(XN*XN)
9922 YY=1/360-Y*(1/1260-Y/1680)
9924 Y=(XN+.5)*LOG(XN)-XN*(1-Y*(1/12-Y*YY))
9928 FA=Y+.91893853#
9932 RETURN
10 ' ESTAD5 - Revision 23/11/88
15 ' -------------------------
20 GOSUB 1000
25 CHAIN "ESTAD"
200 ' EST91 Definicion de Variables
205 ' ---------------------------
210 GOSUB 500
215 IF NV=0 THEN 265
220 PRINT
225 GOSUB 730
15 - 406
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
410 IF NC>0 AND KVA=0 THEN GOSUB 500
411 KVA=0
415 PRINT : 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
452 IF KBM=1 THEN FOR I=1 TO NFM : A(I,X)=XVF : NEXT I : KBM=0
455 PRINT : PRINT " Nombre de la Variable";X;" (";TC$(X);")";
457 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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
545 PRINT
550 RETURN
555 ' EST94 Encabezamiento Pantallas y Resultados
560 ' -------------------------------------------
15 - 407
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
NEXT
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
15 - 408
944 IF ERR=64 OR ERR=75 OR ERR=76 THEN INPUT "** NOMBRE INCORRECTO ARCHIVO",A$ : RESUME
NEXT
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 ' ESTAD5 - Analisis de Variancia
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 TF$(5),NVC(2),VC(PAR1,2),TI(PAR1+1,PAR2+2),TJ(PAR1+1,PAR2+2)
1027 DIM TK(PAR1+1,PAR2+1),MX(2),SD(4),GL(4),DM(4),XNS(4),VX(NFM),VY(NFM),VZ(31)
1030 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
1035 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1040 WHILE KW=0
1045 TP$="ANALISIS DE VARIANCIA" : TSP$=""
1050 NXX=0
1055 GOSUB 555
1060 PRINT TAB(70);FRE(0)
1065 PRINT "PROCESOS"
1070 TF$(1)="Analisis de Variancia"
1075 TF$(2)="Manejo de Datos"
1080 KL=2 : GOSUB 980
1085 IF ISP=0 THEN RETURN
1090 IF ISP=2 THEN CHAIN "ESTAD1"
1095 IF NF=0 THEN KE=1 : GOSUB 900 : GOTO 1150
1100 PRINT : PRINT : PRINT "MODELOS"
1105 TF$(1)="Y=Mu + Alfa(X1)"
1110 TF$(2)="Y=Mu + Alfa(X1) + Beta(X2)"
1115 TF$(3)="Y=Mu + Alfa(X1) + Beta(X2) + Gama(X1,X2)"
1120 KL=3 : GOSUB 980
1125 IF ISP=0 THEN 1150
1130 IF ISP=1 THEN NVI=1
1135 IF ISP=2 THEN NVI=2 : MP=0
1140 IF ISP=3 THEN NVI=2 : MP=1
1145 GOSUB 1155
1150 WEND
1155 ' EST51 - Proceso de Analisis de Variancia
1160 ' ----------------------------------------
1165 GOSUB 555
1170 PRINT "MODELO: ";TF$(ISP) : PRINT
1175 PRINT : PRINT "DEFINICION DE VARIABLES (";NVI+1;")"
15 - 409
1180 PRINT " Las Primeras son los Factores X1,X2"
1185 PRINT " la Ultima es la Variable Respuesta Y" : PRINT
1190 KNV=NVI+1 : GOSUB 200
1195 IF NV=0 THEN RETURN
1200 IF NV<>KNV THEN KE=2 : GOSUB 900 : GOTO 1165
1205 JE=JX(NV)
1210 PRINT : PRINT "INGRESO VALORES DE CLASIFICACION"
1215 FOR K=1 TO NVI
1220 J=JX(K)
1225 PRINT : PRINT " VARIABLE =";J;" - ";TC$(J)
1230 KX=0 : GOSUB 6010
1235 IF NVC(K)=0 THEN RETURN
1240 MX(K)=1
1245 NEXT K
1250 PRINT : PRINT TAB(25);"EN PROCESO"
1260 KA=1 : GOSUB 6140
1265 IF NXX<3 THEN KE=3 : GOSUB 900 : RETURN
1270 XX=NVI
1275 WHILE NVI=1
1280 GA=0 : PY=0
1285 FOR M=0 TO NVC(1)
1287 NXC=TI(M,0)
1290 CA=0 : IF NXC>0 THEN GA=GA+1 : PY=PY+TJ(M,0) : CA=TJ(M,0)/NXC
1291 TJ(M,0)=CA
1293 CA=0 : IF NXC>1 THEN CA=SQR((TK(M,0)-NXC*TJ(M,0)^2)/(NXC-1))
1294 TK(M,0)=CA
1295 TJ(M,1)=TJ(M,0)
1300 NEXT M
1305 PY=PY/TI(MA,0)
1310 NVI=0
1315 WEND
1320 WHILE NVI=2
1325 GA=0 : GB=0 : PY=0
1330 FOR M=0 TO NVC(1)
1335 IF TI(M,NA)>0 THEN GA=GA+1
1340 FOR N=0 TO NVC(2)
1342 NXC=TI(M,N)
1345 IF M=0 AND TI(MA,N)>0 THEN GB=GB+1
1350 CA=0 : IF NXC>0 THEN CA=TJ(M,N)/NXC
1351 TJ(M,N)=CA
1352 CA=0 : IF NXC>1 THEN CA=SQR((TK(M,N)-NXC*TJ(M,N)^2)/(NXC-1))
1353 TK(M,N)=CA
1355 NEXT N,M
1357 IF GA<2 OR GB<2 THEN KE=3 : GOSUB 900 : RETURN
1358 FOR N=0 TO NA : TJ(MA,N)=0 : NEXT N
1360 FOR M=0 TO NVC(1)
1365 IF TI(M,NA)=0 THEN 1400
1370 TJ(M,NA)=0
1375 FOR N=0 TO NVC(2)
1380 TJ(M,NA)=TJ(M,NA)+TJ(M,N)
1385 TJ(MA,N)=TJ(MA,N)+TJ(M,N)
1390 NEXT N
1395 TJ(M,NA)=TJ(M,NA)/GB
1400 NEXT M
1405 FOR N=0 TO NVC(2)
1410 TJ(MA,N)=TJ(MA,N)/GA
1415 PY=PY+TJ(MA,N)
1420 NEXT N
1425 PY=PY/GB
1430 XNP=0
1435 KZZ=0
1440 NPQ=NX/(GA*GB)
1445 FOR M=0 TO MA-1
1450 IF TI(M,NA)=0 THEN 1485
1455 FOR N=0 TO NA-1
1460 IF TI(MA,N)=0 THEN 1480
1465 IF TI(M,N)<.9*NPQ OR TI(M,N)>1.1*NPQ THEN KZZ=1
1470 IF TI(M,N)=0 THEN KZZ=2
1475 IF KZZ<2 THEN XNP=XNP+1/TI(M,N)
1480 NEXT N
1485 NEXT M
15 - 410
1490 IF KZZ=2 THEN KE=3 : GOSUB 900 : RETURN
1495 XNP=GA*GB/XNP
1500 NVI=0
1505 WEND
1510 NVI=XX
1515 FOR K=1 TO 4 : SD(K)=0 : GL(K)=0 : DM(K)=0 : NEXT K
1520 FOR M=0 TO NVC(1)
1525 IF TI(M,NA)=0 THEN 1540
1530 IF NVI=1 THEN SD(1)=SD(1)+TI(M,NA)*(TJ(M,NA)-PY)^2
1535 IF NVI=2 THEN SD(1)=SD(1)+(TJ(M,NA)-PY)^2
1540 NEXT M
1545 IF NVI=2 THEN SD(1)=SD(1)*XNP*GB
1550 GL(1)=GA-1
1555 IF NVI=1 THEN 1635
1560 FOR N=0 TO NVC(2)
1565 IF TI(MA,N)=0 THEN 1575
1570 SD(2)=SD(2)+(TJ(MA,N)-PY)^2
1575 NEXT N
1580 SD(2)=SD(2)*XNP*GA
1585 GL(2)=GB-1
1590 IF MP=0 THEN 1635
1595 FOR M=0 TO NVC(1)
1600 FOR N=0 TO NVC(2)
1605 IF TI(M,NA)=0 OR TI(MA,N)=0 THEN 1615
1610 SD(3)=SD(3)+(TJ(M,N)-TJ(M,NA)-TJ(MA,N)+PY)^2
1615 NEXT N,M
1620 SD(3)=SD(3)*XNP
1625 GL(3)=GL(1)*GL(2)
1630 SDT=0
1635 FOR I=1 TO NF
1640 IF A(I,0)=1 THEN 1690
1645 ND=1 : IF JF>0 THEN ND=A(I,JF)
1650 IF ND=XVF THEN 1690
1655 KE=0
1660 FOR K=1 TO NV
1665 X=A(I,JX(K))
1670 IF X=XVF THEN KE=1 : K=NV
1675 NEXT K
1680 IF KE=1 THEN 1690
1685 SDT=SDT+ND*(A(I,JE)-PY)^2
1690 NEXT I
1695 GLT=NX-1
1700 SD(4)=SDT-SD(1)-SD(2)-SD(3)
1705 GL(4)=GLT-GL(1)-GL(2)-GL(3)
1710 FOR K=1 TO 4
1715 IF GL(K)>0 THEN DM(K)=SD(K)/GL(K)
1720 NEXT K
1725 SER=DM(4)
1727 DEY=SQR(SDT/(NXX-1))
1730 IP=1
1735 FOR K=1 TO 3
1740 IF DM(K)=0 THEN 1765
1745 X=DM(K)/DM(4)
1750 XF(K)=X
1755 P(1)=GL(K) : P(2)=GL(4)
1760 GOSUB 9325 : XNS(K)=100*(1-FP)
1765 NEXT K
1770 KS=1
1775 WHILE KS=1
1780 GOSUB 555
1785 PRINT#3,"MODELO: ";TF$(ISP) : PRINT#3,
1790 XA=12*NVI+12*MP
1795 PRINT#3, : PRINT#3,"Variable Respuesta Y = ";JE;" - ";TC$(JE)
1800 PRINT#3, : PRINT#3," Valor Medio = ";FNR(PY,NDE)
1803 PRINT#3," Desvio Estandar = ";FNR(DEY,NDE) : PRINT#3,
1855 IL=10
1858 FOR N=0 TO NVC(2)
1861 IF N=0 AND TI(MA,N)=0 THEN 1939
1873 IF NVC(2)=0 THEN 1891
1876 B$=">=" : IF N=0 THEN B$="< "
1879 IF MX(2)=1 THEN B$=" ="
15 - 411
1882 PRINT#3, : PRINT#3,"Factor";JX(2);"- ";TC$(JX(2));B$;VC(N,2) :
PRINT#3,
1891 PRINT#3,TAB(3);"Factor";TAB(13);"NroObs. Valor Medio Desv.Estd";
1894 PRINT#3,TAB(XA/2+25);"Efectos Difer."
1895 PRINT#3,TAB(3);JX(1);"- ";TC$(JX(1));TAB(45);"Factor X1";
1896 IF NVI=2 THEN PRINT#3,TAB(56);"Factor X2";
1897 IF NVI=2 AND MP=1 THEN PRINT#3,TAB(67);"Interr.X1-X2";
1898 PRINT#3,
1899 KA=3 : KB=XA+43 : GOSUB 695
1900 IL=IL+5
1903 FOR M=0 TO NVC(1)
1904 IF M=0 AND TI(M,NA)=0 THEN 1933
1906 NXC=TI(M,N)
1909 B$=">=" : IF M=0 THEN B$="< "
1912 IF MX(1)=1 THEN B$=" "
1915 PRINT#3,TAB(4);B$;VC(M,1);
1917 CA=TJ(M,NA)-PY : CB=TJ(MA,N)-PY
1924 PRINT#3,TAB(17);NXC;TAB(25);FNR(TJ(M,N),NDE);TAB(36);
FNR(TK(M,N),NDE);TAB(47);FNR(CA,NDE);
1925 IF NVI=2 THEN PRINT#3,TAB(58);FNR(CB,NDE);
1926 IF MP=1 THEN PRINT#3,TAB(69);FNR((TJ(M,N)-TJ(M,NA)-
TJ(MA,N)+PY),NDE)
1927 KA=3 : KB=XA+43 : GOSUB 695 :IL=IL+2
1930 IF IL>=20 AND DS$="SCRN:" THEN IL=0 : INPUT "",A$
1933 NEXT M
1936 IF NVC(2)=0 THEN N=1
1939 NEXT N
1960 IF DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$
1965 TF$(1)="Factor X1" : TF$(2)="Factor X2" : TF$(3)="Interr.X1-X2"
1970 TF$(4)="Error"
1975 PRINT#3, : PRINT#3,
1980 PRINT#3,"TABLA DE VERIFICACION" : PRINT#3,
1985 PRINT#3,TAB(3);"Causa de Suma de Grados de Dev.Cuadr."; "
F Niv.Sig"
1990 PRINT#3,TAB(3);"Variacion Desv.Cuad. Libertad"; "
Medios (%)"
1995 KA=2 : KB=75 : GOSUB 695
2000 FOR K=1 TO 4
2005 IF DM(K)=0 THEN 2025
2010 PRINT#3,TAB(3);TF$(K);TAB(16);FNR(SD(K),2);TAB(30);GL(K);
2015 PRINT#3,TAB(41);FNR(DM(K),3);
2020 IF K<4 THEN PRINT#3,TAB(53);FNR(XF(K),2);TAB(64);FNR(XNS(K),2)
2025 NEXT K
2030 PRINT#3,TAB(3);"Total";TAB(16);FNR(SDT,2);TAB(30);GLT
2035 KA=2 : KB=75 : GOSUB 695
2040 PRINT#3, : IF KZZ=1 THEN PRINT#3,"Cantidad desigual de observaciones en los grupos"
2045 GOSUB 650
2050 WEND
2055 KZ=0
2060 WHILE KZ=0
2065 GOSUB 555
2070 PRINT "PROCESOS COMPLEMENTARIOS"
2075 TF$(1)="Calculo de Valores Estimados y Residuos"
2077 TF$(2)="Calculo de Intervalos de Confianza por Grupos"
2080 TF$(3)="Comparacion de Medias por grupos"
2085 KL=3 : GOSUB 980
2090 IF ISP=0 THEN KZ=1 : GOTO 2100
2095 ON ISP GOSUB 2110,2450,2800
2100 WEND
2105 RETURN
2110 ' EST511 - Calculo de Valores Estimados y Residuos
2115 ' ------------------------------------------------
2117 FOR M=1 TO 2
2118 A$="VALORES ESTIMADOS DE Y" : IF M=2 THEN A$="RESIDUOS" : KVA=1
2120 PRINT : PRINT
2125 PRINT "ALMACENAMIENTO DE ";A$;" EN MEMORIA DE TRABAJO"
2140 GOSUB 390 : CY(M)=J
2150 NEXT M
2155 KS=1
2160 WHILE KS=1
2165 KX=0
15 - 412
2170 PRINT#3,
2175 FOR I=1 TO NF
2180 WHILE KX=0
2183 PRINT#3,
2185 PRINT#3,"Nro.Obs. Y Real Y Estimado";
" Residuo";TAB(58);"Residuo Normalizado"
2190 PRINT#3,TAB(52);"-2S 0 2S"
2195 KA=1 : KB=79 : GOSUB 695
2200 IL=4 : KX=1
2205 WEND
2210 IF A(I,0)=1 THEN 2385
2215 ND=1 : IF JF>0 THEN ND=A(I,JF)
2220 IF ND=XVF THEN 2385
2225 KE=0
2230 FOR K=1 TO NVI
2235 IJ(K)=NVC(K)
2237 XP(K)=A(I,JX(K))
2240 IF XP(K)=XVF THEN KE=1 : K=NVI : GOTO 2265
2245 FOR M=1 TO NVC(K)
2250 IF XP(K)<VC(M,K) THEN IJ(K)=M-1 : M=NVC(K)
2255 IF XP(K)=VC(M,K) THEN IJ(K)=M : M=NVC(K)
2260 NEXT M
2265 NEXT K
2270 IF KE=1 THEN 2385
2275 IF NVI=1 THEN YE=TJ(IJ(1),MA)
2280 IF NVI=2 THEN YE=TJ(IJ(1),IJ(2))
2285 Y=A(I,JX(NV))
2290 IF Y=XVF THEN 2385
2295 ER=Y-YE : ERN=ER/SER
2300 IF CY(1)>0 THEN A(I,CY(1))=YE
2305 IF CY(2)>0 THEN A(I,CY(2))=ER
2310 PRINT#3,TAB(3);I;TAB(10);Y;TAB(24);FNR(YE,NDE);TAB(38);
FNR(ER,NDE);TAB(53);
2315 FOR M=1 TO 25 : VY(M)=0 : NEXT M
2320 VY(2)=2 : VY(13)=1 : VY(24)=2
2325 X=INT(11*ERN+.5)
2330 IF X>11 THEN X=12
2335 IF X<-11 THEN X=-11
2340 VY(13+X)=3
2345 FOR M=1 TO 25
2350 A$=" "
2355 IF VY(M)=1 THEN A$="."
2360 IF VY(M)=2 THEN A$="I"
2365 IF VY(M)=3 THEN A$="*"
2370 PRINT#3,A$;
2375 NEXT M : PRINT#3,
2380 IL=IL+1 : IF IL=20 AND DS$="SCRN:" THEN INPUT "Enter",A$ : KX=0
2385 NEXT I
2390 GOSUB 650
2395 WEND
2400 RETURN
2450 ' EST512 - Calculo de Intervalos de Confianza por Grupos
2455 ' ------------------------------------------------------
2460 TF=8 : P(1)=NXX-1 : IP=1 : FPX=.95
2465 GOSUB 7710
2470 T=X
2475 XMI=1E+10 : XMA=-1E+10 : L=0
2480 FOR N=0 TO NVC(2)
2485 IF N=0 AND TI(MA,N)=0 THEN 2540
2490 FOR M=0 TO NVC(1)
2495 IF M=0 AND TI(M,NA)=0 THEN 2535
2500 XK=T*DEY/SQR(NXX)
2505 XX=TJ(M,N)-XK
2510 L=L+1 : VX(L)=XX
2515 IF XX<XMI THEN XMI=XX
2520 XX=TJ(M,N)+XK
2525 VY(L)=XX
2530 IF XX>XMA THEN XMA=XX
2535 NEXT M
2540 NEXT N
2545 KS=1
15 - 413
2550 WHILE KS=1
2555 GOSUB 555
2560 IL=7 : L=0
2565 PRINT#3,"INTERVALO DE CONFIANZA POR GRUPOS (Signif. 5%)" : PRINT#3,
2570 CY=INT((PY-XMI)*30/(XMA-XMI))+48
2575 PRINT#3,TAB(3);"Factor";TAB(13);"Valor Medio";
2580 PRINT#3," Limite Inf. Limite Sup.";TAB(50);"Interv. de Confianza"
2585 PRINT#3,TAB(3);JX(1);"- ";TC$(JX(1));TAB(CY-3);"Prom.Y"
2590 KA=3 : KB=79 : GOSUB 695
2595 PRINT#3,TAB(CY);"."
2600 IL=IL+6
2605 FOR N=0 TO NVC(2)
2610 IF N=0 AND TI(MA,N)=0 THEN 2760
2615 IF NVC(2)=0 THEN 2640
2620 B$=">=" : IF N=0 THEN B$="< "
2625 IF MX(2)=1 THEN B$=" ="
2630 PRINT#3,"Factor";JX(2);"- ";TC$(JX(2));B$;VC(N,2) : PRINT#3,
2635 IL=IL+6 : KX=1
2640 FOR M=0 TO NVC(1)
2645 IF M=0 AND TI(M,NA)=0 THEN 2745
2650 B$=">=" : IF M=0 THEN B$="< "
2655 IF MX(1)=1 THEN B$=" "
2660 PRINT#3,TAB(4);B$;VC(M,1);
2665 L=L+1
2670 PRINT#3,TAB(13);FNR(TJ(M,N),NDE);TAB(26);FNR(VX(L),NDE);TAB(39);
FNR(VY(L),NDE);TAB(48);
2675 FOR S=1 TO 31 : VZ(S)=0 : NEXT S
2680 VZ(1)=1 : VZ(16)=1 : VZ(31)=1
2685 CA=INT((VX(L)-XMI)*30/(XMA-XMI))+1
2690 CB=INT((VY(L)-XMI)*30/(XMA-XMI))+1
2695 FOR S=CA TO CB
2700 VZ(S)=2
2705 NEXT S
2710 FOR S=1 TO 31
2715 A$=" "
2720 IF VZ(S)=1 THEN A$="."
2725 IF VZ(S)=2 THEN A$="-"
2730 PRINT#3,A$;
2735 NEXT S : PRINT#3,
2740 IF IL>=22 AND DS$="SCRN:" THEN IL=0 : INPUT "",A$
2745 NEXT M
2750 IF NVC(2)=0 THEN N=1
2755 PRINT#3,
2760 NEXT N
2765 GOSUB 650
2770 WEND
2775 RETURN
2780 '
2800 ' EST513 - Comparacion de Medias por grupos
2805 ' -----------------------------------------
2810 PRINT
2815 PRINT "DEFINICION DE GRUPOS"
2820 JJ(1,2)=NVC(1)+1 : JJ(2,2)=NVC(2)+1
2825 FOR M=1 TO 2
2830 PRINT : PRINT " Grupo = ";M
2835 FOR K=1 TO NVI
2840 PRINT " Variable ";JX(K);"- ";TC$(JX(K))
2845 INPUT " >= ",A$
2850 IF LEN(A$)=0 THEN RETURN
2855 XMI(M,K)=VAL(A$) : JJ(M,K)=0
2860 INPUT " < ",A$
2865 IF LEN(A$)=0 THEN RETURN
2870 XMA(M,K)=VAL(A$)
2875 FOR P=1 TO NVC(K)
2880 IF XMA(M,K)<VC(P,K) THEN JJ(M,K)=P-1 : P=NVC(K)
2885 IF XMI(M,K)=VC(P,K) THEN JJ(M,K)=P : P=NVC(K)
2890 NEXT P
2895 IF JJ(M,K)=0 THEN PRINT "Valor ingresado no define grupo" : GOTO 2845
2900 NEXT K
2905 NEXT M
15 - 414
2910 X=(TJ(JJ(1,1),JJ(1,2))-TJ(JJ(2,1),JJ(2,2)))/SQR(1/TI(JJ(1,1),JJ(1,2))+
1/TI(JJ(2,1),JJ(2,2)))
2915 X=ABS(X)
2920 IP=1 : P(1)=GL(4) : GOSUB 9125
2925 KS=1
2930 WHILE KS=1
2935 PRINT#3, : PRINT#3, : PRINT#3,"COMPARACION ENTRE GRUPOS" : PRINT#3,
2940 FOR M=1 TO 2
2945 PRINT#3,TAB(3);"Grupo";M
2950 FOR K=1 TO NVI
2955 PRINT#3,TAB(6);"Variable";JX(K);"- ";TC$(JX(K));TAB(30);
" >= ";XMI(M,K)"-";" < ";XMA(M,K)
2960 NEXT K
2965 PRINT #3,
2970 PRINT#3,TAB(6);"Valor Medio Variable";JX(NV);"- ";TC$(JX(NV))
; " = ";TJ(JJ(M,1),JJ(M,2))
2975 PRINT #3,
2980 NEXT M
2985 PRINT#3,
2990 PRINT#3,TAB(3);"Estadistica de Prueba t = ";FNR(X,2)
2995 PRINT#3,TAB(6);"Grados de Libertad = ";GL(4)
3000 PRINT#3,TAB(3);"Nivel de Significacion = ";FNR(2*100*(1-FP),2);" %"
3005 GOSUB 650
3010 WEND
3015 RETURN
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
15 - 415
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 '
6010 ' EST221 - Ingreso de Valores de Clasificacion
6015 ' --------------------------------------------
6017 P(1)=PAR1 : P(2)=PAR2
6020 IF NVC(K)=0 THEN 6050
6025 PRINT : PRINT "Valores Actuales de Clasificacion" : PRINT
6030 FOR M=1 TO NVC(K) : PRINT VC(M,K);" - "; : NEXT M : PRINT
6035 PRINT : INPUT "Ingreso de Nuevos Valores ? (N) = ",A$
6040 IF A$<>"S" AND A$<>"s" THEN VC(0,K)=VC(1,K) : RETURN
6045 NVC(K)=0
6050 GOSUB 5480
6055 PRINT " (Valores Maximo y Minimo de los Datos = ";XMI;"-";XMA;")"
6060 PRINT
6065 PRINT : INPUT " Valor de la Variable = ",A$
6070 IF LEN(A$)=0 THEN VC(0,K)=VC(1,K) : RETURN
6075 XB=VAL(A$)
6080 IF NVC(K)>0 AND XB<=X THEN KE=5 : B$=">="+STR$(X) :
GOSUB 900 : GOTO 6065
6085 IF NVC(K)=0 THEN 6130
6090 INPUT " Incremento para obtener Valores intermedios (No) = ",A$
6093 IF LEN(A$)=0 THEN DI=0 : GOTO 6105
6095 DI=VAL(A$)
6100 IF DI<0 OR DI>XB-X THEN KE=5 : B$=">0 y <="+STR$(XB-X) :
GOSUB 900 : GOTO 6090
6105 PRINT
6110 WHILE DI>0 AND X+DI<XB
6115 X=X+DI
6120 NVC(K)=NVC(K)+1 : IF NVC(K)>P(K)-1 THEN 6133
6122 VC(NVC(K),K)=X
6125 WEND
6130 NVC(K)=NVC(K)+1 : IF NVC(K)>P(K) THEN 6133
6132 VC(NVC(K),K)=XB : X=XB : GOTO 6065
6133 PRINT CHR$(7) : PRINT : PRINT "** NUMERO VALORES CLASIFICACION >"; : PRINT
"PARAM";K; " (";P(K);")"; : INPUT " ";A$ : GOTO 6045
6135 '
6140 ' EST222 - Clasificacion
6145 ' ----------------------
6150 IF NVI=1 THEN NVC(2)=0 : IJ(2)=0
6155 FOR M=0 TO NVC(1)+1
6160 FOR N=0 TO NVC(2)+1
6165 TI(M,N)=0
6170 IF KA>0 THEN TJ(M,N)=0 : TK(M,N)=0
6175 NEXT N,M
6180 NXX=0
6185 FOR I=1 TO NF
6190 IF A(I,0)=1 THEN 6300
6195 ND=1 : IF JF>0 THEN ND=A(I,JF)
6200 IF ND=XVF THEN 6300
6205 KE=0
6210 FOR K=1 TO NVI
6215 XP(K)=A(I,JX(K))
6220 IF XP(K)=XVF THEN KE=1 : K=NV
6225 NEXT K
6230 IF KE=1 THEN 6300
6235 FOR K=1 TO NVI
6240 IJ(K)=NVC(K)
6245 FOR M=1 TO NVC(K)
6250 IF XP(K)<VC(M,K) THEN IJ(K)=M-1 : MX(K)=0 : M=NVC(K)
6255 IF XP(K)=VC(M,K) THEN IJ(K)=M : M=NVC(K)
6260 NEXT M
15 - 416
6265 NEXT K
6270 IF KA=1 THEN X=A(I,JE) : IF X=XVF THEN 6300
6275 TI(IJ(1),IJ(2))=TI(IJ(1),IJ(2))+ND
6280 IF KA=0 THEN 6295
6285 TJ(IJ(1),IJ(2))=TJ(IJ(1),IJ(2))+ND*X
6290 TK(IJ(1),IJ(2))=TK(IJ(1),IJ(2))+ND*X*X
6295 NXX=NXX+ND
6300 NEXT I
6305 MA=NVC(1)+1 : NA=NVC(2)+1
6310 FOR M=0 TO NVC(1)
6315 FOR N=0 TO NVC(2)
6320 TI(M,NA)=TI(M,NA)+TI(M,N)
6325 TI(MA,N)=TI(MA,N)+TI(M,N)
6327 TI(MA,NA)=TI(MA,NA)+TI(M,N)
6328 IF KA=0 THEN 6335
6329 TJ(M,NA)=TJ(M,NA)+TJ(M,N)
6330 TJ(MA,N)=TJ(MA,N)+TJ(M,N)
6331 TJ(MA,NA)=TJ(MA,NA)+TJ(M,N)
6332 TK(M,NA)=TK(M,NA)+TK(M,N)
6333 TK(MA,N)=TK(MA,N)+TK(M,N)
6334 TK(MA,NA)=TK(MA,NA)+TK(M,N)
6335 NEXT N,M
6340 RETURN
6345 '
7710 ' EST320 - Calculo del valor x para F(x)
7715 '
7720 WHILE KDI=0
7725 IP=1 : GOSUB 8005
7730 X=XMU : DI=SIG
7735 GOSUB 8005
7740 FP=FP-FPX
7745 IF ABS(FP)<=.001 THEN RETURN
7750 IF FP>0 THEN DI=-DI
7755 MX=0
7760 WHILE MX=0
7765 XY=X : FPY=FP : X=X+DI
7770 GOSUB 8005
7775 FP=FP-FPX
7780 IF ABS(FP)<=.001 THEN RETURN
7785 IF DI<0 AND FP<0 THEN XD=X : XE=XY : FPD=FP : FPE=FPY : MX=1
7790 IF DI>0 AND FP>0 THEN XD=XY : XE=X : FPD=FPY : FPE=FP : MX=1
7795 WEND
7800 WHILE ABS(FPY)>.001
7805 X=XD-FPD*(XE-XD)/(FPE-FPD)
7810 GOSUB 8005
7815 FPY=FP-FPX
7820 IF FPY>0 THEN XE=X : FPE=FPY
7825 IF FPY<0 THEN XD=X : FPD=FPY
7830 WEND
7835 RETURN
7840 WEND
7845 WHILE KDI=1
7850 IP=1 : GOSUB 8005
7855 X=INT(X) : DI=INT(SIG)
7860 GOSUB 8005
7865 FP=FP-FPX
7870 IF FP>0 THEN DI=-DI
7875 MX=0
7880 WHILE MX=0
7885 XY=X : FPY=FP : X=X+DI
7890 GOSUB 8005
7895 FP=FP-FPX
7900 IF DI<0 AND FP<0 THEN XD=X : XE=XY : FPD=FP : MX=1
7905 IF DI>0 AND FP>0 THEN XD=XY : XE=X : FPD=FPY : MX=1
7910 WEND
7915 FOR M=XD TO XE
7920 X=M
7925 GOSUB 8005
7930 FPD=FPD+FD
7935 IF FPD>=0 THEN M=XE
7940 NEXT M
15 - 417
7945 RETURN
7950 WEND
7953 '
8005 ' EST300 - Llamada a Rutinas Distribuciones
8010 '
8015 ON TF GOSUB 8030,8125,8245,8335,8600,8855,8970,9125,9325,9510,9640,
9785,9940,10235,10390
8020 RETURN
8025 '
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
8240 '
8970 ' EST307 - 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 ' EST308 - 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
15 - 418
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
9320 '
9325 ' EST309 - Dist. F
9330 '
9335 KM=P(1) : KN=P(2)
9340 ON IP GOTO 9350,9430,9475
9345 '
9350 XMUX=0 : SIGX=0
9355 IF KN>2 THEN XMUX=KN/(KN-2)
9360 IF KN>4 THEN XSIGX=KN*SQR(2*(KM+KN-2)/(KM*(KN-2)^2*(KN-4)))
9365 IF X<=0 THEN FD=0 : FP=0 : XMU=XMUX : SIG=SIGX : RETURN
9370 XN=(KM+KN-2)/2 : GOSUB 10655 : FDZ=FA
9375 XN=(KM-2)/2 : GOSUB 10655 : FDZ=FDZ-FA
9380 XN=(KN-2)/2 : GOSUB 10655 : FDZ=FDZ-FA
9385 FDZ=FDZ+(KM/2)*LOG(KM/KN)+.5*(KM-2)*LOG(X)-.5*(KM+KN)*LOG(1+KM*X/KN)
9390 FDZ=EXP(FDZ)
9395 XKA=SQR((2/9/KN)*X^(2/3)+2/9/KM)
9400 U=((1-2/9/KN)*X^(1/3)-(1-2/9/KM))/XKA
9405 XA=X : X=U : P(1)=0 : P(2)=1 : GOSUB 8125
9410 X=XA : P(1)=KM : P(2)=KN
9415 FD=FDZ : XMU=XMUX : SIG=SIGX
9420 RETURN
9425 '
9430 XA=PX : IF XA=1 THEN XA=1.001
9435 N=2*XA/(XA-1)
9440 IF KSA(1)=1 THEN P(2)=INT(N+.5)
9445 IF KSA(1)=1 AND P(2)<5 THEN P(2)=5
9450 IF KSA(2)=0 THEN 9460
9455 P(1)=INT((2*P(2)-4)/(DEX^2*(P(2)-2)^2*(P(2)-4)/P(2)^2-2)+.5)
9460 IF KSA(2)=1 AND P(1)<1 THEN P(1)=1
9465 RETURN
9470 '
9475 GOSUB 8970
9480 XX=X
9485 P(1)=KN
9490 GOSUB 8970
9495 P(1)=KM : P(2)=KN
9500 X=XX*KN/(X*KM)
9505 RETURN
9507 '
15 - 419
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
10800 '
10 ' ESTAD6 - Revision 5/ 1/89
15 ' --------------------------
20 GOSUB 1000
25 CHAIN "ESTAD"
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
15 - 420
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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
15 - 421
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
NEXT
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
NEXT
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 ' EST6 - Regresion
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
15 - 422
1025 IF KZZ=0 THEN DIM VX(NFM),VY(NFM),TF$(8),V(NCM),CY(2)
1027 IF KZZ=0 THEN DIM PM(NCM),XYZ(NCM),AA(NCM),DAA(NCM),TS(NCM),SI(NCM),
PMI(5),PMA(5),XI(5),DEL(5)
1030 IF KZZ=0 THEN DIM TI(PAR1+1,PAR2+1),TJ(PAR1+1,PAR2+1),TK(PAR1+1,PAR2+1) :
KZZ=1
1035 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
1040 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1045 WHILE KW=0
1050 TP$="REGRESION" : TSP$=""
1055 NXX=0
1060 GOSUB 555
1065 PRINT TAB(70);FRE(0)
1070 PRINT "PROCESOS"
1075 TF$(1)="Regresion Lineal y Transformables a Lineal"
1080 TF$(2)="Regresion no Lineal"
1085 TF$(3)="Graficacion"
1090 TF$(4)="Manejo de Datos"
1095 KL=4 : GOSUB 980
1100 IF ISP=0 THEN CHAIN "ESTAD"
1110 IF ISP=4 THEN CHAIN "ESTAD1"
1115 IF NF=0 THEN KE=1 : GOSUB 900 : GOTO 1130
1120 IKP=ISP
1125 ON ISP GOSUB 1140,2915,5200
1130 WEND
1135 '
1140 ' EST61 - Regresion Lineal
1145 ' ------------------------
1150 TSP$="Regresion Lineal y Transformables a Lineal"
1155 WHILE KW=0
1160 GOSUB 555
1165 PRINT "FUNCION DE REGRESION"
1170 TF$(1)="LINEAL Y= a0 + a1*X1 +...+ ak*Xk"
1175 TF$(2)="Potencial Y= a0 * (X1^a1) *...* (Xk^ak)"
1180 TF$(3)="Exponencial Y= a0 * exp(a1*X1 +...+ ak*Xk)"
1185 TF$(4)="Exponenc.genral Y= a0 * (a1^X1) *...* (ak^Xk)"
1190 TF$(5)="Semilogaritmica Y= a0 + a1*ln(X1) +...+ ak*ln(Xk)"
1195 TF$(6)="Hiperbolica Y= a0 + a1/X1 +...+ ak/Xk"
1200 TF$(7)="Logistica Y= exp(a0+a1/X)"
1205 TF$(8)="Polinomica Y= a0 + a1*X^1 +...+ ak*X^k"
1210 KL=8 : GOSUB 980
1215 IF ISP=0 THEN RETURN
1220 TF=ISP
1225 C$=TF$(TF)
1230 GOSUB 555
1235 PRINT "FUNCION DE REGRESION: ";C$ : PRINT
1240 PRINT : PRINT "DEFINICION DE VARIABLES (2 ";
1245 IF TF=7 OR TF=8 THEN PRINT ")" ELSE PRINT "a";PAR2-1;")"
1250 PRINT " Las Primeras son las Variables Independientes"
1255 PRINT " La Ultima es la Variable Dependiente"
1260 KNV=PAR2-1 : IF TF=7 OR TF=8 THEN KNV=2
1265 GOSUB 200
1267 IF NV=0 THEN RETURN
1270 IF NV<2 OR NV>KNV THEN KE=2: GOSUB 900: GOTO 1265
1275 NVI=NV-1
1280 IF TF<>8 THEN 1310
1285 PRINT :INPUT "Grado del Polinomio = ",A$
1290 IF LEN(A$)=0 THEN RETURN
1295 GR=VAL(A$)
1300 IF GR<1 OR GR>NX-1 THEN KE=5 : B$=">=1 y <="+STR$(NXX-1) :
GOSUB 900 : GOTO 1285
1305 NVI=GR
1310 XP(0)=1 : KI=0
1315 PRINT : INPUT "Modelo sin Termino Independiente ? (N) = ",A$
1320 IF A$="S" OR A$="s" THEN KI=1
1325 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
1330 FOR K=0 TO NVI+1
1335 PM(K)=0
1340 FOR L=0 TO K : TJ(K,L)=0 :NEXT L
1345 NEXT K
1350 NXX=0 : KE=0
1355 FOR I=1 TO NF
15 - 423
1360 VX(I)=1
1365 IF A(I,0)=1 THEN 1475
1370 ND=1 : IF JF>0 THEN ND=A(I,JF) : IF ND=XVF THEN 1475
1375 KX=0
1380 FOR K=1 TO NV
1385 XP(K)=A(I,JX(K))
1390 IF XP(K)=XVF THEN KX=1 : K=NV
1395 NEXT K
1400 IF KX=1 THEN 1475
1405 FOR K=1 TO NVI+1
1410 IF TF=1 THEN 1450
1415 IF TF<8 THEN X=XP(K)
1420 IF TF=2 THEN IF X>0 THEN XP(K)=LOG(X) ELSE KE=1
1425 IF (TF=3 OR TF=4) AND K=NVI+1 THEN IF X>0 THEN XP(K)=LOG(X)
ELSE KE=1
1430 IF (TF=5 OR TF=6) AND K<NVI+1 THEN IF X>0 THEN XP(K)=LOG(X)
ELSE KE=1
1435 IF TF=7 AND K=NVI+1 THEN IF X>0 THEN XP(K)=LOG(X)
ELSE KE=1
1440 IF TF=7 AND K<NVI+1 THEN IF X<>0 THEN XP(K)=1/X
ELSE KE=1
1445 IF TF=8 THEN IF K<NVI+1 THEN XP(K)=XP(K-1)*A(I,JX(1))
ELSE XP(K)=A(I,JX(2))
1450 PM(K)=PM(K)+XP(K)*ND
1455 FOR L=KI TO K
1460 TJ(K,L)=TJ(K,L)+XP(K)*XP(L)*ND
1465 NEXT L,K
1470 NXX=NXX+ND : VX(I)=0
1475 NEXT I
1480 WHILE KE=1
1485 PRINT CHR$(7) : PRINT
1490 INPUT "** TRANSFORMACION INTERRUMPIDA - Valores<=0",A$ : RETURN
1495 WEND
1500 IF NXX<=NP THEN KE=3 : GOSUB 900 : RETURN
1505 TJ(0,0)=NXX
1510 FOR K=1 TO NVI+1
1515 FOR L=KI TO K
1520 TJ(L,K)=TJ(K,L)
1525 NEXT L,K
1530 FOR K=KI TO NVI
1535 ZXY(K)=TJ(K,NVI+1)
1540 NEXT K
1545 DET=TJ(NVI+1,NVI+1)
1550 N=NVI : GOSUB 11000
1555 IF KE=1 THEN RETURN
1560 AA(0)=0 : DAA(0)=0 : TS(0)=0 : SI(0)=0
1565 TC$(0)="TermIndep" : JX(0)=0
1570 FOR K=KI TO NVI
1575 AA(K)=TJ(K,NVI+1)
1580 TS(K)=ABS(TK(K,K))
1585 DET=DET-AA(K)*ZXY(K)
1590 IF TF=4 THEN AA(K)=EXP(AA(K))
1595 NEXT K
1600 IF TF=2 OR TF=3 THEN AA(0)=EXP(AA(0))
1605 IF KI=0 THEN NP=NVI+1 ELSE NP=NVI
1610 DET=SQR(DET/(NX-NP))
1615 GOSUB 1865
1620 VER=SER/(NXX-NP)
1625 DER=SQR(VER)
1630 SDY=SCY-SY^2/NXX
1635 VY=SDY/(NXX-1)
1640 RR=1-VER/VY
1645 FOR Z=KI TO NVI
1650 DAA(Z)=DET*SQR(TS(Z))
1655 TS(Z)=ABS(AA(Z)/DAA(Z))
1660 X=TS(Z) : P(1)=NXX-NP
1665 IP=1 : GOSUB 9125
1670 SI(Z)=100*2*(1-FP)
1675 NEXT Z
1680 KS=1
1685 WHILE KS=1
15 - 424
1690 GOSUB 555
1695 PRINT#3,"FUNCION DE REGRESION = ";C$
1700 PRINT#3," Variable Y = ";JX(NV);"- ";TC$(JX(NV))
1705 PRINT#3,: PRINT#3,"COEFICIENTES DE REGRESION" : PRINT#3,
1710 PRINT#3," Variable Xj Coefic. aj Desvio.Coef."; "
Valor t Signif.(%)"
1715 KA=3 : KB=79 : GOSUB 695
1717 KZ=0
1720 FOR K=0 TO NVI
1725 XX=JX(K) : IF TF=8 AND K>0 THEN XX=JX(1)
1730 D$=TC$(XX) : IF TF=8 AND K>0 THEN D$=LEFT$(D$,6)+"^"+STR$(K)
1735 PRINT#3,TAB(3);XX;"- ";D$;TAB(20);FNR(AA(K),NDE+2);
TAB(36);FNR(DAA(K),NDE+2);
1740 PRINT#3,TAB(50);FNR(TS(K),NDE);TAB(60);FNR(SI(K),2)
1742 IF K>5 AND KZ=0 AND DS$="SCRN:" THEN INPUT "",A$ : KZ=1
1745 NEXT K
1747 KA=3 : KB=79 : GOSUB 695
1748 PRINT#3,
1750 PRINT#3,"ESTADISTICAS DE REGRESION" : PRINT#3,
1755 PRINT#3, " Coefic.de Determin. R^2 = ";FNR((1-SER/SDY),NDE)
1760 PRINT#3, " Coefic.de Determin. R^2 (Correg.) = ";FNR(RR,NDE)
1765 PRINT#3, " Desvio Residuos = ";FNR(DER,NDE)
1770 GOSUB 650
1775 WEND
1780 KZ=0
1785 WHILE KZ=0
1790 GOSUB 555
1795 PRINT "PROCESOS COMPLEMENTARIOS"
1800 TF$(1)="Salida de Coeficientes de Correlacion"
1805 TF$(2)="Analisis de Variancia"
1810 TF$(3)="Prueba de Durbin-Watson"
1815 TF$(4)="Calculo de Valores Estimados y Residuos"
1820 TF$(5)="Prediccion de Valores de Y"
1825 TF$(6)="Graficacion"
1830 KL=6 : GOSUB 980
1835 IF ISP=0 THEN KZ=1 : GOTO 1845
1840 ON ISP GOSUB 2035,2135,2240,2435,2670,5200
1845 WEND
1850 WEND
1860 '
1865 ' EST612 - Calculo de Desvios Cuadraticos
1870 ' ---------------------------------------
1875 SER=0 : SY=0 : SCY=0
1880 FOR I=1 TO NF
1885 IF VX(I)=1 THEN 1935
1890 ND=1 : IF JF>0 THEN ND=A(I,JF)
1895 FOR K=1 TO NVI
1900 XP(K)=A(I,JX(K))
1905 NEXT K
1910 Y=A(I,JX(NV))
1915 SY=SY+ND*Y : SCY=SCY+ND*Y*Y
1920 GOSUB 1950
1925 ER=Y-YE
1930 SER=SER+ER*ER*ND
1935 NEXT I
1940 RETURN
1945 '
1950 ' EST613 - Calculo de y Estimado
1955 ' ------------------------------
1960 YE=AA(0)
1965 ON TF GOTO 1970,1975,1980,1985,1990,1995,2000,2005,2010
1970 FOR K=1 TO NVI : YE=YE+AA(K)*XP(K) : NEXT K : RETURN
1975 FOR K=1 TO NVI : YE=YE*XP(K)^AA(K) : NEXT K : RETURN
1980 FOR K=1 TO NVI : YE=YE*EXP(AA(K)*XP(K)) : NEXT K : RETURN
1985 FOR K=1 TO NVI : YE=YE*(AA(K))^XP(K) : NEXT K : RETURN
1990 FOR K=1 TO NVI : YE=YE+AA(K)*LOG(XP(K)) : NEXT K : RETURN
1995 FOR K=1 TO NVI : YE=YE+AA(K)/XP(K) : NEXT K : RETURN
2000 YE=EXP(AA(0)+AA(1)/XP(1)) : RETURN
2005 FOR K=1 TO NVI : YE=YE+AA(K)*XP(1)^K : NEXT K : RETURN
2010 FOR K=1 TO NVI : V(JX(K))=XP(K) : NEXT K
2015 YE=P(1)+P(2)*V(1)
15 - 425
2020 RETURN
2030 '
2035 ' EST613 - Calculo de coeficientes de Correlacion
2040 ' -----------------------------------------------
2045 GOSUB 5825
2050 IPC=2
2055 C$="COEFICIENTES DE CORRELACION"
2060 GOSUB 5974
2125 RETURN
2130 '
2135 ' EST614 - Analisis de Variancia
2140 ' ------------------------------
2145 SES=SDY-SER
2150 DES=SES/NVI
2155 X=DES/VER
2160 P(1)=NVI : P(2)=NXX-NVI-1
2165 IP=1 : GOSUB 9325
2170 SI(1)=FNR(100*(1-FP),2)
2175 KS=1
2180 WHILE KS=1
2185 PRINT#3, : PRINT#3, : PRINT#3,"ANALISIS DE VARIANCIA" : PRINT#3,
2190 PRINT#3,TAB(3);"Causa de Suma de Grados de Desvio"; "
F Significac."
2195 PRINT#3,TAB(3);"Variac.de Y Dev.Cuadr. Libertad Medio"; "
%)"
2200 KA=3 : KB=75 : GOSUB 695
2205 PRINT#3,TAB(3);"Variables X";TAB(16);FNR(SES,NDE);TAB(30);P(1);
TAB(38);FNR(DES,NDE);TAB(49);FNR(X,NDE);TAB(60);FNR(SI(1),2)
2210 PRINT#3,TAB(3);"Error e";TAB(16);FNR(SER,NDE);TAB(30);P(2);
TAB(38);FNR(VER,NDE)
2215 PRINT#3,TAB(3);"Total";TAB(16);FNR(SDY,NDE);TAB(30);NXX-1
2220 KA=3 : KB=75 : GOSUB 695 : PRINT#3,
2225 GOSUB 650
2230 WEND
2235 RETURN
2237 '
2240 ' EST615 - Prueba de Durbin-Watson
2245 ' --------------------------------
2250 KX=0 : DW=0 : SER=0
2255 FOR I=1 TO NF
2260 IF VX(I)=1 THEN KX=0 : GOTO 2305
2265 FOR K=1 TO NVI
2270 XP(K)=A(I,JX(K))
2275 NEXT K
2280 Y=A(I,JX(NV))
2285 GOSUB 1950 : ER=Y-YE
2290 SER=SER+ER*ER
2295 IF KX=1 THEN DW=DW+(ER-ERA)^2 ELSE KX=1
2300 ERA=ER
2305 NEXT I
2310 DW=DW/SER
2315 IF DW>2 THEN DW=4-DW
2320 DL(1)=.78576-.16513*NVI+.03427*NX+.0035773*NVI*NX-.0005*NX*NX -
.000022*NVI*NX*NX+2.49E-06*NX*NX*NX
2325 DU(1)=1.1176+.26277*NVI+.004913*NX-.0065215*NVI*NX+.000133*NX*NX
+4.283E-05*NVI*NX*NX-1.33E-06*NX*NX*NX
2330 DL(2)=.5529*(NVI^-.0134)*(NX^.11765)*DL(1)
2335 DU(2)=.69835*(NVI^.02326)*(NX^.05622)*DU(1)
2340 ALF(1)=5 : ALF(2)=1
2345 KS=1
2350 WHILE KS=1
2355 PRINT#3,
2360 PRINT#3,"PRUEBA DE DURBIN-WATSON" : PRINT#3,
2365 PRINT#3," Estadistica Durbin-Watson = ";FNR(DW,3) : PRINT#3,
2370 PRINT#3,TAB(4);"Niv.Sign(%)";TAB(16);"Rechazo";TAB(25);"dl";
TAB(29);"Indefin.";TAB(38);"du";TAB(43);"No Rechazo"
2375 KA=3 : KB=53 : GOSUB 695
2380 FOR M=1 TO 2
2385 A$="" : B$="" : C$=""
2390 IF DW<DL(M) THEN A$="*"
2395 IF DW>=DL(M) AND DW<=DU(M) THEN B$="*"
15 - 426
2400 IF DW>DU(M) THEN C$="*"
2405 PRINT#3,TAB(5);ALF(M);TAB(18);A$;TAB(24);FNR(DL(M),2);TAB(31);B$;
TAB(37);FNR(DU(M),2);TAB(45);C$
2410 NEXT M
2415 PRINT#3,
2420 GOSUB 650
2425 WEND
2430 RETURN
2433 '
2435 ' EST616 - Calculo de Valores Estimados y Residuos
2440 ' ------------------------------------------------
2443 FOR M=1 TO 2
2445 A$="VALORES ESTIMADOS DE Y" : IF M=2 THEN A$="RESIDUOS" : KVA=1
2447 PRINT : PRINT
2450 PRINT "ALMACENAMIENTO DE ";A$;" EN MEMORIA DE TRABAJO"
2460 GOSUB 390 : CY(M)=J
2465 NEXT M
2475 KS=1
2480 WHILE KS=1
2485 KX=0
2490 PRINT#3, : PRINT#3,
2495 FOR I=1 TO NF
2500 WHILE KX=0
2505 PRINT#3,"Nro.Obs. Y Real Y Estimado";" Residuo";
TAB(58);"Residuos Normalizados"
2510 PRINT#3,TAB(52);"-2S 0 2S"
2515 KA=1 : KB=79 : GOSUB 695
2520 IL=4 : KX=1
2525 WEND
2530 IF VX(I)=1 THEN 2645
2535 FOR K=1 TO NVI
2540 XP(K)=A(I,JX(K))
2545 NEXT K
2550 Y=A(I,JX(NV))
2555 GOSUB 1950 : ER=Y-YE : ERN=ER/(DER*2)
2560 IF CY(1)>0 THEN A(I,CY(1))=YE
2565 IF CY(2)>0 THEN A(I,CY(2))=ER
2570 PRINT#3,TAB(3);I;TAB(10);Y;TAB(24);FNR(YE,NDE);TAB(38);FNR(ER,NDE);TAB(53);
2575 FOR M=1 TO 25 : VY(M)=0 : NEXT M
2580 VY(2)=2 : VY(13)=1 : VY(24)=2
2585 X=INT(11*ERN+.5)
2590 IF X>11 THEN X=12
2595 IF X<-11 THEN X=-11
2600 VY(12+X)=3
2605 FOR M=1 TO 25
2610 A$=" "
2615 IF VY(M)=1 THEN A$="."
2620 IF VY(M)=2 THEN A$="I"
2625 IF VY(M)=3 THEN A$="*"
2630 PRINT#3,A$;
2635 NEXT M : PRINT#3,
2640 IL=IL+1 : IF IL=20 AND DS$="SCRN:" THEN INPUT "Enter",A$ : CLS :KX=0
2645 NEXT I
2650 GOSUB 650
2655 WEND
2660 RETURN
2665 '
2670 ' EST617 - Prediccion de valores de Y
2675 ' -----------------------------------
2680 PRINT : INPUT "Nivel de Significacion Prediccion en % = ",A$
2685 IF LEN(A$)=0 THEN RETURN
2690 AL=VAL(A$)
2695 IF AL<=0 OR AL>=100 THEN KE=5 : B$=">0 y <100" : GOSUB 900: GOTO 2680
2700 WHILE KW=0
2705 PRINT
2710 FOR K=1 TO NV-1
2715 J=JX(K)
2720 PRINT "Valor de Variable";J; "(";TC$(J);")"; : INPUT " = ",A$
2725 IF LEN(A$)=0 THEN RETURN
2730 XP(K)=VAL(A$)
2735 XYZ(K)=XP(K)
15 - 427
2740 IF TF=2 OR TF=5 AND XP(K)<=0 THEN KE=5 : B$=">0" :
GOSUB 900 : GOTO 2720
2745 IF TF=2 OR TF=5 THEN XYZ(K)=LOG(XP(K))
2750 IF TF=6 OR TF=7 AND XP(K)<=0 THEN KE=5 : B$=">0" :
GOSUB 900 : GOTO 2720
2755 IF TF=6 OR TF=7 THEN XYZ(K)=1/XP(K)
2760 IF TF=8 THEN FOR M=1 TO NVI : XYZ(M)=XP(M)^M : NEXT M
2765 NEXT K
2770 GOSUB 1950
2775 XXX=TF : TF=7 : IP=1 : P(1)=NX-2
2780 FPX=1-AL/200 : GOSUB 7710 : TF=XXX
2785 XYZ(0)=1
2790 HH=0
2795 FOR K=KI TO NVI
2800 TS(K)=0
2805 FOR L=KI TO NVI
2810 TS(K)=TS(K)+XYZ(L)*TK(L,K)
2815 NEXT L
2820 HH=HH+TS(K)*XYZ(K)
2825 NEXT K
2830 XLP=X*DER*SQR(HH)
2835 XLI=X*DER*SQR(HH+1)
2840 IF TF=1 OR TF=5 OR TF=6 OR TF=8 THEN XSP=YE+XLP : XIP=YE-XLP :
XSI=YE+XLI : XII=YE-XLI
2845 IF TF=2 OR TF=3 OR TF=4 OR TF=7 THEN XSP=YE*EXP(XLP) : XIP=YE/EXP(XLP) :
XSI=YE*EXP(XLI) : XII=YE/EXP(XLI)
2850 KS=1
2855 WHILE KS=1
2860 PRINT#3, : PRINT#3,"PREDICCION" : PRINT#3,
2865 FOR K=1 TO NV-1
2870 PRINT#3,TAB(3);JX(K);"- ";TC$(JX(K));" = ";XYZ(K)
2875 NEXT K
2880 PRINT#3, : PRINT#3,TAB(3);JX(NV);"- ";TC$(JX(NV));" = ";YE
2885 PRINT#3, : PRINT#3,TAB(3);"Intervalos de Confianza (para nivel sign. ";AL;" %)"
2890 PRINT#3,TAB(6);"Promedio = ";FNR(XIP,NDE);" - ";FNR(XSP,NDE)
2895 PRINT#3,TAB(6);"Valor Individual = ";FNR(XII,NDE);" - ";FNR(XSI,NDE)
2900 GOSUB 650
2905 WEND
2910 WEND
2912 '
2915 ' EST62 - Regresion No Lineal
2920 ' ---------------------------
2925 TF=9
2930 TSP$="Regresion no Lineal General"
2935 'WHILE KW=0
2940 GOSUB 555
2945 PRINT : PRINT "DEFINICION DE VARIABLES (2 a";PAR2-1;")"
2947 PRINT " Las Primeras son las Variables Independientes"
2950 PRINT " La Ultima es la Variable Dependiente"
2955 KNV=PAR2-1
2957 GOSUB 200
2960 IF NV=0 THEN RETURN
2965 IF NV<2 OR NV>KNV THEN KE=2: GOSUB 900: GOTO 2957
2970 NVI=NV-1
2975 NXX=0 : KE=0
2980 FOR I=1 TO NF
2985 VX(I)=1
2990 IF A(I,0)=1 THEN 3020
2993 ND=1 : IF JF>0 THEN ND=A(I,JF) : IF ND=XVF THEN 3020
2995 FOR K=1 TO NV
3000 X=A(I,JX(K))
3005 IF X=XVF THEN KE=1 : K=NV
3010 NEXT K
3015 IF KE=0 THEN NXX=NXX+ND : VX(I)=0
3020 NEXT I
3025 IF NXX<=NP THEN KE=3 : GOSUB 900 : RETURN
3030 PRINT : PRINT : PRINT "INGRESO DE FUNCION DE REGRESION" : PRINT
3035 GOSUB 500
3040 IF LEN(FU$)=0 THEN 3060
3045 PRINT "Funcion de Regresion Existente = ",FU$
3050 INPUT "Se Modifica (S/N) ? = ",A$
15 - 428
3055 IF A$<>"S" AND A$<>"s" THEN 3100
3060 PRINT : INPUT "Funcion a Ingresar = ",A$
3065 IF LEN(A$)=0 THEN FU$="" : RETURN
3070 FU$=A$
3075 OPEN DDA$+":xyz.bas" FOR OUTPUT AS #1
3080 PRINT#1,"2015 ye="+FU$
3085 CLOSE#1
3090 CHAIN MERGE DDA$+":xyz",3095,ALL
3095 KILL DDA$+":xyz.bas"
3140 PRINT : INPUT "Numero de Parametros = ",A$
3145 IF LEN(A$)=0 THEN RETURN
3150 NP=VAL(A$)
3155 IF NP<1 OR NP >5 THEN KE=5 : B$=">=1 y <=5" : GOSUB 900 : GOTO 3140
3160 FOR I=1 TO NP
3165 PRINT
3170 PRINT "Parametro";I
3175 INPUT " Valor Inicial = ",A$
3180 IF LEN(A$)=0 THEN RETURN
3185 P(I)=VAL(A$)
3190 INPUT " Incremento Inicial = ",A$
3195 IF LEN(A$)=0 THEN RETURN
3200 DELT(I)=VAL(A$)
3205 IF DELT(I)<=0 THEN KE=5 : B$=">0" : GOSUB 900 : PRINT : GOTO 3190
3215 NEXT I
3220 PRINT : INPUT "Numero Maximo de Iteraciones (50) = ",A$
3225 IF LEN(A$)=0 THEN ITM=50 ELSE ITM=VAL(A$)
3227 IF ITM<1 THEN KE=5 : B$=">0" : GOSUB 900 : GOTO 3220
3230 PRINT : PRINT TAB(25);"EN PROCESO"
3235 GOSUB 1865
3240 GOSUB 3450
3245 VER=SER/(NXX-NP)
3250 DER=SQR(VER)
3255 SDY=SCY-SY^2/NXX
3260 VY=SDY/(NXX-1)
3265 RR=1-VER/VY
3270 KS=1
3275 WHILE KS=1
3280 GOSUB 555
3285 PRINT#3,"FUNCION DE REGRESION = ";FU$
3290 PRINT#3," Variable Y = ";JX(NV);"- ";TC$(JX(NV))
3295 PRINT#3," Variables Independientes = ";
3300 FOR I=1 TO NVI
3305 PRINT#3,TAB(31);JX(I);"- ";TC$(JX(I))
3310 NEXT I
3315 PRINT#3,: PRINT#3,"COEFICIENTES DE REGRESION" : PRINT#3,
3317 PRINT#3," j Coefic. aj Desvio.Coef. aj"
3318 KA=3 : KB=60 : GOSUB 695
3319 KZ=0
3320 FOR I=1 TO NP
3325 PRINT#3,TAB(3);I;TAB(15);FNR(P(I),NDE+2);TAB(30);FNR(SIGP(I),NDE+2)
3327 IF K>5 AND KZ=0 AND DS$="SCRN:" THEN INPUT "",A$ : KZ=1
3330 NEXT I
3333 KA=3 : KB=60 : GOSUB 695
3335 PRINT#3,
3340 PRINT#3, : PRINT#3,"ESTADISTICAS DE REGRESION" : PRINT#3,
3345 PRINT#3, " Coefic.de Determin. R^2 = ";FNR((1-SER/SDY),NDE)
3350 PRINT#3, " Coefic.de Determin. R^2 (Correg.) = ";FNR(RR,NDE)
3355 PRINT#3, " Desvio Residuos = ";FNR(DER,NDE)
3360 GOSUB 650
3365 WEND
3370 KZ=0
3375 WHILE KZ=0
3380 GOSUB 555
3385 PRINT "PROCESOS COMPLEMENTARIOS"
3390 TF$(1)="Coeficientes de Correlacion"
3395 TF$(2)="Analisis de Variancia"
3400 TF$(3)="Prueba de Durbin-Watson"
3405 TF$(4)="Calculo de Valores estimados y Residuos"
3410 TF$(5)="Prediccion de Valores de Y"
3415 TF$(6)="Graficacion"
3420 KL=6 : GOSUB 980
15 - 429
3425 IF ISP=0 THEN KZ=1 : GOTO 3435
3430 ON ISP GOSUB 2035,2135,2240,2435,2670,5200
3435 WEND
3440 GOTO 20
3445 '
3450 ' EST621 - Minimizacion de una funcion general
3455 ' --------------------------------------------
3460 ITE=0 : SERA=0 : SER=1
3500 WHILE ABS((SER-SERA)/SER)>.001 AND ITE<ITM
3510 SERA=SER
3520 FOR J=1 TO NP
3525 GOSUB 1865 : SER1=SER
3530 NK=0
3535 DEL=DELT(J)
3537 XX=P(J)
3540 P(J)=P(J)+DEL
3545 GOSUB 1865 : SER2=SER
3550 IF SER2=SER1 THEN 3540
3555 IF SER2<SER1 THEN 3575
3560 DEL=-DEL
3563 P(J)=XX+DEL
3565 GOSUB 1865
3570 SER1=SER2 : SER2=SER
3575 NK=NK+1
3580 P(J)=P(J)+DEL
3585 GOSUB 1865 : SER3=SER
3590 IF SER3<SER2 THEN SER1=SER2 : SER2=SER3 : GOTO 3575
3595 DEL=DEL*(1/(1+(SER1-SER2)/(SER3-SER2))+.5)
3600 P(J)=P(J)-DEL
3610 SIGP(J)=DELT(J)*SQR(2/((NXX-NP)*(SER3-2*SER2+SER1)))
3615 DELT(J)=DELT(J)*NK/3
3625 NEXT J
3640 WEND
3650 GOSUB 1865
3680 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
15 - 430
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
15 - 431
5960 VX(K)=PM(K)
5962 PM(K)=PM(K)/NXX
5964 DE(K)=SQR((TI(K,K)-NXX*PM(K)^2)/(NXX-1))
5966 FOR L=1 TO K
5968 TI(K,L)=(TI(K,L)-NXX*PM(K)*PM(L))/(NXX-1)
5970 TI(L,K)=TI(K,L)
5971 NEXT L,K
5972 RETURN
5973 '
5974 ' EST215 - Salida Covar. y Coef.Correlac.
5975 ' ---------------------------------------
5977 KS=1
5978 WHILE KS=1
5979 PRINT#3, : PRINT#3, : PRINT#3,C$
5980 PRINT#3, : KN=0
5981 FOR M=1 TO NV STEP 6
5982 KM=KN+1 : KN=KM+5
5983 IF KN>NV THEN KN=NV
5984 PRINT#3,"Variable";
5985 FOR K=KM TO KN : PRINT#3,TAB(9*(K-KM)+19);TC$(JX(K)); : NEXT K
5986 PRINT#3, : PRINT#3,
5987 FOR K=KM TO KN
5988 PRINT#3,TAB(3);JX(K);TAB(7);"-";TC$(JX(K));
5989 FOR L=K TO KN
5990 CA=1 : IF IPC>1 THEN CA=DE(K)*DE(L)
5991 IF CA>0 THEN X=TI(L,K)/CA ELSE X=0
5992 IF IPC<3 THEN 5999
5993 IF X>.9999 THEN X=0 : GOTO 5999
5994 X=ABS(X*SQR((NXX-2)/(1-X*X)))
5995 P(1)=NXX-2 : KXX=K
5996 IP=1 : GOSUB 8800
5997 X=200*(1-FP)
5998 K=KXX
5999 IF IPC<3 THEN PRINT#3,TAB(9*(L-KM)+19);FNR(X,NDE);
6000 IF IPC=3 THEN PRINT#3,TAB(9*(L-KM)+19);FNR(X,NDE-1);
6001 NEXT L
6002 PRINT#3,
6003 NEXT K
6004 IF DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$
6005 NEXT M
6006 GOSUB 650
6007 WEND
6008 RETURN
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)
15 - 432
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 '
7720 WHILE KDI=0
7725 IP=1 : GOSUB 8005
7730 X=XMU : DI=SIG
7735 GOSUB 8005
7740 FP=FP-FPX
7745 IF ABS(FP)<=.001 THEN RETURN
7750 IF FP>0 THEN DI=-DI
7755 MX=0
7760 WHILE MX=0
7765 XY=X : FPY=FP : X=X+DI
7770 GOSUB 8005
7775 FP=FP-FPX
7780 IF ABS(FP)<=.001 THEN RETURN
7785 IF DI<0 AND FP<0 THEN XD=X : XE=XY : FPD=FP : FPE=FPY : MX=1
7790 IF DI>0 AND FP>0 THEN XD=XY : XE=X : FPD=FPY : FPE=FP : MX=1
7795 WEND
7800 WHILE ABS(FPY)>.001
7805 X=XD-FPD*(XE-XD)/(FPE-FPD)
7810 GOSUB 8005
7815 FPY=FP-FPX
7820 IF FPY>0 THEN XE=X : FPE=FPY
15 - 433
7825 IF FPY<0 THEN XD=X : FPD=FPY
7830 WEND
7835 RETURN
7840 WEND
7845 WHILE KDI=1
7850 IP=1 : GOSUB 8005
7855 X=INT(X) : DI=INT(SIG)
7860 GOSUB 8005
7865 FP=FP-FPX
7870 IF FP>0 THEN DI=-DI
7875 MX=0
7880 WHILE MX=0
7885 XY=X : FPY=FP : X=X+DI
7890 GOSUB 8005
7895 FP=FP-FPX
7900 IF DI<0 AND FP<0 THEN XD=X : XE=XY : FPD=FP : MX=1
7905 IF DI>0 AND FP>0 THEN XD=XY : XE=X : FPD=FPY : MX=1
7910 WEND
7915 FOR M=XD TO XE
7920 X=M
7925 GOSUB 8005
7930 FPD=FPD+FD
7935 IF FPD>=0 THEN M=XE
7940 NEXT M
7945 RETURN
7950 WEND
7953 '
8005 ' EST300 - Llamada a Rutinas Distribuciones
8010 '
8015 ON TF GOSUB 8030,8125,8245,8335,8600,8855,8970,9125,9325,9510,9640,
9785,9940,10235,10390
8020 RETURN
8025 '
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
8240 '
8970 ' EST307 - 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
15 - 434
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 ' EST308 - 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 XK=SQR((2/9/K)*Y^(2/3)+2/9)
9185 U=((1-2/9/K)*(Y^(1/3))-7/9)/XK
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
9320 '
9325 ' EST309 - Dist. F
9330 '
9335 KM=P(1) : KN=P(2)
9340 ON IP GOTO 9350,9430,9475
9345 '
9350 XMUX=0 : SIGX=0
9355 IF KN>2 THEN XMUX=KN/(KN-2)
9360 IF KN>4 THEN XSIGX=KN*SQR(2*(KM+KN-2)/(KM*(KN-2)^2*(KN-4)))
9365 IF X<=0 THEN FD=0 : FP=0 : XMU=XMUX : SIG=SIGX : RETURN
9370 XN=(KM+KN-2)/2 : GOSUB 10655 : FDZ=FA
9375 XN=(KM-2)/2 : GOSUB 10655 : FDZ=FDZ-FA
9380 XN=(KN-2)/2 : GOSUB 10655 : FDZ=FDZ-FA
9385 FDZ=FDZ+(KM/2)*LOG(KM/KN)+.5*(KM-2)*LOG(X)-.5*(KM+KN)*LOG(1+KM*X/KN)
9390 FDZ=EXP(FDZ)
15 - 435
9395 XK=SQR((2/9/KN)*X^(2/3)+2/9/KM)
9400 U=((1-2/9/KN)*X^(1/3)-(1-2/9/KM))/XK
9405 XA=X : X=U : P(1)=0 : P(2)=1 : GOSUB 8125
9410 X=XA : P(1)=KM : P(2)=KN
9415 FD=FDZ : XMU=XMUX : SIG=SIGX
9420 RETURN
9425 '
9430 XA=PX : IF XA=1 THEN XA=1.001
9435 N=2*XA/(XA-1)
9440 IF KSA(1)=1 THEN P(2)=INT(N+.5)
9445 IF KSA(1)=1 AND P(2)<5 THEN P(2)=5
9450 IF KSA(2)=0 THEN 9460
9455 P(1)=INT((2*P(2)-4)/(DEX^2*(P(2)-2)^2*(P(2)-4)/P(2)^2-2)+.5)
9460 IF KSA(2)=1 AND P(1)<1 THEN P(1)=1
9465 RETURN
9470 '
9475 GOSUB 8970
9480 XX=X
9485 P(1)=KN
9490 GOSUB 8970
9495 P(1)=KM : P(2)=KN
9500 X=XX*KN/(X*KM)
9505 RETURN
9507 '
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)
15 - 436
11130 TK(I,J)=TK(I,J)-X*TK(IP,J)
11135 NEXT J
11140 NEXT I
11145 NEXT IP
11150 RETURN
11200 '
10 ' ESTAD7 - Revision 8-12-88
15 '
20 GOSUB 1000
25 CHAIN "ESTAD"
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
15 - 437
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 L=1 TO NC
525 IF LEFT$(TC$(L),2)=" " THEN 540
530 PRINT TAB(15*I-11);L;"-";TC$(L);
535 I=I+1 : IF I>5 THEN I=1 : PRINT
540 NEXT L
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
15 - 438
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
NEXT
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
NEXT
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 ' EST7 - Analisis Multivariado
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 DEF FNR(X,DE)=INT(10^DE*X+.5)/10^DE
1030 CLOSE : DS$="SCRN:" : OPEN DS$ FOR OUTPUT AS#3
1035 WHILE KW=0
1040 TP$="ANALISIS MULTIVARIADO" : TSP$=""
1045 NXX=0
1050 IF KZZ=1 THEN 1070
1055 DIM TI(PAR2+1,PAR2+1),TJ(PAR2+1,PAR2+1),TK(PAR2+1,PAR2+1),VC(PAR2,2)
1057 KX=2*PAR2 : IF NFM>KX THEN KX=NFM
1060 DIM VX(KX),TL(PAR2+1,PAR2+1),TF$(20),TG$(3),PM(NCM),DE(NCM),
CY(PAR2),V(PAR2),PMM(PAR2)
1065 KZZ=1
1070 GOSUB 555
1075 PRINT TAB(70);FRE(0)
1080 KE=0
15 - 439
1085 PRINT "PROCESOS"
1090 TF$(1)="Analisis de Componentes Principales"
1095 TF$(2)="Analisis Discriminante Lineal"
1100 TF$(3)="Agrupamiento Jerarquico"
1105 TF$(4)="Graficacion"
1110 TF$(5)="Manejo de Datos"
1115 KL=5 : GOSUB 980
1120 IF ISP=0 THEN RETURN
1125 IF ISP=5 THEN CHAIN "ESTAD1"
1130 IF (ISP=2 OR ISP=4) AND NF=0 THEN KE=1 : GOSUB 900 : GOTO 1140
1135 ON ISP GOSUB 1150,2455,3575,5200
1140 WEND
1145 '
1150 ' EST71 - Analisis de Componentes Principales
1155 ' -------------------------------------------
1160 TSP$="Analisis de Componentes Principales"
1165 GOSUB 555
1170 PRINT : INPUT "Ingreso Directo Matriz Covar./Correlac. ? (N) = ",A$
1175 KID=1 : IF A$="S" OR A$="s" THEN KID=2
1180 XX=KID
1183 WHILE KID=1
1185 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
1190 PRINT : PRINT "DEFINICION DE VARIABLES (1 a";PAR2;")"
1195 KNV=PAR2 : KDA=1 : GOSUB 200
1200 IF NV=0 THEN RETURN
1205 IF NV<2 OR NV>PAR2 THEN KE=2 : GOSUB 900 : GOTO 1195
1210 NVX=NV : KNM=0
1215 PRINT : INPUT "Normalizacion de Observaciones ? (N) = ",A$
1220 IF A$="S" OR A$="s" THEN KNM=1
1230 PRINT : PRINT TAB(25);"EN PROCESO"
1235 GOSUB 5825
1240 IF NXX<3 THEN KE=3 : GOSUB 900 : RETURN
1245 FOR K=1 TO NV
1250 FOR L=K TO NV
1255 IF KNM=0 THEN 1270
1260 CA=DE(K)*DE(L)
1265 IF CA>0 THEN TI(K,L)=TI(K,L)/CA ELSE TI(K,L)=0
1270 TI(L,K)=TI(K,L)
1275 TL(K,L)=TI(K,L) : TL(L,K)=TI(L,K)
1280 NEXT L
1285 NEXT K
1290 KID=0 : NVX=NV
1295 WEND
1300 WHILE KID=2
1305 NVX=NV
1310 PRINT : INPUT "Numero de Variables = ",A$
1315 IF LEN(A$)=0 THEN RETURN
1320 NV= VAL(A$)
1325 IF NV<2 OR NV>PAR2 THEN KE=5 : B$=">=2 y <="+STR$(PAR2) :
GOSUB 900 : GOTO 1310
1330 FOR K=1 TO NV : PRINT : PRINT "Variable ";K
1335 FOR L=K TO NV
1340 PRINT " Covariancia o Correlac.con Variable";L;
1345 INPUT " = ",A$
1350 X=VAL(A$)
1355 IF K=L AND X<=0 THEN KE=5 : B$=">0" : GOSUB 900 : GOTO 1340
1360 TI(K,L)=VAL(A$)
1365 TI(L,K)=TI(K,L)
1370 NEXT L : NEXT K
1375 KID=0
1380 WEND
1385 KID=XX
1390 GOSUB 1785
1395 FOR K=1 TO NV
1400 VX(K)=K : VX(K+NV)=TI(K,K)
1405 NEXT K
1410 KA=1
1415 WHILE KA=1
1420 KA=0
1425 FOR L=2 TO NV
1430 X=VX(L-1+NV) : Y=VX(L+NV)
15 - 440
1435 IF X<Y THEN W=VX(L+NV) : VX(L+NV)=VX(L-1+NV) : VX(L-1+NV)=W : KA=1
1440 IF X<Y THEN W=VX(L) : VX(L)=VX(L-1) : VX(L-1)=W
1445 NEXT L
1450 WEND
1455 WHILE KW=0
1460 GOSUB 555
1465 PRINT "VARIANCIAS DE LAS COMPONENTES" : PRINT
1470 PRINT " Componente Variancia % Acumul.Variancia"
1475 KA=2 : KB=50 : GOSUB 695
1480 SX=0
1485 FOR K=1 TO NV
1490 SX=SX+TI(K,K)
1495 NEXT K
1500 SY=0
1505 FOR K=1 TO NV
1510 L=VX(K)
1515 SY=SY+100*TI(L,L)/SX
1520 PRINT TAB(3);K;TAB(15);FNR(TI(L,L),NDE);TAB(32);FNR(SY,NDE-1)
1525 NEXT K
1530 PRINT : INPUT "Nro.de Componentes Principales seleccionadas = ",A$
1535 IF LEN(A$)=0 THEN NV=NVX : RETURN
1540 NCP=VAL(A$)
1545 IF NCP<1 OR NCP>NV THEN KE=5 : B$=">=1 y <="+STR$(NV) :
GOSUB 900 : GOTO 1530
1550 KS=1
1555 WHILE KS=1
1560 GOSUB 555
1565 KX=1 : GOSUB 730
1570 IF KNM=1 THEN PRINT#3," (Normalizadas)" : PRINT#3,
1575 PRINT#3, : PRINT#3,
1580 PRINT#3,"VARIANCIAS DE LAS COMPONENTES" : PRINT#3,
1585 PRINT#3," Componente Variancia % Acumul.Variancia"
1590 KA=2 : KB=50 : GOSUB 695
1595 SY=0
1600 FOR K=1 TO NV
1605 L=VX(K)
1610 SY=SY+100*TI(L,L)/SX
1615 PRINT#3,TAB(3);K;TAB(15);FNR(TI(L,L),NDE);TAB(32);FNR(SY,NDE-1)
1620 NEXT K
1625 IF DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$
1630 PRINT#3,"COEFICIENTES DE LAS COMPONENTES SELECCIONADAS" : PRINT#3,
1631 KN=0
1632 FOR M=1 TO NV STEP 5
1633 KM=KN+1 : KN=KM+4
1634 IF KN>NV THEN KN=NV
1635 PRINT#3,TAB(13*(KN-KM)/2+15);"Variables"
1640 PRINT#3," Componente";
1645 FOR K=KM TO KN
1650 S=K : IF KID=1 THEN S=JX(K)
1655 PRINT#3,TAB(13*(K-KM)+13);S;"-";TC$(S);
1660 NEXT K
1665 PRINT#3,
1670 KA=2 : KB=79 : GOSUB 695
1675 FOR K=1 TO NCP
1680 PRINT#3,TAB(6);K;
1685 FOR L=KM TO KN
1686 PRINT#3,TAB(13*(L-KM)+13);FNR(TJ(L,VX(K)),NDE+1);
1687 NEXT L
1690 PRINT#3,
1695 NEXT K
1697 PRINT#3,
1698 NEXT M
1700 GOSUB 650
1705 WEND
1710 KZ=0
1715 WHILE KZ=0
1720 GOSUB 555
1725 PRINT "PROCESOS COMPLEMENTARIOS"
1730 TF$(1)="Salida de Coeficientes de Correlacion"
1735 TF$(2)="Calculo de Valores de las Componentes"
1740 TF$(3)="Graficacion de Variables segun Comp.1 y 2"
15 - 441
1745 TF$(4)="Graficacion"
1750 KL=4 : GOSUB 980
1755 IF ISP=0 THEN KZ=1 : GOTO 1770
1760 IF ISP=2 AND KID=2 THEN PRINT CHR$(7) : PRINT : PRINT "No se usaron datos de la memoria
de trabajo" : GOTO 1750
1765 ON ISP GOSUB 2020,2150,2385,5200
1770 WEND
1775 WEND
1780 '
1785 ' EST711 - Calculo de Valores y Vectores Propios
1790 ' ----------------------------------------------
1795 T=0 : DIAG=0 : XNOR=0
1800 FOR I=1 TO NV
1805 TJ(I,I)=1
1810 DIAG=DIAG+TI(I,I)*TI(I,I)
1815 FOR J=I+1 TO NV
1820 T=T+TI(I,J)*TI(I,J)
1825 TJ(I,J)=0 : TJ(J,I)=0
1830 NEXT J
1835 NEXT I
1840 XNOR=DIAG+2*T
1845 WHILE ABS(1-XNOR/DIAG)>.00001
1850 T=0
1855 FOR I=1 TO NV
1860 FOR J=I+1 TO NV
1865 IF ABS(TI(I,J))>T THEN T=ABS(TI(I,J)) : KI=I : KJ=J
1870 NEXT J
1875 NEXT I
1880 QS=TI(KI,KI)-TI(KJ,KJ)
1885 IF QS=0 THEN C=1/SQR(2) : S=(TI(KI,KJ)/ABS(TI(KI,KJ)))*C : GOTO 1915
1890 Q=ABS(QS)
1895 P=(QS/Q)*2*TI(KI,KJ)
1900 SQPQ=SQR(P*P+Q*Q)
1905 C=SQR((1+Q/SQPQ)/2)
1910 S=P/(2*SQPQ*C)
1915 FOR I=1 TO NV
1920 T=TJ(I,KI)
1925 TJ(I,KI)=C*T+S*TJ(I,KJ)
1930 TJ(I,KJ)=C*TJ(I,KJ)-S*T
1935 NEXT I
1940 FOR I=1 TO NV
1945 IF I=KI OR I=KJ THEN 1980
1950 IX=I : IY=KI : IW=I : IZ=KJ
1955 IF I>KI AND I<KJ THEN IX=KI : IY=I
1960 IF I>KJ THEN IX=KI : IY=I : IW=KJ : IZ=I
1965 T=TI(IX,IY)
1970 TI(IX,IY)=C*T+S*TI(IW,IZ)
1975 TI(IW,IZ)=C*TI(IW,IZ)-S*T
1980 NEXT I
1985 DIAG=DIAG+2*TI(KI,KJ)*TI(KI,KJ)
1990 T=TI(KI,KI)
1995 TI(KI,KI)=C*C*T+2*C*S*TI(KI,KJ)+S*S*TI(KJ,KJ)
2000 TI(KJ,KJ)=C*C*TI(KJ,KJ)+S*S*T-2*C*S*TI(KI,KJ)
2005 TI(KI,KJ)=0
2010 WEND
2015 RETURN
2017 '
2020 ' EST712 - Calculo de Coeficientes de Correlacion
2025 ' -----------------------------------------------
2030 IPC=1 : GOSUB 5974
2140 RETURN
2145 '
2150 ' EST713 - Calculo de Valores de Componentes
2155 ' ------------------------------------------
2160 PRINT
2175 FOR K=1 TO NCP
2177 PRINT
2180 PRINT "ALMACENAMIENTO DE VALORES DE COMPONENTE";K;"EN MEMORIA DE TRABAJO"
2185 IF K>1 THEN KVA=1
2190 GOSUB 390
2195 CY(K)=J
15 - 442
2200 NEXT K
2205 KS=1
2210 WHILE KS=1
2215 KX=0
2220 PRINT#3,
2225 PRINT#3,TAB(9*(NCP/2)+15);"Componentes" : PRINT#3,
2230 FOR I=1 TO NF
2235 WHILE KX=0
2240 PRINT#3," Obs.Nro.";
2245 FOR K=1 TO NCP : PRINT#3,TAB(10*K);K; : NEXT K : PRINT#3,
2250 KA=2 : KB= 9+10*NCP : GOSUB 695
2255 IL=6 : KX=1
2260 WEND
2265 IF A(I,0)=1 THEN 2355
2270 KE=0
2275 FOR L=1 TO NV
2280 X=A(I,JX(L))
2285 IF X=XVF THEN KE=1 : L=NV : GOTO 2295
2290 IF KNM=0 THEN XS(L)=X ELSE XS(L)=(X-PM(L))/DE(L)
2295 NEXT L
2300 IF KE=1 THEN 2355
2305 FOR K=1 TO NCP
2310 PMM(K)=0
2315 FOR L=1 TO NV
2320 PMM(K)=PMM(K)+TJ(L,VX(K))*XS(L)
2325 NEXT L
2330 IF CY(K)>0 THEN A(I,CY(K))=PMM(K)
2335 NEXT K
2340 PRINT#3,TAB(3);I;
2345 FOR K=1 TO NCP : PRINT#3,TAB(10*K );FNR(PMM(K),NDE+1); : NEXT K
2350 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN PRINT : INPUT "Enter",A$ :
CLS : KX=0
2355 NEXT I
2360 PRINT#3,
2365 GOSUB 650
2370 WEND
2375 RETURN
2380 '
2385 ' EST714 - Graficacion Variables segun Componentes
2390 ' ------------------------------------------------
2395 FOR I=1 TO NV
2400 TI(I,0)=TJ(I,VX(1)) : TI(I,1)=TJ(I,VX(2))
2405 NEXT I
2410 ISP=2 : JV=22 : JY(1)=1 : NPG=NV
2415 KA=1 : NG=1 : KX=1 : KB(1)=0
2420 XMN(1)=-1 : XMX(1)=1 : DEL(1)=.25
2425 XMN(2)=-1 : XMX(2)=1 : DEL(2)=.25
2430 TG$(1) = "Comp 1" : TG$(2)="Comp 2"
2435 GOSUB 6745
2440 RETURN
2450 '
2455 ' EST72 - Analisis Discriminante Lineal
2460 ' -------------------------------------
2465 '
2467 TSP$="Analisis Discriminante Lineal"
2470 GOSUB 555
2475 PRINT : PRINT "DEFINICION DE VARIABLES (1 a";PAR2;")"
2477 PRINT " Las Primeras son las Variables Independientes"
2478 PRINT " La Ultima es la Variable Dependiente"
2480 KNV=PAR2 : GOSUB 200
2485 IF NV=0 THEN RETURN
2490 IF NV<2 OR NV>PAR2 THEN KE=2 : GOSUB 900 : GOTO 2470
2495 PRINT : PRINT TAB(25);"EN PROCESO"
2500 JY=JX(NV)
2505 NVI=NV-1
2510 NG=0
2515 FOR K=1 TO PAR2 : VC(K,1)=0 : VC(K,2)=0 : NEXT K
2520 NXX=0
2525 FOR I=1 TO NF
2530 VX(I)=-1
2535 IF A(I,0)=1 THEN 2605
15 - 443
2540 ND=1 :IF JF>0 THEN ND=A(I,JF) : IF ND=XVF THEN 2605
2545 KE=0
2550 FOR K=1 TO NV
2555 X=A(I,JX(K))
2560 IF X=XVF THEN KE=1 : K=NV
2565 NEXT K
2570 IF KE=1 THEN 2605
2573 NXX=NXX+ND : VX(I)=0
2575 IF NG=0 THEN 2595
2580 FOR M=1 TO NG
2585 IF X=VC(M,1) THEN VC(M,2)=VC(M,2)+ND : GOTO 2605
2590 NEXT M
2595 NG=NG+1
2597 IF NG>PAR2 THEN PRINT CRH$(7) : PRINT : PRINT "** NRO. DE VALORES ";
"EN VARIABLE";JX(NV);"> ";PAR2;" (Parametro2)"; : INPUT "",A$ : RETURN
2598 VC(NG,1)=X : VC(NG,2)=ND
2605 NEXT I
2607 IF NG>=NXX THEN KE=3 : GOSUB 900 : RETURN
2610 KA=1
2615 WHILE KA=1
2620 KA=0
2625 FOR K=2 TO NG
2630 X=VC(K-1,1) : Y=VC(K,1)
2635 IF X>Y THEN VC(K-1,1)=Y : VC(K,1)=X : KA=1
2640 IF X>Y THEN X=VC(K-1,2) : VC(K-1,2)=VC(K,2) : VC(K,2)=X
2645 NEXT K
2650 WEND
2655 FOR M=1 TO NG
2660 FOR K=1 TO NVI
2665 TL(M,K)=0
2670 NEXT K,M
2675 FOR I=1 TO NF
2680 IF VX(I)<0 THEN 2730
2685 ND=1 : IF JF>0 THEN ND=A(I,JF)
2690 X=A(I,JY)
2695 FOR M=1 TO NG
2700 IF X=VC(M,1) THEN MX=M : VX(I)=M : M=NG
2705 NEXT M
2710 FOR K=1 TO NVI
2715 X=A(I,JX(K))
2720 TL(MX,K)=TL(MX,K)+X*ND
2725 NEXT K
2730 NEXT I
2735 FOR M=1 TO NG
2740 FOR K=1 TO NVI
2745 TL(M,K)=TL(M,K)/VC(M,2)
2750 NEXT K
2755 NEXT M
2760 FOR K=1 TO NVI
2765 FOR L=1 TO NVI
2770 TJ(K,L)=0
2775 NEXT L,K
2780 FOR I=1 TO NF
2785 IF VX(I)<0 THEN 2830
2790 ND=1 : IF JF>0 THEN ND=A(I,JF)
2795 M=VX(I)
2800 FOR K=1 TO NVI
2805 XP(K)=A(I,JX(K))
2810 FOR L=1 TO K
2815 TJ(K,L)=TJ(K,L)+(XP(K)-TL(M,K))*(XP(L)-TL(M,L))*ND
2820 NEXT L
2825 NEXT K
2830 NEXT I
2835 FOR K=1 TO NVI
2840 FOR L=1 TO K
2845 TJ(K,L)=TJ(K,L)/(NXX-NG)
2850 TJ(L,K)=TJ(K,L)
2865 NEXT L
2870 NEXT K
2872 STOP
2873 KE=0
15 - 444
2875 N=NVI : KI=1 : GOSUB 11000
2877 IF KE=1 THEN RETURN
2900 FOR M=1 TO NG
2905 FOR J=1 TO NVI
2910 PM(J)=0
2915 NEXT J
2920 FOR J=1 TO NVI
2925 FOR L=1 TO NVI
2930 PM(J)=PM(J)+TK(J,L)*TL(M,L)
2935 NEXT L
2940 NEXT J
2945 XX=0
2950 FOR J=1 TO NVI
2955 TJ(M,J)=PM(J)
2957 FOR L=1 TO NVI
2960 XX=XX+TK(J,L)*TL(M,J)*TL(M,L)
2963 NEXT L
2965 NEXT J
2970 TJ(M,NV)=-.5*XX
2975 NEXT M
2980 FOR J=1 TO NG
2985 FOR K=1 TO NG+1
2990 TI(J,K)=0
2995 NEXT K,J
3000 FOR I=1 TO NF
3005 IF VX(I)<0 THEN 3040
3010 ND=1 : IF JF>0 THEN ND=A(I,JF)
3015 Y=A(I,JX(NV))
3020 FOR K=1 TO NVI : V(K)=A(I,JX(K)) : NEXT K
3025 GOSUB 3515
3030 TI(KM,Y)=TI(KM,Y)+ND
3035 VX(I)=VC(KM,1)
3040 NEXT I
3045 FOR J=1 TO NG
3050 XX=0
3055 FOR K=1 TO NG
3060 IF K<>J THEN TI(J,NG+1)=TI(J,NG+1)+TI(J,K)
3065 XX=XX+TI(J,K)
3070 NEXT K
3075 FOR K=1 TO NG+1
3080 IF XX>0 THEN TI(J,K)=100*TI(J,K)/XX
3085 NEXT K
3090 NEXT J
3095 KS=1
3100 WHILE KS=1
3105 GOSUB 555
3110 KX=1 : GOSUB 730
3115 PRINT#3, : PRINT#3,"COEFICIENTES FUNCIONES DISCRIMINANTES" : PRINT#3,
3116 KN=0
3117 FOR M=1 TO NV STEP 5
3118 KM=KN+1 : KN=KM+4
3119 IF KN>NV THEN KN=NV
3120 PRINT#3,TAB(13*(KN-KM)+15);"Variables"
3125 PRINT#3,"Grupo";
3130 FOR K=KM TO KN
3135 S=JX(K)
3137 IF K=NV THEN S=0 : A$="Indep" ELSE A$=TC$(S)
3140 PRINT#3,TAB(13*(K-KM)+10);S;"-";A$;
3145 NEXT K : PRINT#3,
3150 KA=1 : KB=79 : GOSUB 695
3155 FOR K=1 TO NG
3160 PRINT#3,TAB(3);K;
3165 FOR L=KM TO KN
3167 PRINT#3,TAB(13*(L-KM)+10);FNR(TJ(K,L),NDE+1);
3168 NEXT L
3170 PRINT#3,
3175 NEXT K
3177 PRINT#3,
3178 NEXT M
3180 PRINT#3, : PRINT#3,
3185 PRINT#3,"MATRIZ DE PROBABILIDADES DE CLASIFICACION" : PRINT#3,
15 - 445
3190 PRINT#3,TAB(4*NG+10);"Grupo Real"
3195 PRINT#3,"Grupo"; : FOR K=1 TO NG: PRINT#3,TAB(8*K+10);K; : NEXT K
3200 PRINT#3,TAB(8*NG+17);"Probabilidad"
3205 PRINT#3,"Estimado";TAB(8*NG+17);"Clasif.Erronea"
3210 KA=1 : KB=8*NG+30 : GOSUB 695
3215 FOR K=1 TO NG
3220 PRINT#3,TAB(3);K;
3225 FOR L=1 TO NG+1 : PRINT#3,TAB(8*L+ 9);FNR(TI(K,L),2); : NEXT L
3230 PRINT#3,
3235 NEXT K
3240 GOSUB 650
3245 WEND
3250 KZ=0
3255 WHILE KZ=0
3260 GOSUB 555
3265 PRINT "PROCESOS COMPLEMENTARIOS"
3270 TF$(1)="Calculo de Grupos Estimados"
3275 TF$(2)="Prediccion de Grupos de Nuevas Observaciones"
3280 TF$(3)="Graficacion"
3285 KL=3 : GOSUB 980
3290 IF ISP=0 THEN KZ=1 : GOTO 3305
3295 IF ISP=1 AND KID=1 THEN PRINT CHR$(7) : PRINT : PRINT
"No se usaron datos de la memoria de trabajo" : GOTO 3285
3300 ON ISP GOSUB 3320,3445,5200
3305 WEND
3310 RETURN
3315 '
3320 ' EST721 - Estimacion de Grupos
3325 ' -----------------------------
3330 PRINT
3335 PRINT "ALMACENAMIENTO DE GRUPO ESTIMADO EN MEMORIA DE TRABAJO"
3340 GOSUB 390
3345 CY(1)=J
3350 KS=1
3355 WHILE KS=1
3360 KX=0
3365 PRINT#3,
3370 FOR I=1 TO NF
3375 WHILE KX=0
3380 PRINT#3,TAB(3);"Obs.Nro.","Grupo Real","Grupo Estim."
3385 KA=3 : KB=47 : GOSUB 695
3390 IL=6 : KX=1
3395 WEND
3400 IF A(I,0)=1 THEN 3420
3405 PRINT#3,TAB(3);I,A(I,JX(NV)),VX(I)
3410 IF CY(1)>0 THEN A(I,CY(1))=VX(I)
3415 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN PRINT :
INPUT "Enter ",A$ : KX=0
3420 NEXT I
3425 GOSUB 650
3430 WEND
3435 RETURN
3440 '
3445 ' EST722 - Prediccion de Grupo
3450 ' ----------------------------
3455 PRINT
3460 PRINT "Valores de las Variables" : PRINT
3465 FOR J=1 TO NVI
3470 PRINT " ";JX(J);"- ";TC$(JX(J));
3475 INPUT " = ",A$
3480 IF LEN(A$)=0 THEN RETURN
3485 V(J)=VAL(A$)
3490 NEXT J
3495 GOSUB 3515
3500 PRINT : PRINT "Grupo Estimado = ";KM : PRINT
3505 GOTO 3465
3510 '
3515 ' EST723 - Clasificacion de las observaciones
3520 ' -------------------------------------------
3525 XKX=-1E+30
3530 FOR M=1 TO NG
15 - 446
3535 XKY=0
3540 FOR K=1 TO NVI
3545 XKY=XKY+TJ(M,K)*V(K)
3550 NEXT K
3555 XKY=XKY+TJ(M,NV)
3560 IF XKY>XKX THEN XKX=XKY : KM=M
3565 NEXT M
3570 RETURN
3573 '
3575 ' EST73 - Agrupamiento Jerarquico
3580 ' -------------------------------
3585 TSP$="Agrupamiento Jerarquico"
3595 ERASE TI,TJ,TK,VC,VX,TL,TF$,TG$
3600 DIM VX(500),VY(100),VZ(100,2),VW(100),TF$(2)
3610 GOSUB 555
3615 PRINT : INPUT " Ingreso directo de Distancias ? (N) = ",A$
3620 KID=1 : IF A$="S" OR A$="s" THEN KID=2
3623 KXX=KID
3625 WHILE KID=1
3630 IF NF=0 THEN KE=1 : GOSUB 900 : RETURN
3635 KNV=NC : KDA=1 : GOSUB 200
3640 IF NV<1 THEN KE=1 : GOSUB 900 : RETURN
3645 KE=0
3650 FOR K=1 TO NV
3655 X=A(I,JX(K))
3660 IF X=XVF THEN KE=1 : K=NV
3665 NEXT K
3670 IF KE=1 THEN 3785
3675 KNM=0
3680 PRINT : INPUT " Normalizacion de Observaciones ? (N) = ",A$
3683 PRINT : PRINT TAB(25);"EN PROCESO"
3685 IF A$<>"A" AND A$<>"s" THEN 3720
3690 KNM=1
3695 FOR K=1 TO NV
3700 J=JX(K)
3705 GOSUB 5480
3710 PM(J)=PX : DE(J)=DEX
3715 NEXT K
3720 NY=0
3725 FOR I=1 TO NXX-1
3730 FOR J=I+1 TO NXX
3735 X=0
3740 FOR K=1 TO NV
3745 JZ=JX(K)
3750 IF KNM=0 THEN Y=A(I,JZ) ELSE Y=(A(I,JZ)-PM(JZ))/DE(JZ)
3755 IF KNM=0 THEN Z=A(J,JZ) ELSE Z=(A(J,JZ)-PM(JZ))/DE(JZ)
3760 X=X+(Y-Z)*(Y-Z)
3765 NEXT K
3770 NY=NY+1
3775 VX(NY)=SQR(X)
3780 NEXT J
3785 NEXT I
3790 KID=0
3795 WEND
3800 WHILE KID=2
3802 PRINT : INPUT "Distancias en Memoria de Trabajo ? (N) = ",A$
3803 IF A$<>"S" OR A$<>"s" THEN 3824
3804 PRINT : INPUT "Variable con Observ. A = ",A$
3805 IF LEN(A$)=0 THEN RETURN
3806 JA=VAL(A$)
3807 IF JA<1 OR JA>NC THEN KE=4 : GOSUB 900 : GOTO 3804
3808 PRINT : INPUT "Variable con Observ. B = ",A$
3809 IF LEN(A$)=0 THEN RETURN
3810 JB=VAL(A$)
3811 IF JB<1 OR JB>NC THEN KE=4 : GOSUB 900 : GOTO 3808
3812 PRINT : INPUT "Variable con Distancia AB = ",A$
3813 IF LEN(A$)=0 THEN RETURN
3814 JD=VAL(A$)
3815 IF JD<1 OR JD>NC THEN KE=4 : GOSUB 900 : GOTO 3812
3817 NY=0
3818 FOR I=1 TO NF
15 - 447
3819 IF A(I,0)=1 THEN 3823
3820 IF A(I,JA)=XVF OR A(I,JB)=XVF OR A(I,JD)=XVF THEN 3823
3821 NY=NY+1
3822 VX(NY)=A(I,JD)
3823 NEXT I : GOTO 3885
3824 PRINT : INPUT " Nro. de Observaciones a agrupar = ",A$
3825 IF LEN(A$)=0 THEN RETURN
3826 NXX=VAL(A$)
3827 IF NXX<3 OR NXX>20 THEN KE=5 : B$=">=3 y <=20" : GOSUB 900 :
GOTO 3824
3828 NY=0
3830 FOR I=1 TO NXX-1
3835 PRINT : PRINT "Observacion Nro.";I
3840 FOR J=I+1 TO NXX
3845 PRINT " Distancia a Observ. Nro.";J; : INPUT " = ",A$
3850 IF LEN(A$)=0 THEN RETURN
3855 X=VAL(A$)
3860 IF X<0 THEN KE=5 : B$=">=0" : GOSUB 900 : PRINT : GOTO 3845
3865 NY=NY+1
3870 VX(NY)=X
3875 NEXT J
3880 NEXT I
3885 KID=0
3890 WEND
3893 KID=KXX
3895 NVX=NY
3932 KZ=0
3933 WHILE KZ=0
3935 FOR I=1 TO NXX
3940 VY(I)=I
3945 NEXT I
3970 PRINT : PRINT "CRITERIO DE CALCULO DE DISTANCIA"
3975 TF$(1)="Distancia Minima"
3980 TF$(2)="Distancia Maxima"
3985 KL=2 : GOSUB 980
3990 IF ISP=0 THEN KZ=1 : GOTO 4315
3991 PRINT : INPUT "Numero de Grupos a obtener (1) = ",A$
3992 IF LEN(A$)=0 THEN NGM=1 ELSE NGM=VAL(A$)
3993 IF NGM<1 OR NGM>NXX-1 THEN KE=5 : B$=">=1 y <="+STR$(NXX-1) :
GOSUB 900 : GOTO 3991
3995 PRINT : PRINT : PRINT TAB(25);"EN PROCESO"
4000 KDIS=ISP
4005 NG=NXX
4010 NGT=0
4015 WHILE NG>NGM
4020 XX=1E+10
4025 FOR I=1 TO NXX-1
4030 IF VY(I)=0 THEN 4065
4035 KX=(2*NXX-I)*(I-1)/2
4040 FOR J=I+1 TO NXX
4045 IF VY(J)=0 THEN 4060
4050 NY=KX+J-I
4055 IF VX(NY)<XX THEN XX=VX(NY) : II=I : JJ=J
4060 NEXT J
4065 NEXT I
4070 NG=NG-1
4075 NGT=NGT+1
4080 VZ(NGT,1)=VY(II)
4085 VZ(NGT,2)=VY(JJ)
4090 VW(NGT)=XX
4095 K=II : L=JJ
4100 FOR M=1 TO NXX
4105 IF VY(M)=0 THEN 4175
4110 IF M=K OR M=L THEN 4175
4115 IF M<K THEN IA=M : JA=K : IB=M : JB=K : IC=M : JC=L
4120 IF M>K AND M<L THEN IA=K : JA=M : IB=K : JB=M : IC=M : JC=L
4125 IF M>L THEN IA=K : JA=M : IB=K : JB=M : IC=L : JC=M
4130 KX=(2*NXX-IB)*(IB-1)/2
4135 XB=VX(KX+JB-IB)
4140 KX=(2*NXX-IC)*(IC-1)/2
4145 XC=VX(KX+JC-IC)
15 - 448
4150 XA=XB
4155 IF KDIS=1 AND XB>XC THEN XA=XC
4160 IF KDIS=2 AND XB<XC THEN XA=XC
4165 KX=(2*NXX-IA)*(IA-1)/2
4170 VX(KX+JA-IA)=XA
4175 NEXT M
4180 VY(II)=-NGT
4185 VY(JJ)=0
4190 WEND
4195 KS=1
4200 WHILE KS=1
4205 GOSUB 555
4210 KX=1 : GOSUB 730
4215 KX=0 : IF KNM=1 THEN PRINT#3," (Normalizadas)" : PRINT#3,
4220 PRINT#3,
4225 FOR I=1 TO NGT
4230 WHILE KX=0
4235 PRINT#3,TAB(3);"Grupo Formado por Distancia"
4240 PRINT#3,TAB(3);" Observaciones Grupos de Agrupamiento"
4245 KA=3 : KB=60 : GOSUB 695
4250 IL=6 : KX=1
4255 WEND
4260 KA=VZ(I,1) : KB=VZ(I,2)
4265 IF KA>0 AND KB>0 THEN LA=13 : LB=17
4270 IF KA>0 AND KB<0 THEN KB=-KB : LA=13 : LB=17
4275 IF KA<0 AND KB>0 THEN X=KB : KB=-KA : KA=X : LA=13 : LB=27
4280 IF KA<0 AND KB<0 THEN KA=-KA : KB=-KB : LA=27 : LB=31
4285 PRINT#3,TAB(3);I;TAB(LA);KA;TAB(LB);KB;TAB(40);FNR(VW(I),NDE-1)
4290 IL=IL+1 : IF IL=22 AND DS$="SCRN:" THEN PRINT : INPUT "Enter",A$ :
CLS : KX=0
4295 NEXT I
4300 KA=3 : KB=60 : GOSUB 695
4305 GOSUB 650
4310 WEND
4315 WEND
4400 KZ=0
4405 WHILE KZ=0
4410 GOSUB 555
4415 PRINT "PROCESOS COMPLEMENTARIOS"
4420 TF$(1)="Determinacion de Grupo de cada Observacion"
4425 TF$(2)="Creacion de Archivo con Distancias"
4435 KL=2 : GOSUB 980
4440 IF ISP=0 THEN KZ=1 : GOTO 4405
4445 IF ISP=1 AND KID=2 THEN PRINT CHR$(7) : PRINT : PRINT
"No se usaron datos de la memoria de trabajo" : GOTO 4435
4450 ON ISP GOSUB 4480,4755
4455 WEND
4458 ERASE VX,VY,VZ,VW,TF$
4459 KZZ=0
4460 RETURN
4475 '
4480 ' EST731 - Determinacion de grupo de Cada Observacion
4485 ' ---------------------------------------------------
4490 PRINT
4495 PRINT "ALMACENAMIENTO DE GRUPO EN MEMORIA DE TRABAJO"
4500 GOSUB 390
4505 CY(1)=J
4507 PRINT : PRINT TAB(25);"EN PROCESO"
4510 FOR I=1 TO NF
4515 VY(I)=0
4520 NEXT I
4525 FOR M=1 TO NGT
4530 FOR L=1 TO 2
4535 KA=VZ(M,L)
4540 IF KA>0 THEN VY(KA)=M : GOTO 4565
4545 KA=-KA
4550 FOR I=1 TO NF
4555 IF VY(I)=KA THEN VY(I)=M
4560 NEXT I
4565 NEXT L
4570 NEXT M
15 - 449
4580 L=0
4600 KS=1
4605 WHILE KS=1
4610 KX=0
4615 PRINT#3,
4620 FOR I=1 TO NF
4625 WHILE KX=0
4630 PRINT#3,TAB(3);"Obs.Nro.","Grupo"
4635 KA=3 : KB=30 : GOSUB 695
4640 IL=6 : KX=1
4645 WEND
4647 KE=0
4648 IF A(I,0)=1 THEN KE=1 : GOTO 4654
4649 FOR K=1 TO NV
4650 X=A(I,JX(K))
4651 IF X=XVF THEN KE=1 : K=NV
4652 NEXT K
4654 IF KE=1 THEN NGX=XVF : GOTO 4700
4670 KA=0
4675 IF L=0 THEN 4695
4677 NK=VY(I)
4678 IF NK=0 THEN L=L+1 : NGX=L : GOTO 4700
4680 FOR M=1 TO L
4685 IF NK=VW(M) THEN NGX=M : KA=1 : M=L
4690 NEXT M
4695 IF KA=0 THEN L=L+1 : VW(L)=NK : NGX=L
4700 PRINT#3,TAB(3);I,NGX
4705 IF CY(1)>0 THEN A(I,CY(1))=NGX
4707 IL=IL+1
4708 IF IL=22 AND DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$ : KX=0
4710 NEXT I
4715 GOSUB 650
4720 WEND
4725 RETURN
4750 '
4755 ' EST732 - Creacion de Archivo con Distancias
4760 ' -------------------------------------------
4765 GOSUB 555
4770 XA$=".EST"
4775 KAR=0 : PRINT : PRINT "Archivos en Disco ";DDA$
4780 PRINT : FILES DDA$+":*"+XA$
4785 IF KAR=1 THEN PRINT " No Existen" : KAR=0
4790 PRINT: INPUT "Nombre del Archivo a Grabar (.EST) = ",A$
4795 IF LEN(A$)=0 THEN RETURN
4800 KE=0
4805 GOSUB 950
4810 XNA$=A$
4815 IF KAR=0 THEN PRINT : INPUT "Archivo Existente - Se Reemplaza ? (N) = ",A$
4820 IF KAR=0 AND (A$<>"S" AND A$<>"s") THEN 4790
4825 IF KE=1 THEN 4790
4830 OPEN XDDA$+XNA$+EXT$ FOR OUTPUT AS #1
4840 PRINT#1,"Matriz de Distancias"
4845 PRINT#1,NY,3
4850 PRINT#1,"Obs1" : PRINT#1,"Obs2" : PRINT#1,"Distancia"
4870 NY=0
4875 FOR I=1 TO NXX-1
4880 FOR J=I+1 TO NXX
4885 NY=NY+1
4890 PRINT#1,I;J;VX(NY)
4895 NEXT J,I
4930 CLOSE#1
4935 PRINT : INPUT "Grabacion Terminada - Enter ",A$
4940 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
15 - 450
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
15 - 451
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)
5962 PM(K)=PM(K)/NXX
5964 DE(K)=SQR((TI(K,K)-NXX*PM(K)^2)/(NXX-1))
5966 FOR L=1 TO K
5968 TI(K,L)=(TI(K,L)-NXX*PM(K)*PM(L))/(NXX-1)
5970 TI(L,K)=TI(K,L)
5971 NEXT L,K
5972 RETURN
5973 '
5974 ' EST214 - Salida Covar. y Coef.Correlac.
5975 ' ---------------------------------------
5977 KS=1
5978 WHILE KS=1
5979 PRINT#3, : PRINT#3, : PRINT#3,C$
5980 PRINT#3, : KN=0
5981 FOR M=1 TO NV STEP 6
5982 KM=KN+1 : KN=KM+5
5983 IF KN>NV THEN KN=NV
5984 PRINT#3,"Variable";
5985 FOR K=KM TO KN : PRINT#3,TAB(9*(K-KM)+19);TC$(JX(K)); : NEXT K
5986 PRINT#3, : PRINT#3,
5987 FOR K=1 TO KN
5988 PRINT#3,TAB(3);JX(K);TAB(7);"-";TC$(JX(K));
5989 FOR L=KM TO KN
5990 CA=1 : IF IPC>1 THEN CA=DE(K)*DE(L)
5991 IF CA>0 THEN X=TL(L,K)/CA : ELSE X=0
5992 IF IPC<3 THEN 5999
5993 IF X>.9999 THEN X=0 : GOTO 5999
5994 X=ABS(X*SQR((NXX-2)/(1-X*X)))
5995 P(1)=NXX-2 : KXX=K
5996 IP=1 : GOSUB 8800
5997 X=200*(1-FP)
5998 K=KXX
5999 IF IPC<3 THEN PRINT#3,TAB(9*(L-KM)+19);FNR(X,NDE);
6000 IF IPC=3 THEN PRINT#3,TAB(9*(L-KM)+19);FNR(X,NDE-1);
6001 NEXT L
6002 PRINT#3,
6003 NEXT K
6004 IF M<NV AND DS$="SCRN:" THEN PRINT : INPUT "Enter ",A$
6005 NEXT M
6006 GOSUB 650
6007 WEND
6008 RETURN
15 - 452
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
15 - 453
7095 NXX=NXX+1
7100 LOCATE 23,1
7105 NEXT I
7110 LOCATE 24 : INPUT "Enter ",A$
7115 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 '
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
15 - 454
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
15 - 455
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
NEXT
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
NEXT
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
15 - 456
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
15 - 457
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$;
15 - 458
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
15 - 459
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
1842
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
15 - 460
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,
15 - 461
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
15 - 462
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)="S''t" : 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
15 - 463
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
15 - 464
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"
15 - 465
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"
15 - 466
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
15 - 467
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
15 - 468
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
15 - 469
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 "."
15 - 470
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)
15 - 471
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)
15 - 472
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))))
15 - 473
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 '
| 