10 @"Structured Basic Sorting Procedures" 20 @"Version 08/11/81" 30 @ 40 @"See Cotton G: ""About Sorts"", Interface Age 1981; 6(8):66" 50 @"and ""About Sorts-Part II"", Interface Age 1981; 6(9):82" 60 @"for standard basic versions and descriptions of most of" 70 @"these sorts." 80 @ 90 Integer Flag,I,J,K,N 100 Long L,Temporary 110 Call .Select'sort (;I) 120 Call .Select'n (;N) 130 Call .Random'list (N) 140 Call .Call'sort (I) 150 Call .Print'results (N) 160 @ 170 Input"Press RETURN to go on. ",A$ 180 Run 190 End 200 Procedure .Select'sort 210 Local I 220 @ 230 @"Sorts Available" 240 @ 250 @"1. Bubble sort 1" 260 @"2. Bubble sort 2" 270 @"3. Bubble sort 3" 280 @"4. Insert sort 1" 290 @"5. Insert sort 2" 300 @"6. Shell sort" 310 @"7. Heap sort" 320 @"8. Quick sort 1" 330 @"9. Quick sort 2" 340 @"10. Bidirectional bubble sort" 350 @ 360 Input"Enter the number of the sort you wish to test ",I 370 If I<1 Or I>10 Then 360 380 Endproc (I) 390 Procedure .Select'n 400 Local N 410 @ 420 Input"Enter the size of the array you wish to sort. ",N 430 If N<1 Or N>1000 Then @"Please enter a number from 1-1000." : Goto 420 440 Endproc (N) 450 Procedure .Call'sort (I) 460 @"Sorting......." 470 If I=1 Then Call .Bubble'sort'1 (N) 480 If I=2 Then Call .Bubble'sort'2 (N) 490 If I=3 Then Call .Bubble'sort'3 (N) 500 If I=4 Then Call .Insert'sort'1 (N) 510 If I=5 Then Call .Insert'sort'2 (N) 520 If I=6 Then Call .Shell'sort (N) 530 If I=7 Then Call .Heap'sort (N) 540 If I=8 Then Call .Quick'sort'1 (N) 550 If I=9 Then Call .Quick'sort'2 (N) 560 If I=10 Then Call .Bidirectional'bubble'sort (N) 570 @"Done......." 580 Endproc 590 Procedure .Random'list (N) 600 @"Creating random array....." 610 Local I 620 Long Numbers(N) 630 For I=1 To N 640 Numbers(I)=Rnd(0)*1000 650 Next I 660 Endproc 670 Procedure .Print'results (N) 680 Local I 690 For I=1 To N 700 @ Using" ####.## ",Numbers(I); 710 Next I 720 Endproc 730 Procedure .Bubble'sort'1 (N) 740 Local I,J,Temporary 750 For J=1 To N-1 760 For I=1 To N-1 770 If Numbers(I)>Numbers(I+1) Then Do 780 Temporary=Numbers(I) 790 Numbers(I)=Numbers(I+1) 800 Numbers(I+1)=Temporary 810 Enddo 820 Next I 830 Next J 840 Endproc 850 Procedure .Bubble'sort'2 (N) 860 Local I,J,Temporary 870 For J=N-1 To 2 Step-1 880 For I=1 To J 890 If Numbers(I)>Numbers(I+1) Then Do 900 Temporary=Numbers(I) 910 Numbers(I)=Numbers(I+1) 920 Numbers(I+1)=Temporary 930 Enddo 940 Next I 950 Next J 960 Endproc 970 Procedure .Bubble'sort'3 (N) 980 Local Flag,I,J,Temporary 990 For J=N-1 To 2 Step-1 1000 Flag=0 1010 For I=1 To J 1020 If Numbers(I)>Numbers(I+1) Then Do 1030 Temporary=Numbers(I) 1040 Numbers(I)=Numbers(I+1) 1050 Numbers(I+1)=Temporary 1060 Flag=1 1070 Enddo 1080 Next I 1090 If Flag=0 Then Endproc 1100 Next J 1110 Endproc 1120 Procedure .Insert'sort'1 (N) 1130 Local I,J,Temporary 1140 For J=2 To N 1150 I=J 1160 If Numbers(I-1)<=Numbers(I) Then 1230 1170 Temporary=Numbers(I) 1180 Numbers(I)=Numbers(I-1) 1190 Numbers(I-1)=Temporary 1200 I=I-1 1210 If I>1 Then 1160 1220 Numbers(I)=Temporary 1230 Next J 1240 Endproc 1250 Procedure .Insert'sort'2 (N) 1260 Local I,J,Temporary 1270 For J=2 To N 1280 I=J 1290 Temporary=Numbers(I) 1300 If Numbers(I-1)<=Temporary Then 1340 1310 Numbers(I)=Numbers(I-1) 1320 I=I-1 1330 If I>1 Then 1300 1340 Numbers(I)=Temporary 1350 Next J 1360 Endproc 1370 Procedure .Shell'sort (N) 1380 Local I,J,K,L,Temporary 1390 L=(2^Int(Log(N)/Log(2)))-1 1400 L=Int(L/2) 1410 If L<1 Then Endproc 1420 For J=1 To L 1430 For K=(J+L) To N Step L 1440 I=K 1450 Temporary=Numbers(I) 1460 If Numbers(I-L)<=Temporary Then 1500 1470 Numbers(I)=Numbers(I-L) 1480 I=I-L 1490 If I>L Then 1460 1500 Numbers(I)=Temporary 1510 Next K 1520 Next J 1530 Goto 1400 1540 Endproc 1550 Procedure .Heap'sort (N) 1560 M=N 1570 For I=Int(N/2) To 1 Step-1 1580 Call .Switch'elements (I,M) 1590 Next I 1600 For M=N-1 To 1 Step-1 1610 Temporary=Numbers(M+1) 1620 Numbers(M+1)=Numbers(1) 1630 Numbers(1)=Temporary 1640 Call .Switch'elements (1,M) 1650 Next M 1660 Endproc 1670 Procedure .Switch'elements (J,M) 1680 Local K,Temporary 1690 K=J+J 1700 If K>M Then 1800 1710 If K=M Then 1740 1720 If Numbers(K)>=Numbers(K+1) Then 1740 1730 K=K+1 1740 If Numbers(J)>=Numbers(K) Then 1800 1750 Temporary=Numbers(J) 1760 Numbers(J)=Numbers(K) 1770 Numbers(K)=Temporary 1780 J=K 1790 Goto 1690 1800 Endproc 1810 Procedure .Quick'sort'1 (N) 1820 Local I 1830 Dim L(20),R(20) 1840 S1=1 1850 L(1)=1 1860 R(1)=N 1870 If S1<1 Then 2150 1880 L1=L(S1) 1890 R1=R(S1) 1900 S1=S1-1 1910 L2=L1 1920 R2=R1 1930 Flag=-1 1940 If L2>=R2 Then 2060 1950 If Numbers(L2)<=Numbers(R2) Then 2010 1960 S=S+1 1970 Temporary=Numbers(L2) 1980 Numbers(L2)=Numbers(R2) 1990 Numbers(R2)=Temporary 2000 Flag=-1*Flag 2010 If Flag<0 Then 2040 2020 L2=L2+1 2030 Goto 1940 2040 R2=R2-1 2050 Goto 1940 2060 If(L2-L1)<2 Then 2100 2070 S1=S1+1 2080 L(S1)=L1 2090 R(S1)=L2-1 2100 If(R1-R2)<2 Then 1870 2110 S1=S1+1 2120 L(S1)=R2+1 2130 R(S1)=R1 2140 Goto 1870 2150 Endproc 2160 Procedure .Quick'sort'2 (N) 2170 Dim L(20),R(20) 2180 S1=1 2190 L(1)=1 2200 R(1)=N 2210 L1=L(S1) 2220 R1=R(S1) 2230 S1=S1-1 2240 L2=L1 2250 R2=R1 2260 X=Numbers(Int((L1+R1)/2)) 2270 If Numbers(L2)>=X Then 2300 2280 L2=L2+1 2290 Goto 2270 2300 If X>=Numbers(R2) Then 2330 2310 R2=R2-1 2320 Goto 2300 2330 If L2>R2 Then 2400 2340 S=S+1 2350 Temporary=Numbers(L2) 2360 Numbers(L2)=Numbers(R2) 2370 Numbers(R2)=Temporary 2380 L2=L2+1 2390 R2=R2-1 2400 If L2<=R2 Then 2270 2410 If L2>=R1 Then 2450 2420 S1=S1+1 2430 L(S1)=L2 2440 R(S1)=R1 2450 R1=R2 2460 If L10 Then 2210 2480 Endproc 2490 Procedure .Bidirectional'bubble'sort (N) 2500 Local Flag,I,J,Temporary 2510 For J=1 To N/2 2520 Flag=0 2530 For I=J To N-J 2540 If Numbers(I)>Numbers(I+1) Then Do 2550 Flag=1 2560 Temporary=Numbers(I) 2570 Numbers(I)=Numbers(I+1) 2580 Numbers(I+1)=Temporary 2590 Enddo 2600 Next I 2610 If Flag=0 Then Endproc 2620 For I=N-J To J+1 Step-1 2630 If Numbers(I-1)>Numbers(I) Then Do 2640 Flag=1 2650 Temporary=Numbers(I-1) 2660 Numbers(I-1)=Numbers(I) 2670 Numbers(I)=Temporary 2680 Enddo 2690 Next I 2700 If Flag=0 Then Endproc 2710 Next J 2720 Endproc