Oxygen Basic

Programming => Example Code => Topic started by: Arnold on September 03, 2017, 01:56:46 AM

Title: The power of typeof
Post by: Arnold on September 03, 2017, 01:56:46 AM

Hello,

this is a small iterative quicksort routine originally coded in Qbasic which I adapted for OxygenBasic:

Code: [Select]

include "$/inc/console.inc"

macro swap(a,b) {c=a : a=b : b=c}

sub QuickSort(int SortArray[], int Lower, Upper)
   'QuickSort iterative (rather than recursive) by Cornel Huth
   type stacktype         'for QuickSort
     int low
     int hi
   end type

   stacktype lstack[128]  'our stack

   int sp                 'our stack pointer
   int low, hi, i, j, midx, compare
   sp = 1

   lstack[sp].low = Lower
   lstack[sp].hi  = Upper
   sp += 1

   while sp <> 1
     sp -= 1
     low = lstack[sp].low
     hi  = lstack[sp].hi
     while low < hi
       i = low : j = hi
       midx = (low + hi) \ 2
       compare = SortArray[midx]
       while i < j
         while SortArray[i] < compare
           i += 1
         wend
         while SortArray[j] > compare
           j -= 1
         wend
         if i <= j then       
           swap SortArray[i], SortArray(j)
           i += 1
           j -= 1
         end if
       wend       
       if (j - low) < (hi - i) then
         if i < hi then
           lstack[sp].low = i
           lstack[sp].hi  = hi
           sp += 1
         end if
         hi = j
       else
         if low < j then
           lstack[sp].low = low
           lstack[sp].hi  = j
           sp += 1
         end if
         low = i
       end if
     wend       
   wend   
end sub

int array[] = {4,65,2,-31,0,99,2,83,782,1}

for x=1 to countof array
  print array[x] ","
next
printl

quicksort (array[], 1, countof array[])

for x=1 to countof array[]
print array[x] ","
next
printl

printl "Enter ... " : waitkey
Output:
4,65,2,-31,0,99,2,83,782,1,
-31,0,1,2,2,4,65,83,99,782,

Enter ...

I tried to change the sub into a macro and using "typeof" this worked quite fine.

Edit: As the code was a little bit buggy I applied the modifications of Charles which can be found further down:

Code: [Select]

include "$/inc/console.inc"

macro swap(a,b,  c) {typeof a c : c=a : a=b : b=c}

macro print_array(a,  i)
scope
  indexbase 1
  int i
  for i=1 to countof a
     print a[i] " "
  next
  printl
end scope
end macro

type stacktype         'for QuickSort
  int low
  int hi
end type

macro quick_sort(a,  Lower, Upper, lstack, sp, low, hi, compare, midx)
   'QuickSort iterative (rather than recursive) by Cornel Huth
scope
   indexbase 1
   int Lower=1
   int Upper=countof a
   
   typeof a compare       'int, double, string etc.

   stacktype lstack[128]  'our stack

   int sp = 1             'our stack pointer
   lstack[sp].low = Lower
   lstack[sp].hi  = Upper
   sp += 1
   
   int low, hi, midx
   int i,j

   while sp <> 1
     sp -= 1
     low = lstack[sp].low
     hi  = lstack[sp].hi
     while low < hi
       i = low : j = hi
       midx = (low + hi) \ 2
       compare = a[midx]
       while i < j
         while a[i] < compare
           i += 1
         wend
         while a[j] > compare
           j -= 1
         wend
         if i <= j then       
           swap a[i], a[j]
           i += 1
           j -= 1
         end if
       wend       
       if (j - low) < (hi - i) then
         if i < hi then
           lstack[sp].low = i
           lstack[sp].hi  = hi
           sp += 1
         end if
         hi = j
       else
         if low < j then
           lstack[sp].low = low
           lstack[sp].hi  = j
           sp += 1
         end if
         low = i
       end if
     wend       
   wend
end scope   
end macro

==========================================

int array1[] = {4,65,2,-31,0,99,2,83,782,1}
double array2[] = {4.5,65.5,2,-31.5,0,99,2.5,83,782.5,1}
string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}

print_array(array1)
quick_sort(array1)
print_array(array1)
printl

print_array(array2)
quick_sort(array2)
print_array(array2)
printl

print_array(array3)
quick_sort(array3)
print_array(array3)
printl

printl "Enter ..." : waitkey
Output:
4 65 2 -31 0 99 2 83 782 1
-31 0 1 2 2 4 65 83 99 782

4.5 65.5 2 -31.5 0 99 2.5 83 782.5 1
-31.5 0 1 2 2.5 4.5 65.5 83 99 782.5

oxygen is a nice and powerful programming language
a and is language nice oxygen powerful programming

"typeof" is really powerful. This should be further investigated.

Roland

Title: Re: The power of typeof
Post by: Arnold on September 07, 2017, 01:17:47 AM

Hi Charles,

sometimes I am unhappy about my faulty logic. This is a small bubblesort example which uses overloading:

Code: [Select]

include "$/inc/console.inc"

macro swap(a,b) {tmpval=a : a=b : b=tmpval}

macro print_array(a,c)
  typeof a *arr
  @arr = @a
  for x=1 to c
     print arr[x] " "
  next
  printl
end macro

'applying indexbase 1
sub bubble_sort(int a[],int c, d)  'd=1 ascending, else descending 
  u=1   'unsorted
  while u
    u=false
    for i=1 to c-1
       if d=1 then   'ascending 
         if a[i]>a[i+1] then
           swap a[i],a[i+1] : u=true
         end if 
       else          'descending
         if a[i]<a[i+1] then
           swap a[i],a[i+1] : u=true
         end if   
       end if 
    next
  wend
end sub

'applying indexbase 1
sub bubble_sort(double a[],int c, d)  'd=1 ascending, else descending 
  u=1   'unsorted
  while u
    u=false
    for i=1 to c-1
       if d=1 then   'ascending 
         if a[i]>a[i+1] then
           swap a[i],a[i+1] : u=true
         end if 
       else          'descending
         if a[i]<a[i+1] then
           swap a[i],a[i+1] : u=true
         end if   
       end if 
    next
  wend
end sub

'applying indexbase 1
sub bubble_sort(string a[],int c, d)  'd=1 ascending, else descending 
  u=1   'unsorted
  while u
    u=false
    for i=1 to c-1
       if d=1 then   'ascending 
         if a[i]>a[i+1] then
           swap a[i],a[i+1] : u=true
         end if 
       else          'descending
         if a[i]<a[i+1] then
           swap a[i],a[i+1] : u=true
         end if   
       end if 
    next
  wend
end sub

==========================================

int array1[] = {4,65,2,-31,0,99,2,83,782,1}
double array2[] = {4.3,65.7,2,-31.4,0,99,2.1,83,782,1}
string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}

print_array(array1[], countof array1[])
bubble_sort(array1[], countof array1[], 0)
print_array(array1[], countof array1[],)
bubble_sort(array1[], countof array1[], 1)
print_array(array1[], countof array1[],)
printl

print_array(array2[], countof array2[])
bubble_sort(array2[], countof array2[], 0)
print_array(array2[], countof array2[])
bubble_sort(array2[], countof array2[], 1)
print_array(array2[], countof array2[])
printl

print_array(array3[], countof array3[])
bubble_sort(array3[], countof array3[], 0)
print_array(array3[], countof array3[])
bubble_sort(array3[], countof array3[], 1)
print_array(array3[], countof array3[])
printl

printl "Enter ..." : waitkey
Output:
4 65 2 -31 0 99 2 83 782 1
782 99 83 65 4 2 2 1 0 -31
-31 0 1 2 2 4 65 83 99 782

4.2999999999999998 65.700000000000003 2 -31.399999999999999 0 99 2.1000000000000001 83 782 1
782 99 83 65.700000000000003 4.2999999999999998 2.1000000000000001 2 1 0 -31.399999999999999
-31.399999999999999 0 1 2 2.1000000000000001 4.2999999999999998 65.700000000000003 83 99 782

oxygen is a nice and powerful programming language
programming powerful oxygen nice language is and a
a and is language nice oxygen powerful programming

If I try to use a macro for the sorting routine this will fail, only the results for the first type are correct:

Code: [Select]

include "$/inc/console.inc"

macro swap(a,b) {tmpval=a : a=b : b=tmpval}

macro print_array(a,c)
  typeof a *arr
  @arr = @a
  for x=1 to c
     print arr[x] " "
  next
  printl
end macro

'applying indexbase 1
macro bubble_sort(a,c,d)  'd=1 ascending, else descending 
  typeof a *bsa
  @bsa = @a
  u=1   'unsorted
  while u
    u=false
    for i=1 to c-1
       if d=1 then   'ascending 
         if bsa[i]>bsa[i+1] then
           swap bsa[i],bsa[i+1] : u=true
         end if
       else          'descending
         if bsa[i]<bsa[i+1] then 
           swap bsa[i],bsa[i+1] : u=true
         end if
       end if 
    next
  wend
end macro

==========================================

int array1[] = {4,65,2,-31,0,99,2,83,782,1}
double array2[] = {4.3,65.7,2,-31.4,0,99,2.1,83,782,1}
string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}

print_array(array1[], countof array1[])
bubble_sort(array1[], countof array1[], 0)
print_array(array1[], countof array1[],)
bubble_sort(array1[], countof array1[], 1)
print_array(array1[], countof array1[],)
printl

print_array(array2[], countof array2[])
bubble_sort(array2[], countof array2[], 0)
print_array(array2[], countof array2[])
bubble_sort(array2[], countof array2[], 1)
print_array(array2[], countof array2[])
printl

print_array(array3[], countof array3[])
bubble_sort(array3[], countof array3[], 0)
print_array(array3[], countof array3[])
bubble_sort(array3[], countof array3[], 1)
print_array(array3[], countof array3[])
printl

printl "Enter ..." : waitkey
Output:
4 65 2 -31 0 99 2 83 782 1
782 99 83 65 4 2 2 1 0 -31
-31 0 1 2 2 4 65 83 99 782

4.2999999999999998 65.700000000000003 2 -31.399999999999999 0 99 2.1000000000000001 83 782 1
782 99 83 66 4 2 2 1 0 -31
-31 0 1 2 2 4 66 83 99 782

oxygen is a nice and powerful programming language
programming language 0 0 0 0 0 0
0 0 0 0 0 0 0 0

Is there a mistake in the sorting macro or do I only exaggerate and overstrain the use of a macro? I also tried to use type 'any' in the bubble_sort routine, but probably I overlooked something in this case too.

Roland

Title: Re: The power of typeof
Post by: Charles Pegge on September 07, 2017, 04:08:21 AM

Hi Roland,

I've been fine tuning macros recently, so I'm not sure whether you might be encountering a bug. So I have attached my latest o2 below. (note the include statement :) )

These macros are as well encapsulated as normal procedures, but also accept any primitive type:

Code: [Select]

'2017-09-07 T 12:48:05
'POLYMORPHIC BUBBLE SORT USING MACROS

include console

macro swap(a,b,  c)
typeof a c
c=a
a=b
b=c
end macro
 
macro bubble_sort(a,d,  cc,u,i)  'd=1 ascending, else descending
scope
  indexbase 1
  int cc=countof(a)-1
  int u=1   'unsorted
  int i
  while u
    u=false
    for i=1 to cc
       if d=1 then   'ascending
         if a[i]>a[i+1] then
           swap a[i],a[i+1] : u=true
         end if
       else          'descending
         if a[i]<a[i+1] then
           swap a[i],a[i+1] : u=true
         end if   
       end if
    next
    cc-- 'FINAL ELEMENT IS FIXED
  wend
end scope
end macro

macro list(a,  i)
scope
  indexbase 1
  int i
  for i=1 to countof a
    print a[i] "  "
  next
  print chr(13,10)
end scope
end macro

int a[]={1.25,2,3,4,5,6,7,8,9,10,"ten"}
bubble_sort(a,0)
print "int:     " : list a
float a[]={1.25,2,3,4,5,6,7,8,9,10,"ten"}
bubble_sort(a,0)
print "double:  " : list a
string a[]={1.25,2,3,4,5,6,7,8,9,10,"ten"}
bubble_sort(a,0)
print "string:  " : list a

waitkey

.

Title: Re: The power of typeof
Post by: Arnold on September 07, 2017, 07:45:38 AM

Hi Charles,

after applying your corrections there is no problem any more with the bubblesort routine neither with the older nor the new version of oxygen.dll. I adapted the quicksort routine above too, hopefully I did this correctly. With this example I learnt that I must be a little bit careful using typeof, that I must respect the scope in a macro, that you use a space to distinguish between arguments for a macro and variables declared inside the macro, and that I must not end an array with brackets when calling the macro.

BTW: the new option to shorten to 'include console' is splendid.

Added is my bubblesort example with your modifications to demonstrate the bad and good usage of typeof and macros.

Roland

Code: [Select]

include "$/inc/console.inc"

macro swap(a,b,  c)
typeof a c
c=a
a=b
b=c
end macro

macro print_array(a,  i)
scope
  indexbase 1
  int i
  for i=1 to countof a
     print a[i] " "
  next
  printl
end scope
end macro

'applying indexbase 1
macro bubble_sort(a,d,  cc,u,i)  'd=1 ascending, else descending 
scope
  indexbase 1
  int cc=countof(a)-1
  int u=1   'unsorted
  int i
  while u
    u=false
    for i=1 to cc
       if d=1 then   'ascending 
         if a[i]>a[i+1] then
           swap a[i],a[i+1] : u=true
         end if
       else          'descending
         if a[i]<a[i+1] then 
           swap a[i],a[i+1] : u=true
         end if
       end if 
    next
    cc-- 'FINAL ELEMENT IS FIXED   
  wend
end scope
end macro

==========================================

int array1[] = {4,65,2,-31,0,99,2,83,782,1}
double array2[] = {4.5,65.5,2,-31.5,0,99,2.5,83,782.5,1}
string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}

print_array(array1)
bubble_sort(array1, 0)
print_array(array1)
bubble_sort(array1, 1)
print_array(array1)
printl

print_array(array2)
bubble_sort(array2, 0)
print_array(array2)
bubble_sort(array2, 1)
print_array(array2)
printl

print_array(array3)
bubble_sort(array3, 0)
print_array(array3)
bubble_sort(array3, 1)
print_array(array3)
printl

printl "Enter ..." : waitkey


Title: Re: The power of typeof
Post by: Arnold on September 09, 2017, 01:27:01 AM

This is a small ShellSort routine solved as a macro. The algorithm is discussed e.g. in Wikipedia:
https://en.wikipedia.org/wiki/Shellsort (https://en.wikipedia.org/wiki/Shellsort)

Shell sort is a very short but effective sorting method. It does not need a stack or recursion. It is much faster than Bubble sort and the speed can be compared with Quick sort and Merge sort. There exist some more formulas to specify the gap of the columns but I think the one I used is a good compromise. Perhaps the execution time can still be optimized using some assembly statements. Although it is an old method, Speed sort will be my favourite in the future.

On my old notebook sorting a million randomized numbers took about 5 to 10 seconds. How much time will it take using a more modern machine? I expect it will be about 2 seconds.

Roland

Code: OxygenBasic

1. 'https://en.wikipedia.org/wiki/Shellsort
2.  
3. include "$/inc/console.inc"
4.  
5. macro swap(a,b,  c) {typeof a c : c=a : a=b : b=c}
6.  
7. macro print_array(a,  i)
8. scope
9.   indexbase 1
10.   int i
11.   for i=1 to countof a
12.      print a[i] " "
13.   next
14.   printl
15. end scope
16. end macro
17.  
18. 'applying indexbase 1
19. macro shell_sort(a,d,  cc,df,i,ig,gap,lim)  'd=1 ascending, else descending  
20. scope
21.   indexbase 1
22.   int cc=countof a  
23.   int i, ig, df, gap
24.  
25.   'Determine starting gap
26.  int lim = cc\3  'Donald E. Knuth, Vaughan R. Pratt
27.  i=1
28.   do
29.     if i>lim then i=(i-1)\3 : exit do
30.     i*=3 +1
31.   end do
32.  
33.   gap=i
34. '  gap=cc \ 2  'Donald L. Shell
35.  
36.   while gap>0
37.      do
38.        df=true          'done flag
39.       for i=1 to cc-gap
40.           ig=i+gap
41.           if d=1 then   'ascending  
42.            if a[i]>a[ig] then
43.               swap a[i],a[ig] : df=false
44.             end if
45.           else          'descending
46.            if a[i]<a[ig] then  
47.               swap a[i],a[ig] : df=false
48.             end if
49.           end if  
50.        next
51.        if df=true then exit do
52.      end do
53. '     gap \= 2       'Shell
54.     gap=(gap-1)\3  'Knuth, Pratt
55.  wend
56. end scope
57. end macro
58.  
59. ==========================================
60.  
61. int array1[] = {30,5,24,11,26,20,4,23,9,25,6,28,15,27,7,22,10,3,1,13,21,29,17,2,19,8,16,14,12,18}
62. double array2[] = {4.5,65.5,2,-31.5,0,99,2.5,83,782.5,1}
63. string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}
64.  
65. print_array(array1)
66. shell_sort(array1, 0)
67. print_array(array1)
68. shell_sort(array1, 1)
69. print_array(array1)
70. printl
71.  
72. print_array(array2)
73. shell_sort(array2, 0)
74. print_array(array2)
75. shell_sort(array2, 1)
76. print_array(array2)
77. printl
78.  
79. print_array(array3)
80. shell_sort(array3, 0)
81. print_array(array3)
82. shell_sort(array3, 1)
83. print_array(array3)
84. printl
85.  
86. ==========================================
87.  
88. 'Use Windows functions
89. ! GetTickCount lib "kernel32.dll" () as sys
90.  
91. ! rand  lib "msvcrt.dll" cdecl () as int
92. ! srand lib "msvcrt.dll" cdecl (int seed)
93.  
94. int array4[1000000]
95. 'double array4[1000000]
96.  
97. srand(GetTickCount)   'Randomize
98.  
99. for x=1 to 1000000 : array4[x]=rand()/2.5 : next
100. 'print_array(array4)
101. printl "Sorting " countof array4 " items of type: " typeof array4 " in ascending order with ShellSort:" cr
102. t1=GetTickCount()
103. shell_sort(array4, 1)
104. t2=GetTickCount
105. 'print_array(array4)
106. printl "Elapsed Time: " (t2-t1)/1000
107. printl
108. printl "Now sorting the sorted array in descending order with ShellSort:" cr
109. t1=GetTickCount()
110. shell_sort(array4, 0)
111. t2=GetTickCount
112. 'print_array(array4)
113. printl "Elapsed Time: " (t2-t1)/1000
114.  
115.  
116. printl "Enter ..." : waitkey
117.  

.

Title: Re: The power of typeof
Post by: Charles Pegge on September 10, 2017, 12:39:42 AM

Hi Roland,

Merge sort is probably the best sorting algorithm there is, in terms of efficiency and conserving order.

This bottom-up version starts with pairs of items. Each pair is sorted, then the pairs are merged into sorted groups of 4, then 8, then 16 ..., until a single pile remains.

Implementing this idea is a little more complicated, since the number of items will seldom be an exponent of 2.

The index array must be twice as large as the number of items to be sorted, to provide a buffer to hold the result of each merge.

Code: [Select]

'bottom-up merge-sort procedure
===============================
macro mergeSort(
  idx,ct,cp, 'params
  src,dest,setsz,cmpr,sw,j,k,kk,bi,bj,ej,ni,nj 'encapsulated
  )
scope
indexbase 1
'
' idx        index array must have ct*2 elements
' ct         element count
' cp         comparator callback/macro
'
sys src    ' index offset for elements to be compared
sys dest   ' index offset for merged ordered elements
sys setsz  ' merge group size
sys cmpr   ' flag to invoke comparator
sys sw     ' flag to select from second group instead of first
sys j      ' general indexer
sys k      ' general indexer
sys kk     ' element counter
sys bi     ' base index for first group
sys bj     ' base index for second group
sys ej     ' boundary index for second goup
sys ni     ' position for first compare element
sys nj     ' position for second compare element
src=0
dest=ct
setsz=1
do 'MERGING LOOP
  if setsz>=ct then
    if src>0 then 'COPY INDEX VALUES BACK TO BASE
      copy @idx, ct*sizeof(sys)+@idx, ct*sizeof(sys)
    end if
    exit do 'DONE
  end if
  kk=1
  bi=src+1     : ni=bi
  bj=bi+setsz : nj=bj
  ej=bj+setsz
  k=src+ct+1
  if ej>k then ej=k
  setsz+=setsz 'SET STRIDE FOR EACH MERGE 2 4 8 ...
  do 'A MERGING PASS
    if kk>ct then exit do 'ALL ELEMENTS PROCESSED
    if ni>=bj then
      if nj>=ej then
        'MOVE TO NEXT GROUP
        bi+=setsz : ni=bi
        bj+=setsz : nj=bj
        ej+=setsz
        k=src+ct+1 'DATA BOUNDARY
        if ej>k then ej=k 'CLIP BOUNDARY
        cmpr=1 : sw=0 'COMPARE BEFORE PICKING
      else
        cmpr=0 : sw=1 'ONLY PICK FROM SECOND GROUP
      end if
    elseif nj>=ej then
      cmpr=0 : sw=0 'ONLY PICK FROM FIRST GROUP
    else
      cmpr=1 : sw=0 'COMPARE BEFORE PICKING   
    end if
    if cmpr
      cp( sw, idx[ni], idx[nj] ) 'DO COMPARE
    end if
    if sw then 'PICK FROM SECOND GROUP
      j=idx[nj] : nj++
    else 'PICK FROM FIRST GROUP
      j=idx[ni] : ni++
    end if
    k=dest+kk : idx[k]=j 'ASSIGN VALUE TO DESTINATION LOCATION
    kk++ 'INCR ELEMENT COUNT
  end do
  swap src,dest 'SWAP SOURCE/DESTINATION INDEX BUFFER BASES
end do
end scope
end macro

I also have a version which uses striding pointers instead of arrays. It is more efficient and cleaner for passing macro parameters.

Code: [Select]

'bottom-up merge-sort procedure
===============================
macro mergeSortP(
  idx,ct,cp, 'params
  src,dest,setsz,cmpr,sw,kk,bi,bj,ej,ed,ni,nj,sx,dj,sd 'encapsulated
  )
'
' idx        index array must have ct*2 elements
' ct         element count
' cp         comparator callback/macro
'
%= sx   sizeof idx  'element size
%= sd   ct*sx       'size of index data (bytes)
'
sys src             ' index offset for elements to be compared
sys dest            ' index offset for merged ordered elements
sys setsz           ' merge group size X sizeof idx element
sys cmpr            ' flag to invoke comparator
sys sw              ' flag to select from second group instead of first
sys kk              ' element counter
sys bi              ' base for first group
sys bj              ' base for second group
sys ej              ' boundary for second goup
sys ed              ' source data boundary
typeof idx * ni     ' position for first compare element
typeof idx * nj     ' position for second compare element
typeof idx * dj     ' destination for element
src=@idx
dest=sd+@idx
setsz=sx 'INITIAL STRIDE IS SIZE OF IDX ELEMENT
do 'MERGING LOOP
  if setsz>=sd then
    if src<>@idx then 'COPY INDEX VALUES BACK TO BASE
      copy @idx, @idx+sd, sd
    end if
    exit do 'DONE
  end if
  kk=1
  bi=src
  bj=bi+setsz : @nj=@bj
  ej=bj+setsz
  @ni=bi
  @nj=bj
  ed=src+sd 'DATA BOUNDARY
  if ej>ed then ej=ed
  @dj=dest
  setsz+=setsz 'DOUBLE STRIDE FOR EACH MERGE 8,16,32 ...
  do 'NEXT MERGING PASS
    if kk>ct then exit do 'ALL ELEMENTS PROCESSED
    if @ni>=bj then
      if @nj>=ej then
        'MOVE TO NEXT GROUP
        bi+=setsz : @ni=bi
        bj+=setsz : @nj=bj
        ej+=setsz
        if ej>ed then ej=ed 'CLIP BOUNDARY
        cmpr=1 : sw=0 'COMPARE BEFORE PICKING
      else
        cmpr=0 : sw=1 'ONLY PICK FROM SECOND GROUP
      end if
    elseif @nj>=ej then
      cmpr=0 : sw=0 'ONLY PICK FROM FIRST GROUP
    else
      cmpr=1 : sw=0 'COMPARE BEFORE PICKING   
    end if
    if cmpr then
      cp sw, ni, nj 'COMPARE PROCEDURE
    end if
    if sw then 'PICK FROM SECOND GROUP
      dj=nj : @nj+=sx
    else 'PICK FROM FIRST GROUP
      dj=ni : @ni+=sx
    end if
    @dj+=sx 'NEXT DESTINATION
    kk++ 'INCR ELEMENT COUNT
  end do
  swap src,dest 'SWAP SOURCE/DESTINATION IDX BASES
end do
end macro


Title: Re: The power of typeof
Post by: Arnold on September 10, 2017, 07:21:38 AM

Hi Charles,

thank you for these macros, they are very helpful for me (although I have two problems at the moment). Since yesterday I am struggling to understand and realize an iterative mergesort algorithm like here:
https://en.wikipedia.org/wiki/Merge_sort
along the diagram here:
https://en.wikipedia.org/wiki/Merge_algorithm

If I compare my code done so far with your macro it seems that I have missed some points.

May I ask some questions about the first macro?
If I have an array1[]={38, 27, 43, 3, 9, 82, 10} how must I apply mergeSort(idx,ct,cp)? Is ct = array1 and idx an empty array with size=2*array1?
I am also not sure how to treat the macro: cp( sw, idx[ni], idx[nj] ) 'DO COMPARE
Will this macro change the value of sw or does it still more?

I am using the latest oxygen.dll which you uploaded with reply #2.

Roland

Title: Re: The power of typeof
Post by: Charles Pegge on September 10, 2017, 10:53:15 AM

idx is an index array, normally of integers, used to index a static block of data records. Only the index gets sorted. This would apply to any sort algorithm in a real application.

ct is the number items to sort

sw is the swap flag, and a,b are a pair of index values used to make the comparison

Code: [Select]

include generics
include console
'CREATE SOME DATA
string dat={"a2","a1","a","b","c","d","e","f","g","h","i","j"}
%= ct = spanof dat
'CREATE AN INDEX FOR TESTING
int idx[ct*2]
for i=1 to ct : idx[i]=i : next 'prime the index

sub compare(sys *sw,i,j)
if dat[i]<dat[j] then sw=1 'DESCENDING ORDER
end sub

mergeSort idx,ct,compare


Title: Re: The power of typeof
Post by: Arnold on September 11, 2017, 01:08:22 AM

Hi Charles,

at the moment I only get the same order for the dat array as result no matter what I do. But with my distribution I cannot find generics.inc so I will wait for your next release anyway. It seems to me that you will use the macros for linked lists?

In the meantime I managed to adapt another iterative mergesort example using bottom-up strategy. The only drawback is that I cannot create a temporary array in the macro which is actually no problem. But perhaps it is still possible to create an array with varying type in a macro too?

I have to admit that when sorting numbers mergesort is a lot faster than shellsort. I can see this even with my old notebook and the results are really impressive.

Roland

Code: [Select]

//https://stackoverflow.com/questions/1557894/non-recursive-merge-sort

include "$/inc/console.inc"

macro merge_sort(a,d,b,
    n,l,r,r_max,m,k,i,j)

    indexbase 1
    int n=countof a
    int r, r_max, m, k
    int i,j

''    sys ba=n*2*sizeof string : string b[] at getmemory ba
 
    k=1
    while k < n+1

        l=1
        while (l+k-1) < n+1
            r = l + k       
            r_max = r + k
            if (r_max > n+1) then r_max = n+1

            m = l : i = l : j = r
            while (i < r and j < r_max)
                if d=1 then
                  if (a[i] <= a[j]) then
                      b[m] = a[i] : i++
                  else
                      b[m] = a[j] : j++
                  end if
                else
                  if (a[i] >= a[j]) then
                      b[m] = a[i] : i++
                  else
                      b[m] = a[j] : j++
                  end if
                end if
                m++
            wend

            while (i < r)
                b[m]=a[i] : i++ : m++
            wend

            while (j < r_max)
                b[m]=a[j] : j++ : m++
            wend

            for m=l to r_max-1
                a[m] = b[m]
            next

        l += k*2
        wend

    k *= 2
    wend

'    freememory b
end macro

==========================================

macro print_array(a,  i)
scope
  indexbase 1
  int i
  for i=1 to countof a
     print a[i] " "
  next
  printl
end scope
end macro

int array1[] = {30,5,24,11,26,20,4,23,9,25,6,28,15,27,7,22,10,3,1,13,21,29,17,2,19,8,16,14,12,18}
double array2[] = {4.5,65.5,2,-31.5,0,99,2.5,83,782.5,1}
string array3[] = {lcase("Oxygen"),"is","a","nice","and","powerful","programming","language"}

print_array(array1)
sys ba=countof array1 *2*sizeof array1 : int temparray[] at getmemory ba
merge_sort(array1, 0, temparray)
print_array(array1)
merge_sort(array1, 1, temparray)
print_array(array1)
freememory @temparray
printl

print_array(array2)
sys ba=countof array2 *2*sizeof array1 : double temparray[] at getmemory ba
merge_sort(array2, 0, temparray)
print_array(array2)
merge_sort(array2, 1, temparray)
print_array(array2)
freememory @temparray
printl

print_array(array3)
sys ba=countof array3 *2*sizeof array3 : string temparray[] at getmemory ba
merge_sort(array3, 0, temparray)
print_array(array3)
merge_sort(array3, 1, temparray)
print_array(array3)
freememory @temparray
printl

==========================================

'Use Windows functions
! GetTickCount lib "kernel32.dll" () as sys

! rand  lib "msvcrt.dll" cdecl () as int
! srand lib "msvcrt.dll" cdecl (int seed)

int array4[1000000]
'double array4[1000000]

srand(GetTickCount)   'Randomize

for x=1 to 100 : array4[x]=rand()/2.5 : next

'print_array(array4)
printl "Sorting " countof array4 " items of type: " typeof array4 " in ascending order with MergeSort:" cr
t1=GetTickCount()
sys ba=countof array4 *2*sizeof array4 : int temparray[] at getmemory ba
'sys ba=countof array4 *2*sizeof array4 : double temparray[] at getmemory ba
merge_sort(array4, 1, temparray)
freememory @temparray
t2=GetTickCount()
'print_array(array4)
printl "Elapsed Time: " (t2-t1)/1000
printl

printl "Now sorting the sorted array in descending order with MergeSort:" cr
t1=GetTickCount()
sys ba=countof array4 *2*sizeof array4 : int temparray[] at getmemory ba
'sys ba=countof array4 *2*sizeof array4 : double temparray[] at getmemory ba
merge_sort(array4, 0, temparray)
freememory @temparray
t2=GetTickCount()
'print_array(array4)
printl "Elapsed Time: " (t2-t1)/1000
printl

printl "Enter ..." : waitkey

.

Title: Re: The power of typeof
Post by: Charles Pegge on September 11, 2017, 03:16:09 AM

Hi Roland,

I am working on generics right now, but you can give it a go in its current state. The latest mergeSort is more efficient, and avoids using arrays. This eliminates the complexity of multiple nested indexes when accessing data.

I have not thought about putting in linked lists yet, though I have found them to be useful in hash storage.

There is a new macro, newSortIndex which creates dynamic indexes and introduces filtering as well as sorting. This example goes with the new generics:

Code: [Select]

'2017-09-11 T 12:13:35
'FILTERING AND SORTING
include generics
include console
'CREATE SOME DATA
string dat={"a2","a1","a","b","c","d","e","f","g","h","i","j"}
int ct = spanof dat
int cf

macro filter(f,i)
if asc(dat[i])<=0x65 then f=1 'e'
end macro

macro compare(sw,i,j)
if dat[i]<dat[j] then sw=1 'DESCENDING ORDER
end macro

newSortIndex idx,ct,cf,filter,compare

'SHOW RESULTS
print "DATA" cr
listArray dat,print,ct
print "INDEXED DATA" cr
listArray dat,print,cf,idx
print "INDEX" cr
listArray idx,print,cf
waitkey
delIndex idx

.

Title: Re: The power of typeof
Post by: JRS on September 16, 2017, 09:10:36 PM

Hi Charles,

I would like to see a keyed file indexing library that would work with flat file systems or multi-line strings.

Title: Re: The power of typeof
Post by: Charles Pegge on September 17, 2017, 07:42:24 PM

Hi John,

We have the basics of one in tableUtil.inc. It works with flat records, and also ascii-delimited records, but needs further testing and some examples. It will use the sort algorithm in generics and a few others.

Title: Re: The power of typeof
Post by: JRS on September 17, 2017, 07:57:09 PM

Great news!

Something I would find very useful in DLLC.

Title: Re: The power of typeof
Post by: Charles Pegge on September 25, 2017, 07:33:07 AM

Hi John,

It's a long time ago, but we had an experimental test, using TableUtil with DLLC. It worked though it was quite cumbersome to set up, and I remember we concluded that SQL was the better option, since you already include it with Scriptbasic. TableUtil is really a low level item intended for simple bespoke databases.

Title: Re: The power of typeof
Post by: JRS on September 25, 2017, 07:05:53 PM

I remember now that you mentioned it. It is how I learn about the SQLite bulk insert trick.

I also didn't have the array sort written at that time.

I miss the simplicity of the DBase ISAM for flat files.