Ir al contenido

Estadística en Microcomputadores/Archivos BASIC/ESTAD1

De Wikilibros, la colección de libros de texto de contenido libre.

10 ' ESTAD1 - Revision 19/4/89

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

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$=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$=""

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 " =

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"

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$

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"

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$

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$

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

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

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

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

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

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

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$=""

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

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 '

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

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

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

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