home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug080.ark / SORTS.STB < prev    next >
Encoding:
Text File  |  1984-04-29  |  7.5 KB  |  275 lines
  1.  
  2.    10   @"Structured Basic Sorting Procedures"
  3.    20   @"Version 08/11/81"
  4.    30   @
  5.    40   @"See Cotton G: ""About Sorts"", Interface Age 1981; 6(8):66"
  6.    50   @"and ""About Sorts-Part II"", Interface Age 1981; 6(9):82"
  7.    60   @"for standard basic versions and descriptions of most of"
  8.    70   @"these sorts."
  9.    80   @
  10.    90   Integer Flag,I,J,K,N
  11.   100   Long L,Temporary
  12.   110   Call .Select'sort (;I)
  13.   120   Call .Select'n (;N)
  14.   130   Call .Random'list (N)
  15.   140   Call .Call'sort (I)
  16.   150   Call .Print'results (N)
  17.   160   @
  18.   170   Input"Press RETURN to go on. ",A$
  19.   180   Run
  20.   190   End
  21.   200 Procedure .Select'sort 
  22.   210   Local I
  23.   220   @
  24.   230   @"Sorts Available"
  25.   240   @
  26.   250   @"1. Bubble sort 1"
  27.   260   @"2. Bubble sort 2"
  28.   270   @"3. Bubble sort 3"
  29.   280   @"4. Insert sort 1"
  30.   290   @"5. Insert sort 2"
  31.   300   @"6. Shell sort"
  32.   310   @"7. Heap sort"
  33.   320   @"8. Quick sort 1"
  34.   330   @"9. Quick sort 2"
  35.   340   @"10. Bidirectional bubble sort"
  36.   350   @
  37.   360   Input"Enter the number of the sort you wish to test ",I
  38.   370   If I<1 Or I>10 Then 360
  39.   380   Endproc (I)
  40.   390 Procedure .Select'n 
  41.   400   Local N
  42.   410   @
  43.   420   Input"Enter the size of the array you wish to sort. ",N
  44.   430   If N<1 Or N>1000 Then @"Please enter a number from 1-1000." : Goto 420
  45.   440   Endproc (N)
  46.   450 Procedure .Call'sort (I)
  47.   460   @"Sorting......."
  48.   470   If I=1 Then Call .Bubble'sort'1 (N)
  49.   480   If I=2 Then Call .Bubble'sort'2 (N)
  50.   490   If I=3 Then Call .Bubble'sort'3 (N)
  51.   500   If I=4 Then Call .Insert'sort'1 (N)
  52.   510   If I=5 Then Call .Insert'sort'2 (N)
  53.   520   If I=6 Then Call .Shell'sort (N)
  54.   530   If I=7 Then Call .Heap'sort (N)
  55.   540   If I=8 Then Call .Quick'sort'1 (N)
  56.   550   If I=9 Then Call .Quick'sort'2 (N)
  57.   560   If I=10 Then Call .Bidirectional'bubble'sort (N)
  58.   570   @"Done......."
  59.   580   Endproc 
  60.   590 Procedure .Random'list (N)
  61.   600   @"Creating random array....."
  62.   610   Local I
  63.   620   Long Numbers(N)
  64.   630     For I=1 To N
  65.   640     Numbers(I)=Rnd(0)*1000
  66.   650     Next I
  67.   660   Endproc 
  68.   670 Procedure .Print'results (N)
  69.   680   Local I
  70.   690     For I=1 To N
  71.   700     @ Using" ####.##  ",Numbers(I);
  72.   710     Next I
  73.   720   Endproc 
  74.   730 Procedure .Bubble'sort'1 (N)
  75.   740   Local I,J,Temporary
  76.   750     For J=1 To N-1
  77.   760       For I=1 To N-1
  78.   770       If Numbers(I)>Numbers(I+1) Then  Do
  79.   780         Temporary=Numbers(I)
  80.   790         Numbers(I)=Numbers(I+1)
  81.   800         Numbers(I+1)=Temporary
  82.   810         Enddo
  83.   820       Next I
  84.   830     Next J
  85.   840   Endproc 
  86.   850 Procedure .Bubble'sort'2 (N)
  87.   860   Local I,J,Temporary
  88.   870     For J=N-1 To 2 Step-1
  89.   880       For I=1 To J
  90.   890       If Numbers(I)>Numbers(I+1) Then  Do
  91.   900         Temporary=Numbers(I)
  92.   910         Numbers(I)=Numbers(I+1)
  93.   920         Numbers(I+1)=Temporary
  94.   930         Enddo
  95.   940       Next I
  96.   950     Next J
  97.   960   Endproc 
  98.   970 Procedure .Bubble'sort'3 (N)
  99.   980   Local Flag,I,J,Temporary
  100.   990     For J=N-1 To 2 Step-1
  101.  1000     Flag=0
  102.  1010       For I=1 To J
  103.  1020       If Numbers(I)>Numbers(I+1) Then  Do
  104.  1030         Temporary=Numbers(I)
  105.  1040         Numbers(I)=Numbers(I+1)
  106.  1050         Numbers(I+1)=Temporary
  107.  1060         Flag=1
  108.  1070         Enddo
  109.  1080       Next I
  110.  1090     If Flag=0 Then Endproc 
  111.  1100     Next J
  112.  1110   Endproc 
  113.  1120 Procedure .Insert'sort'1 (N)
  114.  1130   Local I,J,Temporary
  115.  1140     For J=2 To N
  116.  1150     I=J
  117.  1160     If Numbers(I-1)<=Numbers(I) Then 1230
  118.  1170     Temporary=Numbers(I)
  119.  1180     Numbers(I)=Numbers(I-1)
  120.  1190     Numbers(I-1)=Temporary
  121.  1200     I=I-1
  122.  1210     If I>1 Then 1160
  123.  1220     Numbers(I)=Temporary
  124.  1230     Next J
  125.  1240   Endproc 
  126.  1250 Procedure .Insert'sort'2 (N)
  127.  1260   Local I,J,Temporary
  128.  1270     For J=2 To N
  129.  1280     I=J
  130.  1290     Temporary=Numbers(I)
  131.  1300     If Numbers(I-1)<=Temporary Then 1340
  132.  1310     Numbers(I)=Numbers(I-1)
  133.  1320     I=I-1
  134.  1330     If I>1 Then 1300
  135.  1340     Numbers(I)=Temporary
  136.  1350     Next J
  137.  1360   Endproc 
  138.  1370 Procedure .Shell'sort (N)
  139.  1380   Local I,J,K,L,Temporary
  140.  1390   L=(2^Int(Log(N)/Log(2)))-1
  141.  1400   L=Int(L/2)
  142.  1410   If L<1 Then Endproc 
  143.  1420     For J=1 To L
  144.  1430       For K=(J+L) To N Step L
  145.  1440       I=K
  146.  1450       Temporary=Numbers(I)
  147.  1460       If Numbers(I-L)<=Temporary Then 1500
  148.  1470       Numbers(I)=Numbers(I-L)
  149.  1480       I=I-L
  150.  1490       If I>L Then 1460
  151.  1500       Numbers(I)=Temporary
  152.  1510       Next K
  153.  1520     Next J
  154.  1530   Goto 1400
  155.  1540   Endproc 
  156.  1550 Procedure .Heap'sort (N)
  157.  1560   M=N
  158.  1570     For I=Int(N/2) To 1 Step-1
  159.  1580     Call .Switch'elements (I,M)
  160.  1590     Next I
  161.  1600     For M=N-1 To 1 Step-1
  162.  1610     Temporary=Numbers(M+1)
  163.  1620     Numbers(M+1)=Numbers(1)
  164.  1630     Numbers(1)=Temporary
  165.  1640     Call .Switch'elements (1,M)
  166.  1650     Next M
  167.  1660   Endproc 
  168.  1670 Procedure .Switch'elements (J,M)
  169.  1680   Local K,Temporary
  170.  1690   K=J+J
  171.  1700   If K>M Then 1800
  172.  1710   If K=M Then 1740
  173.  1720   If Numbers(K)>=Numbers(K+1) Then 1740
  174.  1730   K=K+1
  175.  1740   If Numbers(J)>=Numbers(K) Then 1800
  176.  1750   Temporary=Numbers(J)
  177.  1760   Numbers(J)=Numbers(K)
  178.  1770   Numbers(K)=Temporary
  179.  1780   J=K
  180.  1790   Goto 1690
  181.  1800   Endproc 
  182.  1810 Procedure .Quick'sort'1 (N)
  183.  1820   Local I
  184.  1830   Dim L(20),R(20)
  185.  1840   S1=1
  186.  1850   L(1)=1
  187.  1860   R(1)=N
  188.  1870   If S1<1 Then 2150
  189.  1880   L1=L(S1)
  190.  1890   R1=R(S1)
  191.  1900   S1=S1-1
  192.  1910   L2=L1
  193.  1920   R2=R1
  194.  1930   Flag=-1
  195.  1940   If L2>=R2 Then 2060
  196.  1950   If Numbers(L2)<=Numbers(R2) Then 2010
  197.  1960   S=S+1
  198.  1970   Temporary=Numbers(L2)
  199.  1980   Numbers(L2)=Numbers(R2)
  200.  1990   Numbers(R2)=Temporary
  201.  2000   Flag=-1*Flag
  202.  2010   If Flag<0 Then 2040
  203.  2020   L2=L2+1
  204.  2030   Goto 1940
  205.  2040   R2=R2-1
  206.  2050   Goto 1940
  207.  2060   If(L2-L1)<2 Then 2100
  208.  2070   S1=S1+1
  209.  2080   L(S1)=L1
  210.  2090   R(S1)=L2-1
  211.  2100   If(R1-R2)<2 Then 1870
  212.  2110   S1=S1+1
  213.  2120   L(S1)=R2+1
  214.  2130   R(S1)=R1
  215.  2140   Goto 1870
  216.  2150   Endproc 
  217.  2160 Procedure .Quick'sort'2 (N)
  218.  2170   Dim L(20),R(20)
  219.  2180   S1=1
  220.  2190   L(1)=1
  221.  2200   R(1)=N
  222.  2210   L1=L(S1)
  223.  2220   R1=R(S1)
  224.  2230   S1=S1-1
  225.  2240   L2=L1
  226.  2250   R2=R1
  227.  2260   X=Numbers(Int((L1+R1)/2))
  228.  2270   If Numbers(L2)>=X Then 2300
  229.  2280   L2=L2+1
  230.  2290   Goto 2270
  231.  2300   If X>=Numbers(R2) Then 2330
  232.  2310   R2=R2-1
  233.  2320   Goto 2300
  234.  2330   If L2>R2 Then 2400
  235.  2340   S=S+1
  236.  2350   Temporary=Numbers(L2)
  237.  2360   Numbers(L2)=Numbers(R2)
  238.  2370   Numbers(R2)=Temporary
  239.  2380   L2=L2+1
  240.  2390   R2=R2-1
  241.  2400   If L2<=R2 Then 2270
  242.  2410   If L2>=R1 Then 2450
  243.  2420   S1=S1+1
  244.  2430   L(S1)=L2
  245.  2440   R(S1)=R1
  246.  2450   R1=R2
  247.  2460   If L1<R1 Then 2240
  248.  2470   If S1>0 Then 2210
  249.  2480   Endproc 
  250.  2490 Procedure .Bidirectional'bubble'sort (N)
  251.  2500   Local Flag,I,J,Temporary
  252.  2510     For J=1 To N/2
  253.  2520     Flag=0
  254.  2530       For I=J To N-J
  255.  2540       If Numbers(I)>Numbers(I+1) Then  Do
  256.  2550         Flag=1
  257.  2560         Temporary=Numbers(I)
  258.  2570         Numbers(I)=Numbers(I+1)
  259.  2580         Numbers(I+1)=Temporary
  260.  2590         Enddo
  261.  2600       Next I
  262.  2610     If Flag=0 Then Endproc 
  263.  2620       For I=N-J To J+1 Step-1
  264.  2630       If Numbers(I-1)>Numbers(I) Then  Do
  265.  2640         Flag=1
  266.  2650         Temporary=Numbers(I-1)
  267.  2660         Numbers(I-1)=Numbers(I)
  268.  2670         Numbers(I)=Temporary
  269.  2680         Enddo
  270.  2690       Next I
  271.  2700     If Flag=0 Then Endproc 
  272.  2710     Next J
  273.  2720   Endproc 
  274.