September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -0,0 +1,368 @@
|
|||
--
|
||||
-- demo\rosetta\Compare_sorting_algorithms.exw
|
||||
--
|
||||
constant XQS = 01 -- (set to 1 to exclude quick_sort and shell_sort from ones)
|
||||
|
||||
include pGUI.e
|
||||
|
||||
Ihandle dlg, tabs, plot
|
||||
Ihandles plots
|
||||
|
||||
function quick_sort2(sequence x)
|
||||
integer n = length(x), c, mid, midn
|
||||
object xi, midval
|
||||
sequence left = {}, right = {}
|
||||
|
||||
if n<2 then
|
||||
return x -- already sorted (trivial case)
|
||||
end if
|
||||
|
||||
mid = floor((n+1)/2)
|
||||
midval = x[mid]
|
||||
x[mid] = x[1]
|
||||
midn = 1
|
||||
|
||||
for i=2 to n do
|
||||
xi = x[i]
|
||||
c = compare(xi,midval)
|
||||
if c<0 then
|
||||
left &= xi
|
||||
elsif c>0 then
|
||||
right &= xi
|
||||
else
|
||||
midn += 1
|
||||
end if
|
||||
end for
|
||||
|
||||
return quick_sort2(left) & repeat(midval,midn) & quick_sort2(right)
|
||||
end function
|
||||
|
||||
function quick_sort(sequence s)
|
||||
sequence qstack
|
||||
integer first, last, stackptr, I, J, tmp, pivot
|
||||
|
||||
qstack = repeat(0,floor((length(s)/5)+10)) -- create a stack
|
||||
|
||||
first = 1
|
||||
last = length(s)
|
||||
stackptr = 0
|
||||
while 1 do
|
||||
while first<last do
|
||||
pivot = s[floor(last+first)/2]
|
||||
I = first
|
||||
J = last
|
||||
while 1 do
|
||||
while s[I]<pivot do
|
||||
I += 1
|
||||
end while
|
||||
while s[J]>pivot do
|
||||
J -= 1
|
||||
end while
|
||||
if I>J then exit end if
|
||||
if I<J then
|
||||
tmp = s[I]
|
||||
s[I] = s[J]
|
||||
s[J] = tmp
|
||||
end if
|
||||
I += 1
|
||||
J -= 1
|
||||
if I>J then exit end if
|
||||
end while
|
||||
if I<last then
|
||||
qstack[stackptr+1] = I
|
||||
qstack[stackptr+2] = last
|
||||
stackptr += 2
|
||||
end if
|
||||
last = J
|
||||
end while
|
||||
if stackptr=0 then exit end if
|
||||
stackptr -= 2
|
||||
first = qstack[stackptr+1]
|
||||
last = qstack[stackptr+2]
|
||||
end while
|
||||
return s
|
||||
end function
|
||||
|
||||
function radixSortn(sequence s, integer n)
|
||||
sequence buckets = repeat({},10)
|
||||
sequence res = {}
|
||||
for i=1 to length(s) do
|
||||
integer digit = remainder(floor(s[i]/power(10,n-1)),10)+1
|
||||
buckets[digit] = append(buckets[digit],s[i])
|
||||
end for
|
||||
for i=1 to length(buckets) do
|
||||
integer len = length(buckets[i])
|
||||
if len!=0 then
|
||||
if len=1 or n=1 then
|
||||
res &= buckets[i]
|
||||
else
|
||||
res &= radixSortn(buckets[i],n-1)
|
||||
end if
|
||||
end if
|
||||
end for
|
||||
return res
|
||||
end function
|
||||
|
||||
function split_by_sign(sequence s)
|
||||
sequence buckets = {{},{}}
|
||||
for i=1 to length(s) do
|
||||
integer si = s[i]
|
||||
if si<0 then
|
||||
buckets[1] = append(buckets[1],-si)
|
||||
else
|
||||
buckets[2] = append(buckets[2],si)
|
||||
end if
|
||||
end for
|
||||
return buckets
|
||||
end function
|
||||
|
||||
function radix_sort(sequence s)
|
||||
integer mins = min(s)
|
||||
integer passes = max(max(s),abs(mins))
|
||||
passes = floor(log10(passes))+1
|
||||
if mins<0 then
|
||||
sequence buckets = split_by_sign(s)
|
||||
buckets[1] = reverse(sq_uminus(radixSortn(buckets[1],passes)))
|
||||
buckets[2] = radixSortn(buckets[2],passes)
|
||||
s = buckets[1]&buckets[2]
|
||||
else
|
||||
s = radixSortn(s,passes)
|
||||
end if
|
||||
return s
|
||||
end function
|
||||
|
||||
function shell_sort(sequence s)
|
||||
integer gap = floor(length(s)/2), j
|
||||
object temp
|
||||
while gap>0 do
|
||||
for i=gap to length(s) do
|
||||
temp = s[i]
|
||||
j = i-gap
|
||||
while j>=1 and temp<=s[j] do
|
||||
s[j+gap] = s[j]
|
||||
j -= gap
|
||||
end while
|
||||
s[j+gap] = temp
|
||||
end for
|
||||
gap = floor(gap/2)
|
||||
end while
|
||||
return s
|
||||
end function
|
||||
|
||||
function shell_sort2(sequence x)
|
||||
integer gap, j, first, last
|
||||
object xi, xj
|
||||
|
||||
last = length(x)
|
||||
gap = floor(last/10)+1
|
||||
while TRUE do
|
||||
first = gap+1
|
||||
for i=first to last do
|
||||
xi = x[i]
|
||||
j = i-gap
|
||||
while TRUE do
|
||||
xj = x[j]
|
||||
if xi>=xj then
|
||||
j += gap
|
||||
exit
|
||||
end if
|
||||
x[j+gap] = xj
|
||||
if j<=gap then
|
||||
exit
|
||||
end if
|
||||
j -= gap
|
||||
end while
|
||||
x[j] = xi
|
||||
end for
|
||||
if gap=1 then
|
||||
return x
|
||||
else
|
||||
gap = floor(gap/3.5)+1
|
||||
end if
|
||||
end while
|
||||
end function
|
||||
|
||||
function siftDown(sequence arr, integer s, integer last)
|
||||
integer root = s
|
||||
while root*2<=last do
|
||||
integer child = root*2
|
||||
if child<last and arr[child]<arr[child+1] then
|
||||
child += 1
|
||||
end if
|
||||
if arr[root]>=arr[child] then exit end if
|
||||
object tmp = arr[root]
|
||||
arr[root] = arr[child]
|
||||
arr[child] = tmp
|
||||
root = child
|
||||
end while
|
||||
return arr
|
||||
end function
|
||||
|
||||
function heapify(sequence arr, integer count)
|
||||
integer s = floor(count/2)
|
||||
while s>0 do
|
||||
arr = siftDown(arr,s,count)
|
||||
s -= 1
|
||||
end while
|
||||
return arr
|
||||
end function
|
||||
|
||||
function heap_sort(sequence arr)
|
||||
integer last = length(arr)
|
||||
arr = heapify(arr,last)
|
||||
while last>1 do
|
||||
object tmp = arr[1]
|
||||
arr[1] = arr[last]
|
||||
arr[last] = tmp
|
||||
last -= 1
|
||||
arr = siftDown(arr,1,last)
|
||||
end while
|
||||
return arr
|
||||
end function
|
||||
|
||||
include builtins/sort.e
|
||||
|
||||
enum ONES = 1, SORTED = 2, RANDOM = 3, REVERSE = 4
|
||||
|
||||
constant tabtitles = {"ones","sorted","random","reverse"}
|
||||
integer tabidx = 3
|
||||
|
||||
integer STEP
|
||||
|
||||
function tr(sequence name, integer rid=routine_id(name))
|
||||
return {name,rid}
|
||||
end function
|
||||
|
||||
constant tests = {tr("quick_sort"),
|
||||
tr("quick_sort2"),
|
||||
tr("radix_sort"),
|
||||
tr("shell_sort"),
|
||||
tr("shell_sort2"),
|
||||
tr("heap_sort"),
|
||||
tr("sort"), -- builtin
|
||||
}
|
||||
|
||||
sequence results = repeat(repeat({}, length(tests)),length(tabtitles))
|
||||
|
||||
sequence dsdx = repeat(repeat(0,length(tests)),length(tabtitles))
|
||||
|
||||
integer ds_index
|
||||
|
||||
function idle_action_cb()
|
||||
atom best = -1, -- fastest last
|
||||
besti = 0, -- 1..length(tests)
|
||||
bestt = 0, -- 1..length(tabtitles)
|
||||
len
|
||||
sequence todo
|
||||
--
|
||||
-- Search for something to do, active/visible tab first.
|
||||
-- Any result set of length 0 -> just do one.
|
||||
-- Of all result sets<8, pick the lowest [$].
|
||||
--
|
||||
todo = {tabidx}
|
||||
for t=1 to length(tabtitles) do
|
||||
if t!=tabidx then todo &= t end if
|
||||
end for
|
||||
|
||||
for t=1 to length(tabtitles) do
|
||||
integer ti = todo[t]
|
||||
for i=1 to length(results[ti]) do
|
||||
len = length(results[ti][i])
|
||||
if len=0 then
|
||||
best = 0
|
||||
besti = i
|
||||
bestt = ti
|
||||
exit
|
||||
elsif len<8 then
|
||||
if (best=-1) or (best>results[ti][i][$]) then
|
||||
best = results[ti][i][$]
|
||||
besti = i
|
||||
bestt = ti
|
||||
end if
|
||||
end if
|
||||
end for
|
||||
if (t=1) and (besti!=0) then exit end if
|
||||
end for
|
||||
if best>10 then
|
||||
-- cop out if it is getting too slow
|
||||
besti = 0
|
||||
end if
|
||||
if besti!=0 then
|
||||
STEP = iff(not XQS and bestt=ONES?1000:100000)
|
||||
len = (length(results[bestt][besti])+1)*STEP
|
||||
sequence test = iff(bestt=ONES?repeat(1,len):
|
||||
iff(bestt=SORTED?tagset(len):
|
||||
iff(bestt=RANDOM?shuffle(tagset(len)):
|
||||
iff(bestt=REVERSE?reverse(tagset(len)):9/0))))
|
||||
ds_index = dsdx[bestt][besti]
|
||||
atom t0 = time()
|
||||
sequence check = call_func(tests[besti][2],{test})
|
||||
t0 = time()-t0
|
||||
-- if check!=sort(test) then ?9/0 end if
|
||||
plot = plots[bestt]
|
||||
IupPlotInsert(plot, ds_index, -1, len, t0)
|
||||
results[bestt][besti] = append(results[bestt][besti],t0)
|
||||
IupSetAttribute(plot,"REDRAW",NULL)
|
||||
sequence progress = {bestt}
|
||||
for i=1 to length(results[bestt]) do
|
||||
progress &= length(results[bestt][i])
|
||||
end for
|
||||
IupSetStrAttribute(dlg,"TITLE","Compare sorting algorithms %s",{sprint(progress)})
|
||||
return IUP_CONTINUE
|
||||
end if
|
||||
IupSetAttribute(dlg,"TITLE","Compare sorting algorithms (all done, idle)")
|
||||
return IUP_IGNORE -- all done, remove callback
|
||||
end function
|
||||
constant cb_idle_action = Icallback("idle_action_cb")
|
||||
|
||||
function tabchange_cb(Ihandle /*self*/, Ihandle /*new_tab*/)
|
||||
tabidx = IupGetInt(tabs,"VALUEPOS")+1
|
||||
plot = plots[tabidx]
|
||||
return IUP_DEFAULT;
|
||||
end function
|
||||
|
||||
function esc_close(Ihandle /*ih*/, atom c)
|
||||
if c=K_ESC then return IUP_CLOSE end if
|
||||
return IUP_CONTINUE
|
||||
end function
|
||||
|
||||
procedure main()
|
||||
IupOpen()
|
||||
|
||||
plots = {}
|
||||
for i=1 to length(tabtitles) do
|
||||
if XQS then
|
||||
-- results[ONES][1] = repeat(0,8)
|
||||
results[ONES][4] = repeat(0,8)
|
||||
end if
|
||||
plot = IupPlot()
|
||||
IupSetAttribute(plot,"MENUITEMPROPERTIES","YES")
|
||||
IupSetAttribute(plot,"TABTITLE",tabtitles[i])
|
||||
IupSetAttribute(plot,"GRID","YES")
|
||||
IupSetAttribute(plot,"MARGINLEFT","50")
|
||||
IupSetAttribute(plot,"MARGINBOTTOM","40")
|
||||
IupSetAttribute(plot,"LEGEND","YES")
|
||||
IupSetAttribute(plot,"LEGENDPOS","TOPLEFT")
|
||||
-- IupSetAttribute(plot,"AXS_YSCALE","LOG10")
|
||||
-- IupSetAttribute(plot,"AXS_XSCALE","LOG10")
|
||||
for j=1 to length(tests) do
|
||||
IupPlotBegin(plot)
|
||||
dsdx[i][j] = IupPlotEnd(plot)
|
||||
IupSetAttribute(plot,"DS_NAME",tests[j][1])
|
||||
end for
|
||||
plots = append(plots,plot)
|
||||
end for
|
||||
tabs = IupTabs(plots)
|
||||
IupSetCallback(tabs, "TABCHANGE_CB", Icallback("tabchange_cb"))
|
||||
dlg = IupDialog(tabs)
|
||||
IupSetAttributes(dlg, "RASTERSIZE=%dx%d", {640, 480})
|
||||
IupSetAttribute(dlg, "TITLE", "Compare sorting algorithms")
|
||||
IupSetCallback(dlg, "K_ANY", Icallback("esc_close"))
|
||||
IupShow(dlg)
|
||||
IupSetInt(tabs, "VALUEPOS", tabidx-1)
|
||||
IupSetGlobalFunction("IDLE_ACTION", cb_idle_action)
|
||||
IupMainLoop()
|
||||
IupClose()
|
||||
end procedure
|
||||
|
||||
main()
|
||||
Loading…
Add table
Add a link
Reference in a new issue