Estadística en Microcomputadores/Archivos BASIC/ESTAD5

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

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

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 ' 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;")"

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

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

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

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

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

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

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

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

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

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 '

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 '