home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / LNREGRES.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  4.6 KB  |  85 lines
  1. 1  '                       LINEAR REGRESSION
  2. 2  '               Copyright Tracy L. Gustafson, M.D.
  3. 3  '              Round Rock, Texas. Version 3.2, 1985
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 15  DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),ST(1)
  6. 22  DATA "LINEAR REGRESSION",32,19
  7. 30  LOCATE 7,28:PRINT "1.)  Linear regression":PRINT
  8. 35  PRINT TAB(28);"2.)  Data transformations":PRINT
  9. 40  PRINT TAB(28);"3.)  Exit"
  10. 45  LOCATE 14,32:PRINT "Enter choice:":AR=14:AC=46:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 45
  11. 50  ON ASUB GOTO 55,195,385
  12. 55  CLS:PRINT TAB(32);DTTL:PRINT TAB(32);STRING$(17,205):PRINT:GOSUB 4000
  13. 60  PRINT:PRINT "   What are the SAMPLE NUMBERS of the 2 variables you want to compare?":PRINT TAB(10);"Predictor variable (X)";TAB(45);"Dependent variable (Y)"
  14. 65  AR=CSRLIN:AC=13:GOSUB 4200:NS1=NS:AC=48:GOSUB 4200:NS2=NS:PRINT
  15. 70  IF T(NS1)<>T(NS2) THEN BEEP:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(37);"a regression analysis cannot be performed.":FOR Z=1 TO 5000:NEXT:GOTO 20
  16. 75  XC=0:N=T(NS1):FOR Z=1 TO N:XC=XC+VAL(D(NS1,Z))*VAL(D(NS2,Z)):NEXT
  17. 80  SC=XC-X(NS1)*X(NS2)/N:SX=X2(NS1)-X(NS1)*X(NS1)/N
  18. 85  SY=X2(NS2)-X(NS2)*X(NS2)/N:SB=SC/SX:IA=(X(NS2)-SB*X(NS1))/N
  19. 90  COLOR CLR2,CLR1:PRINT TAB(13);"Regression equation:  Y =";IA;:IF SB>0 THEN PRINT "+"; ELSE PRINT "-";
  20. 95  PRINT ABS(SB);"* X";TAB(79):COLOR CLR1,CLR2:PRINT:PRINT
  21. 100  V1=N-2:S2=(SY-SC*SC/SX)/V1:SEB=SQR(S2/SX):ST=ABS(SB)/SEB
  22. 105  PRINT " Significance of slope:    T =";ST;TAB(45);"df =";V1;
  23. 110  R=ATN(ST/SQR(V1)):RC=COS(R):R2=RC*RC:RS=SIN(R):X=1
  24. 115  IF V1 MOD 2=0 THEN 140
  25. 120  IF V1=1 THEN Y=R:GOTO 135
  26. 125  Y=RC:FOR Z=3 TO (V1-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X*RC:NEXT
  27. 130  Y=R+RS*Y
  28. 135  P=1-Y*0.63662:GOTO 150
  29. 140  Y=1:FOR Z=2 TO (V1-2) STEP 2:X=X*R2*(Z-1)/Z:Y=Y+X:NEXT
  30. 145  P=1-Y*RS
  31. 150  PLAY "MS O3 L64 G O2 GE L9 E"
  32. 155  PRINT TAB(60);"p = ";: IF P<9.99E-07 THEN PRINT "< 10 (-6)" ELSE PRINT P
  33. 160  PRINT:COLOR CLR2,CLR1:PRINT TAB(10);"The slope of this line is ";
  34. 165  IF P>0.05 THEN PRINT "NOT ";
  35. 170  PRINT "significantly different than 0";TAB(79):COLOR CLR1,CLR2:PRINT
  36. 175  PRINT:PRINT " Confidence limits on the slope can be calculated as:":PRINT
  37. 180  DF=STR$(V1):DF=RIGHT$(DF,LEN(DF)-1):PRINT TAB(25);SB;"+/- T(";DF;") *";SEB
  38. 185  LOCATE 24,8:INPUT;"Do you want another regression calculation with this DATAFILE?  ",A$
  39. 190  IF A$="y" OR A$="Y" THEN CLS:GOTO 60 ELSE 375
  40. 195  CLS:PRINT TAB(32);"DATA TRANSFORMATIONS":PRINT TAB(32);STRING$(20,205):PRINT:LOCATE 4,1:GOSUB 4000
  41. 200  PRINT:PRINT TAB(29);"1.)  X' = Ax + B":PRINT TAB(29);"2.)  X' = Ax<UNK! {FD20}>+ B"
  42. 205  PRINT TAB(29);"3.)  X' = A*<UNK! {00FB}>x + B":PRINT TAB(29);"4.)  X' = A/x + B"
  43. 210  PRINT TAB(29);"5.)  X' = x - mean":PRINT TAB(29);"6.)  X' = A*ln(x) + B"
  44. 215  PRINT TAB(29);"7.)  X' = ln(x/100-x)":PRINT TAB(29);"8.)  X' = Sample A + Sample B"
  45. 220  PRINT TAB(29);"9.)  X' = Sample A * Sample B":PRINT
  46. 225  LOCATE 16,29:PRINT "Choose transformation:":AR=16:AC=52:GOSUB 4800:TN=VAL(IP$):IF ABS(TN-5)>4 THEN BEEP:GOTO 225
  47. 230  IF TN>7 THEN 240 ELSE PRINT "    Enter the SAMPLE NUMBER of the variable you want transformed:";:AR=17:AC=68:GOSUB 4200:N=T(NS)
  48. 235  IF TN=5 OR TN=7 THEN 245 ELSE PRINT TAB(27);"A =";:AR=CSRLIN:AC=31:GOSUB 4800:KA=VAL(IP$):PRINT TAB(49);"B =";:AC=53:GOSUB 4800:KB=VAL(IP$):GOTO 245
  49. 240  PRINT TAB(15);"Sample A =";:AR=CSRLIN:AC=26:GOSUB 4200:KA=NS:LOCATE AR,45:PRINT "Sample B =";:AC=56:GOSUB 4200:KB=NS:IF T(KB)>T(KA) THEN N=T(KB) ELSE N=T(KA)
  50. 245  A=AN:X(A)=0:X2(A)=0:PRINT:AR=CSRLIN:COLOR 23:LOCATE AR,29:PRINT "PERFORMING TRANSFORMATION";:COLOR CLR1,CLR2
  51. 250  ON TN GOTO 255,260,265,270,275,280,285,290,295
  52. 255  FOR Z=1 TO N:ST(Z)=KA*VAL(D(NS,Z))+KB:NEXT:GOTO 300
  53. 260  FOR Z=1 TO N:L=VAL(D(NS,Z)):ST(Z)=KA*L*L+KB:NEXT:GOTO 300
  54. 265  FOR Z=1 TO N:ST(Z)=KA*SQR(VAL(D(NS,Z)))+KB:NEXT:GOTO 300
  55. 270  FOR Z=1 TO N:ST(Z)=KA/VAL(D(NS,Z))+KB:NEXT:GOTO 300
  56. 275  LM=X(NS)/T(NS):FOR Z=1 TO N:ST(Z)=VAL(D(NS,Z))-LM:NEXT:GOTO 300
  57. 280  FOR Z=1 TO N:ST(Z)=KA*LOG(VAL(D(NS,Z)))+KB:NEXT:GOTO 300
  58. 285  FOR Z=1 TO N:L=VAL(D(NS,Z)):ST(Z)=LOG(L/(100-L)):NEXT:GOTO 300
  59. 290  FOR Z=1 TO N:ST(Z)=VAL(D(KA,Z))+VAL(D(KB,Z)):GOSUB 350:NEXT Z:GOTO 305
  60. 295  FOR Z=1 TO N:ST(Z)=VAL(D(KA,Z))*VAL(D(KB,Z)):GOSUB 350:NEXT Z:GOTO 305
  61. 300  FOR Z=1 TO N:XX=ST(Z):X(A)=X(A)+XX:X2(A)=X2(A)+XX*XX:NEXT
  62. 305  FOR Z=1 TO N:SP=INT(ST(Z)*1E+07)*9.8E-08:DS=STR$(SP)
  63. 310  IF SP>0 THEN D(A,Z)=RIGHT$(DS,LEN(DS)-1) ELSE D(A,Z)=DS
  64. 315  NEXT:IF TN=4 THEN 325 ELSE IF TN>7 THEN 330
  65. 320  FOR Z=1 TO N:CS(A,Z)=CS(NS,Z):NEXT:GOTO 330
  66. 325  FOR Z=1 TO N:CS(A,Z)=CS(NS,(N-Z+1)):NEXT
  67. 330  T(A)=N:VC=0:MN=X(T)/N:FOR ZZ=1 TO N:VC=VC+(ST(ZZ)-MN)^2:NEXT ZZ:SD(A)=SQR(VC/(N-1))
  68. 335  IF N>0 THEN IF N MOD 2=0 THEN MD(A)=(VAL(D(A,CS(A,N/2)))+VAL(D(A,CS(A,N/2+1))))*0.5 ELSE MD(A)=VAL(D(A,CS(A,N/2+0.5)))
  69. 340  LOCATE AR,5:PRINT "The transformed variable has been added to ";FILE$;" as sample #";A
  70. 345  PRINT:PRINT TAB(7);"Enter name for the TRANSFORMED `";N$(NS);:INPUT "' data sample:  ",N$(A):AR=CSRLIN:GOSUB 4100:GOTO 20
  71. 350  X(A)=X(A)+ST(Z):X2(A)=X2(A)+ST(Z)*ST(Z)
  72. 355  FOR ZZ=1 TO (Z-1):VX=ST(CS(A,ZZ)):IF VX<=ST(Z) THEN 365
  73. 360  FOR TZ=Z TO (ZZ+1) STEP -1:CS(A,TZ)=CS(A,TZ-1):NEXT:GOTO 370
  74. 365  NEXT ZZ
  75. 370  CS(A,ZZ)=Z:RETURN
  76. 375  LOCATE 25,25:PRINT "Press any key to return to menu.";
  77. 380  A$=INKEY$:IF A$="" THEN 380 ELSE 20
  78. 385  GOTO 3000
  79. 4025  IF ASUB=1 THEN AN=A ELSE AN=A+1
  80. 4027  ERASE D,CS,T,N$,X,X2,SD,MD,ST
  81. 4030  DIM D(AN,C),CS(AN,C),T(AN),N$(AN),X(AN),X2(AN),MD(AN),SD(AN),ST(C)
  82. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 2,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  83. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  84. 5010  ON ERROR GOTO 0:END
  85.