icecream.pi
main => test.
test => icecream(5).
icecream(N) =>
Margin = N,
printf("%*s()\n",Margin,""),
Spaces = 0,
foreach(I in 1..N)
Margin := Margin-1,
printf("%*s((%*s))\n",Margin,"",Spaces,""),
Spaces := Spaces+2
end,
foreach(I in 1..N+1) print("/\\") end,
nl,
Margin := 0,
Spaces := N*2,
foreach(I in 1..N+1)
printf("%*s\\%*s/\n",Margin,"",Spaces,""),
Spaces := Spaces-2,
Margin := Margin+1
end.
queens.pi
import sat.
main => test.
test =>
evil_and_nice(8,Evil,Nice),
writeln($evil(Evil)),
writeln($nice(Nice)).
evil_and_nice(N,Evil,Nice) =>
QB = new_array(N,N), % Bad (evial) queens
QG = new_array(N,N), % Good (nice ) queens
QB :: 0..1,
QG :: 0..1,
NQB :: 1..N,
sum([QB[I,J] : I in 1..N, J in 1..N]) #= NQB,
sum([QG[I,J] : I in 1..N, J in 1..N]) #= NQG,
abs(NQG-NQB) #=< 1,
foreach(I in 1..N, J in 1..N, I1 in 1..N, J1 in 1..N)
if (I==I1 || J==J1 || I+J==I1+J1 || I-J == I1-J1) then
if (I,J) != (I1,J1) then QB[I,J] #=> #~ QB[I1,J1] end,
QB[I,J] #=> #~ QG[I1,J1]
end
end,
solve([$max(NQB+NQG)],(QB,QG)),
Evil = [$pos(I,J) : I in 1..N, J in 1..N, QB[I,J]==1],
Nice = [$pos(I,J) : I in 1..N, J in 1..N, QG[I,J]==1].
arith.pi
main => test.
test =>
maxval($tree(tree(6,8),tree(2,2)), [mult, mult, plus], Max),
writeln(Max).
test2 =>
maxval($tree(tree(6,8),tree(2,2)), [mult, min, plus], Max),
writeln(Max).
maxval(Tree,Ops,Val) =>
maxval(Tree,Ops,_,Val).
table (+,+,-,max)
maxval(Tree,Ops,OpsO,Val),integer(Tree) => Val=Tree,OpsO=Ops.
maxval(tree(T1,T2),Ops,OpsO,Val) ?=>
select(Op,Ops,Ops1),
minval(T1,Ops1,Ops2,V1),
minval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
maxval(tree(T1,T2),Ops,OpsO,Val) ?=>
select(Op,Ops,Ops1),
minval(T1,Ops1,Ops2,V1),
maxval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
maxval(tree(T1,T2),Ops,OpsO,Val) ?=>
select(Op,Ops,Ops1),
maxval(T1,Ops1,Ops2,V1),
minval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
maxval(tree(T1,T2),Ops,OpsO,Val) =>
select(Op,Ops,Ops1),
maxval(T1,Ops1,Ops2,V1),
maxval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
table (+,+,-,min)
minval(Tree,Ops,OpsO,Val),integer(Tree) => Val=Tree,OpsO=Ops.
minval(tree(T1,T2),Ops,OpsO,Val) ?=>
select(Op,Ops,Ops1),
minval(T1,Ops1,Ops2,V1),
minval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
minval(tree(T1,T2),Ops,OpsO,Val) ?=>
select(Op,Ops,Ops1),
minval(T1,Ops1,Ops2,V1),
maxval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
minval(tree(T1,T2),Ops,OpsO,Val) ?=>
select(Op,Ops,Ops1),
maxval(T1,Ops1,Ops2,V1),
minval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
minval(tree(T1,T2),Ops,OpsO,Val) =>
select(Op,Ops,Ops1),
maxval(T1,Ops1,Ops2,V1),
maxval(T2,Ops2,OpsO,V2),
app(Op,V1,V2) = Val.
app(plus,V1,V2) = V1+V2.
app(min,V1,V2) = V1-V2.
app(mult,V1,V2) = V1*V2.
domain.pi
import cp.
main => test.
test => test1.
test1 => domain([X,Y],$[X+Y = 2],[-1006,1006],Domain), writeln(Domain).
% Domain = [1,1]
test2 => domain([X,Y],$[X+Y = 0, X*Y = -1, X > 0],[-500,500],Domain), writeln(Domain).
% Domain = [-1,1]
test3 => domain([X,Y],$[X+Y=1],[-1000,1000],Domain), writeln(Domain).
% No % because no domain has a unique solution
test4 => domain([X,Y],$[X*Y = 3, X > 1, Y > 1],[-1000,1000],Domain),writeln(Domain).
% No % because there is no solution for any domain
test5 => domain([X,Y],$[X-Y=0],[-2020,-20],Domain),writeln(Domain).
% Domain = [-666,-666] % just one of the many correct answers
domain(Vs,Cs,Domain0,Domain) =>
initialize_table,
csp(Domain0,Domain,_,(Vs,Cs)).
table (+,+,min,nt)
csp(Domain0@[L,U],Domain,Size,CSP),
solve_csp0(CSP,Domain0,Count)
=>
( Count == 1, Domain = Domain0, Size = U-L+1
;
L1 = L+1, L1 <= U,
csp([L1,U],Domain,Size,CSP)
;
U1 = U-1, L < U1,
csp([L,U1],Domain,Size,CSP)
).
solve_csp0((Vs,Cs),[L,U],_Count) ?=>
get_global_map().clear(),
once(solve_csp(Vs,Cs,L,U)),
fail.
solve_csp0(_CSP,_Domain,Count) =>
M = get_global_map(),
M.has_key(count),
Count = M.get(count).
solve_csp(Vs,Cs,L,U) =>
Vs :: L..U,
post_cs(Cs),
M = get_global_map(),
solve(Vs),
(M.has_key(count) ->
M.put(count,2)
;
M.put(count,1),
fail
).
post_cs([]) => true.
post_cs([V1+V2=I|Cs]) =>
V1+V2 #= I,
post_cs(Cs).
post_cs([V1-V2=I|Cs]) =>
V1-V2 #= I,
post_cs(Cs).
post_cs([V1*V2=I|Cs]) =>
V1*V2 #= I,
post_cs(Cs).
post_cs([V1>V2|Cs]) =>
V1 #> V2,
post_cs(Cs).
post_cs([V1<V2|Cs]) =>
V1 #< V2,
post_cs(Cs).
travel.pi
main => test.
test =>
maximalpleasure($[journey(bozo,[heverlee, bertem, tervuren]),
journey(bozo,[heverlee, korbeekdijle, tervuren]),
journey(dork,[hammemille, korbeekdijle, tervuren, sterrebeek]),
journey(dork,[hammemille, overijse, tervuren, sterrebeek])],
10,3,P),
writeln(P).
maximalpleasure(Js,PDay,PNight,P) =>
Ts = [T : $journey(T,_) in Js],
sort_remove_dups(Ts) = Ts1,
mp(Ts1,_,P,(Js,PDay,PNight)).
table (+,-,max,nt)
mp([],Plans,P,_) => Plans=[],P=0.
mp([T|Ts],Plans,P,GData@(Js0,PDay,PNight)) =>
Plans=[Plan|Plans1],
member($journey(T,Plan),Js0),
mp(Ts,Plans1,P1,GData),
P = P1+sum([pleasure(Plan,Plan1,PDay,PNight) : Plan1 in Plans1]).
pleasure([],_,_PDay,_PNight) = 0.
pleasure([_],_,_PDay,_PNight) = 0.
pleasure(_,[],_PDay,_PNight) = 0.
pleasure(_,[_],_PDay,_PNight) = 0.
pleasure([From,To|J],[From,To|J1],PDay,PNight) = 2*PDay+2*PNight+pleasure([To|J],[To|J1],PDay,PNight).
pleasure([_,To|J],[_,To|J1],PDay,PNight) = 2*PNight+pleasure([To|J],[To|J1],PDay,PNight).
pleasure([_,To|J],[_,To1|J1],PDay,PNight) = pleasure([To|J],[To1|J1],PDay,PNight).