home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG080.ARK
/
SORTS.STB
< prev
next >
Wrap
Text File
|
1984-04-29
|
8KB
|
275 lines
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 L1<R1 Then 2240
2470 If S1>0 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