Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 515 lines (386 sloc) 15.094 kB
8d3e9ba @akkartik 3
authored
1 :- public([
2 split/2,null/1,not_null_list/1,consp/1,cons/3,split_last/3,
139aa31 @akkartik 1
authored
3 firstn/3,reverse/2,removeall/3,remove/3,
4 remove_or_die/3,
5 removelast/2,nth/3,wrlist/1,myinput/1,list/1,flatten/2,
6 lastof/2,append/3,concat/3,replace/4,assoclist/3,union/3,
7 setdiff/3,intersection/3,
8d3e9ba @akkartik 3
authored
8 makeset/2,merge/3,setmember/2,
139aa31 @akkartik 1
authored
9
8d3e9ba @akkartik 3
authored
10 member/2,seteq/2,delete/3,absval/2,mysetof/3,mybagof/3,
11 /*ucall/1,*/clock/2,gensym/2,myprint/2,pp/1,printstring/1,
12 printstrings/1,makename/3,
139aa31 @akkartik 1
authored
13
8d3e9ba @akkartik 3
authored
14 collectclauses/3, makelist/2, if/2, if/3,
139aa31 @akkartik 1
authored
15
8d3e9ba @akkartik 3
authored
16 explode/2,random/2,removedups/2,removetop/3,setdif/3,
17 apply/2,format/3,format/2,prompt_and_read/3,randomelement/2,
18 remove_random/2,randombreak/3,remove_nth/3]).
139aa31 @akkartik 1
authored
19
20 split(X,X).
21
22 null([]).
23
24 not_null_list([_|_]).
25 consp([_|_]).
26 cons(A,B,[A|B]).
27
28 /* Split_last(+List,-Allbutlast,-Last) */
29 split_last([A,B],[A],B).
30 split_last([H|T],[H|T1],Last) :- split_last(T,T1,Last).
31
32 firstn([],N,[]).
33 firstn([H|Remlist],N,[H|Remfirst]):-
34 N>0, N1 is N-1,firstn(Remlist,N1,Remfirst).
35 firstn(List,N,[]):- \+N>0.
36
37
38
8d3e9ba @akkartik 3
authored
39 %? reverse(L,L1):- reverse_concat(L,[],L1).
40 %? reverse_concat([X|L1],L2,L3):- reverse_concat(L1,[X|L2],L3).
41 %? reverse_concat([],L,L).
139aa31 @akkartik 1
authored
42
43
44 removeall(Set1,[],Set1).
45 removeall(Set1,[Del|Rest],Set2):- remove(Set1,Del,SetX),
46 removeall(SetX,Rest,Set2).
47
48 remove(_,[],[]).
49 remove(Member,[Member|Rest],Rest).
50 remove(Member,[H|Rest],[H|Newrest]):- \+H=Member, remove(Member,Rest,Newrest).
51
52 remove_or_die(Member,List,Newlist) :- member(Member,List),
53 remove(Member,List,Newlist).
54
55 removelast([X],[]).
56 removelast([X|Y],[X|Z]) :- removelast(Y,Z).
57
8d3e9ba @akkartik 3
authored
58 %? nth(L,P,V):- nth2(L,P,V,1).
59 %? nth2([H|T],N,H,N).
60 %? nth2([H|T],P,V,N):- \+P=N, N1 is N+1, nth2(T,P,V,N1).
139aa31 @akkartik 1
authored
61
62 %length([],0).
63 %length([X|Y],N) :- length(Y,N1), N is N1 + 1.
64
65 wrlist([]).
66 wrlist([H|Rest]):- write(' '),write(H),nl,wrlist(Rest).
67
8d3e9ba @akkartik 3
authored
68 %? list([]).
69 %? list([_|_]).
139aa31 @akkartik 1
authored
70
71 flatten(Atom,Atom):- \+list(Atom).
72 flatten(L,F):- list(L), flatten2(L,F),!.
73 flatten2([],[]).
74 flatten2([X],[X]):- \+list(X).
75 flatten2([X|Y],Z):- flatten2(X,X1),flatten2(Y,Y1),append(X1,Y1,Z).
76 flatten2(X,[X]):- \+list(X).
77
78 lastof(L,[L]).
79 lastof(L,[A|B]):- lastof(L,B).
80
81 /* myinput allows character input ending with CR, no periods needed */
82 myinput(I):- myread(T),reverse(T,R), name(I,R).
83 myread(I):- myread2([],I).
84 myread2(Prev, More):- ttyget0(C), \+C=10, % 10 in quintus prolog
85 myread2([C|Prev],More),!.
86 myread2(A,A):- !.
87
8d3e9ba @akkartik 3
authored
88 %? append([],L,L).
89 %? append([A|B], L2, [A|L3]):- append(B,L2,L3).
139aa31 @akkartik 1
authored
90
91 concat([X|L1],L2,[X|L3]):- concat(L1,L2,L3).
92 concat([],L,L).
93
94 strcat(H,T,HT):-name(H,HL), name(T,TL), append(HL,TL,HTL), name(HT,HTL).
95
96 replace(Old,New,[Old|Rest],[New|Rest]).
97 replace(Old,New,[Car|Oldlist],[Car|Newlist]):-
98 replace(Old,New,Oldlist,Newlist).
99
100 /* assoclist(Oldlist,list of pairs,Newlist) */
101
102 assoclist(List,[],List).
103 assoclist(List,[H|Tail],L2):-assocterm(List,H,L1),
104 assoclist(L1,Tail,L2).
105
106 /*
107 assocterm(Lhs=>Rhs, H, Nlhs=>Rhs):- assocterm(Lhs, H, Nlhs).
108 */
109 assocterm([],H,[]):- !.
110 assocterm([F|B],H,[F1|B1]):-ass1(F,H,F1),assocterm(B,H,B1).
111 assocterm(T,H,T2):- ass1(T,H,T2),!.
112
113 ass1(H,[H,T],T):- !. /* no choice here */
114 /*
115 ass1(X,Pr,T):- X=..[eq,Eqno|T1], assocterm(T1,Pr,T2), T=..[eq,Eqno|T2].
116 ass1(X,Pr,T):- X=..[*|Ts], assocterm(Ts,Pr,T2), T=..[*|T2].
117 */
118 ass1(X,Pr,T):- X=..[X1|T1], assocterm(T1,Pr,T2), T=..[X1|T2].
119 ass1(X,Pr,X).
120
121 union(L,[],L).
122 union([],L,L).
123 union([H|T],L,L1):-member(H,L),union(T,L,L1).
124 union([H|T],L,[H|L1]):-union(T,L,L1).
125
126
127 /* setdiff(Set1,Set2,Diff) : Diff returns the elements in Set1 not in Set2 */
128
129 setdiff([],_,[]).
130 setdiff([H|T],Set2,[H|Diff]) :-
131 \+ member(H,Set2),
132 setdiff(T,Set2,Diff).
133 setdiff([H|T],Set2,Diff) :-
134 setdiff(T,Set2,Diff).
135
136
137 intersection([],L,[]).
138 intersection([H|A1],A2,[H|L]) :-
139 member(H,A2),
140 intersection(A1,A2,L).
141 intersection([H|A1],A2,L) :-
142 intersection(A1,A2,L).
143
144 makeset(Bag,Set) :- mysetof(X,member(X,Bag),Set).
145
146 merge([],L,L).
147 merge([H|T],L,L1):-setmember(H,L),merge(T,L,L1).
148 merge([H|T],L,L1):-merge(T,[H|L],L1).
149
150 setmember(H,[H1|L]):-seteq(H,H1).
151 setmember(H,[_|L]):-setmember(H,L).
152
8d3e9ba @akkartik 3
authored
153 %? member(X,[X|T]).
154 %? member(X,[_|T]):-member(X,T).
139aa31 @akkartik 1
authored
155
156
157 seteq([],[]).
158 seteq([A|B],C):-delete(A,C,C1),seteq(B,C1).
159
8d3e9ba @akkartik 3
authored
160 %? delete(A,[A|B],B).
161 %? delete(A,[B|C],[B|C1]):-delete(A,C,C1).
139aa31 @akkartik 1
authored
162
163 absval(N,N):- integer(N), \+N<0.
164 absval(N,AbsN):- integer(N), N<0, AbsN is -1*N.
165
166
167 call2(X):- \+list(X), call(X). % Choice can be a single goal...
168 call2([]). % ... or a list of goals.
169 call2([H|T]):- call(H), call2(T).
170
171 % This IF does not try to resatisfy the condition if it fails (as the QP built
172 % in '->' does). It behaves exactly as if-then, if-then-else structures of
173 % other languages do.
174 % NOTE: The if, then, and else slots may be single predicates, or lists of
175 % predicates. ie: if( [foo(x),bar(y)] , write(foobar) , [write(no),nl] ).
176 % NOTE: IF will ALWAYS succeed, hence it's invisible to the goal satisfaction
177 % process.
178 % WARNING: The clauses in lists are evaluated regardless of their resulting
179 % value, so in the above example, suppose the test fails, the 'nl' would be
180 % evaluated even if the 'write' failed for some reason.
181 if(If,Then):- if(If,Then,true).
182 if(If,Then,_):- call2(If), call2(Then), !.
183 if(If,_,Else):- call2(Else).
184
185
186
187 /* mysetof & mybagof return [] if there are no values that satisfy
188 * P(X), rather than failing as do setof & bagof.
189 */
190 mysetof(A,B,C) :- setof(A,B,C).
191 mysetof(_,_,[]).
192
193 mybagof(A,B,C) :- bagof(A,B,C).
194 mybagof(_,_,[]).
195
196 /* t(X) gives time since last call to statistics. It is not
197 * generally as useful as clock(_,_) since intermediate calls
198 * to t(_) will reset the time.
199 */
200
201 t(X) :- statistics(runtime,[_,X]).
202
203
204 /***
205 **** turn a list into a function call
206 ***/
8d3e9ba @akkartik 3
authored
207 %? :-op(100,fx,ucall).
208 %? ucall(X) :- Z =.. X ,Z.
139aa31 @akkartik 1
authored
209
210 /* Create a new atom starting with a root provided and
211 * finishing with a unique number.
212 */
213 gensym(Root,Atom) :-
214 get_num(Root,Num),
215 name(Root,Name1),
216 name(Num,Name2),
217 append(Name1,Name2,Name),
218 name(Atom,Name).
219
220 get_num(Root,Num) :-
221 retract(current_num(Root,Num1)), !,
222 Num is Num1 + 1,
223 asserta(current_num(Root,Num)).
224 get_num(Root,1) :- asserta(current_num(Root,1)).
225
226
227 /* convert from an integer to a list of chars */
228
229 integer_name(Int,List) :- integer_name(Int,[],List).
230
231 integer_name(I,Sofar,[C|Sofar]) :- I < 10, !, C is I + 48.
232 integer_name(I,Sofar,List) :- Top is I / 10,
233 Bot is I mod 10,
234 C is Bot + 48,
235 integer_name(Top,[C|Sofar],List).
236
237 /* print a list of atoms with spaces between them, return length
238 * of all printed chars (len of atoms + spaces)
239 */
240 myprint([],0).
241 myprint([H|T],Len) :-
242 name(H,L),length(L,Len1),
243 write(H),write(' '),
244 myprint(T,Len2), Len is Len1 + Len2 +1.
245
246 /* 'list' pretty printer with brackets */
247 /* --- Martin Purvis */
248
249 pp(X) :- write('['),
250 pp_aux(X,1),
251 write(']').
252
253 pp_aux([],_).
254 pp_aux([[HH|HT]|T], I) :- J is I + 1,
255 write('['),
256 pp_aux([HH|HT],J),
257 write(']'),
258 pp_aux2(T,I).
259
260 pp_aux([H|T],I) :- pp_aux(H,I),
261 pp_aux2(T,I).
262 pp_aux(X,I) :- write(X).
263
264 pp_aux2(X,I) :- null(X).
265 pp_aux2(X,I) :- nl,
266 tab(I),
267 pp_aux(X,I).
268
269
270
271
272
273 /* print a string */
274 printstring([]).
275 printstring([H|T]) :- put(H), printstring(T).
276
277 /* print a list of strings */
278 printstrings([]).
279 printstrings([H|T]) :- printstring(H),printstrings(T).
280
281 makename(X,Y,N) :- name(X,X1),name(Y,Y1),append(X1,Y1,N1),
282 name(N,N1).
283
284
285
8d3e9ba @akkartik 3
authored
286 %? /*** collectclauses forms a list of all clauses with a given mainfunctor.
287 %? **** The only tricky part is forming a template which will match the
288 %? **** head of each of the clauses (this to satisfy the 'clause' predicate).
289 %? ***/
290 %?
291 %? collectclauses(Mainfunctor,N,Clauses):- functemplate(Mainfunctor,N,Func),
292 %? bagof([Func,Body], clause(Func,Body), Clauses).
293 %? functemplate(Mainfunctor,N,Func):- makelist(N,L), Func=..[Mainfunctor|L].
294 %?
295 %? /*** makelist(+N,-L) forms a list L of length N of uninstantiated variables. */
296 %?
297 %? makelist(0,[]).
298 %? makelist(N,[_|L]):- N>0, N1 is N-1, makelist(N1,L).
139aa31 @akkartik 1
authored
299
300
301
302
303 explode(Var,X) :- var(Var),gensym(A,X).
304 explode(Atom,L) :- atomic(Atom),name(Atom,L).
305 explode(L,E) :- list(L),
306 numbervars(L,1,_),
307 explode1(L,L1),
308 append(L1,[93],L2),
309 E = [91|L2].
310
311 explode1([],[]).
312 explode1([H|T],L) :-
313 explode(H,L1),
314 explode1(T,L2),
315 append(L1,L2,L).
316
317 /* return a pseudo random number between 1 and R */
318 random(R,N) :-
319 \+R=0, % else div by 0 error
320 ((retract(seed(X)),S=X) ;
321 (statistics(runtime,[S,_]),
322 integer(S),asserta(seed(S)))),
323 N is (S mod R) +1,
324 Newseed is (125 * S + 1) mod 4096,
325 asserta(seed(Newseed)),!.
326
8d3e9ba @akkartik 3
authored
327 dynamic(seed/1).
139aa31 @akkartik 1
authored
328 seed(13).
329
330 /* remove duplicate entries from a list, maintaining original order */
331
332 removedups([],[]).
333 removedups([H|T],[H|L]) :- removetop(H,T,L1),
334 removedups(L1,L).
335
336
337 /* remove all top level occurences of Element from a List */
338 removetop(_,[],[]).
339 removetop(E,[E|R],L) :- removetop(E,R,L).
340 removetop(E,[H|T],[H|T1]) :- removetop(E,T,T1).
341
342 /* setdif(S1,S2,S) removes all the members of S2 from S1 to yield S */
343
344 setdif([],_,[]).
345 setdif(A,[],A).
346 setdif(S,To_remove,Newset) :-
347 length(S,S_length),
348 length(To_remove,T_length),
349 S_length > T_length,
350 setdif1(S,To_remove,Newset).
351 setdif(S1,S2,NewS) :- setdif2(S1,S2,NewS).
352
353 setdif1(S,[],S).
354 setdif1(L,[H|T],L2) :- removetop(H,L,L1),
355 setdif(L1,T,L2).
356
357 setdif2(S,[],S).
358 setdif2([],_,[]).
359 setdif2([H|T],Remove_list,L) :-
360 member(H,Remove_list),
361 setdif2(T,Remove_list,L).
362 setdif2([H|T],Remove_list,[H|L]) :-
363 setdif2(T,Remove_list,L).
364
365
366 /* e.g. apply(append,[[1,2,3],[4,5,6],X]) will bind X to [1,2,3,4,5,6].
367 */
368 apply(Functor,Arglist) :- X =.. [Functor|Arglist],X.
369
370
371
372
373 /*******************************************************************
374
375 FORMAT
376 Two caveats: Prolog cannot keep two files open at the same time
377 so amformat(t,'<some stuff>'[<sme args>]. goes to the currently open stream
378 which defaults to user at the beginning. The moral of all this is that
379 you should close files with told. as soon as you are finished with them,
380 and don't try to output to the user at the same time.
381
382 -Brad
383
384 Use:
385 amformat(<filename>,<stuff>,<Args>).
386 <stuff> is the info to be printed surrounded by single quotes.
387 It may also contain the following escape chars:
388
389 ~a Add the next value from <Args> to the output.
390
391 ~l Treat the next value on the <Args> as a
392 predicate name. List it to the output stream.
393
394 ~n Newline.
395
396 ~s skip white space, skips <cr>,spaces,tabs, to
397 next char. Use when you want to break up
398 text in you source file.
399
400 <Args> is a list containing Variables or atoms. They are treated
401 according to the escape chars in <stuff>.
402
403 Example:
404 Fun = append,
405 amformat(foo,'list the ~a on the next line ~n ~l',
406 [function,Fun]).
407 would add "list the function on the next line
408 append([],_1,_1).
409 append([_1|_2],_3,[_1|_4]) :- append(_2,_3,_4)."
410 to the file foo.
411
412 */
413
414 /* format/2 can be used if the current stream is desired */
415
416 amformat(Weird_atom,Args) :- amformat(t,Weird_atom,Args).
417 amformat(Stream,Atom,Args) :- format1(Stream,Atom,Args), !.
418
419 format1([],[],_).
420 format1([], Weird_big_atom, Args) :-
421 tell(user),
422 name(Weird_big_atom, String),
423 formatprint(String,Args).
424 format1(t, Weird_big_atom, Args) :- /* t is zeta syntax, and can be*/
425 name(Weird_big_atom, String), /* changed to any global */
426 formatprint(String,Args).
427 format1(File, Weird_big_atom, Args) :-
428 tell(File),
429 name(Weird_big_atom,String),
430 formatprint(String, Args).
431
432 formatprint([126, 97 | Rest_of_string],Args) :- /* the case of ~a */
433 first_or_nil(Args,An_arg,Rest_of_args), /* a is for atom */
434 write(An_arg),
435 formatprint(Rest_of_string,Rest_of_args).
436 formatprint([126, 108 | Rest_of_string],Args) :- /* this is ~l */
437 first_or_nil(Args,An_arg,Rest_of_args), /* l is for listing */
438 listing(An_arg),
439 formatprint(Rest_of_string,Rest_of_args).
440 formatprint([126, 110 | Rest_of_string],Args) :- /* and ~n */
441 nl, /* n is for newline */
442 formatprint(Rest_of_string,Args).
443 formatprint([126, 115, 31 | Rest_of_string],Args) :- /* and ~s */
444 remove_white_space(Rest_of_string, String), /* s is for skip cr's and */
445 formatprint(String,Args). /* other white space */
446 formatprint([126, 110 | Rest_of_string],Args) :- /* and ~n */
447 put(32), put(32), /* n is for newline */
448 formatprint(Rest_of_string,Args).
449 formatprint([Letter | Rest_of_string],Args) :-
450 put(Letter),
451 formatprint(Rest_of_string,Args).
452 formatprint([],_).
453
454 /* maybe? */
455
456 prompt_and_read(Weird_atom, Args, Answer) :-
457 format1([],Weird_atom,Args),ttyflush,
458 myinput(Answer).
459
460
461
462 remove_white_space([32 | Rest], No_white) :-
463 remove_white_space(Rest,No_white).
464 remove_white_space([9 | Rest], No_white) :-
465 remove_white_space(Rest, No_white).
466 remove_white_space(No_white, No_white).
467
468 /* this does work and produces the file foo which is both human and
469 machine readable */
470
471 test(X) :-
472 X1 is X + 1, X2 is X + 2, X3 is X + 3,
8d3e9ba @akkartik 3
authored
473 amformat([],'~a testing foo ~n bar ~s baz ~a testing ~a', [X1, X2, X3]), nl,
139aa31 @akkartik 1
authored
474 amformat(foo,'/* foo written ~n this is formatprint */ ~l ',[formatprint]),
475 amformat(t,'~n /* this is test */ ~n ~l ', [test]),
476 told,
477 amformat([],'~a testing ~a testing ~a', [X1, X2, X3]), nl,
478 nl.
479
480
481 /* surely I'm not the only one who needs (car ()) -> (cdr ()) -> (). */
482
483 first_or_nil([],[],[]).
484 first_or_nil([H | T],H,T).
485
486 randomelement(L,E) :-
487 length(L,N),
488 random(N,R),
489 nth(L,R,E).
490
491 break([H|T],Element,1,Restoflist):-Element=H,Restoflist=T,!.
492 break([H|T],Element,Index,Restoflist):-Newindex is Index-1,
493 Restoflist=[H|Rest],
494 break(T,Element,Newindex,Rest).
495 /* breaks a list into Element and the rest of the list. [H|T] is the list,
496 Element is to be the Indexth element, and Restoflist is the list without
497 the Indexth element.
498 */
499
500 randombreak(List,Element,Restoflist):-
501 length(List,Len),random(Len,An_index),
502 break(List,Element,An_index,Restoflist),!.
503 /* breaks List into a random Element and the Restoflist. */
504
505 remove_random(L1,L2) :-
506 length(L1,N),
507 random(N,R),
508 remove_nth(L1,R,L2).
509 remove_nth([],0,[]).
510 remove_nth([H|T],0,T).
511 remove_nth([H|T],N,[H|New]) :-
512 N1 is N-1,
513 remove_nth(T,N1,New).
514
Something went wrong with that request. Please try again.