home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / QBNWS301.ZIP / I-INSERT.ZIP / I-INSERT.BAS
Encoding:
BASIC Source File  |  1992-02-12  |  4.4 KB  |  126 lines
  1. '+==============================================+
  2. '|                I-INSERT.BAS                  |
  3. '|             By Lawrence Stone                |
  4. '|                  02/12/92                    |
  5. '|                                              |
  6. '|  Purpose:  Demonstrate insert sort routine   |
  7. '|            on integer arrays using B$ASSN.   |
  8. '+----------------------------------------------+
  9. DEFINT A-Z
  10.  
  11. DECLARE SUB QuickInsert (LastElement%, Value%, Arry%())
  12.  
  13. DECLARE SUB QBMemCopy ALIAS "B$ASSN" (SEG FromAddress, _
  14. BYVAL BytesFrom%, SEG ToAddress, BYVAL BytesTo%)
  15.  
  16. '---- Array we will be inserting into
  17. DIM SortArray%(1 TO 150)
  18.  
  19. '---- Used by QuickInsert for temporary storage
  20. DIM SHARED TempSortArray%(1 TO 150)
  21.  
  22. CLS
  23.  
  24. PRINT "Unsorted Values..."
  25.  
  26. FOR LastElement% = 1 TO 150
  27.     READ Value
  28.     PRINT Value;          ' Display the unsorted value
  29.    
  30.     '---- Insert the value into its appropriate position.
  31.     QuickInsert LastElement%, Value, SortArray%()
  32. NEXT
  33.  
  34. PRINT : PRINT
  35. PRINT "Sorted Values..."
  36.  
  37. '---- Display our sorted values
  38. FOR N = 1 TO 150
  39.     PRINT SortArray(N);
  40. NEXT
  41.  
  42. END
  43.  
  44. '---- Random numbers between 1 and 150
  45. DATA 59,109,54,111,33,90,144,86,11,30,127,3,94,19,91,60,108,58,73,9,21
  46. DATA 23,40,101,100,107,66,128,43,97,110,42,143,25,65,74,125,46,129,78
  47. DATA 112,104,99,8,31,24,145,51,2,118,16,150,95,55,102,64,98,71,7,77,137
  48. DATA 113,119,141,29,4,72,80,105,18,126,49,70,115,17,120,38,122,69,50,56
  49. DATA 135,147,83,62,61,27,136,34,37,6,57,121,39,93,15,89,82,139,79,132
  50. DATA 32,35,138,142,92,148,140,96,88,84,22,45,67,85,130,133,116,131,1,106
  51. DATA 87,47,146,13,12,52,134,114,26,124,48,103,75,28,117,36,44,68,10,123
  52. DATA 14,53,76,41,20,63,5,81,149
  53.  
  54. SUB QuickInsert (LastElement%, Value%, Arry%()) STATIC
  55.    
  56.     begin% = LBOUND(Arry%)
  57.     Low% = begin%
  58.     ending% = LastElement%
  59.                           
  60.     '---- Binary search toward area of insertion point (fast).
  61.     DO WHILE begin% <= ending%
  62.  
  63.         '---- Set middle midway between begin and ending
  64.         middle% = (begin% + ending%) \ 2
  65.        
  66.         IF middle% > Low% AND middle% < LastElement% THEN
  67.             '---- Bail out if we're at the spot
  68.             IF Value% > Arry%(middle% - 1) AND Value% < Arry%(middle%) _
  69.             THEN EXIT DO
  70.         END IF
  71.  
  72.         IF Value% = Arry%(middle%) THEN     'We found a match so bail out
  73.             EXIT DO
  74.         ELSEIF Value% > Arry%(middle%) THEN 'Look higher up in the array
  75.             begin% = middle% + 1
  76.         ELSE                                'Look lower down the array
  77.             ending% = middle% - 1
  78.         END IF
  79.     LOOP
  80.    
  81.     '**************************************************************
  82.     '---- This REMmed loop would then adjust one element at a time.
  83.     '     This is how it must be done from within the QB or QBX
  84.     '     environment.
  85.  
  86.     'FOR N% = LastElement% - 1 TO middle% STEP -1
  87.         'Arry%(N% + 1) = Arry%(N%)
  88.     'NEXT
  89.     'Arry%(middle%) = Value%
  90.     'EXIT SUB
  91.     '**************************************************************
  92.    
  93.  
  94.     '---- Use this routine in compiled QB (or PDS).  It is EXTREMELY
  95.     '     quick.  It works by copying all of the array's data from
  96.     '     the insertion point through the last element to a temporary
  97.     '     holding array in one quick move.  Then copies from the temp
  98.     '     holding array back to our original array at a location one
  99.     '     element past the insertion point.  Again in one quick move.
  100.     '     It will not work from within the QB or QBX environment so
  101.     '     use the REMmed code above within the environment and the
  102.     '     code below for compiled programs.
  103.     
  104.     '---- Determine the number of bytes to move (64K max)
  105.     MoveBytes% = (LastElement% - middle%) * LEN(Arry%(Low%))
  106.     
  107.     IF MoveBytes% THEN
  108.         '---- Get the lower bound of TempSortArray
  109.         Low% = LBOUND(TempSortArray%)
  110.        
  111.         '---- Copy from our Arry(middle) to TempSortArray
  112.         CALL QBMemCopy(Arry%(middle%), MoveBytes%, _
  113.         TempSortArray%(Low%), MoveBytes%)
  114.        
  115.         '---- Now copy from TempSortArray to Arry(middle + 1)
  116.         CALL QBMemCopy(TempSortArray%(Low%), MoveBytes%, _
  117.         Arry%(middle% + 1), MoveBytes%)
  118.     END IF
  119.    
  120.     '---- Now that data is moved, set the new value into the array at
  121.     '     it's appropriate insertion point
  122.     Arry%(middle%) = Value%
  123.  
  124. END SUB
  125.  
  126.