Russian Sorting Halves Danilin

[DANILIN]

Russian Sorting Halves and fast and human
sorts 1'000'000 in 2.2 seconds

number of elements is written to file with c:/N.txt or use variable n
array d(n) can be read from a file or synthesized in a program

Code: QB64: [Select]

1. ' Russian Sorting Halves Danilin
2.  
3. DECLARE SUB RussianSortingHalvesDAV (ab!, yz!, part!, age!)
4. CLOSE
5. OPEN "c:/N.txt" FOR INPUT AS #1
6. INPUT #1, n
7. 'n=1234567
8. age = 1 + LOG(n) / LOG(2)
9. PRINT n
10.  
11. DIM SHARED d(n) 'AS LONG
12. DIM SHARED a(n) 'AS LONG
13.  
14. 'OPEN "c:/ISX.txt" FOR INPUT AS #2
15. 'FOR i=1 TO n: INPUT #2, d(i): NEXT
16.  
17. 'FOR i = 1 TO n: d(i) = n - i + 1: NEXT ' INT(RND*n)
18. FOR i = 1 TO n: d(i) = INT(RND * n): NEXT '
19.  
20. FOR k = 1 TO 20: PRINT d(k);: NEXT: PRINT: PRINT
21. FOR k = n - 19 TO n: PRINT d(k);: NEXT: PRINT: PRINT
22.  
23. start = TIMER
24.  
25. IF age > 0 THEN
26.     CALL RussianSortingHalvesDAV(1, n, 1, age)
27. END IF
28.  
29. finish = TIMER
30.  
31. PRINT finish - start; "second ": PRINT
32.  
33. OPEN "c:/=RuSortHalves_dav.txt" FOR OUTPUT AS #3
34. PRINT #3, finish - start; "second "
35. PRINT #3, n; "elements", "RECURSION"
36. FOR i = 1 TO 22: PRINT #3, d(i): NEXT
37. FOR i = n - 22 TO n: PRINT #3, d(i): NEXT
38.  
39. FOR k = 1 TO 20: PRINT d(k);: NEXT: PRINT: PRINT
40. FOR k = n - 19 TO n: PRINT d(k);: NEXT: PRINT: PRINT
41.  
42. END
43.  
44. SUB RussianSortingHalvesDAV (ab, yz, part, age)
45.  
46. IF yz - ab < 1 THEN EXIT SUB
47.  
48. FOR i = ab TO yz
49.     summa = summa + d(i)
50. NEXT
51. middle = summa / (yz - ab + 1)
52.  
53. abc = ab - 1
54. xyz = yz + 1
55.  
56. FOR i = ab TO yz
57.     IF d(i) < middle THEN abc = abc + 1: a(abc) = d(i): ELSE xyz = xyz - 1: a(xyz) = d(i)
58. NEXT
59.  
60. FOR i = ab TO yz: d(i) = a(i): NEXT
61.  
62. IF part < age THEN
63.     IF abc >= ab THEN CALL RussianSortingHalvesDAV(ab, abc, part + 1, age)
64.     IF xyz <= yz THEN CALL RussianSortingHalvesDAV(xyz, yz, part + 1, age)
65. END IF
66.  
67. END SUB
68.  

Russian Sorting Halves Danilin visualisation

http://kenokeno.ucoz.ru/win/rusortpol10.gif

  [ You are not allowed to view this attachment ]  

[bplus]

Welcome to the forum DANILIN,

Let me guess, you are running in Linux. Can't remember last time Windows let us print to root, c:\

Are files really necessary?

[codeguy]

With a couple mods, no. I found this sort for n=1234567 to be slower by considerable margins than even the visualized version of FlashSort.

Code: QB64: [Select]

1. TYPE SortRec
2.     Swaps AS DOUBLE
3.     compares AS DOUBLE
4.     writes AS DOUBLE
5.     timestart AS DOUBLE
6.     timeend AS DOUBLE
7.     accumulatedtime AS DOUBLE
8.     runs AS SINGLE
9.     NSorted AS DOUBLE
10.     retrievals AS DOUBLE
11.     NotSwapped AS DOUBLE
12.     title AS STRING * 256
13.     sorttocall AS INTEGER
14. END TYPE
15.  
16. TYPE PixelRec
17.     pcolor AS INTEGER
18.     pixnum AS LONG
19. END TYPE
20. DIM SHARED Sorts(0 TO 255) AS SortRec
21. DIM SHARED SortNum
22. DIM SHARED numcolors%
23. maxscreenx = 1366
24. maxscreeny = 768
25. numcolors% = 256
26. n& = (maxscreenx * maxscreeny)
27. DIM SHARED Pixels(0 TO n& - 1) AS PixelRec
28. SCREEN _NEWIMAGE(maxscreenx, maxscreeny, numcolors%)
29. DIM t AS SortRec
30. '* OpenFile t, "r", channel%, "stats.txt"
31. 'DO
32. '    IF i& > LOF(channel%) \ LEN(t) THEN
33. '        EXIT DO
34. '    ELSE
35. '        i& = i& + 1
36. '        GET #channel%, i&, t
37. '        Sorts(i&) = t
38. '    END IF
39. 'LOOP
40. lastsort% = -1
41. DO
42.     SortNum = 3 'INT(RND * 19)
43.     Sorts(SortNum).sorttocall = SortNum
44.     SELECT CASE SortNum
45.         CASE 1
46.             HandleSort Sorts(), "QuickSort (Recursive) -- CAR Hoare", 0, n& - 1, maxscreenx
47.         CASE 2
48.             HandleSort Sorts(), "ShellSort (Metzler Variant) -- (DL Shell) with improvement by Donald Metzler and seal of approval by Donald knuth", 0, n& - 1, maxscreenx
49.         CASE 3
50.             HandleSort Sorts(), "FlashSort -- (Karl Dietrich Neubert) non-comparison sort really fast", 1, n& - 1, maxscreenx
51.         CASE 4
52.             HandleSort Sorts(), "Radix Sort -- Jon Von Neumann", 0, n& - 1, maxscreenx
53.         CASE 5
54.             HandleSort Sorts(), "Shell Sort (Original) -- (DL Shell)", 0, (n& - 1) \ 8, maxscreenx
55.         CASE 6
56.             HandleSort Sorts(), "Shell Sort (Single pass per gap - shrink factor = 1.247...) -- (DL Shell)", 0, n& - 1, maxscreenx
57.         CASE 7
58.             HandleSort Sorts(), "HeapSort -- (BR Heap)", 0, n& - 1, maxscreenx
59.         CASE 8
60.             HandleSort Sorts(), "CombSort  -- Wlodzimierz Dobosiewicz (later, Lacey, Box)", 0, n& - 1, maxscreenx
61.         CASE 9
62.             HandleSort Sorts(), "ShearSort -- some CompuGeeks", 0, 16 * maxscreenx - 1, maxscreenx
63.             ResetScreen% = -1
64.         CASE 10
65.             HandleSort Sorts(), "PostSort -- Your Local Mailman", 0, n& - 1, maxscreenx
66.         CASE 11
67.             BatcherScreenX& = 1
68.             DO
69.                 IF BatcherScreenX& * 2 > maxscreenx THEN
70.                     EXIT DO
71.                 ELSE
72.                     BatcherScreenX& = BatcherScreenX& * 2
73.                 END IF
74.             LOOP
75.             BatcherScreenY& = 1
76.             DO
77.                 IF BatcherScreenY& * 2 > maxscreeny THEN
78.                     EXIT DO
79.                 ELSE
80.                     BatcherScreenY& = BatcherScreenY& * 2
81.                 END IF
82.             LOOP
83.             xy& = BatcherScreenX& * BatcherScreenY&
84.             HandleSort Sorts(), "Batcher Odd-even MergeSort -- Kenneth E Batcher", 0, xy& - 1, BatcherScreenX&
85.             ResetScreen% = -1
86.         CASE 12
87.             HandleSort Sorts(), "Bucket Sort -- Bucky T (not really)", 0, n& - 1, maxscreenx
88.         CASE 13
89.             HandleSort Sorts(), "MergeSort (recursive)", 0, n& - 1, maxscreenx
90.         CASE 14
91.             HandleSort Sorts(), "QuickSort Recursive (Stable) -- CAR Hoare, Codeguy!", 0, n& - 1, maxscreenx
92.         CASE 15
93.             HandleSort Sorts(), "QuickSort Iterative -- CAR Hoare", 0, n& - 1, maxscreenx
94.         CASE 16
95.             HandleSort Sorts(), "MergeExperiment -- ** codeguy! **", 0, n& - 1, maxscreenx
96.         CASE 17
97.             HandleSort Sorts(), "Bidirectional ShellSort -- guys in white coats & codeguy", 0, n& - 1, maxscreenx
98.         CASE 18
99.             HandleSort Sorts(), "CodeGuySort -- Who Knows but it works -- and fast -- invented by codeguy", 0, n& - 1, maxscreenx
100.         CASE 19
101.             HandleSort Sorts(), "Prime Gap Sort -- codeguy", 0, n& - 1, maxscreenx
102.         CASE 20
103.             HandleSort Sorts(), "QuickStepRecursive", 0, n& - 1, maxscreenx
104.         CASE 97
105.             HandleSort Sorts(), "Tree Sort Ascending -- the keebler elves", 0, 2 * (n& - 1) \ 8, maxscreenx
106.         CASE 98
107.             HandleSort Sorts(), "OESort", 0, n& - 1, maxscreenx
108.         CASE 99
109.             HandleSort Sorts(), "JSort -- Some guy named J", 0, (n& - 1) \ 16, maxscreenx
110.         CASE ELSE
111.             HandleSort Sorts(), "CodeGuySort -- Who Knows but it works -- and fast -- invented by codeguy", 0, n& - 1, maxscreenx
112.     END SELECT
113.     IF SortNum <> lastsort% THEN
114.         IF ResetScreen% THEN
115.             SCREEN _NEWIMAGE(maxscreenx, maxscreeny, numcolors%)
116.             ResetScreen% = 0
117.             lastsort% = SortNum
118.         END IF
119.     END IF
120.     x$ = INKEY$
121.     IF x$ = "\" THEN
122.         EXIT DO
123.     END IF
124. LOOP
125. nprinted = 0: GetRawSpeed% = -1
126. FOR i = 0 TO UBOUND(sorts)
127.     IF Sorts(i).runs > 0 THEN
128.         IF Sorts(i).accumulatedtime > 0 THEN
129.             IF Sorts(i).NSorted > 0 THEN
130.                 LOCATE nprinted \ 2 + 1, (nprinted MOD 2) * 40 + 1
131.                 PRINT USING "SpeedIndex(lo=fast)####.####:"; SpeedIndex#(Sorts(i), 0, n& - 1, GetRawSpeed%, tstart#, tend#, maxscreenx)
132.                 PRINT USING "Swaps    ###,###,###,###,###:"; Sorts(i).Swaps
133.                 PRINT USING "comparisons#,###,###,###,###:"; Sorts(i).compares
134.                 PRINT USING "writes     #,###,###,###,###:"; Sorts(i).writes
135.                 PRINT USING "10000(acc)time##,###,###,###:"; Sorts(i).accumulatedtime * 10000
136.                 PRINT USING "times executed##,###,###,###:"; Sorts(i).runs
137.                 PRINT USING "items sorted ###,###,###,###:"; Sorts(i).NSorted
138.                 PRINT USING "NRetrievals#,###,###,###,###:"; Sorts(i).retrievals
139.                 PRINT USING "Not Swapped#,###,###,###,###:"; Sorts(i).NotSwapped
140.                 PRINT USING "Items/sec##,###,###,###.####:"; Sorts(i).NSorted / Sorts(i).accumulatedtime
141.                 PRINT USING "time(start)  ##,###,###.####:"; Sorts(i).timestart
142.                 PRINT USING "time(end)    ##,###,###.####:"; Sorts(i).timeend
143.                 PRINT LTRIM$(RTRIM$(Sorts(i).title))
144.                 PRINT STRING$(100, "-")
145.                 nprinted = nprinted + 1
146.             END IF
147.         END IF
148.     END IF
149.     '* PUT #channel%, i, Sorts(i)
150. NEXT
151. '* OpenFile t, "c", channel%, "stats.txt"
152. DO
153.     x$ = INKEY$
154. LOOP UNTIL x$ = ""
155. DO
156.     x$ = INKEY$
157. LOOP UNTIL x$ = CHR$(27)
158. SYSTEM
159.  
160. SUB OpenFile (rec AS SortRec, mode$, channel%, f$)
161.     channel% = FREEFILE
162.     IF channel% > 0 THEN
163.         SELECT CASE mode$
164.             CASE "r"
165.                 OPEN f$ FOR RANDOM AS channel% LEN = LEN(rec)
166.             CASE "o"
167.                 OPEN f$ FOR OUTPUT AS channel%
168.             CASE "a"
169.                 OPEN f$ FOR APPEND AS channel%
170.             CASE "i"
171.                 OPEN f$ FOR INPUT AS channel%
172.             CASE "c"
173.                 IF channel% > 0 THEN
174.                     CLOSE channel%
175.                 END IF
176.         END SELECT
177.     END IF
178. END SUB
179. SUB HandleSort (s() AS SortRec, x$, start&, finish&, maxw)
180.     SortNum = s(SortNum).sorttocall
181.     s(SortNum).title = "[" + LTRIM$(STR$(SortNum)) + "]" + x$
182.     s(SortNum).sorttocall = SortNum
183.     _TITLE Sorts(SortNum).title
184.     s(SortNum).NSorted = s(SortNum).NSorted + finish& - start& + 1
185.     SCREEN _NEWIMAGE(maxw, (finish& - start& + 1) / maxw, numcolors%)
186.     FOR i& = start& TO finish&
187.         Pixels(i&).pcolor = INT(RND * numcolors%) + 1
188.         Pixels(i&).pixnum = i&
189.         PixelSet i&, maxw, Pixels(i&).pcolor
190.     NEXT
191.     s(SortNum).timestart = TIMER
192.     SELECT CASE SortNum
193.         CASE 1
194.             QuickSort start&, finish&, maxw
195.         CASE 2
196.             ShellSortMetzler start&, finish&, maxw
197.         CASE 3
198.             FlashSort start&, finish&, maxw
199.         CASE 4
200.             RadixSort start&, finish&, maxw
201.         CASE 5
202.             ShellSort start&, finish&, maxw
203.         CASE 6
204.             ShellSortSinglepass start&, finish&, maxw
205.         CASE 7
206.             HeapSort start&, finish&, maxw
207.         CASE 8
208.             CombSort start&, finish&, maxw
209.         CASE 9
210.             ShearSort start&, finish&, maxw
211.             ResetScreen% = -1
212.         CASE 10
213.             PostSort start&, finish&, maxw
214.         CASE 11
215.             BatcherOddEvenMergeSort start&, finish&, maxw
216.             ResetScreen% = -1
217.         CASE 12
218.             BucketSort start&, finish&, maxw
219.         CASE 13
220.             MergeSort start&, finish&, maxw
221.         CASE 14
222.             QuickSortRStable Pixels(), start&, finish&, maxw
223.         CASE 15
224.             QuickSortIterative start&, finish&, maxw
225.         CASE 16
226.             MergeExperiment start&, finish&, maxw
227.         CASE 17
228.             BidirectionalShellSort start&, finish&, maxw
229.         CASE 18
230.             CodeGuySort start&, finish&, maxw
231.         CASE 19
232.             PrimeGapSort start&, finish&, maxw
233.         CASE 20
234.             QuickStepRecursive start&, finish&, 2, maxw
235.             QuickStepRecursive start&, finish&, 1, maxw
236.         CASE 97
237.             TreeSortAscending start&, finish&, maxw
238.         CASE 98
239.             OESort start&, finish&, maxw
240.         CASE 99
241.             JSort start&, finish&, maxw
242.         CASE ELSE
243.             CodeGuySort start&, finish&, maxw
244.     END SELECT
245.     s(SortNum).timeend = TIMER
246.     s(SortNum).runs = s(SortNum).runs + 1
247.     IF s(SortNum).timeend < s(SortNum).timestart THEN
248.         s(SortNum).accumulatedtime = s(SortNum).accumulatedtime + (s(SortNum).timeend - s(SortNum).timestart) + 86400
249.     ELSE
250.         s(SortNum).accumulatedtime = s(SortNum).accumulatedtime + s(SortNum).timeend - s(SortNum).timestart
251.     END IF
252. END SUB
253. SUB SetRandomPixels (p() AS PixelRec, start&, finish&, maxw)
254.     FOR i& = start& TO finish&
255.         Pixels(i&).pixnum = i&
256.         Pixels(i&).pcolor = INT(RND * numcolors%) + 1
257.     NEXT
258. END SUB
259.  
260. SUB QuickSort (start&, finish&, maxw)
261.     IF finish& - start& = 1 THEN
262.         IF LessThan%(CompareScreen%(finish&, start&, maxw)) THEN
263.             PixelSwap start&, finish&, maxw
264.         END IF
265.     ELSE
266.         IF finish& - start& > 1 THEN
267.             i& = start&
268.             j& = finish&
269.             m% = GetPixel%(i& + RND * (j& - i& + 1), maxw)
270.             DO
271.                 WHILE GetPixel%(i&, maxw) < m%
272.                     i& = i& + 1
273.                     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
274.                 WEND
275.                 WHILE GetPixel%(j&, maxw) > m%
276.                     j& = j& - 1
277.                     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
278.                 WEND
279.                 IF i& < j& THEN
280.                     PixelSwap i&, j&, maxw
281.                 END IF
282.                 i& = i& + 1
283.                 j& = j& - 1
284.             LOOP UNTIL i& > j&
285.             QuickSort i&, finish&, maxw
286.             QuickSort start&, j&, maxw
287.         END IF
288.     END IF
289. END SUB
290.  
291. '* Radix sort is akin to Postman's sort, however instead of sorting items after they've been inserted into their proper "boxes,"
292. '* another pass is made using the next character (in this case bit) of the sortation key. bits& can be changed to the number of
293. '* characters in the sorting key (Field length). RadixSort also has a linear running time, but requires extra storage in exchange
294. '* for speed. RadixSort is not a true comparison sort. It's actually more of a computed distribution sort than anything else. RadixSort
295. '* in this implementation is Stable. Speed... Stability... Linear running time... (Hmmm...)
296.  
297. SUB RadixSort (Start&, Finish&, maxw)
298.     'ChangeTitleBar "RadixSort ****"
299.     FOR i& = Start& TO Finish&
300.         t% = GetPixel%(i&, maxw)
301.         IF t% > h% THEN
302.             h% = t%
303.         END IF
304.     NEXT
305.     DIM PsCount%(0 TO h%, Start& TO Finish&), ct&(h%), Pow2&(32)
306.     bits& = LOG(h% + 2) \ LOG(2) + 1
307.     FOR i = 0 TO bits&
308.         Pow2&(i) = 2 ^ i
309.     NEXT
310.     FOR j& = 0 TO bits&
311.         FOR i& = Start& TO Finish&
312.             a% = GetPixel%(i&, maxw)
313.             x% = a% AND Pow2&(j&)
314.             PsCount%(x%, ct&(x%)) = a%
315.             ct&(x%) = ct&(x%) + 1
316.         NEXT
317.         index& = Start&
318.         FOR u% = 0 TO h%
319.             FOR i& = 0 TO ct&(u%) - 1
320.                 PixelSet index&, maxw, PsCount%(u%, i&)
321.                 index& = index& + 1
322.             NEXT
323.             ct&(u%) = 0
324.         NEXT
325.     NEXT
326. END SUB
327.  
328. '* this is dl shell's sort but modified for faster running time than standard shellsort.
329. SUB ShellSortMetzler (Start&, Finish&, maxw)
330.     m& = Metzler&(Start&, Finish&)
331.     WHILE m& > 0
332.         FOR j& = Start& TO Finish& - m&
333.             l& = j& + m&
334.             B% = GetPixel%(l&, maxw)
335.             FOR i& = j& TO Start& STEP -m&
336.                 IF GetPixel%(i&, maxw) > B% THEN
337.                     PixelSwap i& + m&, i&, maxw
338.                     l& = i&
339.                 ELSE
340.                     i& = Start&
341.                 END IF
342.                 Sorts(SortNum).compares = Sorts(SortNum).compares + 1
343.             NEXT
344.             PixelSet l&, maxw, B%
345.         NEXT
346.         m& = (m& - 1) \ 3
347.     WEND
348. END SUB
349.  
350. FUNCTION Metzler& (a&, b&)
351.     x& = (b& - a& + 1) \ 3
352.     s& = 0
353.     DO
354.         IF x& < 1 THEN
355.             EXIT DO
356.         ELSE
357.             s& = 3 * s& + 1
358.             x& = (x& - 1) \ 3
359.         END IF
360.     LOOP
361.     Metzler& = s&
362. END FUNCTION
363.  
364. SUB ShellSort (start, finish&, maxw)
365.     Gap& = (finish& - Start& + 1)
366.     DO
367.         st& = Start&: b& = st&
368.         ends& = finish& - Gap&: a& = ends&
369.         DO
370.             st& = b&
371.             ends& = a&
372.             a& = st&
373.             b& = ends&
374.             FOR i& = st& TO ends&
375.                 IF GetPixel%(i&, maxw) > GetPixel%(i& + Gap&, maxw) THEN
376.                     PixelSwap i&, i& + Gap&, maxw
377.                     a& = i&
378.                     IF i& < b& THEN
379.                         b& = i&
380.                     END IF
381.                 END IF
382.             NEXT
383.         LOOP WHILE (a& > st&) ' OR (b& = ends&)
384.         Gap& = Gap& \ 2
385.         st& = Start&
386.         ends& = finish& - Gap&
387.     LOOP UNTIL Gap& < 1
388. END SUB
389.  
390. SUB ShellSortSinglepass (start&, finish&, maxw)
391.     Gap& = (finish& - start& + 1) \ 1.247#
392.     DO
393.         FOR i& = start& TO finish& - Gap&
394.             IF CompareScreen%(i&, i& + Gap&, maxw) = 1 THEN
395.                 PixelSwap i&, i& + Gap&, maxw
396.             END IF
397.         NEXT
398.         Gap& = INT(Gap& / 1.247#)
399.     LOOP UNTIL Gap& < 1
400. END SUB
401.  
402. SUB FlashSort (Start&, finish&, maxw)
403.     m& = .128 * finish&
404.     DIM L(m&), a(Start& TO finish&)
405.     nmax& = Start&
406.     minptr& = Start&
407.     FOR i& = Start& TO finish&
408.         a(i&) = GetPixel%(i&, maxw)
409.         IF CompareScreen%(i&, minptr&, maxw) = -1 THEN minptr& = i&
410.         IF CompareScreen%(i&, nmax&, maxw) = 1 THEN nmax& = i&
411.     NEXT i&
412.     IF CompareScreen%(minptr&, nmax&, maxw) = 0 THEN EXIT SUB
413.     C1# = (m& - 1) / (a(nmax&) - a(minptr&))
414.     FOR k& = 1 TO m&
415.         L(k&) = 0
416.     NEXT k&
417.     FOR i& = Start& TO finish&
418.         k& = 1 + INT(C1# * (a(i&) - a(minptr&)))
419.         L(k&) = L(k&) + 1
420.     NEXT i&
421.     FOR k& = 2 TO m&
422.         L(k&) = L(k&) + L(k& - 1)
423.     NEXT k&
424.     anmin% = a(minptr&)
425.     hold% = a(nmax&)
426.     a(nmax&) = a(Start&)
427.     a(Start&) = hold%
428.     PixelSwap nmax&, Start&, maxw
429.     PixelSet Start&, hold%, maxw
430.     nmove& = 0
431.     j& = 1
432.     k& = m&
433.     WHILE (nmove& < (finish& - 1))
434.         WHILE (j& > L(k&))
435.             j& = j& + 1
436.             k& = 1 + INT(C1# * (a(j&) - anmin%))
437.         WEND
438.         flash% = a(j&)
439.         PixelSet j&, maxw, flash%
440.         WHILE (NOT (j& = (L(k&) + 1)))
441.             k& = 1 + INT(C1# * (flash% - anmin%))
442.             PixelSet L(k&), maxw, a(L(k&))
443.             hold% = a(L(k&))
444.             a(L(k&)) = flash%
445.             PixelSet L(k&), maxw, flash%
446.             flash% = hold%
447.             L(k&) = L(k&) - 1
448.             nmove& = nmove& + 1
449.         WEND
450.     WEND
451.     FOR i& = finish& - 2 TO Start& STEP -1
452.         IF CompareArray%(a(), i& + 1, i&) = -1 THEN
453.             hold% = a(i&)
454.             j& = i&
455.             WHILE (a(j& + 1) < hold%)
456.                 PixelSwap j&, j& + 1, maxw
457.                 a(j&) = a(j& + 1)
458.                 j& = j& + 1
459.             WEND
460.             a(j&) = hold%
461.             PixelSet j&, maxw, hold%
462.         END IF
463.     NEXT i&
464. END SUB
465.  
466. FUNCTION GetPixel% (i&, maxw)
467.     col% = i& MOD maxw
468.     row% = (i& - col%) / maxw
469.     GetPixel% = POINT(col%, row%)
470.     Sorts(SortNum).retrievals = Sorts(SortNum).retrievals + 1
471. END FUNCTION
472.  
473. SUB PixelSet (i&, maxw, c%)
474.     col% = i& MOD maxw
475.     row% = (i& - col%) / maxw
476.     PSET (col%, row%), c%
477.     Sorts(SortNum).writes = Sorts(SortNum).writes + 1
478.     'Pixels(i&).pcolor = c%
479. END SUB
480.  
481. SUB PixelSwap (i&, j&, maxw)
482.     IF i& <> j& THEN
483.         a% = GetPixel%(i&, maxw)
484.         b% = GetPixel%(j&, maxw)
485.         IF a% = b% THEN
486.             Sorts(SortNum).NotSwapped = Sorts(SortNum).NotSwapped + 1
487.         ELSE
488.             PixelSet j&, maxw, a%
489.             PixelSet i&, maxw, b%
490.             Sorts(SortNum).Swaps = Sorts(SortNum).Swaps + 1
491.             'Pixels(i&).pcolor = b%
492.             'Pixels(j&).pcolor = a%
493.         END IF
494.     END IF
495. END SUB
496.  
497. FUNCTION CompareScreen% (i&, j&, maxw)
498.     s% = 0
499.     IF GetPixel%(i&, maxw) > GetPixel%(j&, maxw) THEN
500.         s% = 1
501.     ELSE
502.         IF GetPixel%(i&, maxw) < GetPixel%(j&, maxw) THEN
503.             s% = -1
504.         END IF
505.     END IF
506.     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
507.     CompareScreen% = s%
508. END SUB
509.  
510. FUNCTION CompareArray% (a(), i&, j&)
511.     s% = 0
512.     IF a(i&) < a(j&) THEN
513.         s% = -1
514.     ELSE
515.         IF a(i&) > a(j&) THEN
516.             s% = 1
517.         END IF
518.     END IF
519.     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
520.     CompareArray% = s%
521. END FUNCTION
522.  
523. FUNCTION LessThan% (a%)
524.     s% = 0
525.     IF a% = -1 THEN
526.         s% = -1
527.     END IF
528.     LessThan% = s%
529. END FUNCTION
530.  
531. SUB QuickStepRecursive (start&, finish&, incby%, maxw)
532.     IF finish& - start& < incby% ^ 2 THEN
533.         IF LessThan%(CompareScreen%(finish&, start&, maxw)) THEN
534.             PixelSwap finish&, start&, maxw
535.         END IF
536.     ELSE 'IF finish& - start& > incby% ^ 2 THEN
537.         i& = start&
538.         remainder% = (finish& - start&) MOD incby%
539.         j& = i& + incby% * ((finish& - start& - remainder%) / incby%)
540.         'j& = start& + incby% * ((finish& - start&) / (incby%))
541.         middle& = i& + (j& - i&) \ (incby%)
542.         m% = GetPixel%(middle&, maxw)
543.         DO
544.             WHILE GetPixel%(i&, maxw) < m% AND i& < j&
545.                 i& = i& + incby%
546.             WEND
547.             WHILE GetPixel%(j&, maxw) > m% AND j& > i&
548.                 j& = j& - incby%
549.             WEND
550.             IF i& < j& THEN
551.                 PixelSwap i&, j&, maxw
552.             END IF
553.             i& = i& + incby%
554.             j& = j& - incby%
555.         LOOP UNTIL j& - i& <= incby% ^ 2
556.         QuickStepRecursive i&, finish&, incby%, maxw
557.         QuickStepRecursive start&, j&, incby%, maxw
558.     END IF
559. END SUB
560.  
561. FUNCTION NLOGN# (n&)
562.     NLOGN# = n& * (LOG(n&) / LOG(2))
563. END FUNCTION
564.  
565. ' this version of HeapSort can now sort parts of lists, rather than being limited to entire lists. The one that usually appears is one that
566. ' sorts from the beginning to the end.
567.  
568. SUB HeapSort (Start&, Finish&, maxw)
569.     FOR i& = Start& + 1 TO Finish&
570.         PercolateUp Start&, i&, maxw
571.     NEXT i&
572.  
573.     FOR i& = Finish& TO Start& + 1 STEP -1
574.         PixelSwap Start&, i&, maxw
575.         PercolateDown Start&, i& - 1, maxw
576.     NEXT i&
577.  
578. END SUB
579.  
580. SUB PercolateDown (Start&, MaxLevel&, maxw)
581.     i& = Start&
582.     ' Move the value in GetPixel%(Start&) down the heap until it has
583.     ' reached its proper node (that is, until it is less than its parent
584.     ' node or until it has reached MaxLevel&, the bottom of the current heap):
585.     DO
586.         Child& = 2 * (i& - Start&) + Start& ' Get the subscript for the Child& node.
587.         ' Reached the bottom of the heap, so exit this procedure:
588.         IF Child& > MaxLevel& THEN EXIT DO
589.         ' If there are two Child nodes, find out which one is bigger:
590.         ax& = Child& + 1
591.         IF ax& <= MaxLevel& THEN
592.             IF CompareScreen%(ax&, Child&, maxw) = 1 THEN
593.                 Child& = ax&
594.             END IF
595.         END IF
596.  
597.         ' Move the value down if it is still not bigger than either one of
598.         ' its Child&ren:
599.         IF CompareScreen%(i&, Child&, maxw) = -1 THEN
600.             PixelSwap i&, Child&, maxw
601.             i& = Child&
602.  
603.             ' Otherwise, GetPixel%() has been restored to a heap from 0 to MaxLevel&,
604.             ' so exit:
605.         ELSE
606.             EXIT DO
607.         END IF
608.     LOOP
609. END SUB
610.  
611. SUB PercolateUp (Start&, MaxLevel&, maxw)
612.     i& = MaxLevel&
613.  
614.     ' Move the value in GetPixel%(MaxLevel&, maxw) up the heap until it has
615.     ' reached its proper node (that is, until it is greater than either
616.     ' of its Child& nodes, or until it has reached 1, the top of the heap):
617.     DO UNTIL i& = Start&
618.         Parent& = Start& + (i& - Start&) \ 2 ' Get the subscript for the parent node.
619.  
620.         ' The value at the current node is still bigger than the value at
621.         ' its parent node, so swap these two array elements:
622.         IF CompareScreen%(i&, Parent&, maxw) = 1 THEN
623.             PixelSwap Parent&, i&, maxw
624.             i& = Parent&
625.  
626.             ' Otherwise, the element has reached its proper place in the heap,
627.             ' so exit this procedure:
628.         ELSE
629.             EXIT DO
630.         END IF
631.     LOOP
632. END SUB
633.  
634. SUB CombSort (Start&, Finish&, maxw)
635.     m = INT(RND * 2)
636.     SELECT CASE m
637.         CASE 0
638.             ShrinkFactor# = 1.247330950103979#
639.         CASE ELSE
640.             ShrinkFactor# = 1.3#
641.     END SELECT
642.     gap& = Finish& - Start&
643.     BooleanSwapped% = -1
644.     WHILE (gap& > 1) OR BooleanSwapped%
645.         IF (gap& > 1) THEN
646.             gap& = INT(gap& / ShrinkFactor#)
647.         END IF
648.         BooleanSwapped% = 0
649.         FOR i& = Start& TO Finish& - gap&
650.             IF CompareScreen%(i&, i& + gap&, maxw) = 1 THEN
651.                 PixelSwap i&, i& + gap&, maxw
652.                 BooleanSwapped% = -1
653.             END IF
654.         NEXT
655.         IF (gap& = 1 AND NOT BooleanSwapped%) THEN
656.             EXIT SUB
657.         END IF
658.     WEND
659. END SUB
660.  
661. '* ShearSort rearranges elements into a "square" array and then sorts even and odd sets of columns and rows. this is the slice and dice method of sorting
662. '* which i assume runs far more quickly on multiprocessors. it is included only as a matter of interest as it is what i consider a "beautiful," even if not
663. '* blindingly fast sorting method. this is a parallel sorting algo translated to single-processor (could be tackled with simultaneous threading if our man
664. '* Galleon could find some way to exploit multiple threads and processors).
665.  
666. SUB ShearSort (start&, finish&, maxw)
667.     MakeSquare% = -1
668.     sortorder% = 1
669.     IF MakeSquare% THEN
670.         '* put elements into a "square" arrangement.
671.         rows& = INT(SQR(finish& - start& + 1))
672.         IF (finish& - start& + 1) MOD rows& THEN
673.             cols& = (finish& - start& + 1) \ rows& + 1
674.         ELSE
675.             cols& = (finish& - start& + 1) / rows&
676.         END IF
677.         IF rows& > cols& THEN
678.             rows& = cols&
679.         ELSE
680.             cols& = rows&
681.         END IF
682.     ELSE
683.         cols& = maxw
684.         rows& = (finish& - start& + 1) / maxw
685.     END IF
686.     SCREEN _NEWIMAGE(cols&, rows&, numcolors%)
687.     FOR i& = start& TO finish&
688.         PixelSet i&, cols&, Pixels(i&).pcolor
689.     NEXT
690.  
691.     colsminusone& = cols& - 1
692.     rminuslplusoneminuscols& = finish& - start& + 1 - cols&
693.     k& = rows&
694.     DO
695.         '* slice
696.         FOR j& = 1 TO cols&
697.             tmpj& = j& MOD 2
698.             FOR i& = start& TO finish& STEP cols&
699.                 IF ((i& - start&) / cols&) MOD 2 THEN
700.                     OETransSort i& + tmpj&, i& + colsminusone&, 1, -sortorder%, cols& '-sortorder%
701.                 ELSE
702.                     OETransSort i& + tmpj&, i& + colsminusone&, 1, sortorder%, cols& '+sortorder% +
703.                 END IF
704.             NEXT
705.         NEXT
706.         '* and then dice
707.         FOR j& = 1 TO rows&
708.             tmpj& = j& MOD 2
709.             FOR i& = start& TO start& + colsminusone&
710.                 SELECT CASE tmpj&
711.                     CASE 0
712.                         OETransSort i&, rminuslplusoneminuscols& + i&, cols&, -sortorder%, cols&
713.                     CASE ELSE
714.                         OETransSort i& + tmpj& * cols&, rminuslplusoneminuscols& + i&, cols&, -sortorder%, cols& '-s%
715.                 END SELECT
716.             NEXT
717.         NEXT
718.         FOR j& = 1 TO cols&
719.             tmpj& = j& MOD 2
720.             FOR i& = l& TO r& STEP cols&
721.                 SELECT CASE tmpj&
722.                     CASE 0
723.                         OETransSort i&, i& + colsminusone&, rows&, sortorder%, cols&
724.                     CASE ELSE
725.                         OETransSort i& + tmpj&, i& + colsminusone&, rows&, sortorder%, cols&
726.                 END SELECT
727.             NEXT
728.         NEXT
729.         k& = (k& - (k& MOD 2)) \ 2
730.     LOOP WHILE k& > 2
731.  
732.     EXIT SUB
733.     FOR j& = 1 TO cols&
734.         tmpj& = j& MOD 2
735.         FOR i& = l& TO r& STEP cols&
736.             SELECT CASE tmpj&
737.                 CASE 0
738.                     OETransSort i&, i& + colsminusone&, 1, sortorder%, cols&
739.                 CASE ELSE
740.                     OETransSort i& + tmpj&, i& + colsminusone&, 1, sortorder%, cols&
741.             END SELECT
742.         NEXT
743.     NEXT
744. END SUB
745.  
746. SUB OETransSort (l&, r&, gap&, order%, maxw)
747.     rx& = gap&
748.     lst& = r& - rx&
749.     FOR i& = l& TO lst& STEP gap& * 2
750.         x% = CompareScreen%(i&, i& + gap&, maxw)
751.         IF x% <> order% THEN
752.             IF x% THEN
753.                 PixelSwap i&, i& + gap&, maxw
754.             END IF
755.         END IF
756.     NEXT
757. END SUB
758.  
759. '* PostSort find the range of the data to be sorted and loads those into "boxes," which is essentially a 2-d array.
760. '* then sort what's in the "boxes" individually using whatever sort -- in this case quicksort.
761. SUB PostSort (start&, Finish&, maxw)
762.     FindMinMax start&, Finish&, lptr&, rptr&, maxw
763.     cmin% = GetPixel%(lptr&, maxw)
764.     cmax% = GetPixel%(rptr&, maxw)
765.     DIM PsCount&(cmin% TO cmax%, start& TO Finish&), ct&(cmin% TO cmax%)
766.     FOR i& = start& TO Finish&
767.         x% = GetPixel%(i&, maxw)
768.         PsCount&(x%, ct&(x%)) = x%
769.         ct&(x%) = ct&(x%) + 1
770.     NEXT
771.     Index& = start&
772.     Last = start&
773.     FOR i% = cmin% TO cmax%
774.         FOR j& = 0 TO ct&(i%) - 1
775.             PixelSet Index&, maxw, PsCount&(i%, start& + j&)
776.             Index& = Index& + 1
777.         NEXT
778.         QuickSort Last&, Last& + ct&(i%) - 1, maxw
779.         Last& = Index&
780.     NEXT
781. END SUB
782.  
783. SUB BatcherOddEvenMergeSort (Start&, Finish&, maxw)
784.     IF (Finish& > 1) THEN
785.         m& = (Finish& + (Finish& MOD 2)) \ 2
786.         BatcherOddEvenMergeSort Start&, m&, maxw
787.         BatcherOddEvenMergeSort Start& + m&, m&, maxw
788.         BatcheroddEvenMerge Start&, Finish&, 1, maxw
789.     END IF
790. END SUB
791.  
792. SUB BatcheroddEvenMerge (Start&, Finish&, r&, maxw)
793.     m& = r& * 2
794.     IF (m& < Finish&) AND m& > 0 THEN
795.         BatcheroddEvenMerge Start&, Finish&, m&, maxw
796.         BatcheroddEvenMerge Start& + r&, Finish&, m&, maxw
797.         i& = Start& + r&
798.         DO
799.             IF i& + m& > Start& + Finish& THEN
800.                 EXIT DO
801.             ELSE
802.                 IF GetPixel%(i&, maxw) > GetPixel%(i& + r&, maxw) THEN
803.                     PixelSwap i&, i& + r&, maxw
804.                 END IF
805.                 i& = i& + m&
806.             END IF
807.         LOOP
808.     ELSE
809.         IF GetPixel%(Start&, maxw) > GetPixel%(Start& + r&, maxw) THEN
810.             PixelSwap Start&, Start& + r&, maxw
811.         END IF
812.     END IF
813. END SUB
814.  
815. SUB JSortReHeap (length&, i&, maxw)
816.     done% = 0
817.     T% = GetPixel%(i&, maxw)
818.     parent& = i&
819.     child& = 2 * (i& + 1) - 1
820.     WHILE ((child& < length&) AND NOT (done%))
821.         IF (child& < length& - 1) THEN
822.             IF (GetPixel%(child&, maxw) >= GetPixel%(child& + 1, maxw)) THEN
823.                 child& = child& + 1
824.             END IF
825.         END IF
826.         IF (T% < GetPixel%(child&, maxw)) THEN
827.             done% = -1
828.         ELSE
829.             PixelSet parent&, maxw, GetPixel%(child&, maxw)
830.             parent& = child&
831.             child& = 2 * (parent& + 1) - 1
832.         END IF
833.         PixelSet parent&, maxw, T%
834.     WEND
835. END SUB
836.  
837. SUB JSortInvReHeap (length&, i&, maxw)
838.     done% = 0
839.     T% = GetPixel%(length& - 1 - i&, maxw)
840.     parent& = i&
841.     child& = 2 * (i& + 1) - 1
842.     WHILE ((child& < length&) AND (NOT done%))
843.         IF (child& < length& - 1) THEN
844.             ns& = length& - 1
845.             IF GetPixel%(ns& - child&, maxw) <= GetPixel%(ns& - child& - 1, maxw) THEN
846.                 child& = child& + 1
847.             END IF
848.         END IF
849.         IF T% > GetPixel%(length& - 1 - child&, maxw) THEN
850.             done% = -1
851.         ELSE
852.             PixelSet length& - 1 - parent&, maxw, GetPixel%(length& - 1 - child&, maxw)
853.             parent& = child&
854.             child& = 2 * (parent& + 1) - 1
855.         END IF
856.     WEND
857.     PixelSet length& - 1 - parent&, maxw, T%
858. END SUB
859.  
860. SUB JSort (start&, finish&, maxw)
861.     '// Do an insertion sort on the almost sorted array
862.     FOR j& = start& TO finish& - 1
863.         '// Heapify top down
864.         IF finish& > j& THEN
865.             FOR i& = finish& - 1 TO j& STEP -2
866.                 JSortReHeap i&, j&, maxw
867.             NEXT
868.             FOR i& = finish& - 1 TO j& STEP -2
869.                 JSortInvReHeap i&, j&, maxw
870.             NEXT
871.         END IF
872.         T% = GetPixel%(j&, maxw)
873.         a& = j&
874.         DO
875.             IF a& > start& THEN
876.                 b& = a&
877.                 a& = a& - 1
878.                 IF GetPixel%(a&, maxw) > T% THEN
879.                     PixelSwap a&, b&, maxw
880.                 ELSE
881.                     EXIT DO
882.                 END IF
883.             ELSE
884.                 EXIT DO
885.             END IF
886.         LOOP
887.         PixelSet b&, maxw, T%
888.     NEXT
889. END SUB
890.  
891. '* to keep BucketSort stable, you must use a stable sort on Lists&(), or if you prefer speed, just use quicksort if you don't care about
892. '* sort stability.
893.  
894. SUB BucketSort (start&, finish&, maxw)
895.     FindMinMax start&, finish&, lptr&, rptr&, maxw
896.     min% = GetPixel%(lptr&, maxw)
897.     max% = GetPixel%(rptr&, maxw)
898.     NBuckets& = SQR(((max% - min%) / 2) ^ 2)
899.     BucketSize& = 1.28 * (finish& - start& + 1) \ (NBuckets&)
900.     DIM Lists&(NBuckets&, BucketSize&), Counts&(min% TO max%), OverFlowedCt&(min% TO max%)
901.     difference& = (max% - min% + 1) \ NBuckets&
902.     FOR i& = start& TO finish&
903.         BucketNum& = GetPixel%(i&, maxw) \ difference&
904.         DO
905.             IF Counts&(BucketNum&) > BucketSize& THEN
906.                 OverFlowedCt&(BucketNum&) = -1
907.                 IF BucketNum& > 0 THEN
908.                     IF Counts&(BucketNum& - 1) > BucketSize& THEN
909.                         BucketNum& = BucketNum& + 1
910.                     ELSE
911.                         BucketNum& = BucketNum& - 1
912.                     END IF
913.                 ELSE
914.                     IF BucketNum& < NBuckets& THEN
915.                         BucketNum& = BucketNum& + 1
916.                     ELSE
917.                         STOP
918.                     END IF
919.                 END IF
920.             ELSE
921.                 EXIT DO
922.             END IF
923.         LOOP
924.         Lists&(BucketNum&, Counts&(BucketNum&)) = GetPixel%(i&, maxw)
925.         Counts&(BucketNum&) = Counts&(BucketNum&) + 1
926.     NEXT
927.     idx& = start&
928.     last& = start&
929.     FOR i& = min% TO max%
930.         '* roughly sorts Lists&() in a stable manner
931.         SortBuckets Lists&(), 0, Counts&(i&) - 1, i&, maxw
932.         FOR u& = 0 TO Counts&(i&) - 1
933.             PixelSet idx&, maxw, Lists&(i&, u&)
934.             idx& = idx& + 1
935.         NEXT
936.         ShellSortMetzler last&, idx& - 1, maxw
937.         last& = idx&
938.     NEXT
939. END SUB
940.  
941. SUB SortBuckets (Lists&(), Start&, Finish&, ListIndex&, maxw)
942.     IF Finish& - Start& = 1 THEN
943.         IF Lists&(ListIndex&, Start&) > Lists&(ListIndex&, Finish&) THEN
944.             SWAP Lists&(ListIndex&, Start&), Lists&(ListIndex&, Finish&)
945.         END IF
946.     ELSE
947.         IF Finish& - Start& > 1 THEN
948.             'u& = (Finish& - Start&) MOD 2
949.             m& = Start& + (Finish& - Start&) \ 2
950.             SortBuckets Lists&(), Start&, m&, ListIndex&, maxw
951.             SortBuckets Lists&(), m&, Finish&, ListIndex&, maxw
952.         END IF
953.     END IF
954. END SUB
955.  
956. SUB FindMinMax (start&, finish&, MinPtr&, MaxPtr&, maxw)
957.     MinPtr& = start&: min% = GetPixel%(start&, maxw)
958.     MaxPtr& = start&: max% = GetPixel%(start&, maxw)
959.     FOR i& = start& TO finish&
960.         m% = GetPixel%(i&, maxw)
961.         IF m% < min% THEN
962.             min% = m%
963.             MinPtr& = i&
964.         END IF
965.         IF m% > max% THEN
966.             max% = m%
967.             MaxPtr& = i&
968.         END IF
969.     NEXT
970. END SUB
971.  
972. SUB MergeSort (start&, finish&, maxw)
973.     IF start& >= finish& THEN EXIT SUB
974.     length& = finish& - start& + 1
975.     middle& = start& + (finish& - start&) \ 2
976.     MergeSort start&, middle&, maxw
977.     MergeSort middle& + 1, finish&, maxw
978.     DIM temp(length& - 1)
979.     FOR i& = 0 TO length& - 1
980.         temp(i&) = GetPixel%(start& + i&, maxw)
981.     NEXT
982.     mptr& = 0
983.     sptr& = middle& - start& + 1
984.     FOR i& = 0 TO length& - 1
985.         IF sptr& <= finish& - start& THEN
986.             IF mptr& <= middle& - start& THEN
987.                 IF temp(mptr&) > temp(sptr&) THEN
988.                     PixelSet i& + start&, maxw, temp(sptr&)
989.                     sptr& = sptr& + 1
990.                 ELSE
991.                     PixelSet i& + start&, maxw, temp(mptr&)
992.                     mptr& = mptr& + 1
993.                 END IF
994.             ELSE
995.                 PixelSet i& + start&, maxw, temp(sptr&)
996.                 sptr& = sptr& + 1
997.             END IF
998.         ELSE
999.             PixelSet i& + start&, maxw, temp(mptr&)
1000.             mptr& = mptr& + 1
1001.         END IF
1002.     NEXT
1003. END SUB
1004.  
1005. SUB OESort (Start&, Finish&, maxw)
1006.     sorted = 0
1007.     WHILE NOT sorted
1008.         sorted = -1
1009.         FOR i& = Start& TO Finish& - 1 STEP 2
1010.             IF CompareScreen%(i&, i& + 1, maxw) = 1 THEN
1011.                 PixelSwap i&, i& + 1, maxw
1012.                 sorted = 0
1013.             END IF
1014.         NEXT
1015.         FOR i& = Start& + 1 TO Finish& - 2 STEP 2
1016.             IF CompareScreen%(i&, i& + 1, maxw) = 1 THEN
1017.                 PixelSwap i&, i& + 1, maxw
1018.             END IF
1019.         NEXT
1020.     WEND
1021. END SUB
1022.  
1023. SUB QuickSortRStable (r() AS PixelRec, start&, finish&, maxw)
1024.     IF finish& - start& = 1 THEN
1025.         CompareRecs r(), start&, finish&, maxw
1026.     ELSE
1027.         IF finish& - start& > 1 THEN
1028.             i& = start&
1029.             j& = finish&
1030.             p# = StableIndex#(r(), (i& + (j& - i& + 1) \ 2), maxw)
1031.             DO
1032.                 WHILE StableIndex#(r(), i&, maxw) < p#
1033.                     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
1034.                     i& = i& + 1
1035.                 WEND
1036.                 WHILE StableIndex#(r(), j&, maxw) > p#
1037.                     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
1038.                     j& = j& - 1
1039.                 WEND
1040.                 IF i& <= j& THEN
1041.                     CompareRecs r(), i&, j&, maxw
1042.  
1043.                     i& = i& + 1
1044.                     j& = j& - 1
1045.                 END IF
1046.             LOOP UNTIL i& > j&
1047.             QuickSortRStable r(), i&, finish&, maxw
1048.             QuickSortRStable r(), start&, j&, maxw
1049.         END IF
1050.     END IF
1051. END SUB
1052.  
1053. '* swapping indexes is much faster than swapping entire records
1054. '* the index for this Pixels is simply the r().pixnum field of Pixels type PixelRec r()
1055. SUB CompareRecs (r() AS PixelRec, i&, j&, maxw)
1056.     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
1057.     IF r(r(i&).pixnum).pcolor <= r(r(j&).pixnum).pcolor THEN
1058.         IF r(i&).pixnum > r(j&).pixnum THEN
1059.             SWAP r(i&).pixnum, r(j&).pixnum
1060.         END IF
1061.     ELSE
1062.         Sorts(SortNum).compares = Sorts(SortNum).compares + 1
1063.         IF r(r(i&).pixnum).pcolor > r(r(j&).pixnum).pcolor THEN
1064.             SWAP r(i&).pixnum, r(j&).pixnum
1065.         END IF
1066.     END IF
1067.     PixelSet i&, maxw, r(r(i&).pixnum).pcolor
1068.     PixelSet j&, maxw, r(r(j&).pixnum).pcolor
1069.     EXIT SUB
1070.     IF StableIndex#(r(), i&, maxw) > StableIndex#(r(), j&, maxw) THEN
1071.         PixelSwap r(r(i&).pixnum).pixnum, r(r(j&).pixnum).pixnum, maxw
1072.         SWAP r(i&).pixnum, r(j&).pixnum
1073.     END IF
1074. END SUB
1075.  
1076. FUNCTION StableIndex# (r() AS PixelRec, a&, maxw)
1077.     np# = 10 ^ (LOG(UBOUND(r) + 1) \ LOG(10))
1078.     StableIndex# = r(r(a&).pixnum).pcolor * np# + r(a&).pixnum
1079. END FUNCTION
1080.  
1081. SUB QuickSortIterative (Start&, Finish&, maxw)
1082.     MinStack& = LOG(Finish& - Start& + 1) \ LOG(2) + 1
1083.     DIM LStack&(MinStack&, 1)
1084.     StackPtr% = 0
1085.     LStack&(StackPtr%, 0) = Start&
1086.     LStack&(StackPtr%, 1) = Finish&
1087.     DO
1088.         Low& = LStack&(StackPtr%, 0)
1089.         Hi& = LStack&(StackPtr%, 1)
1090.         DO
1091.             i& = Low&
1092.             j& = Hi&
1093.             Mid& = Low& + (Hi& - Low& + 1) \ 2
1094.             Compare% = GetPixel%(Mid&, maxw)
1095.             DO
1096.                 DO WHILE GetPixel%(i&, maxw) < Compare%
1097.                     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
1098.                     i& = i& + 1
1099.                 LOOP
1100.                 DO WHILE GetPixel%(j&, maxw) > Compare%
1101.                     Sorts(SortNum).compares = Sorts(SortNum).compares + 1
1102.                     j& = j& - 1
1103.                 LOOP
1104.                 IF i& < j& THEN
1105.                     PixelSwap i&, j&, maxw
1106.                 END IF
1107.                 i& = i& + 1
1108.                 j& = j& - 1
1109.             LOOP UNTIL i& > j&
1110.             IF j& - Low& < Hi& - i& THEN
1111.                 IF i& < Hi& THEN
1112.                     LStack&(StackPtr%, 0) = i&
1113.                     LStack&(StackPtr%, 1) = Hi&
1114.                     StackPtr% = StackPtr% + 1
1115.                 END IF
1116.                 Hi& = j&
1117.             ELSE
1118.                 IF Low& < j& THEN
1119.                     LStack&(StackPtr%, 0) = Low&
1120.                     LStack&(StackPtr%, 1) = j&
1121.                     StackPtr% = StackPtr% + 1
1122.                 END IF
1123.                 Low& = i&
1124.             END IF
1125.         LOOP WHILE Low& < Hi&
1126.         StackPtr% = StackPtr% - 1
1127.     LOOP UNTIL StackPtr% < 0
1128. END SUB
1129.  
1130. ' this sort splits the list in half and then merges them, however, it requires extra space -- the travails of gaining extra speed!
1131. ' but on average, it is quicker than quicksorting the entire list as the arrays are already sorted by the time they get merged, which
1132. ' itself is a nearly linear process. as long as a stable sort is used to sort array segments, this should remain a stable sort!
1133. SUB MergeExperiment (Start&, Finish&, maxw)
1134.     HowManySets = 2 'LOG(Finish& - Start& + 1) \ LOG(2) + 1
1135.     DIM Starts&(HowManySets), Ends&(HowManySets)
1136.     m& = (Finish& - Start&) MOD HowManySets
1137.     segment& = (Finish& - Start& - m&) / HowManySets
1138.     u = HowManySets - 1
1139.     f& = Finish&
1140.     DO
1141.         Ends&(u) = f&
1142.         Starts&(u) = f& - segment&
1143.         f& = f& - (segment& + 1)
1144.         u = u - 1
1145.     LOOP UNTIL u < 0
1146.     index& = 0
1147.     FOR i = 0 TO HowManySets - 1
1148.         MergeSort Starts&(i), Ends&(i), maxw
1149.     NEXT
1150.     mergetosum& = 0
1151.     FOR i = 0 TO HowManySets - 1 STEP 2
1152.         StartMast& = Starts&(i)
1153.         EndMast& = Ends&(i)
1154.         StartSlave& = Starts&(i + 1)
1155.         EndSlave& = Ends&(i + 1)
1156.         REDIM Master%(StartMast& TO EndMast&)
1157.         REDIM Slave%(StartSlave& TO EndSlave&)
1158.         FOR i& = StartMast& TO EndMast&
1159.             Master%(i&) = GetPixel%(i&, maxw)
1160.         NEXT
1161.         FOR i& = StartSlave& TO EndSlave&
1162.             Slave%(i&) = GetPixel%(i&, maxw)
1163.         NEXT
1164.         Master& = StartMast&
1165.         Slave& = StartSlave&
1166.         index& = Start&
1167.         DO
1168.             IF Master& > EndMast& THEN
1169.                 IF Slave& > EndSlave& THEN '* both lists are fully traversed
1170.                     EXIT DO
1171.                 ELSE '* empty the slave list
1172.                     PixelSet index&, maxw, Slave%(Slave&)
1173.                     Slave& = Slave& + 1
1174.                 END IF
1175.             ELSE
1176.                 IF Slave& > EndSlave& THEN '* empty the master list
1177.                     PixelSet index&, maxw, Master%(Master&)
1178.                     Master& = Master& + 1
1179.                 ELSE '* Master%() and Slave%() both have unprocessed elements
1180.                     IF Master%(Master&) > Slave%(Slave&) THEN
1181.                         PixelSet index&, maxw, Slave%(Slave&)
1182.                         Slave& = Slave& + 1
1183.                     ELSE
1184.                         PixelSet index&, maxw, Master%(Master&)
1185.                         Master& = Master& + 1
1186.                     END IF
1187.                 END IF
1188.             END IF
1189.             index& = index& + 1
1190.         LOOP
1191.     NEXT
1192. END SUB
1193.  
1194. '* part 2, dammit!
1195.  
1196. '* this has been modified to become a bidirectional shellsort, which is far faster than the bubblesort version, which is a special case where
1197. '* gap& is 1, and runs in polynomial time when gap& is 1
1198. SUB BidirectionalShellSort (Start&, Finish&, maxw)
1199.     gap& = (Finish& - Start& + 1) \ 2
1200.     DO
1201.         up% = -1: down% = -1
1202.         startup& = Start&: endup& = Finish& - gap&: FirstUp& = Finish& - gap&: LastUp& = Start&
1203.         startdn& = Finish&: enddown& = Start& + gap&: FirstDown& = Start& + gap&: LastDown& = Finish&
1204.         DO
1205.             IF up% THEN
1206.                 up% = 0
1207.                 FOR i& = startup& TO endup&
1208.                     IF CompareScreen%(i&, i& + gap&, maxw) = 1 THEN
1209.                         PixelSwap i&, i& + gap&, maxw
1210.                         IF i& < FirstUp& THEN
1211.                             FirstUp& = i&
1212.                         END IF
1213.                         LastUp& = i&
1214.                         up% = -1
1215.                     END IF
1216.                 NEXT
1217.                 startup& = FirstUp&
1218.                 endup& = LastUp&
1219.                 SWAP FirstUp&, LastUp&
1220.             END IF
1221.             '*******************************
1222.             IF down% THEN
1223.                 down% = 0
1224.                 FOR i& = startdn& TO enddown& STEP -1
1225.                     IF CompareScreen%(i&, i& - gap&, maxw) = -1 THEN
1226.                         PixelSwap i&, i& - gap&, maxw
1227.                         IF i& > FirstDown& THEN
1228.                             FirstDown& = i&
1229.                         END IF
1230.                         LastDown& = i&
1231.                         down% = -1
1232.                     END IF
1233.                 NEXT
1234.                 startdn& = FirstDown&
1235.                 enddown& = LastDown&
1236.                 SWAP FirstDown&, LastDown&
1237.             END IF
1238.         LOOP UNTIL NOT (up% OR down%)
1239.         gap& = gap& \ 2
1240.     LOOP WHILE gap& > 0
1241. END SUB
1242.  
1243. '* for highly repetitive data, TreeSortAscending becomes like an insertion sort, which degenerates to polynomial time, which is NOT good. this sort is far
1244. '* better suited to data that is not repetitive. by the way, 16 is an arbitrary number and can be set to whatever your threshold of pain for a possibly
1245. '* polynomial time sort.
1246.  
1247. SUB TreeSortAscending (start&, finish&, maxw)
1248.     FindMinMax start&, finish&, MinPtr&, MaxPtr&, maxw
1249.     delta# = GetPixel%(MaxPtr&, maxw) - GetPixel%(MinPtr&, maxw)
1250.     IF delta# = 0 THEN 'already sorted because they're all equal
1251.         EXIT SUB
1252.     ELSE
1253.         IF ABS((finish& - start& + 1) / delta#) > 65535 THEN
1254.             BucketSort start&, finish&, maxw
1255.             EXIT SUB
1256.         END IF
1257.     END IF
1258.     NilValue% = GetPixel%(MinPtr&, maxw) - 1
1259.     TYPE TreeNode
1260.         value AS LONG
1261.         left AS LONG
1262.         right AS LONG
1263.     END TYPE
1264.     DIM tree(start& + 1 TO finish& + 1) AS TreeNode
1265.     FOR x& = start& + 1 TO finish& + 1
1266.         tree(x&).value = NilValue%
1267.         tree(x&).left = NilValue%
1268.         tree(x&).right = NilValue%
1269.     NEXT
1270.     tree(1).value = GetPixel%(1 - 1, maxw)
1271.     free& = 2
1272.     FOR x& = 2 TO finish&
1273.         pointer& = 1
1274.         xv& = (GetPixel%(x& - 1, maxw))
1275.         DO
1276.             IF xv& < tree(pointer&).value THEN
1277.                 IF tree(pointer&).left = NilValue% THEN
1278.                     tree(pointer&).left = free&
1279.                     tree(free&).value = xv&
1280.                     'PixelSet free& - 1, maxw, tree(tree(pointer&).left).value
1281.                     free& = free& + 1
1282.                     EXIT DO
1283.                 ELSE
1284.                     pointer& = tree(pointer&).left
1285.                 END IF
1286.             ELSE
1287.                 IF tree(pointer&).right = NilValue% THEN
1288.                     tree(pointer&).right = free&
1289.                     tree(free&).value = xv&
1290.                     'PixelSet free& - 1, maxw, tree(tree(pointer&).right).value
1291.                     free& = free& + 1
1292.                     EXIT DO
1293.                 ELSE
1294.                     pointer& = tree(pointer&).right
1295.                 END IF
1296.             END IF
1297.         LOOP
1298.     NEXT x&
1299.     depth& = 1
1300.     traverse start& + 1, depth&, tree(), NilValue%, maxw
1301. END SUB
1302.  
1303. SUB traverse (start&, depth&, tree() AS TreeNode, NilValue%, maxw)
1304.     IF tree(start&).left <> NilValue% THEN traverse tree(start&).left, depth&, tree(), NilValue%, maxw
1305.     PixelSet depth& - 1, maxw, tree(start&).value
1306.     depth& = depth& + 1
1307.     IF tree(start&).right <> NilValue% THEN traverse tree(start&).right, depth&, tree(), NilValue%, maxw
1308. END SUB
1309.  
1310. '* this algo at first glance looks like it'd be just another slow version of shellsort, but crap if it doesn't rank well with my sortindex at 31
1311. SUB CodeGuySort (Start&, Finish&, maxw)
1312.     'rows& = (Finish& - Start& + 1) / maxw
1313.     gap& = (Finish& - Start& + 1) \ 2
1314.     DO
1315.         IF gap& < maxw THEN
1316.             m& = Start&
1317.             FOR x% = 0 TO (Finish& - Start& + 1) \ maxw
1318.                 ShellSortMetzler m&, m& + gap&, maxw
1319.                 m& = m& + gap&
1320.             NEXT
1321.         ELSE
1322.             rows& = (Finish& - Start& - gap&) / maxw
1323.             FOR b% = 0 TO 1
1324.                 FOR offset& = b% TO maxw STEP b% + 1
1325.                     FOR x% = b% TO (maxw - gap&) \ gap& STEP b% + 1
1326.                         FOR j& = b% TO rows& STEP b% + 1
1327.                             y& = j& * maxw + offset&
1328.                             z& = y& + gap&
1329.                             IF z& > Finish& THEN
1330.                                 exitnextfor = -1
1331.                                 EXIT FOR
1332.                             END IF
1333.                             IF CompareScreen%(y&, z&, maxw) = 1 THEN
1334.                                 PixelSwap y&, z&, maxw
1335.                             END IF
1336.                         NEXT
1337.                         IF exitnextfor THEN
1338.                             exitnextfor = 0
1339.                             EXIT FOR
1340.                         END IF
1341.                     NEXT
1342.                 NEXT
1343.             NEXT
1344.         END IF
1345.         gap& = INT((gap& / 5) * 4)
1346.     LOOP UNTIL gap& < 1
1347. END SUB
1348.  
1349. SUB SortColumns (Start&, Finish&, maxw)
1350.     EXIT SUB
1351.     FOR column& = 0 TO maxw - 1
1352.         IF GetPixel%(column&, maxw) > GetPixel%(column& + maxw, maxw) THEN
1353.             PixelSwap column&, column& + maxw, maxw
1354.         END IF
1355.     NEXT
1356. END SUB
1357.  
1358. '* uses PrimeNumber&() function to calculate the prime number less than or equal to the gap
1359. SUB PrimeGapSort (start&, finish&, maxw)
1360.     Gap& = (finish& - start& + 1)
1361.     DO
1362.         FOR i& = start& TO finish& - Gap&
1363.             'IF i& > finish& - Gap& THEN
1364.             '    IF CompareScreen%(i&, i& + Gap& - finish&, maxw) = -1 THEN
1365.             '        PixelSwap i&, i& + Gap& - finish&, maxw
1366.             '    END IF
1367.             'ELSE
1368.             IF CompareScreen%(i&, i& + Gap&, maxw) = 1 THEN
1369.                 PixelSwap i&, i& + Gap&, maxw
1370.             END IF
1371.             'END IF
1372.             'IF i& < Gap& THEN
1373.             '    IF CompareScreen%(i&, i& - Gap& + finish&, maxw) = 1 THEN
1374.             '        PixelSwap i&, i& - Gap& + finish&, maxw
1375.             '    END IF
1376.             'ELSE
1377.             '    IF CompareScreen%(i&, i& - Gap&, maxw) = -1 THEN
1378.             '        PixelSwap i&, i& - Gap&, maxw
1379.             '    END IF
1380.             'END IF
1381.         NEXT
1382.         Gap& = primeNumber&(Gap& * .727)
1383.         'PrimeNumber&(Gap& \ 2)
1384.     LOOP UNTIL Gap& <= 1
1385.     FOR i& = finish& - 2 TO start& STEP -1
1386.         IF CompareScreen%(i& + 1, i&, maxw) = -1 THEN
1387.             hold% = GetPixel%(i&, maxw)
1388.             j& = i&
1389.             WHILE (GetPixel%(j& + 1, maxw) < hold%)
1390.                 PixelSwap j&, j& + 1, maxw
1391.                 'a(j&) = a(j& + 1)
1392.                 j& = j& + 1
1393.             WEND
1394.             'a(j&) = hold%
1395.             PixelSet j&, maxw, hold%
1396.         END IF
1397.     NEXT i&
1398. END SUB
1399.  
1400. FUNCTION primeNumber& (a&)
1401.     ' Find a prime number below a& (excluding 3 and 5)
1402.     '
1403.     ' Notice that there is a:
1404.     ' 59,9% chance for a single successive guess,
1405.     ' 83,9% chance for a successive guess out of two guesses,
1406.     ' 93,6% chance for a successive guess out of three guesses,
1407.     ' 97,4% chance for a successive guess out of four guesses,
1408.     ' 99,98% chance for a successive guess out of ten guesses...
1409.     '
1410.     ' Worst bad luck over 10000 tested primes: 19 guesses.
1411.  
1412.     STATIC firstCall%
1413.     STATIC pps%() 'Previous Prime in Sequence. Contains about 59.9% of all primes modulo 30.
1414.  
1415.     IF firstCall% = 0 THEN
1416.         firstCall% = -1
1417.         REDIM pps%(0 TO 29)
1418.         ' Map numbers from 0 to 29 to the next lower prime in the sequence {1,7,11,13,17,19,23,29}.
1419.         pps%(0) = -1: pps%(1) = -1 ' -1 = 29 (modulo 30)
1420.         pps%(2) = 1: pps%(3) = 1: pps%(4) = 1: pps%(5) = 1: pps%(6) = 1: pps%(7) = 1
1421.         pps%(8) = 7: pps%(9) = 7: pps%(10) = 7: pps%(11) = 7
1422.         pps%(12) = 11: pps%(13) = 11:
1423.         pps%(14) = 13: pps%(15) = 13: pps%(16) = 13: pps%(17) = 13
1424.         pps%(18) = 17: pps%(19) = 17
1425.         pps%(20) = 19: pps%(21) = 19: pps%(22) = 19: pps%(23) = 19
1426.         pps%(24) = 23: pps%(25) = 23: pps%(26) = 23: pps%(27) = 23: pps%(28) = 23: pps%(29) = 23
1427.     END IF
1428.  
1429.     b& = a& + 1
1430.     c& = (b& \ 30) * 30: b& = c& + pps%(b& - c&)
1431.     div& = 3
1432.     DO
1433.         IF b& MOD div& THEN
1434.             IF b& / div& < div& THEN
1435.                 EXIT DO
1436.             ELSE
1437.                 div& = div& + 2
1438.             END IF
1439.         ELSE
1440.             c& = (b& \ 30) * 30: b& = c& + pps%(b& - c&)
1441.             div& = 3
1442.         END IF
1443.     LOOP
1444.     primeNumber& = b&
1445. END FUNCTION
1446.  
1447. FUNCTION SpeedIndex# (T AS SortRec, start&, finish&, doit%, tstart#, tend#, maxw)
1448.     IF doit% THEN
1449.         tstart# = TIMER
1450.         FOR npixel& = start& TO finish&
1451.             p% = GetPixel%(npixel&, maxw)
1452.         NEXT
1453.         tend# = TIMER
1454.         IF tend# < start# THEN
1455.             tend# = tend# + 86400
1456.         END IF
1457.         doit% = 0
1458.     END IF
1459.     SpeedIndex# = ((finish& - start& + 1) / (tend# - tstart#)) / (T.NSorted / T.accumulatedtime)
1460. END FUNCTION
1461.  

[DANILIN]

Using a simple configuration is convenient in conjunction with standalone exe and in the program it is possible to change the path and i welcome any improvements.

On Internet, more and more sites include visualization and comparison of sortings.

I assume on QB64 it is possible to create a program with a menu that compares 2 or more sorting live.

[codeguy]

The performance profile is similar to Bitonic Sort, respectable but not insanely efficient. Yes, you can visualize a lot of algorithms, just as I did in the code submitted to this thread.

[DANILIN]

feature of the algorithm of the topic:
everyone is able to understand this algorithm
unlike certain incomprehensible algorithms machine sorting.

especially considering: my algorithm is pretty quick.

means using for example sorting of goods
or sorting the way people can be sure:
algorithm and quick and understandable to people.

and another feature: speeds up slow sorts
2 ... 4 ... 8 times dividing the bubble sort array
which makes my algorithm even more human.

[codeguy]

It's comparable speed to MergeSort. Yes, it's a fairly simple but efficient algorithm. I will give it a passing review as it performs well enough to be competitive with O(NLogN) class sorting methods. The fact it's not in-place isn't much of a deterrent for reasonable array sizes. In all, nicely done. I have learned something new. Good luck.

[DANILIN]

info for an expected review:

Russian Sorting Halves
author: Andrey Danilin

Danilin is last name

[DANILIN]

O(N) = 3*N*LOG(N;2)

requires recalculation of entire array
and further distribution of entire array
and further return of sub-array back are required.

and number of distributions takes into account division by halves.
proves visualization and counters.

O(N) = 3*N*LOG(N;2)

Created 13 options are Russian sorting halves:

1. Acceleration of bubble sorting by 2 times
adding a few lines code by dividing array into 2 parts

2. Acceleration of bubble sorting 4 times
adding a few lines code by dividing array into 4 parts

3. Acceleration of selection sorting by 2 times
adding a few lines code by dividing array into 2 parts

4. Acceleration of selection sorting by 4 times
adding a few lines code by dividing array into 4 parts

5. Recursive of QB64 1'000'000 in 2.2 seconds
6. Recursive of PureBasic 1'000'000 in 0.3 seconds
7. Recursive of FreeBasic 1'000'000 in 0.15 seconds
8. Recursive of C# Csharp 1'000'000 in 0.2 seconds
9. QB64 sorting integral of letters

10. Excel fast for 250 items on 5 second
11. Excel animation for 250 items on 150 second

12. Acceleration of bubble sorting
by dividing into 4 parts C# Csharp
13. Nested loops and indexes of indexes

[codeguy]

BubbleSortModified which can sort ranges is designed to be adaptive and increases speed over standard BubbleSort by twice on average for randomly arranged datasets. Also, if the array is mostly sorted by the time  BubbleSort is called, you can use InsertionSort to better effect.

[DANILIN]

to use insertionsort people need to know insertionsort
and for those who massively know only bubblesort:

a human-friendly solution that accelerates bubblesort 4 times:
division of array by method of Russian sorting halves.

Russian Sorting Halves and risk management:
in 1st approximation relative to risk of 50%:

to left events with minimal risk for large participation
to right of event with maximum risk for small participation

and still easy to sort inside 2 parts
at least dividing risks into 4 parts.

Russian Sort Halves Accelerate Danilin visualisation

[DANILIN]

news:

Russian Sorting Halves and fast and human

9. Recursive version of C# Csharp 1'000'000 in 0.2 seconds

resume:

Russian Sorting Halves and fast and human
sorts 1'000'000 in 2.2 seconds on QB64
sorts 1'000'000 in 0.3 seconds on PureBasic
sorts 1'000'000 in 0.2 seconds on C# Csharp
sorts 1'000'000 in 0.15 seconds on Freebasic

[bplus]

It's comparable speed to MergeSort. Yes, it's a fairly simple but efficient algorithm. I will give it a passing review as it performs well enough to be competitive with O(NLogN) class sorting methods. The fact it's not in-place isn't much of a deterrent for reasonable array sizes. In all, nicely done. I have learned something new. Good luck.

Blah! It sucks in comparison to simple, easy to understand, standard QSort:

Code: QB64: [Select]

1. _TITLE "Compare RussianSorting presented by Danilin to a Basic standard QuickSort by B+ 2018-10-28"
2. RANDOMIZE TIMER
3.  
4. 'first here is Danilin's main code: ------------------------------------------------------------------------
5. 'DECLARE SUB RussianSortingHalvesDAV (ab!, yz!, part!, age!)
6. 'CLOSE
7. 'OPEN "c:/N.txt" FOR INPUT AS #1
8. 'INPUT #1, n
9. ''n=1234567
10. 'age = 1 + LOG(n) / LOG(2)
11. 'PRINT n
12.  
13. 'DIM SHARED d(n) 'AS LONG
14. 'DIM SHARED a(n) 'AS LONG
15.  
16. ''OPEN "c:/ISX.txt" FOR INPUT AS #2
17. ''FOR i=1 TO n: INPUT #2, d(i): NEXT
18.  
19. ''FOR i = 1 TO n: d(i) = n - i + 1: NEXT ' INT(RND*n)
20. 'FOR i = 1 TO n: d(i) = INT(RND * n): NEXT '
21. 'FOR k = 1 TO 20: PRINT d(k);: NEXT: PRINT: PRINT
22. 'FOR k = n - 19 TO n: PRINT d(k);: NEXT: PRINT: PRINT
23.  
24. 'start = TIMER
25.  
26. 'IF age > 0 THEN
27. '    CALL RussianSortingHalvesDAV(1, n, 1, age)
28. 'END IF
29.  
30. 'finish = TIMER
31.  
32. 'PRINT finish - start; "second ": PRINT
33.  
34. 'OPEN "c:/=RuSortHalves_dav.txt" FOR OUTPUT AS #3
35. 'PRINT #3, finish - start; "second "
36. 'PRINT #3, n; "elements", "RECURSION"
37. 'FOR i = 1 TO 22: PRINT #3, d(i): NEXT
38. 'FOR i = n - 22 TO n: PRINT #3, d(i): NEXT
39.  
40. 'FOR k = 1 TO 20: PRINT d(k);: NEXT: PRINT: PRINT
41. 'FOR k = n - 19 TO n: PRINT d(k);: NEXT: PRINT: PRINT
42.  
43. 'END  - of Danilin's code --------------------------------------------------------------------
44.  
45. 'Since the timed test involves nothing to do with file input and output, leave that crap out!
46. 'And since Danilin is advertising this crap as the cat's meow, lets do a sort of random type single
47. '
48. ' Here is the only relevant parts of Danilin
49. CONST n = 1000000
50. DIM SHARED d(n) ' single
51. DIM SHARED a(n) ' single
52. DIM SHARED QS(n) ' to compare to Danilin's "simple" code
53.  
54. ' Make a sample set of test data
55. FOR i = 1 TO n
56.     r = RND * n
57.     d(i) = r
58.     QS(i) = r
59. NEXT
60.  
61. ' Since Danilin does not provide us with "c:/N.txt" file data, can't be important to his demo
62. age = 1 + LOG(n) / LOG(2)
63. start = TIMER
64. IF age > 0 THEN
65.     CALL RussianSortingHalvesDAV(1, n, 1, age)
66. END IF
67. finish = TIMER
68. PRINT finish - start; "second "
69. IF n > 100 THEN stopper = 100 ELSE stopper = n
70. FOR i = 1 TO stopper
71.     PRINT d(i); ", ";
72. NEXT
73. DanilinTime = finish - start
74. PRINT: PRINT: INPUT "Now for the Quick Sort Test, press enter...", enter$
75. CLS
76.  
77. 'now try good ole Quick Sort
78. start = TIMER
79. qSort 1, n
80. finish = TIMER
81. PRINT finish - start; "sec."
82. IF n > 100 THEN stopper = 100 ELSE stopper = n
83. FOR i = 1 TO stopper
84.     PRINT d(i); ", ";
85. NEXT
86. QSortTime = finish - start
87. PRINT: PRINT: PRINT "Ha, ha, ha QSort took "; INT(QSortTime / DanilinTime * 1000) / 1000; " times lomger than Danilin's Sort!"
88.  
89.  
90. SUB RussianSortingHalvesDAV (ab, yz, part, age)
91.  
92.     IF yz - ab < 1 THEN EXIT SUB
93.  
94.     FOR i = ab TO yz '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> really a time waster and String Array Buster here!!!!!
95.         summa = summa + d(i)
96.     NEXT
97.     middle = summa / (yz - ab + 1)
98.  
99.     abc = ab - 1
100.     xyz = yz + 1
101.  
102.     FOR i = ab TO yz
103.         IF d(i) < middle THEN abc = abc + 1: a(abc) = d(i): ELSE xyz = xyz - 1: a(xyz) = d(i)
104.     NEXT
105.  
106.     FOR i = ab TO yz: d(i) = a(i): NEXT
107.  
108.     IF part < age THEN
109.         IF abc >= ab THEN CALL RussianSortingHalvesDAV(ab, abc, part + 1, age)
110.         IF xyz <= yz THEN CALL RussianSortingHalvesDAV(xyz, yz, part + 1, age)
111.     END IF
112.  
113. END SUB
114.  
115. 'QS is DIM SHARED to compare to Danilin's method that needs two DIM SHARED Arrays for his SUB
116. SUB qSort (start AS LONG, finish AS LONG)
117.     DIM Hi AS LONG, Lo AS LONG, Middle AS SINGLE
118.     Hi = finish: Lo = start
119.     Middle = QS((Lo + Hi) / 2) 'find middle of array
120.     DO
121.         DO WHILE QS(Lo) < Middle: Lo = Lo + 1: LOOP
122.         DO WHILE QS(Hi) > Middle: Hi = Hi - 1: LOOP
123.         IF Lo <= Hi THEN
124.             SWAP QS(Lo), QS(Hi)
125.             Lo = Lo + 1: Hi = Hi - 1
126.         END IF
127.     LOOP UNTIL Lo > Hi
128.     IF Hi > start THEN qSort start, Hi
129.     IF Lo < finish THEN qSort Lo, finish
130. END SUB
131.  

EDIT: Sorry, in QSort sub, I had Middle dimensioned as _FLOAT, it should be single like the rest of the array items. It made a significant difference to timed test, now QSort compares even better!

[DANILIN]

comparisons have long been known:

faster than:
selection insertion binary bubble
gnome comb heap smooth odd-even
cocktail bitonic cyrcle blockmerge

slower than:
merge quick shell radix tim

faster than human natural sorts
slower than machine sorts understandable <1% of people

[bplus]

Hi Danilin,

What's with all the file crap in your demo? It makes no sense. Sorry to be blunt.