1 ! SATMED -- CALCULATES MEDIAN SAT SCORES FROM ! ADMISSIONS DATA (SCORES SELECTED IN LINE 220) 2 ! BASED ON "SORTX" PROGRAM 3 ! 07-JAN-74 J. WARDEN WABASH COLLEGE 10 T3=TIME(0%) : &"MEDIAN SAT SCORES V03B" 20 DIM I$(63),O$(63),A$(63),P$(63),A2$(16) 40 ON ERROR GO TO 410 50 I0$="VERBAL" 60 INPUT"WANT ACC, APP, DEP, OR ALL";C1$ 65 M0,V0,M2,V2=0. 70 IF C1$="ACC" THEN L5$="ACCEPTANCES" : D1%=159% : Q1%=2% : D1$="A" : D2$="B" : D3$="D" : GO TO 142 75 IF C1$="APP" THEN L5$="APPLICATIONS" : D1%=146% : Q1%=0% : D1$="7" : GO TO 142 80 IF C1$="DEP" THEN L5$="DEPOSITS" : D1%=166% : Q1%=2% : D1$="Y" : D2$="1" : D3$="**" : GO TO 142 85 IF C1$="ALL" THEN L5$="COMPLETE FILE" : D1%=250% : Q1%=0% : D1$=" " : GO TO 142 90 PRINT"** RETYPE PLEASE **" : GO TO 60 142 INPUT"ADMISSIONS FILE (DEV:FILE)";F$ : R%=INSTR(1%,F$,":") : IF R% THEN D$=LEFT(F$,R%) 144 IF INSTR(1%,D$,"DT") THEN PRINT : PRINT "** INPUT FILE MUST BE ON A DISK **" : GO TO 9999 150 N%=2% ! ADMISSIONS FILE BLOCKING 155 N6%=N%-1% : N1%=510%/N% : N3%=N%*N1% : N2%=N1%-8% 162 OPEN F$ FOR INPUT AS FILE 5% 163 FIELD #5%,N1%*R% AS Z$,N1% AS I$(R%) FOR R%=0% TO N6% 170 C%=1% 175 P1$= D$+"SORT1" : GOSUB 1400 200 IF R%" " THEN 200 210 I1$=MID(I$(R%),D1%,1%) : IF I1$=D1$ THEN 220 ELSE IF Q1%=0% OR (I1$<>D2$ AND I1$<>D3$) THEN 200 220 V%=VAL(MID(I$(R%),151%,3%)) : M%=VAL(MID(I$(R%),154%,3%)) 225 IF M%<100% OR V%<100% THEN 200 230 LSET P$(P%)=CVT%$(V%)+CVT%$(M%) 232 M=M% : V=V% : M0=M0+M : V0=V0+V : M2=M2+M^2 : V2=V2+V^2 235 GOSUB 1700 : C%=C%+1% : GO TO 200 260 C%=C%-1% 270 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 275 PUT #1%,COUNT 504% 280 CLOSE 1% 285 PRINT"=======" : PRINT L5$+": "; 290 ! INIT LINK FILE 300 PRINT C%;"SCORES SELECTED" 310 A1$= D$+"SORT1" : GOSUB 1320 312 P1$= D$+"MERGE" : GOSUB 1400 315 ! - - - - - - - - - - - - - - 330 PRINT"-"; 340 I%=C%/16% : I2%=I%*16% : I3%=C%-I2% 345 FOR I1%=1% TO I% 350 C2%=16%*(I1%-1%)+1% : C3%=C2%+15% 360 GOSUB 5000 365 NEXT I1% 370 C2%=C3%+1% : C3%=C2%+I3%-1% 375 GOSUB 5000 ! SORT TAG END 380 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 385 PUT #1%,COUNT 504% 390 CLOSE 1%,2% 400 PRINT"-"; 402 IF C%<=16% THEN 905 ! SKIP MERGE IF 16 REC OR LESS 404 ! - - - - - - - - - - - - - 405 GO TO 450 409 ! ERRORS COME HERE... 410 IF ERR=11% THEN RESUME 260 415 IF ERR<>5% THEN 430 416 PRINT"** CAN'T FIND FILE '"+F$+"' **" 418 INPUT"FILE TO BE SORTED IS";F$ 420 IF INSTR(1%,F$,"/") THEN F$=LEFT(F$,INSTR(1%,F$,"/")-1%) 422 RESUME 162 430 ON ERROR GO TO 0 435 GO TO 9999 450 ! NOW WE MUST OPEN A MERGE FILE 455 ON ERROR GO TO 0 460 P1$= D$+"SORT1" : GOSUB 1400 465 A1$= D$+"MERGE" : GOSUB 1300 480 ! BEGIN MERGE SEQUENCE 490 PRINT"-"; 500 F%=16% 509 ! RE-INITIALIZE MERGE SEQUENCES HERE 510 S1%=1% : S2%=1%+F% ! STARTING PLACES 512 PRINT"-"; 519 ! SHORT MERGES CONTINUE HERE 520 U1%=S1%+F%-1% : U2%=S2%+F%-1% ! UPPER LIMITS 530 IF U1%>=C% THEN 780 540 IF U2%>C% THEN U2%=C% 560 H%=S1% : GOSUB 1500 562 H%=S2% : GOSUB 1550 564 IF A$(A%)<=O$(O%) THEN 600 570 LSET P$(P%)=O$(O%) 580 S2%=S2%+1% 585 GOSUB 1700 590 IF S2%>U2% THEN 690 595 GOSUB 1650 : GO TO 564 600 LSET P$(P%)=A$(A%) 610 S1%=S1%+1% 615 GOSUB 1700 617 IF S1%>U1% THEN 630 620 GOSUB 1600 : GO TO 564 630 LSET P$(P%)=O$(O%) 632 GOSUB 1700 634 FOR I%=S2%+1% TO U2% 640 GOSUB 1650 : LSET P$(P%)=O$(O%) : GOSUB 1700 670 NEXT I% 680 GO TO 760 690 LSET P$(P%)=A$(A%) 695 GOSUB 1700 700 FOR I%=S1%+1% TO U1% 710 GOSUB 1600 : LSET P$(P%)=A$(A%) : GOSUB 1700 740 NEXT I% 750 ! FIRST SHORT MERGE COMPLETE 760 S1%=U2%+1% : S2%=S1%+F% 770 GO TO 520 779 ! WRITE UNMERGED ENTRIES 780 H%=P9% : GOSUB 1500 781 Q%=P9% 782 FOR I%=Q% TO C% 784 GOSUB 1600 : LSET P$(P%)=A$(A%) : GOSUB 1700 786 NEXT I% 788 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 790 PUT #1%,COUNT 504% 799 ! COMPLETE PASS THROUGH FILE 800 CLOSE 1%,2%,3% 805 F%=F%*2% 807 IF F%>=C% THEN 900 820 IF P1$= D$+"SORT1" THEN 830 822 P1$= D$+"SORT1" : GOSUB 1400 824 A1$= D$+"MERGE" : GOSUB 1300 826 GO TO 510 830 P1$= D$+"MERGE" : GOSUB 1400 832 A1$= D$+"SORT1" : GOSUB 1300 850 GO TO 510 900 ! WE'RE DONE!! 905 PRINT : KILL A1$ 945 ! NOW WRITE THE RESULTS 950 OPEN P1$ FOR INPUT AS FILE 1% 952 FIELD #1%,8%*A% AS Z$,8% AS A$(A%) FOR A%=0% TO 62% 954 GET #1% : L0%=CVT$%(LEFT(A$(0%),2%)) 956 N%=63% : N6%=62% : R1%=(C%+N6%)/N% : A%=C%-1%-(R1%-1%)*N% 958 GET #1%,RECORD R1% : H0%=CVT$%(LEFT(A$(A%),2%)) 964 C1%=C%-2%*(C%/2%) 966 I2%=C%/2% : C0=C% 968 R1%=(I2%+N6%)/N% : A%=I2%-1%-(R1%-1%)*N% 970 GET #1%,RECORD R1% : M1%=CVT$%(LEFT(A$(A%),2%)) 974 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #1% 976 M2%=CVT$%(LEFT(A$(A%),2%)) 980 IF C1%THEN M%=M2% ELSE M%=(M1%+M2%)/2% 982 CLOSE 1% : PRINT I0$+" "; 985 PRINT"MEDIAN =";M% 987 PRINT I0$+" MEAN ="; : PRINT USING "####",V0/C0 988 PRINT I0$+" S.D. ="; : PRINT USING "####", SQR( V2/C0 - (V0/C0)^2 ) 989 PRINT I0$+" RANGE="; : PRINT USING"#### TO####",L0%,H0% 990 IF I0$<>"MATH" THEN I0$="MATH" : GO TO 1000 992 PRINT"-------" 995 PRINT USING "TIME ####.# MINUTES",(TIME(0%)-T3)/60 : GO TO 9999 1000 ! SWAP VERBAL, MATH SCORES 1005 V0=M0 : V2=M2 1010 A$=A1$ : A1$=P1$ : P1$=A$ 1020 GOSUB 1320 : GOSUB 1400 1025 FOR I%=1% TO C% 1030 GOSUB 1600 1040 LSET P$(P%)=MID(A$(A%),3%,2%)+LEFT(A$(A%),2%)+RIGHT(A$(A%),5%) 1050 GOSUB 1700 : NEXT I% 1060 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 1070 PUT #1%,COUNT 504% 1080 KILL A1$ 1090 IF P1$<>D$+"SORT1" THEN NAME P1$ AS D$+"SORT1" 1100 GO TO 310 1200 ! - - - I/O SUBROUTINES - - - 1300 OPEN A1$ FOR INPUT AS FILE 3% 1310 FIELD #3%,8%*O% AS Z$,8% AS O$(O%) FOR O%=0% TO 62% 1320 OPEN A1$ FOR INPUT AS FILE 2% 1330 FIELD #2%,8%*A% AS Z$,8% AS A$(A%) FOR A%=0% TO 62% 1340 RETURN 1400 OPEN P1$ FOR OUTPUT AS FILE 1% 1410 FIELD #1%,8%*P% AS Z$, 8% AS P$(P%) FOR P%=0% TO 62% 1415 P%,P9%=0% 1420 RETURN 1500 R1%=(H%+62%)/63% 1510 A%=H%+62%-R1%*63% 1520 GET #2%,RECORD R1% 1530 RETURN 1550 R2%=(H%+62%)/63% 1560 O%=H%+62%-R2%*63% 1570 GET #3%,RECORD R2% 1580 RETURN 1600 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #2% 1610 RETURN 1650 IF O%<62% THEN O%=O%+1% ELSE O%=0% : GET #3% 1660 RETURN 1700 IF P%<62% THEN P%=P%+1% ELSE P%=0% : PUT #1%,COUNT 504% 1705 P9%=P9%+1% 1710 RETURN 5000 ! BUBBLE SORT SUBROUTINE 5100 FOR R%=C2% TO C3% 5110 S%=R%-C2% 5120 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #2% 5140 A2$(S%)=A$(A%)+"" 5160 NEXT R% 5200 FOR R%=0% TO C3%-C2% 5210 T2%=0% 5220 FOR S%=1% TO C3%-C2% 5230 S1%=S%-1% 5240 IF A2$(S%)>=A2$(S1%) THEN 5300 5250 T$=A2$(S%) : A2$(S%)=A2$(S1%) : A2$(S1%)=T$ 5270 T2%=1% 5300 NEXT S% 5310 IF T2%=0% THEN 5400 5320 NEXT R% 5400 FOR R%=C2% TO C3% 5410 S%=R%-C2% 5420 LSET P$(P%)=A2$(S%) 5425 IF P%<62% THEN P%=P%+1% ELSE P%=0% : PUT #1%, COUNT 504% 5430 NEXT R% 5450 RETURN 9999 END