1:- module(dlist,[
2 ]). 3
18
19
20cfib(0, 1) :- !.
21cfib(1, 1) :- !.
22cfib(N, F) :-
23 N1 is N-1, cfib(N1, F1),
24 N2 is N-2, cfib(N2, F2),
25 F is F1 + F2.
26
28:- dynamic(stored/1). 29
30memo(Goal) :- stored(Goal) -> true; Goal, assertz(stored(Goal)).
31
32mfib(0,1).
33mfib(1,1).
34mfib(2,1).
35mfib(N,F) :-
36 N1 is N-1, memo(mfib(N1,F1)),
37 N2 is N-2, memo(mfib(N2,F2)),
38 F is F1 + F2.
39
40
41
42mofib(N,F) :-
43 (N =< 2) ->
44 F = 1 ;
45 (N1 is N-1, memo(mofib(N1,F1)),
46 N2 is N-2, memo(mofib(N2,F2)),
47 F is F1 + F2).
48
49
50
51ofib(N,F) :-
52 Self = ofib(N,F),
53 repeat,
54 (arg(1,Self,N),
55 arg(2,Self,F)),
56
57 (N =< 2) ->
58 F = 1 ;
59 (N1 is N-1, ofib(N1,F1),
60 N2 is N-2, ofib(N2,F2),
61 F is F1 + F2).
62
63
64 67
68lmember(El, [H|T]) :-
69 lmember_(T, El, H).
70
71lmember_(_, El, El).
72lmember_([H|T], El, _) :-
73 lmember_(T, El, H).
74
75
76
77mk_test(S,lo(S), L):- numlist(1, S, L).
78mk_test(S,lr(S), R):- numlist(1, S, L),reverse(L,R).
79mk_test(S,lu(S), R):- numlist(1, S, L),random_permutation(L,R).
80
81:- dynamic(stest/2). 82:- forall((mk_test(50,X,Y), \+ stest(X,_)),assert(stest(X,Y))). 83
84
85test(lo1, [1]).
86test(lo2, [1,2]).
87test(lr2, [2,1]).
88test(X,Y):- stest(X,Y).
89
90
95
96
97
98perm([], []).
99perm(List, [First|Perm]) :-
100 sselect(First, List, Rest),
101 perm(Rest, Perm).
102
103sselect(X, [X|Tail], Tail).
104 sselect(Elem, [Head|Tail], [Head|Rest]) :-
105 sselect(Elem, Tail, Rest).
106
107
108do_while_loop(Test,Goal):-
109 repeat,
110 once(Goal),
111 (Test->fail; (!)).
112
113
114is_sorted([X,Y|T]):- !, X=<Y, is_sorted([Y|T]).
115is_sorted(_).
116
117is_sorted_nd(In):-
118 List = value(In),
119 repeat,
120 (List = value([X,Y|T]) ->
121 ((X=<Y->(nb_setarg(1,List,[Y|T]),fail);(!,fail))); !).
122
123
124:- discontiguous dlist:is_sorter/1. 125
126is_sorter(sort).
127
130naive_sort(List,Sorted):-
131 perm(List,Sorted),
132 is_sorted(Sorted).
133
134
139is_sorter(insert_sort).
140insert_sort(List,Sorted):-i_sort(List,[],Sorted).
141i_sort([],Acc,Acc).
142i_sort([H|T],Acc,Sorted):-insert(H,Acc,NAcc),i_sort(T,NAcc,Sorted).
143
144insert(X,[Y|T],[Y|NT]):-X>Y,insert(X,T,NT).
145insert(X,[Y|T],[X,Y|T]):-X=<Y.
146insert(X,[],[X]).
147
148
149
150stest:-
151 forall((is_sorter(A),
152 SORT =..[A,Y,S]),
153 forall((test(X,Y),nl,nl,dmsg(test(A,X)),dmsg(input=Y)),
154 once((prolog_statistics:time(SORT),
155 dmsg(output=S))))).
156
157
163is_sorter(bubble_sort).
164bubble_sort(List,Sorted):-b_sort(List,[],Sorted).
165b_sort([],Acc,Acc).
166b_sort([H|T],Acc,Sorted):-bubble(H,T,NT,Max),b_sort(NT,[Max|Acc],Sorted).
167
168bubble(X,[],[],X).
169bubble(X,[Y|T],[Y|NT],Max):-X>Y,bubble(X,T,NT,Max).
170bubble(X,[Y|T],[X|NT],Max):-X=<Y,bubble(Y,T,NT,Max).
171
176
178merge_sort([],[]):-!. 179merge_sort([X],[X]):-!. 180merge_sort(List,Sorted):-
181 List=[_,_|_],
182 divide_3(List,L1,L2), 183 merge_sort(L1,Sorted1),merge_sort(L2,Sorted2), 184 merge(Sorted1,Sorted2,Sorted),!. 185
186merge([],L,L).
187merge(L,[],L):-L\=[].
188merge([X|T1],[Y|T2],[X|T]):-X=<Y,merge(T1,[Y|T2],T).
189merge([X|T1],[Y|T2],[Y|T]):-X>Y,merge([X|T1],T2,T).
190
192
193is_even(E):- (0 is E /\ 1).
194
195even_odd(L,L1,L2):- partition(is_even, L, L1, L2).
196
197
198halve([X,Y|L],[X|L1],[Y|L2]):- !, halve(L,L1,L2).
199halve(X,[],X).
200
201divide_3(L,L1,L2):-even_odd(L,L1,L2),!.
203divide_3(L,L1,L2):-halve(L,L1,L2).
204
209is_sorter(quick_sort).
210quick_sort([],[]).
211quick_sort([H|T],Sorted):-
212 pivoting(H,T,L1,L2),quick_sort(L1,Sorted1),quick_sort(L2,Sorted2),
213 append(Sorted1,[H|Sorted2],Sorted).
214
215append([], L, L).
216append([H|T], L, [H|R]) :-
217 append(T, L, R).
218
219pivoting(_,[],[],[]).
220pivoting(H,[X|T],[X|L],G):-X=<H,pivoting(H,T,L,G).
221pivoting(H,[X|T],L,[X|G]):-X>H,pivoting(H,T,L,G).
222
227
228is_sorter(quick_sort2).
229quick_sort2(List,Sorted):-q_sort(List,[],Sorted).
230q_sort([],Acc,Acc).
231q_sort([H|T],Acc,Sorted):-
232 pivoting(H,T,L1,L2),
233 q_sort(L1,Acc,Sorted1),
234 q_sort(L2,[H|Sorted1],Sorted).
235
236
237
238
239
240uncons(H,T,[H|T]).
241headOf([H|_],H).
242tailOf([_|T],T).
243
245
246conj_goal(A,True,A):-True=='true',!.
247conj_goal(True,A,A):-True=='true',!.
248conj_goal(A,B,(A,B)).
249
250unlistify_clause((P:-B),(NewP:-PBody)):- !,
251 unlistify_head(P,NewP,Pre1),
252 unlistify_goal(B,Body),
253 conj_goal(Pre1,Body,PBody).
254unlistify_clause(P,POut):-
255 unlistify_head(P,NewP,Pre1),!,
256 (Pre1==true->
257 POut= P;
258 POut =(NewP:-Pre1)).
259
260
261unlistify_goal(P,P):- \+ compound(P),!.
262unlistify_goal((P,B),PBody):-!,
263 unlistify_goal(P,NewP),unlistify_goal(B,Body),
264 conj_goal(NewP,Body,PBody).
265unlistify_goal(P,PO):-
266 unlistify_head(P,NewP,Pre),
267 conj_goal(Pre,NewP,PO).
268
269unlistify_head(P,NewP,Pre):- compound(P),!,unlistify_cmp(P,NewP,'true',Pre),!.
270unlistify_head(P,P,'true').
271
272unlistify_cmp(P,NewP,In,Out):-
273 P=..[F|ARGS],
274 unlistify_args(P,F,ARGS,ARGSO,In,Out),
275 NewP=..[F|ARGSO].
276
277unlistify_args(_P,_F,[],[],In,In):-!.
278unlistify_args(P,F,[E|ARGS],[E|ARGSO],In,Post):- \+ compound(E),!,
279 unlistify_args(P,F,ARGS,ARGSO,In,Post).
280unlistify_args(P,F,[[H|T]|ARGS],[NewE|ARGSO],In,Post):-
281 conj_goal(uncons(H,T,NewE),In,Pre),!,
282 unlistify_args(P,F,ARGS,ARGSO,Pre,Post).
283unlistify_args(P,F,[E|ARGS],[NewE|ARGSO],In,Post):-
284 unlistify_cmp(E,NewE,In,Pre),
285 unlistify_args(P,F,ARGS,ARGSO,Pre,Post).
286
287
288:- fixup_exports.