/* Several examples in Picat */ /**** begin file exs.pi ****/ module exs. import cp. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% PREDICATES AND FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Here are several versions for computing Fibonacci numbers % A predicate fibp(0,F) => F=1. fibp(1,F) => F=1. fibp(N,F),N>1 => fibp(N-1,F1),fibp(N-2,F2),F=F1+F2. % A function fibf(0)=F => F=1. fibf(1)=F => F=1. fibf(N)=F,N>1 => F=fibf(N-1)+fibf(N-2). % A function with function facts fibfa(0)=1. fibfa(1)=1. fibfa(N)=F,N>1 => F=fibfa(N-1)+fibfa(N-2). % Using a conditional expression fibc(N) = cond((N==0;N==1), 1, fibc(N-1)+fibc(N-2)). % A tabled function table fibt(0)=1. fibt(1)=1. fibt(N)=F,N>1 => F=fibt(N-1)+fibt(N-2). % A nondeterministic predicate with a backtrackable rule member(Y,[X|_]) ?=> Y=X. member(Y,[_|L]) => member(Y,L). between(From,To,X),From==To => X=From. between(From,To,X),From X=From; between(From+1,To,X). % predicate facts index(+,-) (-,+) edge(1,2). edge(1,3). edge(2,3). edge(3,2). % several sort algorithms merge_sort([])=[]. merge_sort([X])=[X]. merge_sort(L)=SL => split(L,L1,L2),SL=merge(merge_sort(L1),merge_sort(L2)). split([X,Y|Zs],L1,L2) => L1=[X|LL1], L2=[Y|LL2], split(Zs,LL1,LL2). split(Zs,L1,L2) => L1=Zs,L2=[]. merge([],Ys) = Ys. merge(Xs,[]) = Xs. merge([X|Xs],Ys@[Y|_])=[X|Zs],X Zs=merge(Xs,Ys). % Ys@[Y|_] is an as-pattern merge(Xs,[Y|Ys])=[Y|Zs] => Zs=merge(Xs,Ys). insert_sort([]) = []. insert_sort([H|T]) = insert(H,insert_sort(T)). private insert(X,[]) = [X]. insert(X,Ys@[Y|_]) = Zs, X= Zs=[X|Ys]. insert(X,[Y|Ys]) = [Y|insert(X,Ys)]. % two versions that return the minumum and maximum of a list % a predicate min_max_p([H|T],Min,Max) => min_max_p_aux(T,H,Min,H,Max). % A private function is not visiable outside private min_max_p_aux([],CMin,Min,CMax,Max) => CMin=Min,CMax=Max. min_max_p_aux([H|T],CMin,Min,CMax,Max) => min_max_p_aux(T,min(CMin,H),Min,max(CMax,H),Max). % a function that returns the minimum and maximum of a list as a pair min_max([H|T]) = min_max_aux(T,H,H). private min_max_aux([],CMin,CMax) = (CMin,CMax). min_max_aux([H|T],CMin,CMax) = min_max_aux(T,min(CMin,H),max(CMax,H)). % return the sum of a list sum_list(L)=Sum => sum_list_aux(L,0,Sum). % a private predicate is never exported private sum_list_aux([],Acc,Sum) => Sum=Acc. sum_list_aux([X|L],Acc,Sum) => sum_list_aux(L,Acc+X,Sum). % two lists that are structually equal, e.g., struct_equal(X,[a]) fails struct_equal(A,B),atomic(A) => A==B. struct_equal([H1|T1],[H2|T2]) => struct_equal(H1,H2), struct_equal(T1,T2). % An example that uses data constructors % A term in the form of $f(X) is a data constructor divide_main => Exp= $((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x, d(Exp,x,D), writeln(D). d(U+V,X,D) => D = $DU+DV, d(U,X,DU), d(V,X,DV). d(U-V,X,D) => D = $DU-DV, d(U,X,DU), d(V,X,DV). d(U*V,X,D) => D = $DU*V+U*DV, d(U,X,DU), d(V,X,DV). d(U/V,X,D) => D = $(DU*V-U*DV)/(^(V,2)), d(U,X,DU), d(V,X,DV). d(^(U,N),X,D) => D = $DU*N*(^(U,N1)), integer(N), N1=N-1, d(U,X,DU). d(-U,X,D) => D = $-DU, d(U,X,DU). d(exp(U),X,D) => D = $exp(U)*DU, d(U,X,DU). d(log(U),X,D) => D = $DU/U, d(U,X,DU). d(X,X,D) => D=1. d(_,_,D) => D=0. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% LOOPS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % another version for summing up a list sum_list_imp(L)=Sum => S=0, foreach (X in L) S:=S+X end, Sum=S. % using a loop to find the minimum and maximum of a list min_max_ip([H|T], Min, Max) => LMin = H, LMax = H, foreach (E in T) LMin := min(LMin, E), LMax := max(LMax, E) end, Min = LMin, Max = LMax. % replace occurrences of Old (a variable or an atomic value) with New replace(Old,New,[H|T]) = [NH|NT] => NH = replace(Old,New,H), NT = replace(Old,New,T). replace(Old,New,T)=NT,struct(T) => NT = new_struct(T.name,T.length), foreach(I in 1 .. T.length) NT[I] = replace(Old,New,T[I]) end. replace(Old,New,Old) = New. replace(_Old,_New,T) = T. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% LIST COMPREHENSION %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % a list comprehension inside another list comprehension % Picat> L=list_of_lists(5) % L = [[1],[1,2] [1,2,3],[1,2,3,4],[1,2,3,4,5]] list_of_lists(N) = [[Y : Y in 1..X] : X in 1..N]. % another definition another_list_of_lists(N) = [1..X : X in 1..N]. qsort([])=[]. qsort([H|T])=sort([E : E in T, E=H]). power_set([]) = [[]]. power_set([H|T]) = P1++P2 => P1 = power_set(T), P2 = [[H|S] : S in P1]. % A*B=C matrix_multi(A,B) = C => C = new_array(A.length,B[1].length), foreach(I in 1..A.length) foreach(J in 1..B[1].length) C[I,J] = sum([A[I,K]*B[K,J] : K in 1..A[1].length]) end end. % Sieve of Eratosthenes primes(N)=L => A=new_array(N), foreach(I in 2..floor(sqrt(N))) if (var(A[I])) then foreach(J in I**2..I..N) A[J]=0 end end end, L=[I : I in 2..N, var(A[I])]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% TABLING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % mode-directed tabling % finding shortest paths on a graph given by the relation edge/3. table(+,+,-,min) sp(X,Y,Path,W) ?=> Path=[(X,Y)], edge(X,Y,W). sp(X,Y,Path,W) => Path=[(X,Z)|PathR], edge(X,Z,W1), sp(Z,Y,PathR,W2), W=W1+W2. index(+,-,-) (+,+,-) edge(1,2,1). edge(1,3,2). edge(2,3,3). edge(3,2,4). % computing the minimal editing distance of two given lists table(+,+,min) edit([],[],D) => D=0. edit([X|Xs],[X|Ys],D) => % copy edit(Xs,Ys,D). edit(Xs,[_Y|Ys],D) ?=> % insert edit(Xs,Ys,D1), D=D1+1. edit([_X|Xs],Ys,D) => % delete edit(Xs,Ys,D1), D=D1+1. % the Farmer's problem farmer => S0=[s,s,s,s], plan(S0,Plan,_), writeln(Plan.reverse()). table (+,-,min) plan([n,n,n,n],Plan,Len) => Plan=[], Len=0. plan(S,Plan,Len) => Plan=[Action|Plan1], action(Action,S,S1), not unsafe(S1), plan(S1,Plan1,Len1), Len=Len1+1. action(Action,[F,F,G,C],S1) ?=> Action=farmer_wolf, opposite(F,F1), S1=[F1,F1,G,C]. action(Action,[F,W,F,C],S1) ?=> Action=farmer_goat, opposite(F,F1), S1=[F1,W,F1,C]. action(Action,[F,W,G,F],S1) ?=> Action=farmer_cabbage, opposite(F,F1), S1=[F1,W,G,F1]. action(Action,[F,W,G,C],S1) => Action=farmer_alone, opposite(F,F1), S1=[F1,W,G,C]. index (+,-) (-,+) opposite(n,s). opposite(s,n). unsafe([F,W,G,_C]),W==G,F!==W => true. unsafe([F,_W,G,C]),G==C,F!==G => true. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% CONSTRAINT PROGRAMS (using cp) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % SEND+MORE=MONEY sendmory => Vars=[S,E,N,D,M,O,R,Y], % generate variables Vars in 0..9, all_different(Vars), % generate constraints S #!= 0, M #!= 0, 1000*S+100*E+10*N+D+1000*M+100*O+10*R+E #= 10000*M+1000*O+100*N+10*E+Y, solve(Vars), % search writeln(Vars). % N-queens queens(N) => Qs=new_array(N), Qs in 1..N, foreach (I in 1..N-1, J in I+1..N) Qs[I] #!= Qs[J], abs(Qs[I]-Qs[J]) #!= J-I end, solve([ff],Qs), writeln(Qs). % another program for N-queens queens2(N, Q) => Q=new_list(N), Q in 1..N, Q2 = [$Q[I]+I : I in 1..N], Q3 = [$Q[I]-I : I in 1..N], all_different(Q), all_different(Q2), all_different(Q3), solve([ff],Q). % graph coloring (reuse edge/2 defined above) color(NV,NC) => A=new_array(NV), A in 1..NC, foreach(I in 1..NV-1, J in I+1..NV) if edge(I,J);edge(J,I) then A[I] #!= A[J] end end, solve(A), writeln(A). % a 0-1 integer model for graph coloring bcolor(NV,NC) => A=new_array(NV,NC), A in [0,1], foreach(I in 1..NV) sum([A[I,K] : K in 1..NC]) #= 1 end, foreach(I in 1..NV-1, J in I+1..NV) if edge(I,J);edge(J,I) then foreach(K in 1..NC) #~ A[I,K] #\/ #~ A[J,K] end end end, solve(A), writeln(A). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% I/O %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Read a list of integers, stopping when 0 is read read_array_main => A=new_array(100), Len=read_array(A), foreach (I in 1..Len) writeln(A[I]) end. read_array(A)=Len => Count=0, E=read_int(), % read from stdin while (E != 0) Count:=Count+1, A[Count]=E, E := read_int() end, Len=Count. % copy a text file line-by-line copy(IName,OName) => IStream = open(IName), OStream = open(OName,write), Line = IStream.read_line(), while (Line != end_of_file) OStream.printf("%s%n",Line), Line := IStream.read_line() end, close(IStream), close(OStream). % Picat> output_students([$student("john","cs",3),$student("marry","math",4.0)]) % john cs 3.00 % marry math 4.00 output_students(Students) => foreach($student(Name,Major,GPA) in Students) printf("%10s %10s %5.2f%n",Name,Major,to_real(GPA)) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% HIGHER-ORDER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Picat> map(-,[1,2,3]) = L % L = [-1,-2,-3] % Picat> map(+,[1,2,3],[4,5,6]) = L % L = [5,6,7] % Picat> fold(+,0,[1,2,3]) = S % S = 6 map(_F,[]) = []. map(F,[X|Xs])=[apply(F,X)|map(F,Xs)]. map(_F,[],[]) = []. map(F,[X|Xs],[Y|Ys])=[apply(F,X,Y)|map(F,Xs,Ys)]. fold(_F,Acc,[]) = Acc. fold(F,Acc,[H|T])=fold(F, apply(F,H,Acc),T). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% EXCEPTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% catch_divided_by_zero => catch(write(myd(4,0)),E, $handle(E)). myd(X,Y)=X/Y. handle(E) => throw(E). % just re-throw it /**** end file exs.pi ****/