5 REM CALL -936
10 DIM KEY(125),RLINK(125),LLINK(125)
12 FALSE=0:TRUE=1:N=0:ROOT=1:NIL=0
14 EMPTY=FALSE
16 PRINT "THIS PROGRAM GENERATES 100 RANDOM NUMBERS AND SORTS THEM USING"
18 PRINT "A BINARY SEARCH TTEE.  IT ALSO ALLOWS DELETIONS FROM, OR ADDITIONS"
20 PRINT "TO THE TREE. "
22 REM  ** GENERATE DATA ***
24 FOR N=1 TO 100
26 KEY(N)=INT(RND*100) : REM WAS ORIGINALLY KEY(N)=RND(100)
27 LLINK(N)=NIL
28 RLINK(N)=NIL
29 Q=N
30 GOSUB 580
32 NEXT N
34 PRINT : PRINT "ELEMENTS AS THEY WERE GENERATED ARE :": PRINT
36 FOR I=1 TO 100: PRINT KEY(I), : NEXT I
38 PRINT
100 PRINT : PRINT "DO YOU WANT TO:"
110 PRINT "  1.  ADD A NODE"
120 PRINT "  2.  DELETE A NODE"
130 PRINT "  3.  LIST THE TREE"
132 PRINT "  4.  END"
140 INPUT X
150 IF X=1 THEN 160
151 IF X=2 THEN 200
152 IF X=3 THEN 300
153 IF X=4 THEN 9999
154 GOTO 100
160 N=N+1
162 IF EMPTY THEN 164
163 GOTO 170
164 FOR I=1 TO N
165 LLINK(I)=NIL
166 RLINK(I)=NIL
167 NEXT I
168 N=1
169 ROOT=1
170 INPUT "GIVE KEY ", KEY(N)
175 Q=N
180 GOSUB 580
190 GOTO 100
200 INPUT "GIVE KEY TO BE DELETED ",P
205 ALPHA=P
210 GOSUB 1390
212 P=SEARCH
220 GOSUB 3000
230 GOTO 100
300 PRINT : PRINT "TREE FOLLOWS:": PRINT
310 GOSUB 980
320 GOTO 100
580 REM ** SUBROUTINE BILDER **
582 EMPTY=FALSE
600 IF N=1 THEN 830
630 P=ROOT
640 INSERT=FALSE
650 IF KEY(Q)<=KEY(P) THEN 740
660 IF RLINK(P)<=NIL THEN 690
670 P=RLINK(P)
680 GOTO 810
690 RLINK(Q)=RLINK(P)
700 RLINK(P)=Q
710 LLINK(Q)=NIL
720 INSERT=TRUE
730 GOTO 810
740 IF LLINK(P)<>NIL THEN 800
750 LLINK(P)=Q
760 LLINK(Q)=NIL
770 RLINK(Q)=-P
780 INSERT=TRUE
790 GOTO 810
800 P=LLINK(P)
810 IF INSERT=FALSE THEN 650
830 RETURN
850 REM  ** SUBROUTINE FIX **
890 I=1
900 IF I<=N THEN 920
910 GOTO 960
920 LLINK(I)=NIL
921 RLINK(I)=NIL
940 I=I+1
950 GOTO 900
960 RETURN
980 REM ** SUBROUTINE LIST **
1000 PRINT
1020 IF EMPTY=FALSE THEN 1030
1022 PRINT "TREE EMPTY"
1023 GOTO 1220
1030 RET=FALSE
1040 R=ROOT
1050 PRINT "ELEMENTS IN ORDER"
1070 IF LLINK(R)=NIL THEN 1115
1100 R=LLINK(R)
1110 GOTO 1070
1115 B=R
1120 IF ((RLINK(B)<>NIL) AND (RET=FALSE)) THEN 1140
1130 GOTO 1200
1140 PRINT KEY(B),
1145 P=B
1150 GOSUB 1240
1151 B=SUC
1160 IF B<>NIL THEN 1120
1170 RET=TRUE
1180 GOTO 1120
1200 IF RET THEN 1220
1210 PRINT KEY(B)
1220 RETURN
1240 REM ** SUBROUTINE SUCCESSOR **
1280 Q=RLINK(P)
1290 IF RLINK(P)>NIL THEN 1320
1300 Q=-Q
1310 GOTO 1360
1320 IF LLINK(Q)=NIL THEN 1360
1340 Q=LLINK(Q)
1350 GOTO 1320
1360 SUC=Q
1370 RETURN
1390 REM  ** SUBROUTINE SEARCH **
1450 P=ROOT
1460 F1=FALSE
1470 IF ((P<>NIL) AND (F1=FALSE)) THEN 1490
1480 GOTO  1600
1490 IF ALPHA=KEY(P) THEN 1580
1500 IF ALPHA<KEY(P) THEN 1560
1510 IF RLINK(P)<=NIL THEN 1540
1520 P=RLINK(P)
1530 GOTO 1470
1540 P=NIL
1550 GOTO 1470
1560 P=LLINK(P)
1570 GOTO 1470
1580 F1=TRUE
1590 GOTO 1470
1600 SEARCH=P
1610 RETURN
2480 REM  ** SUBROUTINE PAR **
2530 F1=FALSE
2540 R=ROOT
2550 IF P<>ROOT THEN 2560
2555 F1=TRUE:R=NIL
2560 IF ((LLINK(R)=P) OR (RLINK(R)=P) OR (F1=TRUE)) THEN 2630
2570 IF KEY(R)<KEY(P) THEN 2600
2580 R=LLINK(R)
2590 GOTO 2610
2600 R=RLINK(R)
2610 IF R=NIL THEN F1=TRUE
2620 GOTO 2560
2630 PAR=R
2640 REM
2650 RETURN
3000 REM ** SUBROUTINE DEL **
3010 IF P=ROOT THEN GOTO 7000
3020 REM  CASE II
3030 GOSUB 2480
3035 Q=PAR
3040 IF LLINK(Q)=P THEN GOTO 6000
3050 REM  CASE II GROUP B
3060 IF RLINK(P)>NIL THEN GOTO 3200
3070 IF LLINK(P)<>NIL THEN GOTO 3110
3080 REM  SUBCASE 1
3090 RLIN(Q)=NIL
3100 GOTO 9000
3110 REM  SUBCASE 3
3120 RLINK(Q)=LLINK(P)
3130 R=LLINK(P)
3140 IF RLINK(R)=-P THEN 3150
3145 R=RLINK(R)
3147 GOTO 3140
3150 RLINK(R)=RLINK(P)
3160 GOTO 9000
3200 IF LLINK(P)<>NIL THEN GOTO 3240
3210 REM SUBCASE 2
3220 RLINK(Q)=RLINK(P)
3230 GOTO 9000
3240 REM  SUBCASE 4
3250 RLINK(Q)=RLINK(P)
3260 R=RLINK(P)
3270 IF LLINK(R)=NIL THEN 3280
3275 R=LLINK(R)
3277 GOTO 3270
3280 LLINK(R)=LLINK(P)
3320 R1=LLINK(P)
3330 IF RLINK(R1)=-P THEN 3340
3335 R1=RLINK(R1)
3337 GOTO 3330
3340 RLINK(R1)=-R
3350 GOTO 9000
6000 REM  CASE II GROUP A
6010 IF RLINK(P)>NIL THEN GOTO 6150
6020 IF LLINK(P)<>NIL THEN GOTO 6060
6030 REM  SUBCASE 1
6040 LLINK(Q)=NIL
6050 GOTO 9000
6060 REM  SUBCASE 3
6070 LINK(Q)=LLINK(P)
6080 R=LLINK(P)
6090 IF RLINK(R)=-P THEN 6100
6095 R=RLINK(R)
6097 GOTO 6090
6100 RLINK(R)=-Q
6110 GOTO 9000
6150 IF LLINK(P)<>NIL THEN GOTO 6190
6160 REM  SUBCASE 2
6170 LLINK(Q)=RLINK(P)
6180 GOTO 9000
6190 REM  SUBCASE 4
6200 LLINK(Q)=RLINK(P)
6210 R=RLINK(P)
6220 IF LLINK(R>)=NIL THEN 6230
6225 R=LLINK(R)
6227 QOTO 6220
6230 LLINK(R)=LLINK(PS)
6270 R1=LLINK(P)
6280 IF RLINK(R1)=-P THEN 6290
6285 R1=RLINK(R1)
6287 GOTO 6280
6290 RLINK(R1)=-R
6300 GOTO 9000
7000 REM  CASE I
7010 IF RLINK(P)>NIL THEN 7150
7020 IF LLINK(P)>NIL THEN 7070
7030 REM  SUBCASE A
7040 EMPTY=TRUE
7850 N=0
7060 GOTO 9000
7070 REM  SUBCASE C
7080 ROOT=LLINK(P)
7090 R=LLINK(P)
7100 IF RLINK(R)=-P THEN 7130
7110 R=RLINK(R)
7120 GOTO 7100
7130 RLINK(R)=NIL
7140 GOTO 9000
7150 IF LLINK(P)>NIL THEN 7190
7160 REM  SUBCASE B
7170 ROOT=RLINK(P)
7180 GOTO 9000
7190 REM  SUBCASE D
7200 ROOT=RLINK(P)
7210 R=ROOT
7220 IF LLINK(R)=NIL THEN 7250
7230 R=LLINK(R)
7240 GOTO 7220
7250 LLINK(R)=LLINK(P)
7260 R1=LLINK(P)
7270 IF RLINK(R1)=-P THEN 7300
7280 R1=RLINK(R1)
7290 GOTO 7270
7300 RLINK(R1)=-R
9000 RETURN
9999 END