Ir al contenido

Estadística en Microcomputadores/Archivos BASIC/ESTAD7

Añadir enlaces
De Wikilibros, la colección de libros de texto de contenido libre.

10 ' ESTAD7 - Revision 8-12-88

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

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

930 IF KE=5 THEN PRINT "** VALOR ERRONEO - Debe ser ";B$ : INPUT " ",A$ :

KE=0 : RETURN

931 IF KE=6 THEN INPUT "** CAPACIDAD INSUFICIENTE DE MEMORIA DE TRABAJO",A$ :

KE=0 : RETURN

934 INPUT "Valor Erroneo ",A$

935 RETURN

936 IF ERR<>53 THEN PRINT CHR$(7) : PRINT

937 IF ERR<>53 THEN KE=KE+1 : IF KE>1 THEN RESUME 948

938 IF ERR=25 OR ERR=57 OR ERR=68 OR ERR=70 OR ERR=71 THEN PRINT "** DISPOSITIVO ";XDDA$;

" NO DISPONIBLE O ERROR E/S"; : INPUT " ",A$ : RESUME NEXT

939 IF ERR=61 THEN PRINT "** DISCO ";XDDA$;" LLENO" : INPUT " ",A$ : RESUME

940 IF ERR=53 THEN KAR=1 : RESUME NEXT

941 IF ERR=62 THEN PRINT "** FIN DE GRABACION O LECTURA EN DISP. ";XDDA$; : INPUT "

",A$ : RESUME NEXT

942 IF ERR=2 OR ERR=22 THEN PRINT "** ERROR DE SINTAXIS EN FUNCION "; : INPUT "O

CONDICION",A$ : RESUME NEXT

943 IF ERR=24 OR ERR=27 THEN INPUT "** PROBLEMA EN IMPRESORA",A$ : RESUME NEXT

944 IF ERR=64 OR ERR=75 OR ERR=76 THEN INPUT "** NOMBRE INCORRECTO ARCHIVO",A$ : RESUME

947 PRINT "Error";ERR;"en linea";ERL :STOP

948 CHAIN"ESTAD"

950 ' EST98 - Descripcion Archivo

952 ' ---------------------------

954 LD=0

956 IF MID$(A$,2,1)<>":" THEN XDDA$=DDA$+":" : GOTO 964

958 B$=LEFT$(A$,1)

960 'IF INSTR("ABCabc",B$)=0 THEN GOSUB 900 : RETURN

962 XDDA$="" : LD=2

964 B$=RIGHT$(A$,4)

966 IF LEFT$(B$,1)<>"." THEN EXT$=XA$ ELSE EXT$="" : LD=LD+4

968 'IF LEN(A$)-LD>8 THEN GOSUB 900

970 KAR=0 : KE=0

972 OPEN XDDA$+A$+EXT$ FOR INPUT AS#1

974 CLOSE#1

978 RETURN

980 ' EST9. - Presentacion Menu

982 ' -------------------------

983 PRINT : ISP=0 : A$=""

984 FOR K=1 TO KL

986 PRINT " ";K;"- ";TF$(K)

988 NEXT K

990 PRINT : PRINT "Opcion Elegida = ";

991 B$=INKEY$ : PRINT B$;

992 IF B$=CHR$(13) THEN 996

993 IF B$=CHR$(27) THEN A$="" : GOTO 996

994 A$=A$+B$ : GOTO 991

996 IF LEN(A$)=0 THEN RETURN

997 ISP=INT(VAL(A$))

998 IF ISP<1 OR ISP>KL THEN PRINT CHR$(7) : GOTO 983

999 RETURN

1000 ' 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

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)

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"

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

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

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

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,

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

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

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)

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

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

5240 IF ISP=0 THEN RETURN

5245 KM=3 : IF ISP=2 THEN KM=1

5250 GOSUB 500

5255 PRINT

5260 FOR Y=1 TO 2

5265 IF Y>1 THEN 5305

5270 INPUT "Variable Independiente = ",A$

5275 IF LEN(A$)=0 THEN RETURN

5280 IF (A$="I" OR A$="i") THEN TG$(0)="Nro.Obs" : XMN(1)=0

XMX(1)=INT(NF/5+1)*5:DEL(1)=XMX(1)/5:GOTO 5460

5285 KX=VAL(A$)

5290 J=KX : GOSUB 5480

5295 XC=XMI : XD=XMA

5300 TG$(0)=TC$(KX) : GOTO 5380

5305 XC=1E+10 : XD=-1E+10

5310 PRINT

5315 FOR Z=1 TO KM

5320 PRINT "Variable Dependiente";Z;

5325 INPUT " = ",A$

5330 IF LEN(A$)=0 THEN NG=Z-1 : Z=KM : GOTO 5365

5335 NG=Z

5340 JY(Z)=VAL(A$)

5345 J=JY(Z) : GOSUB 5480

5350 IF XMI<XC THEN XC=XMI

5355 IF XMA>XD THEN XD=XMA

5360 TG$(Z)=TC$(JY(Z))

5365 NEXT Z

5370 IF NG=0 THEN RETURN

5375 PRINT

5380 PRINT "(Valores Maximo y Minimo de los Datos = ";XC;"-";XD;")"

5385 INPUT " Valor Minimo = ",A$

5390 IF LEN(A$)=0 THEN RETURN

5395 XMN(Y)=VAL(A$)

5400 INPUT " Valor Maximo = ",A$

5405 IF LEN(A$)=0 THEN RETURN

5410 XMX(Y)=VAL(A$)

5415 INPUT " Intervalo = ",A$

5420 IF LEN(A$)=0 THEN RETURN

5425 DEL(Y)=VAL(A$)

5430 IF ISP=1 THEN GOTO 5460

5435 IF Y=1 THEN 5460

5440 PRINT : INPUT "Variable con Valores codificados (No) = ",A$

5445 IF LEN(A$)=0 THEN ISP=1 : GOTO 5460

5450 IF A$="I" OR A$="i" THEN JV=0 : GOTO 5460

5455 JV=VAL(A$)

5460 NEXT Y

5463 NPG=NF

5465 KA=0

5470 IF NG>0 THEN GOSUB 6745

5475 WEND

5477 '

5480 ' EST211 - Calculo de Valor medio, Desv.Std.,Max.,Min.

5485 ' ----------------------------------------------------

5490 SX=0 : SCX=0 : NXX=0

5495 XMI=1E+10 : XMA=-1E+10

5500 FOR I=1 TO NF

5505 IF A(I,0)=1 THEN 5550

5510 X= A(I,J)

5515 IF X=XVF THEN 5550

5520 IF X<XMI THEN XMI=X

5525 IF X>XMA THEN XMA=X

5530 ND=1 : IF JF>0 THEN ND=A(I,JF)

5535 IF ND=XVF THEN 5550

5540 SX=SX+ND*X : SCX=SCX+ND*X^2

5545 NXX=NXX+ND

5550 NEXT I

5555 IF NXX<2 THEN RETURN

5560 PX=SX/NXX

5565 DEM=SQR((SCX-NXX*PX^2)/NXX)

5570 DEX=SQR((SCX-NXX*PX^2)/(NXX-1))

5575 RETURN

5580 '

5825 ' EST214 - Calculo de Matriz de Covariancias

5830 ' ------------------------------------------

5835 FOR K=1 TO NV

5840 PM(K)=0

5845 FOR L=1 TO K : TI(K,L)=0 :NEXT L

5850 NEXT K

5855 NXX=0

5860 FOR I=1 TO NF

5865 IF A(I,0)=1 THEN 5945

5870 ND=1 : IF JF>0 THEN ND=A(I,JF)

5875 IF ND=XVF THEN 5945

5880 KE=0

5885 FOR K=1 TO NV

5890 XP(K)=A(I,JX(K))

5895 IF XP(K)=XVF THEN KE=1 : K=NV

5900 NEXT K

5905 IF KE=1 THEN 5945

5910 FOR K=1 TO NV

5915 PM(K)=PM(K)+XP(K)*ND

5920 FOR L=1 TO K

5925 TI(K,L)=TI(K,L)+XP(K)*XP(L)*ND

5930 NEXT L

5935 NEXT K

5940 NXX=NXX+ND

5945 NEXT I

5950 IF NXX<2 THEN RETURN

5955 FOR K=1 TO NV

5960 VX(K)=PM(K)

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

6743 '

6745 ' EST241 - Proceso de Graficacion

6750 ' -------------------------------

6755 DEF FNC(X)=60*(X-XMN(1))/(XMX(1)-XMN(1))

6760 DEF FNF(X)=20*(X-XMN(2))/(XMX(2)-XMN(2))

6765 CLS

6770 X=21-FNF(0) : KC=0

6775 IF X>0 AND X<21 THEN KC=1

6780 FOR I=1 TO 60

6785 IF KC=1 THEN LOCATE X,I+20 : PRINT "."

6790 LOCATE 1,I+20 : PRINT "-"

6795 LOCATE 21,I+20 : PRINT "-"

6800 NEXT I

6805 FOR X=XMN(1) TO XMX(1) STEP DEL(1)

6810 XC=FNC(X)

6815 LOCATE 1,XC+20 : PRINT "+"

6820 LOCATE 21,XC+20 : PRINT "+"

6825 IF X<XMX(1) THEN LOCATE 22,XC+18 : PRINT FNR(X,2)

6830 NEXT X

6835 LOCATE 23,70 : PRINT TG$(0)

6840 X=FNC(0)+20 : KC=0

6845 IF X>20 AND X<80 THEN KC=1

6850 FOR I=1 TO 20

6855 IF KC=1 THEN LOCATE I,X : PRINT "."

6860 LOCATE I,20 : PRINT CHR$(124)

6865 LOCATE I,80 : PRINT CHR$(124)

6870 NEXT I

6875 FOR X=XMN(2) TO XMX(2) STEP DEL(2)

6880 XF=21-FNF(X)

6885 LOCATE XF,20 : PRINT "+"

6890 LOCATE XF,80 : PRINT "+"

6895 LOCATE XF,13 : PRINT FNR(X,2)

6900 NEXT X

6905 TF$(1)="*" : TF$(2)=CHR$( 22) : TF$(3)="x"

6910 IF ISP=2 THEN C$="ABCDEFGHIJKLMNOPQRTSUVWXYZ"

6915 FOR J=1 TO NG

6920 LOCATE 3+3*J,1 : IF ISP=1 THEN PRINT TF$(J)

6925 PRINT TG$(J)

6930 NEXT J

6935 IF ISP=2 THEN PRINT : PRINT : PRINT "Var.Codif=" : PRINT JV;" - ";TC$(JV)

6940 NXX=0

6945 FOR I=1 TO NPG

6950 IF KA=0 THEN IF A(I,0)=1 THEN 7105

6955 IF KX=0 THEN X=I : GOTO 6975

6960 IF KA=0 THEN X=A(I,KX)

6965 IF KA=0 AND X=XVF THEN 7105

6970 IF KA=1 THEN X=TI(I,0)

6975 XC=FNC(X)+20

6980 IF XC<20 OR XC>80 THEN 7100

6985 FOR J=1 TO NG

6990 IF KA=0 THEN Y=A(I,JY(J))

6995 IF KA=0 AND Y=XVF THEN 7105

7000 IF KA=1 THEN Y=TI(I,JY(J))

7005 YF=21-FNF(Y)

7010 IF YF<1 OR YF>21 THEN 7090

7015 FOR XF=YF TO 21

7020 LOCATE XF,XC

7025 A$=TF$(J)

7030 IF ISP=1 THEN 7075

7035 IF JV>0 THEN X=A(I,JV)

7040 IF JV>0 AND X=XVF THEN XF=21 : GOTO 7085

7045 IF JV>0 THEN X=INT(X)

7050 IF JV=0 THEN X=I

7055 IF X<0 THEN A$="-"

7060 IF X>=0 AND X<10 THEN A$=STR$(X)

7065 IF X>=10 AND X<35 THEN A$=MID$(C$,X-9,1)

7070 IF X>35 THEN A$="+"

7075 PRINT A$

7080 IF KB(J)=0 THEN XF=21

7085 NEXT XF

7090 NEXT J

7095 NXX=NXX+1

7100 LOCATE 23,1

7105 NEXT I

7110 LOCATE 24 : INPUT "Enter ",A$

7115 RETURN

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 '

Obtenido de «https://es.wikibooks.org/w/index.php?title=Estadística_en_Microcomputadores/Archivos_BASIC/ESTAD7&oldid=143004»