## Russian Sorting Halves Danilin

General FreeBASIC programming questions.
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

### Russian Sorting Halves Danilin

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

me interested implementation of algorithm in language FreeBasic

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: Select all

`' Russian Sorting Halves DanilinDECLARE SUB RussianSortingHalvesDAV (ab!, yz!, part!, age!)CLOSEOPEN "c:/N.txt" FOR INPUT AS #1INPUT #1, n'n=1234567age = 1 + LOG(n) / LOG(2)PRINT nDIM SHARED d(n) 'AS LONGDIM SHARED a(n) 'AS LONG'OPEN "c:/ISX.txt" FOR INPUT AS #2'FOR i=1 TO n: INPUT #2, d(i): NEXT'FOR i = 1 TO n: d(i) = n - i + 1: NEXT ' INT(RND*n)FOR i = 1 TO n: d(i) = INT(RND * n): NEXT 'FOR k = 1 TO 20: PRINT d(k);: NEXT: PRINT: PRINTFOR k = n - 19 TO n: PRINT d(k);: NEXT: PRINT: PRINTstart = TIMERIF age > 0 THEN    CALL RussianSortingHalvesDAV(1, n, 1, age)END IFfinish = TIMERPRINT finish - start; "second ": PRINTOPEN "c:/=RuSortHalves_dav.txt" FOR OUTPUT AS #3PRINT #3, finish - start; "second "PRINT #3, n; "elements", "RECURSION"FOR i = 1 TO 22: PRINT #3, d(i): NEXTFOR i = n - 22 TO n: PRINT #3, d(i): NEXTFOR k = 1 TO 20: PRINT d(k);: NEXT: PRINT: PRINTFOR k = n - 19 TO n: PRINT d(k);: NEXT: PRINT: PRINTENDSUB RussianSortingHalvesDAV (ab, yz, part, age)IF yz - ab < 1 THEN EXIT SUBFOR i = ab TO yz    summa = summa + d(i)NEXTmiddle = summa / (yz - ab + 1)abc = ab - 1xyz = yz + 1FOR i = ab TO yz    IF d(i) < middle THEN abc = abc + 1: a(abc) = d(i): ELSE xyz = xyz - 1: a(xyz) = d(i)NEXTFOR i = ab TO yz: d(i) = a(i): NEXTIF part < age THEN    IF abc >= ab THEN CALL RussianSortingHalvesDAV(ab, abc, part + 1, age)    IF xyz <= yz THEN CALL RussianSortingHalvesDAV(xyz, yz, part + 1, age)END IFEND SUB`

Russian Sorting Halves Danilin visualisation

me interested implementation of algorithm in language FreeBasic
Last edited by DANILIN on Oct 29, 2018 20:07, edited 1 time in total.
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

### Re: Russian Sorting Halves 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
Last edited by DANILIN on Oct 27, 2018 13:39, edited 1 time in total.
jj2007
Posts: 1319
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: Russian Sorting Halves Danilin

Not bad, but without knowing the CPU, how can we judge how fast your algo is?

Code: Select all

`Intel(R) Core(TM) i5-2450M CPU @ 2.50GHz0.15 seconds for sorting 1000000 integers0.15 seconds for sorting 1000000 integers0.15 seconds for sorting 1000000 integers0.15 seconds for sorting 1000000 integers0.15 seconds for sorting 1000000 integers...1.73 seconds for sorting 10000000 integers1.72 seconds for sorting 10000000 integers1.75 seconds for sorting 10000000 integers1.72 seconds for sorting 10000000 integers1.72 seconds for sorting 10000000 integers`
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

### Re: Russian Sorting Halves Danilin

program contains blocks to enable same array from disk
OPEN "c:/ISX.txt" FOR INPUT AS #2
FOR i=1 TO n: INPUT #2, d(i): NEXT

or for the inverse array
FOR i=1 TO n: d(i)=n-i+1: NEXT

or for random numbers
FOR i=1 TO n: d(i)=INT(RND*n): NEXT

between of lines
start = TIMER
...
finish = TIMER

it is possible to substitute any sorting algorithm
using N elements of d(n) array

and I recall main feature:
Russian Sorting Halves and fast and human
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

### Re: Russian Sorting Halves Danilin

a 4 times acceleration proof qb64 & freebasic

Code: Select all

`'RUSSIAN sorting halves 4 part bubbleN=17539DIM d(N), a(N), v(N), q(5)RANDOMIZE TIMER: FOR i=1 TO N: d(i)=INT(RND * N): NEXTFOR k=1 TO 10: PRINT d(k);: NEXT: PRINT: FOR k=N-9 TO N: PRINT d(k);: NEXT: PRINT: PRINTstart=TIMER: s=0' ALLsumma=0: FOR i=1 TO N: summa=summa+d(i): NEXT: middle=summa/N: y=1: z=0FOR i=1 TO N    IF d(i) < middle THEN a(y)=d(i): y=y+1: ELSE a(N-z)=d(i): z=z+1NEXTq(3)=y-1PRINT "ALL middle="; middleFOR k=1 TO 10: PRINT a(k);: NEXT: PRINT: FOR k=N-9 TO N: PRINT a(k);: NEXT: PRINT: PRINT'1 FROM 2summa=0: FOR i=1 TO q(3): summa=summa+a(i): NEXT: middle=summa/q(3): y=1: z=0PRINT "1 FROM 2="; middle, "1 ..."; q(3)FOR i=1 TO q(3)    IF a(i) < middle THEN v(y)=a(i): y=y+1: ELSE v(q(3)-z)=a(i): z=z+1NEXTFOR k=1 TO 10: PRINT v(k);: NEXT: PRINT: FOR k=q(3)-9 TO q(3): PRINT v(k);: NEXT: PRINT: PRINTq(2)=y-1'2 FROM 2summa=0: FOR i=q(3)+1 TO N: summa=summa+a(i): NEXT: middle=summa/(1+N-q(3)): y=q(3): z=0PRINT "2 FROM 2="; middle, q(3)+1; "..."; NFOR i=q(3) TO N    IF a(i) < middle THEN v(y)=a(i): y=y+1: ELSE v(N-z)=a(i): z=z+1NEXTFOR k=q(3) TO q(3)+10: PRINT v(k);: NEXT: PRINT: FOR k=N-9 TO N: PRINT v(k);: NEXT: PRINT: PRINTq(4)=y-1: q(1)=2: q(5)=N' SORTINGPRINT "1="; 1, "2="; q(2), "3="; q(3), "4="; q(4), "5="; N: PRINTFOR t=1 TO 4    FOR i=q(t)-1 TO q(t+1): FOR j=i+1 TO q(t+1)            IF v(i) > v(j) THEN SWAP v(i), v(j): s=s+1NEXT: NEXT: NEXTfinish=TIMERFOR k=1 TO 10: PRINT v(k);: NEXT: PRINT: FOR k=N-9 TO N: PRINT v(k);: NEXT: PRINT: PRINTPRINT "DA RUS 4 ", finish-start; "second ", "swap "; sOPEN "c:/RUsortdav4.txt" FOR OUTPUT AS #2PRINT #2, finish-start; "second ", "swap "; sPRINT #2, N; "Russian sorting halves 4 parts bubble "FOR i=1 TO 20: PRINT #2, v(i): NEXTFOR i=N-19 TO N: PRINT #2, v(i): NEXTstart=TIMER: s=0FOR i=1 TO N: FOR j=i+1 TO N        IF d(i) > d(j) THEN SWAP d(i), d(j): s=s+1NEXT: NEXTfinish=TIMERPRINT "BUBBLE ", finish-start; "second ", "swap "; sEND`

1:50 Russian Sort Halves Accelerate Danilin visualisation

division of array into 4 parts occurs instantly
name q(3) will be replaced by a simpler name

but separation attempts for 2 nested loops
broken about order of midpoints 3 2 4

which leads to arrays with 2nd brackets
which complicates understanding and better apply

speaking variables of type middle3
leaving 3 cycles separate
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Russian Sorting Halves Danilin

very elegant sort - great job!
jj2007
Posts: 1319
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: Russian Sorting Halves Danilin

To make it work in FB:

Code: Select all

`Dim as integer K, N, I, summa, start, finish, middle, s, y, z, t, jN=17539DIM as integer d(N), a(N), v(N), q(5)`
D.J.Peters
Posts: 7941
Joined: May 28, 2005 3:28

### Re: Russian Sorting Halves Danilin

Code: Select all

`'RUSSIAN sorting halves 4 part bubbleRANDOMIZE TIMERconst as integer N = 17539DIM as integer d(1 to N), a(1 to N), v(1 to N), q(1 to 5)FOR i as integer =1 TO N  d(i)=INT(RND * N)NEXTprint "DA RUS 4 start"dim as double start=TIMERdim as integer summaFOR i as integer=1 TO N  summa += d(i)NEXTdim as integer middle=summa/N,y=1,z=0FOR i as integer=1 TO N  IF d(i) < middle THEN     a(y)=d(i): y+=1  ELSE    a(N-z)=d(i): z+=1  end if  NEXTq(3)=y-1' 1 FROM 2summa=0FOR i as integer=1 TO q(3)  summa+=a(i)NEXTmiddle=summa/q(3): y=1: z=0FOR i as integer=1 TO q(3)  IF a(i) < middle THEN    v(y)=a(i): y+=1  ELSE    v(q(3)-z)=a(i): z+=1  end if  NEXTq(2)=y-1'2 FROM 2summa=0FOR i as integer=q(3)+1 TO N  summa+=a(i)NEXTmiddle=summa/(1+N-q(3)): y=q(3): z=0FOR i as integer=q(3) TO N  IF a(i) < middle THEN    v(y)=a(i): y+=1  ELSE    v(N-z)=a(i): z+=1  end if  NEXTq(4)=y-1: q(1)=2: q(5)=N' SORTINGdim as integer sFOR t as integer=1 TO 4  FOR i as integer = q(t)-1 TO q(t+1)    FOR j as integer=i+1 TO q(t+1)      IF v(i) > v(j) THEN SWAP v(i), v(j): s+=1    NEXT  NEXTNEXTdim as double finish=TIMERPRINT "DA RUS 4 " & finish-start & " second number of swaps " & svar flag=trueprint "BUBBLE start"start=TIMER: s=0while flag=true  flag=false  FOR i as integer = 1 TO N-1    IF d(i) > d(i+1) THEN      SWAP d(i), d(i+1): s+=1      flag=true    end if    NEXTwend finish=TIMERPRINT "BUBBLE   " & finish-start & " second number of swaps " & sprint "done ..."sleep`
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Russian Sorting Halves Danilin

Code: Select all

`const as integer true=1, false=0`

Here is my results:
DA RUS 4 start
DA RUS 4 0.2691443795338273 second number of swaps 14154822
BUBBLE start
BUBBLE 1.524239694263088 second number of swaps 77348521
done ...
St_W
Posts: 1481
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

### Re: Russian Sorting Halves Danilin

Code: Select all

`const as integer true=1, false=0`
which means you're using an outdated FreeBasic version ;-)
D.J.Peters
Posts: 7941
Joined: May 28, 2005 3:28

### Re: Russian Sorting Halves Danilin

I would name it split sort :-) (see function arraySplit)

Joshy

Code: Select all

`'function arraySplit(outArray() as integer, _                    inArray()  as integer, _                    startIndex as integer, _                    lastIndex  as integer,_                    iDiv       as integer) as integer   dim as integer splitPoint  FOR i as integer=startIndex TO lastIndex    splitPoint += inArray(i)  NEXT  splitPoint\=iDiv  dim as integer leftIndex=startIndex,rightIndex=lastIndex  FOR i as integer=startIndex to lastIndex    IF inArray(i) < splitPoint THEN       outArray(leftIndex) =inArray(i) : leftIndex+=1    ELSE      outArray(rightIndex)=inArray(i) : rightIndex-=1    end if    NEXT  return leftIndex-1end functionRANDOMIZE TIMERconst as integer N = 17539DIM as integer inputArray(1 to N), tempArray(1 to N), resultArray(1 to N), q(1 to 5)FOR i as integer =1 TO N  inputArray(i)=INT(RND * N)NEXTprint "DA RUS 4 start"var start=TIMER()q(1)=2q(3)=arraySplit(tempArray()  ,inputArray(),1   ,N   ,N)q(2)=arraySplit(tempArray()  ,tempArray() ,1   ,q(3),q(3))q(4)=arraySplit(resultArray(),tempArray() ,q(3),N   ,1+N-q(3))q(5)=N' SORTINGdim as integer sFOR t as integer=1 TO 4  print "sort from : " & q(t)-1 & " to: " & q(t+1)-1  FOR i as integer = q(t)-1 TO q(t+1)-1    FOR j as integer=i+1 TO q(t+1)      IF resultArray(i) > resultArray(j) THEN SWAP resultArray(i), resultArray(j): s+=1    NEXT  NEXTNEXTvar finish = TIMER()PRINT "DA RUS 4 " & finish-start & " second number of swaps " & svar ok=truefor i as integer = 1 to N-1  if resultArray(i)>resultArray(i+1) then beep : ok=falsenextif ok=false then print "sorting error DA RUS 4!"FOR i as integer = 1 TO N-1  resultArray(i)=inputArray(i)NEXTvar flag=true : s=0printprint "BUBBLE start"start=TIMER()while flag=true  flag=false  FOR i as integer = 1 TO N-1    IF resultArray(i) > resultArray(i+1) THEN      SWAP resultArray(i), resultArray(i+1): s+=1      flag=true    end if    NEXTwend finish = TIMER()PRINT "BUBBLE   " & finish-start & " second number of swaps " & sok=truefor i as integer = 1 to N-1  if resultArray(i)>resultArray(i+1) then beep : ok=falsenextif ok=false then  print "error BUBBLE!"end ifprint "done ..."sleep`
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Russian Sorting Halves Danilin

St_W wrote:

Code: Select all

`const as integer true=1, false=0`
which means you're using an outdated FreeBasic version ;-)

ahhh I just downloaded it.... but it was the one combined with FBide... I can never setup the parameters for FBedit correctly.... I will see if I can update it - thanks
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

### Re: Russian Sorting Halves Danilin

? is there a compiled version the latest program

from the message from 06 Nov 2018, 04:58 ?
DANILIN
Posts: 7
Joined: Oct 20, 2018 0:57
Contact:

### Re: Russian Sorting Halves Danilin

c# version of "guess my number game" 1 line

Code: Select all

`using System; using System.Text;namespace GURU { class Program { static void Main(string[] args) { Random rand = new Random(); int Russia = 0; int n = 0; int num = 0; dav: if(Russia == 0) {Russia = 2222; num = rand.Next(100)+1; goto dav; }else if (Russia != 0) {Console.Write("? "); n = Convert.ToInt32(Console.ReadLine());} if (n < num) { Console.WriteLine("MORE"); goto dav;}else if (n > num) { Console.WriteLine("less"); goto dav;}else if (n == num) {Console.Write("da"); Console.ReadKey(); }else goto dav;}}}// DANILIN Russia 9-9-2019 guessnum.cs`

using System; using System.Text;namespace GURU { class Program { static void Main(string[] args) { Random rand = new Random(); int Russia = 0; int n = 0; int num = 0; dav: if(Russia == 0) {Russia = 2222; num = rand.Next(100)+1; goto dav; }else if (Russia != 0) {Console.Write("? "); n = Convert.ToInt32(Console.ReadLine());} if (n < num) { Console.WriteLine("MORE"); goto dav;}else if (n > num) { Console.WriteLine("less"); goto dav;}else if (n == num) {Console.Write("da"); Console.ReadKey(); }else goto dav;}}}// DANILIN Russia 9-9-2019 guessnum.cs

c# version of "guess my number game" 1 line

qbasic version of "guess my number game" 1 line

Code: Select all

`1 IF Russia = 0 THEN Russia = 2222: RANDOMIZE TIMER: num = INT(RND * 100) + 1: GOTO 1 ELSE IF Russia <> 0 THEN INPUT n: IF n < num THEN PRINT "MORE": GOTO 1 ELSE IF n > num THEN PRINT "less": GOTO 1 ELSE IF n = num THEN PRINT "da": END ELSE GOTO 1 'DANILIN Russia 9-9-2019 guessnum.bas`

1 IF Russia = 0 THEN Russia = 2222: RANDOMIZE TIMER: num = INT(RND * 100) + 1: GOTO 1 ELSE IF Russia <> 0 THEN INPUT n: IF n < num THEN PRINT "MORE": GOTO 1 ELSE IF n > num THEN PRINT "less": GOTO 1 ELSE IF n = num THEN PRINT "da": END ELSE GOTO 1 'DANILIN Russia 9-9-2019 guessnum.bas

qbasic version of "guess my number game" 1 line
dafhi
Posts: 1324
Joined: Jun 04, 2005 9:51

### Re: Russian Sorting Halves Danilin

Code: Select all

`' sort timer - 2017 Dec 4 - by dafhi'' shorthand, for later#define d #define'' sort thisType vector3d  As double         x,y,z  as uinteger       colorEnd Type' -------------------------------------Type my_SORT_TYPE   as vector3d' -------------------------------------'' comment out the .z for plain var typed dot   .z'' sort directiond direction <'' -------------------------------------' -------------------------------------'   independent' -------------------------------------d sort_type         as my_sort_type#Ifndef floor  #Define floor(x) (((x)*2.0-0.5)shr 1)  #define ceil(x) (-((-(x)*2.0-0.5)shr 1))#EndIfnamespace sorts '' namespacing for shared (global) vars  dim sort_type     sw                'swap var  type my_dot_type  as typeof(sw dot)    d dot_type        as my_dot_type  d sort_type       as my_sort_type  #undef int  d int             as Integer  d sng             as single  d dbl             as double  d dc              declare      sub SetLU(a() sort_type, byref lb int, byref ub int)    if ub<=lb then lb=lbound(a): ub=ubound(a)  end sub      #macro ifswap(x,y)    if a(y)dot direction a(x)dot then      swap a(x),a(y)    endif  #EndMacro     ' good with quicksort  sub bidi_sel_sort(a() SORT_TYPE, lb int=0, ub int=0)    static int j    while lb<ub      dim int lo=lb: j=lb      for i int = lb+1 to ub        if a(i)dot direction a(lo)dot then: lo=i        elseif a(j)dot direction a(i)dot then: j=i        endif      Next      ifswap(lb, lo):  if j=lb then j=lo      ifswap(j, ub):  lb+=1: ub-=1    wend  End Sub  Dim dot_type  pivot  Sub QuickSort(a() SORT_TYPE, l int, r int)      if (r-l) < 17 then bidi_sel_sort a(), l, r:  exit sub      Dim int     i = (l + r) \ 2      static int  j      ifswap(i,r) 'mid-of-3 was slower      pivot = a(i)dot      i = l      j = r-1      Do          While a(i)dot direction pivot              i += 1          Wend          While pivot direction a(j)dot              j -= 1          Wend          if j<i then exit do          Swap a(i), a(j)          i += 1          j -= 1      Loop Until i > j      If l < j Then quicksort(a(), l, j)      If i < r Then quicksort(a(), i, r)  End Sub    sub _RussianSortingHalvesDAV( e() sort_type, ab int, yz int, part int, age int )        IF yz - ab < 1 THEN EXIT SUB        static int        i      ''     static dot_type   summa    static sort_type  a(any)        if lbound(a)<> lbound(e) or ubound(a)<> ubound(e) then      redim a( lbound(e) to ubound(e) )    end if        summa = 0    FOR i = ab TO yz        summa = summa + e(i)dot    NEXT:  var middle = summa / (yz - ab + 1)    static int abc:  abc = ab - 1    var xyz = yz + 1    FOR i = ab TO yz        IF e(i)dot < middle THEN abc = abc + 1: a(abc) = e(i): ELSE xyz = xyz - 1: a(xyz) = e(i)    NEXT    FOR i = ab TO yz: e(i) = a(i): NEXT    IF part < age THEN        IF abc >= ab THEN _RussianSortingHalvesDAV(e(), ab, abc, part + 1, age)        IF xyz <= yz THEN _RussianSortingHalvesDAV(e(), xyz, yz, part + 1, age)    END IF  end sub    SUB Russian_SH_DAV( e() sort_type, lb int, ub int )    SetLU e(), lb, ub    _RussianSortingHalvesDAV e(), lb, ub, lb, ub      END SUBend namespace' ------- timing metrics ============================='Const                 SortElements = 9 * 999dim shared as long    ub_times = 15sub RandomData(a() SORT_TYPE)  for i int = 0 to ubound(a)    a(i)dot = rnd  NextEnd Subfunction Sorted(a() SORT_TYPE) as boolean  var b = a(0)dot, correct = true  for p as my_SORT_TYPE ptr = @a(1) to @a(ubound(a))    if p->z direction b then correct=FALSE: exit for    b = p->z  Next  if not correct then   for p as my_SORT_TYPE ptr = @a(0) to @a(ubound(a))     ? p->z; " ";   Next: ?  end if  : return correctend functiontype tTimings  as long           ub = -1  as double         a(any)  as string         mesg  declare operator  cast as string  declare operator  cast as double  declare operator  cast as singleEnd Typeoperator tTimings.cast as string:  return str(a(ub/2))End Operatoroperator tTimings.cast as double:  return a(ub/2)End Operatoroperator tTimings.cast as single:  return a(ub/2)End Operatordim shared as double  times(ub_times)sub InsertionSort_Timings(A() As double,UB int=-1,LB int=0)  if lb>ub then lb=lbound(a): ub=ubound(a)  var lo=lb: for i int=lb+1 to ub: if a(i) < a(lo) then lo=i  next: swap a(lb), a(lo)  For i int=lb+1 To ub-1    dim int j=i+1: if a(j) < a(i) then      dim as double sw=a(j): j=i: while sw < a(j)        a(j+1)=a(j): j-=1: wend: a(j+1)=sw: endif: NextEnd Sub#Macro mac_timer(algo,ret, algorithm_name)  ret.mesg = algorithm_name & " "  for i int = 0 to ub_times    RandomData a()    dim as double t = timer      algo    times(i) = timer - t    If not Sorted( a() ) then ? "sort error! "; ret.mesg  Next: InsertionSort_Timings times()  ret.ub+=1  redim preserve ret.a(ret.ub)  ret.a(ret.ub) = times(ub_times/2)  InsertionSort_Timings ret.a()#EndMacro'' ----function round(in as single, places as ubyte = 2) as string  dim int mul = 10 ^ places  return str(csng(floor(in * mul + .5) / mul))End Functionsub Main   dim int    ub = SortElements - 1  dim SORT_TYPE a(ub)  dim as tTimings   tA, tB  sleep 250  randomize     d sort_a mac_timer( quicksort( a(), 0, ubound(a) ), tA, "quicksort" )    d sort_b mac_timer( Russian_SH_DAV( a(), 0, ubound(a) ), tB, "RussianDAV" )      using sorts ''namespace   ? " sorting .."  for i as long = 1 to 8    sleep 15    if rnd<.5 then 'algorithm sequence can make a difference      sort_a      sort_b    else      sort_b      sort_a    endif  next  cls   var s = 0f, mesg = " "  if tA<tB then    s = tA / tB: mesg = tA.mesg  else    s = tB / tA: mesg = tB.mesg  EndIf  ?  ? " winner:  "; mesg  ?  ? s; " .. "; round(1 / s); "x"  sleepend subMain`