OpenEuphoria

Pastey multi-sort and supporting libraries

• Posted by kobi May 03, 2012

-- assert.e
namespace assert  
  
include std/error.e  
 
public procedure assert(integer x, sequence text = "")  
	if x = 0 then  
		crash(text)  
	end if  
end procedure  
 
public procedure require(integer x,sequence text="") 
    assert(x,text) 
end procedure 
 
public procedure ensure(integer x, sequence text = "")  
    assert(x,text) 
end procedure  
 
-- conditions.e 
namespace conditions 
 
include seq_ops.e  
 
function notneg(atom a) 
    return not (a < 0) 
end function 
 
function positive(atom a) 
    return a > 0 
end function 
 
public function all_uint(sequence sequ) 
    integer rid = routine_id("notneg") 
    return all(sequ,rid) 
end function 
 
public function all_positive(sequence sequ) 
    integer rid = routine_id("positive") 
    return all(sequ,rid) 
end function 
 
-- seqops.e 
include assert.e 
 
public function all(sequence seq, integer func) 
    for i=1 to length(seq) do 
        if call_func(func,{seq[i]}) = 0 then 
            return 0 
        end if 
    end for 
     
    return 1 
end function 
 
public function any(sequence seq, integer func) 
    for i=1 to length(seq) do 
        if call_func(func,{seq[i]}) = 1 then 
            return 1 
        end if 
    end for 
     
    return 0 
end function 
 
public function map(sequence seq, integer func) --> sequence 
                                                        assert (func != -1, "map::invalid routine") 
    sequence result = {} 
    for i=1 to length(seq) do 
        object res = call_func(func, { seq[i]}) 
        result = append(result, res) 
    end for 
    return result 
end function 
 
public procedure each(sequence seq, integer func) --> sequence 
                                                      assert (func != -1, "each::invalid routine: ") 
    for i=1 to length(seq) do 
        call_proc(func, { seq[i]}) 
    end for 
end procedure 
 
-- multisort.ex 
namespace multisort 
 
include assert.e 
include std/sort.e 
include conditions.e 
 
function compare_two(sequence a, object b, sequence fields) 
    require(all_positive(fields),"fields must positive") 
    require(sequence(a),"should be a sequence") 
    require(sequence(b),"should be a sequence") 
    for i=1 to length(fields) do 
        integer field = fields[i] 
        integer cmp = compare(a[field],b[field]) 
        if cmp != 0 then 
            return cmp 
        end if 
    end for 
    return 0 -- equal. 
end function 
 
 
function multisort(sequence seq, sequence fields_order) 
     return custom_sort(routine_id("compare_two"),seq,{fields_order}) 
end function 
 
-- example: sorting houses. 
 
type house(sequence seq) 
    return length(seq)=4 and all_uint(seq) 
end type 
 
enum CHAIR, DESK, ROOMS, WALL 
--         CHAIR, DESK, ROOMS, WALL 
house a =   {3,     4,     2,      1} 
house b =   {4,     4,     2,      1} 
house c =   {5,     4,     3,      1} 
house d =   {3,     4,     2,      3} 
 
? multisort({a,b,c,d}, { WALL, ROOMS, DESK, CHAIR}) 
 
-- { 
--   {3,4,2,1}, 
--   {4,4,2,1}, 
--   {5,4,3,1}, 
--   {3,4,2,3} 
-- }