home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / boot / sort.pl < prev    next >
Text File  |  1992-05-26  |  3KB  |  109 lines
  1. /*  sort.pl,v 1.1.1.1 1992/05/26 11:51:23 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: keysort and predsort
  7. */
  8.  
  9. :- module($sort,
  10.     [ keysort/2
  11.     , predsort/3
  12.     , merge/3
  13.     , merge_set/3
  14.     ]).
  15.  
  16. %   merge_set(+Set1, +Set2, -Set3)
  17. %   Merge the ordered sets Set1 and Set2 into a new ordered set without
  18. %   duplicates.
  19.  
  20. merge_set([], L, L) :- !.
  21. merge_set(L, [], L) :- !.
  22. merge_set([H1|T1], [H2|T2], [H1|R]) :- H1 @< H2, !, merge_set(T1, [H2|T2], R).
  23. merge_set([H1|T1], [H2|T2], [H2|R]) :- H1 @> H2, !, merge_set([H1|T1], T2, R).
  24. merge_set([H1|T1], [H2|T2], [H1|R]) :- H1 == H2,    merge_set(T1, T2, R).
  25.  
  26. %    merge(+List1, +List2, -List3)
  27. %    Merge the ordered sets List1 and List2 into a new ordered  list.
  28. %    Duplicates are not removed.
  29.  
  30. merge([], L, L) :- !.
  31. merge(L, [], L) :- !.
  32. merge([H1|T1], [H2|T2], [H1|R]) :- H1 @< H2, !, merge(T1, [H2|T2], R).
  33. merge([H1|T1], [H2|T2], [H2|R]) :- H1 @>= H2,   merge([H1|T1], T2, R).
  34.  
  35. %    keysort(+Random, ?Ordered)
  36. %    Sorts a random list of Key-Value pairs, and does not remove duplicates.
  37.  
  38. keysort(List, Sorted) :-
  39.     length(List, Length), 
  40.     $keysort(Length, List, _, Result), 
  41.     Sorted = Result.
  42.  
  43. $keysort(2, [X1, X2|L], L, R) :- !, 
  44.     (   X1 @< X2, R = [X1, X2]
  45.     ;             R = [X2, X1]
  46.     ), !.
  47. $keysort(1, [X|L], L, [X]) :- !.
  48. $keysort(0, L, L, []) :- !.
  49. $keysort(N, L1, L3, R) :-
  50.     N1 is N // 2, 
  51.     N2 is N - N1, 
  52.     $keysort(N1, L1, L2, R1), 
  53.     $keysort(N2, L2, L3, R2), 
  54.     $keymerge(R1, R2, R).
  55.  
  56. $keymerge([], R, R) :- !.
  57. $keymerge(R, [], R) :- !.
  58. $keymerge(R1, R2, [X|R]) :-
  59.     R1 = [X1|R1a], 
  60.     R2 = [X2|R2a], 
  61.     (   X1 @> X2, X = X2, $keymerge(R1, R2a, R)
  62.     ;             X = X1, $keymerge(R1a, R2, R)
  63.     ), !.
  64.  
  65. :- module_transparent
  66.     predsort/3, 
  67.     $predsort/5, 
  68.     $predmerge/4, 
  69.     $predmerge/7, 
  70.     $predcompare/4.
  71.  
  72. /*  Predicate based sort. This one is not copied.
  73.  
  74.  ** Sun Jun  5 16:13:38 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  75.  
  76. predsort(P, L, R) :-
  77.     length(L, N), 
  78.     $predsort(P, N, L, _, R1), !, 
  79.     R = R1.
  80.  
  81. $predsort(P, 2, [X1, X2|L], L, R) :- !, 
  82.     $predcompare(P, Delta, X1, X2), 
  83.     (   Delta = (>),  R = [X2, X1]
  84.     ;                 R = [X1, X2]
  85.     ), !.
  86. $predsort(_, 1, [X|L], L, [X]) :- !.
  87. $predsort(_, 0, L, L, []) :- !.
  88. $predsort(P, N, L1, L3, R) :-
  89.     N1 is N // 2, 
  90.     plus(N1, N2, N), 
  91.     $predsort(P, N1, L1, L2, R1), 
  92.     $predsort(P, N2, L2, L3, R2), 
  93.     $predmerge(P, R1, R2, R).
  94.  
  95. $predmerge(_, [], R, R) :- !.
  96. $predmerge(_, R, [], R) :- !.
  97. $predmerge(P, [H1|T1], [H2|T2], Result) :-
  98.     $predcompare(P, Delta, H1, H2), 
  99.     $predmerge(Delta, P, H1, H2, T1, T2, Result).
  100.  
  101. $predmerge((>), P, H1, H2, T1, T2, [H2|R]) :- !,
  102.     $predmerge(P, [H1|T1], T2, R).
  103. $predmerge(_, P, H1, H2, T1, T2, [H1|R]) :-
  104.     $predmerge(P, T1, [H2|T2], R).
  105.  
  106. $predcompare(P, (>), A, B) :-
  107.     $apply(P, [B, A]), !.
  108. $predcompare(_, (<), _, _).
  109.