/* Several examples in Picat */
/**** begin file exs.pi ****/
import cp, planner.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% 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) = fibfa(N-1)+fibfa(N-2).
% Using if-then-else
fibi(N) = F =>
if N == 0 then
F = 1
elseif N == 1 then
F = 1
else
F = fibg(N-1)+fibg(N-2)
end.
% Using Prolog-style if-then-else
fibg(N) = F =>
(N == 0 ->
F = 1
;N == 1 ->
F = 1
;
F = fibg(N-1)+fibg(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) = fibt(N-1)+fibt(N-2).
% A nondeterministic predicate with a backtrackable rule
my_member(Y,[X|_]) ?=> Y = X.
my_member(Y,[_|L]) => my_member(Y,L).
my_between(From,To,X), From == To => X = From.
my_between(From,To,X),From < To => X = From; my_between(From+1,To,X).
my_select(Y,[X|L],LR) ?=> Y = X, LR = L.
my_select(Y,[X|L],LR) => LR = [X|LRR], my_select(Y,L,LRR).
my_permutation([],P) => P = [].
my_permutation(L,P) =>
P = [X|PR],
my_select(X,L,LR),
my_permutation(LR,PR).
% 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 < Y => 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 =< Y => 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).
is_sorted([]) => true.
is_sorted([_]) => true.
is_sorted([X|L@[Y|_]]) =>X @<= Y, is_sorted(L).
% An empty tree is represented by {}, and a non-empty binary tree is
% represented by its root, which takes form {Val,Left,Right}.
is_btree({}) => true.
is_btree({_Val,Left,Right}) =>
is_btree(Left),
is_btree(Right).
inorder({}) = [].
inorder({Val,Left,Right}) = inorder(Left) ++ [Val] ++ inorder(Right).
% binary search tree
is_bstree({}) => true.
is_bstree(BT@{Val,Left,Right}) =>
is_bstree(Left,min_bstree(BT),Val),
is_bstree(Right,Val,max_bstree(BT)).
is_bstree({},_,_) => true.
is_bstree({Val,Left,Right},Min,Max) =>
Val @>= Min, Val @=< Max,
is_bstree(Left,Min,Val),
is_bstree(Right,Val,Max).
min_bstree({Elm,{},_Right}) = Elm.
min_bstree({_Elm,Left,_Right}) = min_bstree(Left).
max_bstree({Elm,_Left,{}}) = Elm.
max_bstree({_Elm,_Left,Right}) = max_bstree(Right).
lookup_bstree({Elm,_,_},Elm) => true.
lookup_bstree({Val,Left,_},Elm), Elm < Val =>
lookup_bstree(Left,Elm).
lookup_bstree({_,_,Right},Elm) =>
lookup_bstree(Right,Elm).
tree_inst1 = {6, {5, {4, {}, {}},
{7, {}, {}}},
{8, {3, {}, {}},
{9, {}, {}}}}.
tree_inst2 = {7, {5, {4, {}, {}},
{6, {}, {}}},
{8, {8, {}, {}},
{9, {}, {}}}}.
test_btree =>
Tree1 = tree_inst1(),
println(inorder(Tree1)),
println(cond(is_bstree(Tree1),"a binary search tree","not a binary search tree")),
Tree2 = tree_inst2(),
println(inorder(Tree2)),
println(cond(is_bstree(Tree2),"a binary search tree","not a binary search tree")).
% 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.
% draw the Pascal triangle
pascal =>
print("enter an integer:"),
N = read_int(),
foreach(I in 0..N)
Num := 1,
foreach(K in 1..I+1)
printf("%d ",Num),
Num := Num*(I-K+1) div K
end,
nl
end.
% another solution
pascal2 =>
print("enter an integer:"),
N = read_int(),
Row = [1],
foreach(_I in 1..N)
writeln(Row),
Row := next_row(Row)
end.
private
next_row(Row)=Res =>
NewRow = [1], Prev = 1,
foreach (K in tail(Row))
NewRow := [Prev+K|NewRow],
Prev := K
end,
Res = [1|NewRow].
/* another definition, not so efficient because Row[I] takes O(I) time
private
next_row(Row) = [1] ++ [Row[I]+Row[I+1] : I in 1..Row.length-1] ++ [1].
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% 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]) = qsort([E : E in T, E =< H])++[H]++qsort([E : E in T, E>H]).
power_set([]) = [[]].
power_set([H|T]) = P1++P2 =>
P1 = power_set(T),
P2 = [[H|S] : S in P1].
% generate permutations
perm([]) = [[]].
perm(Lst) = [[E|P] : E in Lst, P in perm(Lst.delete(E))].
%another definition
perm1([]) = [[]].
perm1([H|T]) = [insert(P,I,H) : P in Ps, I in 1..P.length+1] => Ps = perm1(T).
% A*B=C
matrix_multi(A,B) = C =>
C = new_array(A.length,B[1].length),
foreach(I in 1..A.length, J in 1..B[1].length)
C[I,J] = sum([A[I,K]*B[K,J] : K in 1..A[1].length])
end.
% Sieve of Eratosthenes
my_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).
% binomial coefficient
bc(_N,0) = 1.
bc(N,N) = 1.
bc(N,1) = N.
bc(N,K) = bc(N-1,K-1) + bc(N-1,K).
% 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 (use planner)
farmer =>
S0 = [s,s,s,s],
plan(S0,Plan),
println(Plan).
final([n,n,n,n]) => true.
action([F,F,G,C],S1,Action,ActionCost) ?=>
Action = farmer_wolf,
ActionCost = 1,
opposite(F,F1),
S1 = [F1,F1,G,C],
not unsafe(S1).
action([F,W,F,C],S1,Action,ActionCost) ?=>
Action = farmer_goat,
ActionCost = 1,
opposite(F,F1),
S1 = [F1,W,F1,C],
not unsafe(S1).
action([F,W,G,F],S1,Action,ActionCost) ?=>
Action = farmer_cabbage,
ActionCost = 1,
opposite(F,F1),
S1 = [F1,W,G,F1],
not unsafe(S1).
action([F,W,G,C],S1,Action,ActionCost) =>
Action = farmer_alone,
ActionCost = 1,
opposite(F,F1),
S1 = [F1,W,G,C],
not unsafe(S1).
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 :: 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 :: 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 :: 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 :: 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 :: [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("mary","math",4.0)])
% john cs 3.00
% mary 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 (not recommended because of poor performance)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Picat> my_map(-,[1,2,3]) = L
% L = [-1,-2,-3]
% Picat> my_map(+,[1,2,3],[4,5,6]) = L
% L = [5,6,7]
% Picat> my_fold(+,0,[1,2,3]) = S
% S = 6
my_map(_F,[]) = [].
my_map(F,[X|Xs]) = [apply(F,X)|my_map(F,Xs)].
my_map(_F,[],[]) = [].
my_map(F,[X|Xs],[Y|Ys]) = [apply(F,X,Y)|my_map(F,Xs,Ys)].
my_fold(_F,Acc,[]) = Acc.
my_fold(F,Acc,[H|T]) = my_fold(F, apply(F,H,Acc),T).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% ACTION RULES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
test_ar =>
watch_event(X),
watch_dom(X),
watch_dom_any(X),
watch_ins(X),
watch_bound(X),
X.post_event(event),
X.post_event_dom(dom),
X.post_event_ins(),
X.post_event_bound(),
X.post_event_any(any).
watch_event(X),
{event(X,T)}
=>
writeln($event(T)).
watch_dom(X),
{dom(X,T)}
=>
writeln($dom(T)).
watch_dom_any(X),
{dom_any(X,T)}
=>
writeln($dom_any(T)).
watch_ins(X),
{ins(X)}
=>
writeln($ins(X)).
watch_bound(X),
{bound(X)}
=>
writeln($bound(X)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% EXCEPTIONS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
catch_divided_by_zero =>
catch(write(myd(4,0)),E, $handle(E)).
myd(X,Y)=X/Y.
handle(E) =>
writeln(E),
throw(E). % just re-throw it
/**** end file exs.pi ****/