home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCMATH / STATS / FILETRAN.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  3.8 KB  |  70 lines
  1. 1  '                     FILE TRANSFER PROGRAM
  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),TR(1)
  6. 17  D1="What is the name of the DATAFILE you wish to ":D2="Which sample do you want to "
  7. 22  DATA "TRANSFERING SAMPLES FROM ONE DATAFILE TO ANOTHER",15,50
  8. 30  AF=0:AR=CSRLIN:PRINT TAB(10);D1;"modify?":PRINT TAB(22);"(REPLACE, ADD, or APPEND a sample to) "
  9. 35  LOCATE AR,64:INPUT "",FILE1$:EF=1:FILE$=FILE1$
  10. 40  ON ERROR GOTO 5020:OPEN FILE1$ FOR INPUT AS #1:INPUT #1,A,C:CC=C
  11. 45  PRINT:PRINT " ";D1;:INPUT "retrieve a sample from?  ",FILE2$:EF=2:FILE$=FILE2$
  12. 50  OPEN FILE2$ FOR INPUT AS #2:INPUT #2,AZ,CZ:PRINT:AR=CSRLIN
  13. 55  PRINT TAB(5);"What is the SAMPLE NUMBER in ";FILE2$;" that you want to retrieve?"
  14. 60  SWAP A,AZ:AC=72:GOSUB 315:NZ=NS:SWAP A,AZ
  15. 65  FILE$=FILE1$:PRINT:IF AF=1 THEN 95 ELSE PRINT
  16. 70  PRINT "Do you want to:  1.)  REPLACE an existing data sample in ";FILE1$
  17. 75  PRINT TAB(18);"2.)  ADD this data sample to ";FILE1$;" as sample #";A+1
  18. 80  PRINT TAB(18);"3.)  APPEND this sample to an existing sample in ";FILE1$
  19. 85  PRINT:PRINT TAB(30);"Enter choice:";
  20. 90  AR=CSRLIN:AC=45:GOSUB 4800:ASUB=VAL(IP$):IF ABS(ASUB-2)>1 THEN BEEP:GOTO 90
  21. 95  AR=CSRLIN:AC=61:ON ASUB GOTO 100,105,110
  22. 100  AT=A:PRINT TAB(22);D2;"replace?";:AR=17:GOSUB 315:NR=NS:GOTO 115
  23. 105  IF A<28 THEN NR=A+1:AT=A+1:GOTO 115 ELSE BEEP:AR=CSRLIN:LOCATE 25,3:PRINT FILE$;" already has the maximum number of samples allowed (28)";:LOCATE AR,1:GOTO 70
  24. 110  NR=A+1:AT=A+1:PRINT TAB(20);D2;"append to?";:AR=CSRLIN:GOSUB 315:NA=NS
  25. 115  PRINT:PRINT:COLOR 23:PRINT TAB(31);"TRANSFERING SAMPLE":COLOR CLR1
  26. 120  IF AF=1 THEN 135 ELSE ERASE D,CS,T,N$,X,X2,MD,SD,TR
  27. 125  DIM D(AT,2000/AT),CS(AT,2000/AT),T(AT),N$(AT),X(AT),X2(AT),MD(AT),SD(AT),TR(28)
  28. 130  GOSUB 4040
  29. 135  FOR T=1 TO NZ-1:INPUT #2,TR(T):NEXT
  30. 140  INPUT #2,T(NR):FOR T=NZ+1 TO AZ:INPUT #2,TR(T):NEXT
  31. 145  FOR T=1 TO NZ-1:FOR Z=1 TO CZ:INPUT #2,DZ:NEXT:NEXT
  32. 150  FOR Z=1 TO CZ:INPUT #2,D(NR,Z):NEXT
  33. 155  FOR T=NZ+1 TO AZ:FOR Z=1 TO CZ:INPUT #2,DZ:NEXT:NEXT
  34. 160  FOR T=1 TO NZ-1:FOR Z=1 TO TR(T):INPUT #2,CSZ:NEXT:NEXT
  35. 165  FOR Z=1 TO T(NR):INPUT #2,CS(NR,Z):NEXT
  36. 170  FOR T=NZ+1 TO AZ:FOR Z=1 TO TR(T):INPUT #2,CSZ:NEXT:NEXT
  37. 175  FOR T=1 TO NZ-1:INPUT #2,NZ$,XZ,X2Z,MDZ,SDZ:NEXT
  38. 180  INPUT #2,N$(NR),X(NR),X2(NR),MD(NR),SD(NR):CLOSE #2
  39. 185  IF ASUB<3 THEN 235 ELSE AT=T(NA)+1
  40. 190  T(NA)=T(NA)+T(NR):X(NA)=X(NA)+X(NR):X2(NA)=X2(NA)+X2(NR)
  41. 195  FOR AZ=1 TO T(NR):CC=CC+1:D(NA,CC)=D(NR,AZ):IF D(NA,CC)="" THEN 220 ELSE VC=VAL(D(NA,CC))
  42. 200  FOR Z=1 TO AT-1:VX=VAL(D(NA,CS(NA,Z))):IF VX<=VC THEN 210
  43. 205  FOR TZ=AT TO Z+1 STEP -1:CS(NA,TZ)=CS(NA,TZ-1):NEXT:GOTO 215
  44. 210  NEXT Z
  45. 215  CS(NA,Z)=CC:AT=AT+1
  46. 220  NEXT AZ:IF CC>CMAX THEN CMAX=CC
  47. 225  N=T(NA):MD(NA)=0:IF N>0 THEN IF N MOD 2=0 THEN MD(NA)=(VAL(D(NA,CS(NA,N/2)))+VAL(D(NA,CS(NA,N/2+1))))*0.5 ELSE MD(NA)=VAL(D(NA,CS(NA,N/2+0.5)))
  48. 230  SD(NA)=0:IF N>1 THEN IF X2(NA)>X(NA)*X(NA)/N THEN SD(NA)=SQR((X2(NA)-X(NA)*X(NA)/N)/(N-1))
  49. 235  PLAY "MS O3 L64 G O2 GE L9 E"
  50. 240  CLS:PRINT:PRINT TAB(5);"A memory file has been constructed that ";:IF ASUB=3 THEN PRINT "APPENDS "; ELSE PRINT "ADDS ";
  51. 245  PRINT "sample";NZ;"FROM ";FILE2$;:IF ASUB=3 THEN PRINT TAB(25);"TO sample";NA;"IN "; ELSE PRINT TAB(18);"TO ";
  52. 250  PRINT FILE1$;
  53. 255  IF ASUB=1 THEN PRINT "   (REPLACING sample number";NR;")":GOTO 270 ELSE IF ASUB=2 THEN PRINT "   (NEW sample number =";NR;")":GOTO 270
  54. 260  PRINT:PRINT:PRINT "   Do you want to APPEND data to another sample in datafile ";FILE1$;:INPUT A$
  55. 265  IF A$="y" OR A$="Y" THEN CC=C:AF=1:GOTO 45 ELSE IF A$<>"n" AND A$<>"N" THEN BEEP:GOTO 260
  56. 270  PRINT:PRINT TAB(10);"How do you want to SAVE this modified datafile to disk:"
  57. 275  PRINT:PRINT TAB(25);"1.)  Under the filename ";FILE1$;"
  58. 280  PRINT TAB(25);"2.)  Under a NEW filename."
  59. 285  PRINT TAB(25);"3.)  CANCEL file modification.":PRINT
  60. 290  PRINT TAB(31);"Enter choice:";:AR=CSRLIN:AC=45:GOSUB 4800:BSUB=VAL(IP$):AR=AR+1:IF ABS(BSUB-2)>1 THEN BEEP:GOTO 290 ELSE IF BSUB=3 THEN 305
  61. 295  IF ASUB=3 THEN C=CMAX ELSE A=AT:IF T(NR)>C THEN C=T(NR)
  62. 300  IF BSUB=2 THEN AR=CSRLIN:GOSUB 4100 ELSE GOSUB 4110
  63. 305  LOCATE 25,15:INPUT;"Do you want to perform another FILE TRANSFER?  ",A$:IF A$="y" OR A$="Y" THEN 20
  64. 310  GOTO 3000
  65. 315  GOSUB 4800:NS=VAL(IP$):IF NS>0 AND NS<=A THEN RETURN ELSE BEEP:LOCATE 25,22:PRINT FILE$;" has only";A;"samples.";:GOTO 315
  66. 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:"
  67. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  68. 5010  ON ERROR GOTO 0:END
  69. 5032  IF EF=1 THEN RESUME 30 ELSE IF EF=2 THEN RESUME 45
  70.