1:-  module(plist, [
    2    plength/2,
    3    pnth0/3,
    4    pnth1/3,
    5    pmember/3,
    6    pmemberchk/2,    
    7    psublist/5,
    8    pfilter/3,
    9    ppartition/4,
   10    pinclude/3,
   11    pexclude/3,
   12    non_member/2,
   13    remove_dups/2,
   14    list_join/3,
   15    psort/2
   16]).   17
   18:- use_module(purity).   19
   20:- multifile(purity:pcompare/4).   21:- multifile(purity:ptype/2).   22
   23purity:ptype([], plist).
   24purity:ptype([_|_], plist).
   25 
   26purity:pcompare(plist, L1, L2, C) :-
   27    plist_compare(L1, L2, C).
   28 
   29plist_compare([],S,C) :- plist_compare_0(S, C).
   30plist_compare([A|T1], S, C) :- plist_compare_1(S, [A|T1], C).
   31
   32plist_compare_0([], =).
   33plist_compare_0([_|_], <).
   34
   35plist_compare_1([], _, >).
   36plist_compare_1([A|T1], [B|T2], C) :-
   37        pcompare(B, A, TC), 
   38        plist_compare_cond(TC, T2, T1, C).
   39
   40plist_compare_cond(<, _, _, <).
   41plist_compare_cond(>, _, _, >).
   42plist_compare_cond(=, T1, T2, C) :- 
   43       plist_compare(T1, T2, C).
   44
   45% plength(List, Length).
   46plength([], zero).
   47plength([_|T], c(Z)) :- plength(T, Z).
   48
   49
   50% pnth0(Nth, Val, List).
   51pnth0(zero, V, [V|_]).
   52pnth0(c(Z), V, [_|T]) :-
   53    pnth0(Z, V, T).
   54
   55
   56% pnth1(Nth, Val, List).
   57pnth1(c(zero), V, [V|_]).
   58pnth1(c(c(Z)), V, [_|T]) :-
   59    pnth1(c(Z), V, T).
   60
   61% pmember(Element, List, Truth).
   62pmember(Element, List, Truth) :-
   63   pmember_(List, Element, Truth).
   64
   65pmember_([], _, false).
   66pmember_([X|Xs], Element, Truth) :-
   67   pif( X = Element, 
   68        Truth = true, 
   69        pmember_(Xs, Element, Truth) 
   70    ).
   71
   72% pmemberchk(Element, List).
   73pmemberchk_(=,_,_).
   74pmemberchk_(>,A,L) :-
   75	pmemberchk(A,L).
   76pmemberchk_(<,A,L) :-
   77	pmemberchk(A,L).
   78
   79pmemberchk(A,[B|T]) :-
   80	pcompare(A, B, C ),
   81	pmemberchk_(C,A,T).
   82
   83
   84% non_member(Element, List).
   85non_member(A, L) :- non_member_(L, A).
   86
   87non_member_([], _).
   88non_member_([A|T], B) :-
   89	pdif(A, B),
   90	non_member_(T, B).
   91
   92
   93% psublist(List, Before, Length, After, SubList).
   94psublist([A|T], zero, c(Len), End, [A|St]) :-
   95    psublist_(T, Len, End, St).
   96
   97psublist([_|T], c(Start), Len, End, Sub) :-
   98    psublist(T, Start, Len, End, Sub).
   99
  100psublist_(L, zero, End, []) :-
  101    plength(L, End).
  102
  103psublist_([A|T], c(Len), End, [A|St]) :-
  104        psublist_(T, Len, End, St).
  105
  106% remove_dups(List, NoDups).
  107remove_dups([],[]).
  108remove_dups([A|T],R) :-
  109	member(A,T),
  110	remove_dups(T,R).
  111remove_dups([A|T],[A|R]) :-
  112	non_member(A,T),
  113	remove_dups(T,R).
  114
  115% list_join(ListOfLists, DelimList, ResultList).
  116list_join(Lol, Dl, Rl) :-
  117    list_join(Lol, [], Dl, Rl).
  118
  119list_join([], [], _, []). % joining an empty list?
  120list_join([E|T], Prev, Dl, Rl) :-
  121    list_join2(T, E, Prev, Dl, Rl).
  122
  123list_join2([], E, Prev, _, Rl) :-
  124    append(Prev, E, Rl).
  125list_join2([E2|T], E, Prev, Dl, Rl) :-
  126    append(Prev, E, PrevE),
  127    append(PrevE, Dl, Joined),
  128    list_join([E2|T], Joined, Dl, Rl).
  129
  130
  131% pfilter(Goal, Elements, Filtered).
  132%
  133% adapted from https://github.com/mthom/scryer-prolog/blob/master/src/lib/reif.pl
  134pfilter(Goal, Elements, Filtered) :-
  135   pfilter_(Elements, Goal, Filtered).
  136
  137pfilter_([], _, []).
  138pfilter_([E|Es], Goal, Filtered) :-
  139   pif(call(Goal, E), Filtered = [E|Fs], Filtered = Fs),
  140   pfilter_(Es, Goal, Fs).
  141
  142% ppartition(Goal, List, Included, Excluded).
  143ppartition(G,L,I,E) :-
  144    ppartition_(L,G,I,E).
  145
  146ppartition_([],_,[],[]).
  147ppartition_([A|T],G,I,E) :-
  148    call(G,A,B),
  149    ppartition__(B,[A|T],G,I,E).
  150
  151ppartition__(true, [A|T],G,[A|I],E) :- 
  152    ppartition_(T,G,I,E).
  153ppartition__(false,[A|T],G,I,[A|E]) :-
  154    ppartition_(T,G,I,E).
  155
  156
  157% pinclude(Goal, List, Included).
  158pinclude(G, L, I) :-
  159    ppartition(G, L, I, _).
  160
  161% pexclude(Goal, List, Excluded).
  162pexclude(G, L, E) :-
  163    ppartition(G, L, _, E).
  164
  165% psort(Domain, List, Sordered)
  166psort(L, S) :-
  167	same_length(L, S),
  168    psort_(L, S).
  169
  170psort_([], []).
  171psort_([A|T], S) :-
  172    psort_1(T, A, S).
  173
  174psort_1([], A, [A]).
  175psort_1([A2|T], A, S) :-
  176	split([A,A2|T], L, R),
  177	psort_(L, SL),
  178	psort_(R, SR),
  179	pmerge(SL, SR, S).
  180
  181
  182% split(List, LeftPart, RightPart )
  183split([], [], []).
  184split([A|T], R, O) :-
  185    split_(T, A, R, O).
  186
  187split_([], A, [A], []).
  188split_([A2|T], A, [A|LT], [A2|RT]) :-
  189    split(T, LT, RT).
  190
  191% pmerge(LeftSide, RightSide, Merged, Domain)
  192pmerge( [], R, M ) :- pmerge_0( R, [], M ).
  193pmerge( [L|Lt], R, M ) :- pmerge_x( R, [L|Lt], M ).
  194
  195pmerge_0( [], [], [] ).
  196pmerge_0( [R|Rt], [], [R|Rt] ).
  197
  198pmerge_x( [], [L|Lt], [L|Lt] ).
  199pmerge_x( [R|Rt], [L|Lt], T ) :-
  200	pcompare( L, R, C ),
  201	pmerge_( C, [L|Lt], [R|Rt], T ).
  202
  203pmerge_( =, [L|Lt], [R|Rt], [L,R|T] ) :-
  204	pmerge( Lt, Rt, T ).
  205pmerge_( <, [L|Lt], [R|Rt], [L|T] ) :-
  206	pmerge( Lt, [R|Rt], T ).
  207pmerge_( >, [L|Lt], [R|Rt], [R|T] ) :-
  208	pmerge( [L|Lt], Rt, T ).
  209
  210
  211% p_is_set/1
  212pset_empty(set([])).
  213
  214% subset_t(SubSet, Set, Truth)
  215subset_t(set(Sub), set(Set), T) :-
  216    subset_(Sub, Set, T).
  217
  218subset_([],_,true).
  219subset_([A|Sub],Set,T) :-
  220    subset__(Set, [A|Sub],T).
  221
  222subset__([],_,false).
  223subset__([B|Set],[A|Sub],T) :-
  224    pcompare(A,B,C),
  225    subset_c(C,[A|Sub],[B|Set],T).
  226
  227subset_c(=,[_|Sub],[_|Set],T) :- 
  228    subset_(Sub,Set,T).
  229subset_c(<,_,_,false).
  230subset_c(>,Sub,[_|Set],T) :- 
  231    subset_(Sub,Set,T).
  232
  233% list_set(List, Set).
  234list_set(L, set(Set)) :-
  235    psort(L,B),
  236    remove_dups_sorted(B,Set).
  237
  238remove_dups_sorted([], []).
  239remove_dups_sorted([A|T],R) :-
  240    remove_dups_sorted_(T,A,R).
  241
  242remove_dups_sorted_([],A,[A]).
  243remove_dups_sorted_([B|T],A,R) :-
  244    pdif_t(A,B,C),
  245    remove_dups_sorted_(C,[A,B|T],R).
  246
  247remove_dups_sorted_(true,[A,B|T],[A|R]) :-
  248    remove_dups_sorted([B|T],R).
  249remove_dups_sorted_(false,[A,A|T],R) :-
  250    remove_dups_sorted([A|T],R).
  251
  252/*
  253
  254These predicates apply to a prolog system that doesn't have inbuilt library predicates.
  255
  256% member/2
  257member(A,[A|_]).
  258member(A,[_|T]) :-
  259    member(A,T).
  260
  261% append/3
  262append([], A, A).
  263append([A|B], C, [A|D]) :-
  264    append(B, C, D).
  265
  266% select/3
  267select(A, [A|B], B).
  268select(B, [A|C], [A|D]) :-
  269    select(B, C, D).
  270
  271% select/4
  272select(A,[A|C], B, [B|C]).
  273select(C, [A|B], D, [A|E]) :-
  274    select(C, B, D, E).
  275
  276% reverse/2
  277% solution taken from https://courses.cs.washington.edu/courses/cse341/10wi/clpr/difference_lists.clpr
  278preverse(Xs,Rs) :- reverse_dl(Xs,Rs-[]).
  279
  280reverse_dl([],T-T).
  281reverse_dl([X|Xs],Rs-T) :- reverse_dl(Xs,Rs-[X|T]).
  282
  283% permutation/2
  284permutation([],[]).
  285permutation(A,[E|R]) :-
  286	select(E,A,B),
  287	permutation(B,R).
  288
  289% last/2
  290last([A],A).
  291last([_|T],A) :-
  292    last(T,A).
  293
  294
  295% prefix/2
  296prefix([], _).
  297prefix([A|B], [A|C]) :-
  298    prefix(B, C).
  299
  300% same_length
  301psame_length([],[]).
  302psame_length([_|A],[_|B]) :-
  303    psame_length(A,B).
  304*/