1% generated: 19 June 1990 2% option(s): 3% 4% browse 5% 6% Tep Dobry (from Lisp version by R. P. Gabriel) 7% 8% (modified January 1987 by Herve' Touati) 9 10top :- 11 init(100,10,4, 12 [[a,a,a,b,b,b,b,a,a,a,a,a,b,b,a,a,a], 13 [a,a,b,b,b,b,a,a,[a,a],[b,b]], 14 [a,a,a,b,[b,a],b,a,b,a] 15 ], 16 Symbols), 17 randomize(Symbols,RSymbols,21),!, 18 investigate(RSymbols, 19 [[star(SA),B,star(SB),B,a,star(SA),a,star(SB),star(SA)], 20 [star(SA),star(SB),star(SB),star(SA),[star(SA)],[star(SB)]], 21 [_,_,star(_),[b,a],star(_),_,_] 22 ]). 23 24 25init(N,M,Npats,Ipats,Result) :- init(N,M,M,Npats,Ipats,Result). 26 27init(0,_,_,_,_,_) :- !. 28init(N,I,M,Npats,Ipats,[Symb|Rest]) :- 29 fill(I,[],L), 30 get_pats(Npats,Ipats,Ppats), 31 J is M - I, 32 fill(J,[pattern(Ppats)|L],Symb), 33 N1 is N - 1, 34 (I =:= 0 -> I1 is M; I1 is I - 1), 35 init(N1,I1,M,Npats,Ipats,Rest). 36 37fill(0,L,L) :- !. 38fill(N,L,[dummy([])|Rest]) :- 39 N1 is N - 1, 40 fill(N1,L,Rest). 41 42randomize([],[],_) :- !. 43randomize(In,[X|Out],Rand) :- 44 length(In,Lin), 45 Rand1 is (Rand * 17) mod 251, 46 N is Rand1 mod Lin, 47 split(N,In,X,In1), 48 randomize(In1,Out,Rand1). 49 50split(0,[X|Xs],X,Xs) :- !. 51split(N,[X|Xs],RemovedElt,[X|Ys]) :- 52 N1 is N - 1, 53 split(N1,Xs,RemovedElt,Ys). 54 55investigate([],_) :- !. 56investigate([U|Units],Patterns) :- 57 property(U,pattern,Data), 58 p_investigate(Data,Patterns), 59 investigate(Units,Patterns). 60 61get_pats(Npats,Ipats,Result) :- get_pats(Npats,Ipats,Result,Ipats). 62 63get_pats(0,_,[],_) :- !. 64get_pats(N,[X|Xs],[X|Ys],Ipats) :- 65 N1 is N - 1, 66 get_pats(N1,Xs,Ys,Ipats). 67get_pats(N,[],Ys,Ipats) :- 68 get_pats(N,Ipats,Ys,Ipats). 69 70property([],_,_) :- fail. /* don't really need this */ 71property([Prop|_],P,Val) :- 72 functor(Prop,P,_),!, 73 arg(1,Prop,Val). 74property([_|RProps],P,Val) :- 75 property(RProps,P,Val). 76 77p_investigate([],_). 78p_investigate([D|Data],Patterns) :- 79 p_match(Patterns,D), 80 p_investigate(Data,Patterns). 81 82p_match([],_). 83p_match([P|Patterns],D) :- 84 (match(D,P),fail; true), 85 p_match(Patterns,D). 86 87match([],[]) :- !. 88match([X|PRest],[Y|SRest]) :- 89 var(Y),!,X = Y, 90 match(PRest,SRest). 91match(List,[Y|Rest]) :- 92 nonvar(Y),Y = star(X),!, 93 '$concat'(X,SRest,List), 94 match(SRest,Rest). 95match([X|PRest],[Y|SRest]) :- 96 (atom(X) -> X = Y; match(X,Y)), 97 match(PRest,SRest). 98 99'$concat'([],L,L). 100'$concat'([X|L1],L2,[X|L3]) :- '$concat'(L1,L2,L3). 101