home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib20a.dsk / JULY.1984 / PPMC.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  196 lines
  1. 10  REM  **********************
  2. 20  REM  *        PPMC        *
  3. 30  REM  * BY STEVEN SCHWARTZ *
  4. 40  REM  * COPYRIGHT (C) 1984 *
  5. 50  REM  * BY MICROSPARC, INC *
  6. 60  REM  * LINCOLN, MA. 01773 *
  7. 70  REM  **********************
  8. 80  ONERR  GOTO 1850
  9. 90  HOME 
  10. 100  GOSUB 1160: CLEAR 
  11. 110 D$ =  CHR$(4):D1 = 10000:D2 = .5
  12. 120  DIM MEAN(20),X(250,20),NAME$(20)
  13. 130  HOME : INVERSE : PRINT "ENTER DATA FROM DISK (Y/N)?";: GET A$: PRINT : PRINT A$: IF A$ < >"Y"  AND A$ < >"N"  THEN 130
  14. 140  NORMAL 
  15. 150  IF A$ = "Y"  THEN 1270
  16. 160  HOME 
  17. 170  VTAB 1: HTAB 1: CALL  -958: INVERSE : PRINT "NUMBER OF VARIABLES";: NORMAL : INPUT ": ";NVAR: PRINT 
  18. 180  IF NVAR >20  THEN  PRINT  CHR$(7); CHR$(7);"*** MAXIMUM OF 20 VARS. EXCEEDED ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 170
  19. 190  IF NVAR <2  THEN  PRINT  CHR$(7); CHR$(7);"*** MINIMUM OF 2 VARS. REQUIRED ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 170
  20. 200  VTAB 3: HTAB 1: CALL  -958: INVERSE : PRINT "NUMBER OF SUBJECTS";: NORMAL : INPUT ": ";N: PRINT 
  21. 210  IF N >250  THEN  PRINT  CHR$(7); CHR$(7);"*** MAXIMUM OF 250 CASES EXCEEDED ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 200
  22. 220  IF N <3  THEN  PRINT "*** MIN. OF 3 SUBJECTS REQUIRED ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 200
  23. 230  HOME : PRINT "PLEASE NAME EACH VARIABLE OR PRESS      <RETURN> FOR DEFAULT--VAR1, VAR2, ETC.": PRINT : FOR I = 1 TO NVAR
  24. 240  VTAB 5: HTAB 1: CALL  -958: INVERSE : PRINT "VARIABLE #";I;: NORMAL : INPUT " ";NAME$(I)
  25. 250  IF  LEN(NAME$(I)) >6  THEN  PRINT  CHR$(7); CHR$(7);"*** MAXIMUM LENGTH = 6 CHARS. ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 240
  26. 260  IF NAME$(I) = ""  THEN NAME$(I) = "VAR" + STR$(I)
  27. 270  NEXT I
  28. 280  VTAB 8: HTAB 1: CALL  -958: INVERSE : PRINT "ENTER TITLE FOR OUTPUT:": NORMAL : PRINT : INPUT "";TI$: IF  LEN(TI$) >40  THEN  PRINT  CHR$(7); CHR$(7);"*** MAX. LENGTH = 40 CHARS. ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 280
  29. 290  HOME : HTAB 16: INVERSE : PRINT "DATA INPUT": NORMAL 
  30. 300  FOR I = N1 +1 TO N
  31. 310  FOR J = 1 TO NVAR
  32. 320  VTAB 5: HTAB 1: CALL  -958: PRINT  TAB( 8)"CASE #";I;"  VARIABLE #";J;: INPUT ": ";X(I,J)
  33. 330  NEXT J: NEXT I
  34. 340  VTAB 11: HTAB 6: CALL  -958
  35. 350  INVERSE : PRINT "EDIT/REVIEW THE DATA(Y/N)? ";: PRINT "";: NORMAL : GET A$: PRINT A$: IF A$ < >"N"  AND A$ < >"Y"  THEN 340
  36. 360  IF A$ = "Y"  THEN 790
  37. 370  VTAB 23: HTAB 1: CALL  -958: PRINT : INVERSE : PRINT  CHR$(7); CHR$(7);"  TURN ON PRINTER AND PRESS <RETURN>  ";: NORMAL : GET A$
  38. 380  IF A$ < > CHR$(13)  THEN 370
  39. 390  HOME 
  40. 400  PRINT : PRINT D$;"PR#1"
  41. 410  PRINT  TAB(  INT((40 - LEN(TI$))/2) +1)TI$: PRINT : PRINT 
  42. 420  REM  SUMMARY STATISTICS CALCULATIONS
  43. 430  PRINT "  VARIABLE     MEAN         STD. DEV."
  44. 440  PRINT 
  45. 450  FOR L = 1 TO NVAR:SUM = 0
  46. 460  FOR LL = 1 TO N
  47. 470 SUM = SUM +X(LL,L)
  48. 480  NEXT LL
  49. 490 MEAN(L) = SUM/N
  50. 500 S1 = 0
  51. 510  FOR LL = 1 TO N
  52. 520 S1 = S1 +(X(LL,L) -MEAN(L)) ^2
  53. 530  NEXT LL
  54. 540 S1 =  SQR(S1/(N -1))
  55. 550  PRINT  TAB( 3)NAME$(L); TAB( 16) INT(MEAN(L) *D1 +D2)/D1; TAB( 29) INT(S1 *D1 +D2)/D1
  56. 560  NEXT L
  57. 570  PRINT : PRINT  TAB( 3)"NUMBER OF CASES = ";N
  58. 580  PRINT : PRINT : PRINT  TAB( 3)"CORRELATION COEFFICIENTS": PRINT  TAB( 3)"----------- ------------": PRINT 
  59. 590  REM  CALCULATE R VALUES
  60. 600  FOR J = 1 TO NVAR
  61. 610  FOR K = 2 TO NVAR:XSUM = 0:YSUM = 0:XY = 0:X2 = 0:Y2 = 0
  62. 620  FOR I = 1 TO N
  63. 630  IF K < = J  THEN I = N: GOTO 720
  64. 640 XSUM = X(I,J) +XSUM:YSUM = X(I,K) +YSUM:XY = X(I,J) *X(I,K) +XY:X2 = X(I,J) ^2 +X2:Y2 = X(I,K) ^2 +Y2
  65. 650  NEXT I
  66. 660 R = (N *XY -(XSUM *YSUM))/( SQR((N *X2 -XSUM ^2) *(N *Y2 -YSUM ^2)))
  67. 670 R =  INT(R *D1 +D2)/D1
  68. 680  PRINT  TAB( 3)NAME$(J); TAB( 11)"WITH  ";NAME$(K); TAB( 25)"=";
  69. 690  IF  SGN(R) =  -1  THEN  PRINT  TAB( 27)R: GOTO 720
  70. 700  IF  SGN(R) = 0  THEN  PRINT  TAB( 28)".0000": GOTO 720
  71. 710  PRINT  TAB( 28)R
  72. 720  NEXT K: PRINT : NEXT J
  73. 730  PRINT : PRINT D$;"PR#0"
  74. 740  HOME : INVERSE : PRINT "SAVE DATA TO DISK (Y/N)";: NORMAL : GET A$: PRINT : IF A$ < >"Y"  AND A$ < >"N"  THEN 740
  75. 750  IF A$ = "N"  THEN  HOME : PRINT "END OF RUN": END 
  76. 760  PRINT : INVERSE : PRINT "FILE NAME";: NORMAL : INPUT " ";F$: GOTO 1510
  77. 770  HOME : PRINT  CHR$(7); CHR$(7);"END OF RUN"
  78. 780  END 
  79. 790  REM  EDIT/REVIEW DATA
  80. 800  VTAB 14: HTAB 6: CALL  -958: INVERSE : PRINT " (A)LL OR (S)ELECTED CASES? ";: NORMAL : GET A$: PRINT : PRINT A$: IF A$ < >"A"  AND A$ < >"S"  THEN 800
  81. 810  IF A$ = "S"  THEN 990
  82. 820  REM  REVIEW ALL CASES
  83. 830  FOR I = 1 TO N: HOME 
  84. 840  INVERSE : PRINT " CASE #";I;" ": NORMAL : PRINT : PRINT 
  85. 850  FOR J = 1 TO NVAR
  86. 860  PRINT NAME$(J); TAB( 8)"= ";X(I,J);
  87. 870  IF NVAR > = J +13  THEN  PRINT  TAB( 21)NAME$(J +13); TAB( 28)"= ";X(I,J +13): GOTO 890
  88. 880  PRINT 
  89. 890  IF J <13  THEN  NEXT J
  90. 900 J = NVAR
  91. 910  VTAB 24: HTAB 1: CALL  -958: INVERSE : PRINT "  <ESC> TO EDIT; <RETURN> TO CONTINUE  ";: PRINT "";: GET A$: PRINT : NORMAL : IF A$ < > CHR$(13)  AND A$ < > CHR$(27)  THEN 910
  92. 920  IF A$ =  CHR$(13)  THEN  NEXT I
  93. 930  IF I >N  THEN 370
  94. 940  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT "CHANGE DATA FOR VARIBLE # (1-";NVAR;")? ";: NORMAL : INPUT "";V
  95. 950  IF V <1  OR V >NVAR  THEN 940
  96. 960  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT "PRESENT VALUE FOR CASE ";I;" ";NAME$(V);" = ";X(I,V): PRINT "CHANGE TO? ";: NORMAL : INPUT "";X(I,V)
  97. 970 I = I -1: NEXT I
  98. 980  GOTO 370
  99. 990  REM  SELECTED CASES
  100. 1000  HOME : INVERSE : PRINT "CASE # TO REVIEW (OR 0 TO END)?";: NORMAL : INPUT " ";CASE
  101. 1010  IF CASE = 0  THEN 370
  102. 1020  IF CASE <1  OR CASE >N  THEN  PRINT : PRINT  CHR$(7); CHR$(7);"*** CASE MUST BE BETWEEN 1 AND ";N;" ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 1000
  103. 1030  HOME : INVERSE : PRINT " CASE # ";CASE: NORMAL : PRINT : PRINT 
  104. 1040  FOR J = 1 TO NVAR
  105. 1050  PRINT NAME$(J); TAB( 8)"= ";X(CASE,J);
  106. 1060  IF NVAR > = J +13  THEN  PRINT  TAB( 21)NAME$(J +13); TAB( 28)"= ";X(CASE,J +13): GOTO 1080
  107. 1070  PRINT 
  108. 1080  IF J <13  THEN  NEXT J
  109. 1090 J = NVAR
  110. 1100  VTAB 24: HTAB 1: CALL  -958: INVERSE : PRINT "  <ESC> TO EDIT; <RETURN> TO CONTINUE  ";: GET A$: PRINT : NORMAL : IF A$ < > CHR$(13)  AND A$ < > CHR$(27)  THEN 1100
  111. 1110  IF A$ =  CHR$(13)  THEN 990
  112. 1120  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT "CHANGE DATA FOR VARIBLE # (1-";NVAR;")? ";: NORMAL : INPUT "";V
  113. 1130  IF V <1  OR V >NVAR  THEN 1120
  114. 1140  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT "PRESENT VALUE FOR CASE ";CASE;" ";NAME$(V);" = ";X(CASE,V): PRINT "CHANGE TO? ";: NORMAL : INPUT "";X(CASE,V)
  115. 1150  GOTO 1030
  116. 1160  REM  TITLE
  117. 1170  FOR I1 = 1 TO 40: PRINT "*";: NEXT : PRINT 
  118. 1180  PRINT "  PEARSON PRODUCT-MOMENT CORRELATIONS": PRINT 
  119. 1190  FOR I1 = 1 TO 40: PRINT "*";: NEXT I1
  120. 1200  VTAB 12: HTAB 9: INVERSE : FOR I1 = 1 TO 23: PRINT " ";: NEXT I1
  121. 1210  VTAB 13: HTAB 9: PRINT " ";: HTAB 31: PRINT " "
  122. 1220  VTAB 14: HTAB 9: PRINT " ";: NORMAL : PRINT "  AUTHOR/PROGRAMMER ";: HTAB 31: INVERSE : PRINT " "
  123. 1230  VTAB 15: HTAB 9: PRINT " ";: NORMAL : PRINT " DR. STEVEN SCHWARTZ";: HTAB 31: INVERSE : PRINT " "
  124. 1240  VTAB 16: HTAB 9: PRINT " ";: HTAB 31: PRINT " "
  125. 1250  VTAB 17: HTAB 9: FOR I1 = 1 TO 23: PRINT " ";: NEXT I1: NORMAL : PRINT : VTAB 21: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **": HTAB 8: PRINT "PRESS ANY KEY TO BEGIN";
  126. 1260  GET A$: PRINT : NORMAL : HOME : RETURN 
  127. 1270  REM  DATA INPUT FROM DISK
  128. 1280  ONERR  GOTO 1680
  129. 1290  HOME : INVERSE : PRINT "NAME OF FILE:";: NORMAL : INPUT " ";F$: IF F$ = ""  OR  VAL(F$) >0  THEN 1290
  130. 1300  VTAB 3: PRINT "PRESS ANY KEY WHEN YOU ARE READY...";: GET A$: PRINT : VTAB 6: HTAB 15: FLASH : PRINT "<<WORKING>>": NORMAL 
  131. 1310  PRINT D$;"OPEN";F$
  132. 1320  PRINT D$;"READ";F$
  133. 1330  INPUT NVAR: INPUT N1
  134. 1340  FOR I = 1 TO NVAR: INPUT NAME$(I): NEXT 
  135. 1350  FOR I = 1 TO N1: FOR J = 1 TO NVAR
  136. 1360  INPUT X(I,J)
  137. 1370  NEXT J
  138. 1380  NEXT I
  139. 1390  PRINT D$;"CLOSE";F$
  140. 1400  ONERR  GOTO 1850
  141. 1410 N = N1
  142. 1420  REM  ADDITIONAL DATA (AFTER DISK ENTRIES)?
  143. 1430  HOME : PRINT "ENTER ADDITIONAL DATA FROM KEYBOARD?": PRINT "(PRESS Y OR N): ";: GET A$: PRINT : IF A$ < >"Y"  AND A$ < >"N"  THEN 1430
  144. 1440  IF A$ = "N"  THEN N1 = 0: GOTO 1490
  145. 1450  VTAB 5: HTAB 1: CALL  -958: INVERSE : PRINT "NUMBER OF ADDITIONAL CASES:";: NORMAL : INPUT " ";N2
  146. 1460 N = N1 +N2
  147. 1470  IF N >250  THEN  PRINT  CHR$(7); CHR$(7);"*** MAXIMUM OF 250 CASES EXCEEDED ***": FOR I1 = 1 TO 1500: NEXT : GOTO 1450
  148. 1480  GOTO 280
  149. 1490  VTAB 5: HTAB 1: CALL  -958: INVERSE : PRINT "ENTER TITLE FOR OUTPUT:": NORMAL : PRINT : INPUT "";TI$: IF  LEN(TI$) >40  THEN  PRINT "*** MAX. LENGTH = 40 CHARS. ***": FOR I1 = 1 TO 1500: NEXT I1: GOTO 1490
  150. 1500  GOTO 340
  151. 1510  REM  SAVE DATA SET
  152. 1520  ONERR  GOTO 1760
  153. 1530  VTAB 3: PRINT "PRESS ANY KEY WHEN YOU ARE READY...";: GET A$: PRINT : VTAB 6: HTAB 15: FLASH : PRINT "<<WORKING>>": NORMAL 
  154. 1540  PRINT D$;"OPEN";F$
  155. 1550  PRINT D$;"CLOSE";F$
  156. 1560  PRINT D$;"DELETE";F$
  157. 1570  PRINT D$;"OPEN";F$
  158. 1580  PRINT D$;"WRITE";F$
  159. 1590  PRINT NVAR: PRINT N
  160. 1600  FOR I = 1 TO NVAR: PRINT NAME$(I): NEXT 
  161. 1610  FOR I = 1 TO N
  162. 1620  FOR J = 1 TO NVAR: PRINT X(I,J)
  163. 1630  NEXT J
  164. 1640  NEXT I
  165. 1650  PRINT D$;"CLOSE";F$
  166. 1660  ONERR  GOTO 1850
  167. 1670  GOTO 770
  168. 1680  REM  ERROR ROUTINE--READ OF NON-EXISTENT FILE
  169. 1690 ERR =  PEEK(222)
  170. 1700  PRINT D$;"CLOSE"
  171. 1710  IF ERR = 5  OR ERR = 6  THEN  PRINT D$;"DELETE"F$: HOME : FLASH : PRINT  CHR$(7); CHR$(7);"FILE DOES NOT EXIST.  SELECT AGAIN...": NORMAL : PRINT D$;"CATALOG": PRINT "PRESS ANY KEY TO CONTINUE ";: GET A$: PRINT : GOTO 1290
  172. 1720  IF ERR = 13  THEN  HOME : FLASH : PRINT "WRONG FILE TYPE. SELECT AGAIN...": NORMAL : PRINT D$;"CATALOG": PRINT "PRESS ANY KEY TO CONTINUE ";: GET A$: PRINT : GOTO 1290
  173. 1730  IF ERR = 254  THEN  HOME : FLASH : PRINT "NOT A PPMC DATA FILE. SELECT AGAIN...": NORMAL : PRINT D$;"CATALOG": PRINT "PRESS ANY KEY TO CONTINUE ";: GET A$: PRINT : GOTO 1290
  174. 1740  IF ERR = 8  THEN  HOME : FLASH : PRINT "CLOSE DRIVE DOOR AND TRY AGAIN...": NORMAL : FOR I1 = 1 TO 1000: NEXT I1: GOTO 1290
  175. 1750  GOTO 1850
  176. 1760  REM  DISK WRITE ERROR
  177. 1770 ERR =  PEEK(222): HOME 
  178. 1780  PRINT D$;"CLOSE"
  179. 1790  IF ERR = 4  THEN  FLASH : PRINT  CHR$(7); CHR$(7);"DISK IS WRITE-PROTECTED.  INSERT ANOTHER": NORMAL : GOTO 1510
  180. 1800  IF ERR = 9  THEN  PRINT D$;"DELETE"F$: FLASH : PRINT  CHR$(7); CHR$(7);"DISK FULL.  INSERT ANOTHER AND TRY AGAIN": NORMAL : GOTO 1510
  181. 1810  IF ERR = 8  THEN  HOME : FLASH : PRINT "CLOSE DRIVE DOOR AND TRY AGAIN...": NORMAL : GOTO 1510
  182. 1820  IF ERR = 10  THEN  FLASH : PRINT  CHR$(7); CHR$(7);"FILE ALREADY EXISTS AND IS LOCKED...": NORMAL : INPUT "WRITE OVER IT (Y/N)? ";A$: GOTO 1940
  183. 1830  IF ERR = 11  THEN  FLASH : PRINT  CHR$(7); CHR$(7);"ILLEGAL FILENAME.  SELECT AGAIN...": NORMAL : PRINT D$;"CATALOG": INPUT "NEW FILE NAME: ";F$: HOME : GOTO 1510
  184. 1840  IF ERR = 13  THEN  FLASH : PRINT  CHR$(7); CHR$(7);"WRONG FILE TYPE. SELECT AGAIN...": NORMAL : PRINT D$;"CATALOG": INPUT "NEW FILE NAME: ";F$: HOME : GOTO 1510
  185. 1850  REM  ALL OTHER ERRORS
  186. 1860  PRINT : PRINT D$;"PR#0": REM  TURN OFF PRINTER, IF ON
  187. 1870 ERR =  PEEK(222)
  188. 1880  IF ERR = 254  THEN  POKE 34,23: VTAB 23: FLASH : PRINT "ILLEGAL INPUT. PLEASE RE-ENTER ANSWER.": NORMAL : FOR I1 = 1 TO 1500: NEXT I1: VTAB 23: HTAB 1: CALL  -958: POKE 34,0: RESUME 
  189. 1890  IF ERR = 69  OR ERR = 133  THEN  HOME : PRINT "CALCULATION ERROR (OVERFLOW OR DIVISION BY ZERO).": PRINT "DO YOU WANT TO EDIT YOUR DATA? (Y/N)";: GET A$: PRINT : ON (A$ = "Y") GOTO 790: ON (A$ = "N") GOTO 1930: HOME : GOTO 1890
  190. 1900  HOME 
  191. 1910  INVERSE : PRINT "ERROR CODE = ";ERR: NORMAL : PRINT 
  192. 1920  PRINT "CHECK PG. 136 OF APPLESOFT PROGRAMMING  REFERENCE MANUAL FOR CODE MEANING.  THE ERROR OCCURRED IN LINE #"; PEEK(218) + PEEK(219) *256
  193. 1930  END 
  194. 1940  IF A$ = "Y"  THEN  PRINT D$;"UNLOCK"F$: GOTO 1510
  195. 1950  IF A$ = "N"  THEN  INPUT "NEW FILE NAME (RETURN TO ABORT): ";F$: IF F$ = ""  THEN  HOME : END 
  196. 1960  GOTO 1510