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 '