OpenEuphoria

Re: Natural sort comparison

• Posted by petelomax Aug 14, 2017
• 1826 views

Here it is

enum SPLIT, MERGE 
 
function pihism_sort(sequence x) 
-- 
-- Pete's Iterative Half-In-Situ Merge Sort. 
-- 
integer first = 1, mid, last = length(x), adx, 
        op = SPLIT,  
        qslen = 2*ceil(log(last)/log(2)+1), 
        qdx=0 
sequence qsop = repeat(0,qslen), 
         qsf = repeat(0,qslen), 
         qsm = repeat(0,qslen), 
         qsl = repeat(0,qslen), 
         a 
object ai, xmid 
 
    while 1 do  -- until qstack is empty 
 
        if op=SPLIT then 
            -- 
            -- just push further split/merge pair(s) onto the stack... 
            -- 
            while first<last do 
                mid = floor((first+last)/2) 
                qdx += 1  
                qsop[qdx] = MERGE 
                qsf[qdx] = first 
                qsm[qdx] = mid 
                qsl[qdx] = last 
                if mid+1<last then 
                    qdx += 1 
                    qsop[qdx] = SPLIT 
                    qsf[qdx] = mid+1 
                    qsl[qdx] = last 
                end if 
                if first=mid then exit end if 
                last = mid 
            end while 
 
        else -- op=MERGE                             
            -- 
            -- first, leave any parts of the first half already in place. 
            -- 
            mid += 1 
            xmid = x[mid] 
            while first<mid and x[first]<=xmid do 
                first += 1 
            end while 
            -- 
            -- then merge until the first half is empty. 
            -- any remainder of the second half will already be in place. 
            -- 
            if first<mid then 
                a = x[first..mid-1] 
                ai = a[1] 
                adx = 1 
                while 1 do 
                    if mid>last 
                    or compare(ai,xmid)<=0 then 
                        x[first] = ai 
                        first += 1 
                        adx += 1 
                        if adx>length(a) then exit end if 
                        ai = a[adx] 
                    else 
                        x[first] = xmid 
                        first += 1 
                        mid += 1 
                        if mid<=last then 
                            xmid = x[mid] 
                        end if 
                    end if 
                end while 
            end if 
        end if 
        if qdx=0 then exit end if 
        op = qsop[qdx] 
        first = qsf[qdx] 
        mid = qsm[qdx] 
        last = qsl[qdx] 
        qdx -= 1 
    end while 
    return x 
end function 
 
sequence s,r,t 
for i=1 to 100 do 
--for i=1 to 1000000 by 10000 do  -- slow! 
--?i 
    t = tagset(i) 
    s = pihism_sort(t) 
    if s!=t then ?9/0 end if 
    s = reverse(t) 
    r = pihism_sort(s) 
    if r!=t then ?9/0 end if 
    s = shuffle(t) 
    r = pihism_sort(s) 
    if r!=t then ?9/0 end if 
end for 
 
constant LIM = 1000000-0 
t = shuffle(tagset(LIM)) 
atom t0 = time() 
s = pihism_sort(t) 
atom t1 = time() 
r = sort(t) 
atom t2 = time() 
?{t1-t0,":",t2-t1} 
     
?"ok" 
{} = wait_key() 

and the medals awarded are:

                  ones    sorted  random  reverse 
  pihism_sort      gold    gold    silver  bronze 
  quick_sort       silver  silver  gold    gold 
  builtin_sort     bronze  bronze  bronze  silver 

Not much in it though. I'm very pleased with that result.

Pete

PS: I tested this, integer-only, on RDS Eu/OpenEuphoria, and can post that version (f06.exw) if required.

PPS: Obviously 100% in-situ with a doubly-linked list was a completely insane idea, but 50% works well.