chicken.pi
main => test.
test => chicken(5).
chicken(N) =>
NR is 5+2*(N-1),
NC is 7*2*(N-1)+6,
A = new_array(NR,NC),
place_u(A,2*(N-1)+1,1,N),
(N mod 2=:=0->place_c2(A,1,7*(N-1)+1); place_c1(A,1,7*(N-1)+1)),
place_d(A,3,7*(N-1)+7,N),
foreach(R in 1..NR)
foreach(C in 1..NC)
(var(A[R,C])->print(" "); printf("%c",A[R,C]))
end,
nl
end.
place_u(_A,_R,_C,I), I=<1 => true.
place_u(A,R,C,I) =>
place_cb(A,R,C),
place_u(A,R-2,C+7,I-1).
place_d(_A,_R,_C,I), I=<1 => true.
place_d(A,R,C,I) =>
place_bc(A,R,C),
place_d(A,R+2,C+7,I-1).
place_c1(A,R,C) =>
place_s(A,R,C, " \\\\ "),
place_s(A,R+1,C," (o>"),
place_s(A,R+2,C,"\\\\_//)"),
place_s(A,R+3,C," \\_/_)"),
place_s(A,R+4,C,"___|__").
place_c2(A,R,C) =>
place_s(A,R,C, " // "),
place_s(A,R+1,C," <o)"),
place_s(A,R+2,C,"(\\\\_//"),
place_s(A,R+3,C,"(_\\_/)"),
place_s(A,R+4,C,"__|___").
place_cb(A,R,C) =>
place_s(A,R,C, " \\\\ "),
place_s(A,R+1,C," (o> "),
place_s(A,R+2,C,"\\\\_//) "),
place_s(A,R+3,C," \\_/_)|"),
place_s(A,R+4,C,"___|__|").
place_bc(A,R,C) =>
place_s(A,R,C, " // "),
place_s(A,R+1,C," <o) "),
place_s(A,R+2,C," (\\\\_//"),
place_s(A,R+3,C,"|(_\\_/ "),
place_s(A,R+4,C,"|__|___").
place_s(_A,_R,_C,[]) => true.
place_s(A,R,C,[X|Xs]) =>
A[R,C] = X,
place_s(A,R,C+1,Xs).
pattern.pi
import cp.
main => test.
test => pattern(3,L), writeln(L).
pattern(N,L) =>
M is 2**N,
LBs = new_list(M),
foreach(Bs in LBs)
Bs = new_list(N),
Bs :: 0..1
end,
Bs0 = [0 : _ in 1..N],
LBs=[Bs0|LBs1],
last(LBs) = Bs1,
constr([Bs1|LBs]),
solve(LBs),
N1 is N-1,
Dum = new_list(N1),
once(append(LBs2,Dum,LBs1)),
flat(LBs2,L1),
Bs0++L1 = L.
constr([_]) => true.
constr([Bs1,Bs2|LBs]) =>
[_|Sub] = Bs1,
once(append(Sub,[_],Bs2)),
foreach(Bs in LBs) diff(Bs,Bs2) end,
constr([Bs2|LBs]).
diff(Bs1,Bs2) =>
Disj = 0,
foreach({B1,B2} in zip(Bs1,Bs2))
Disj := Disj #\/ (B1 #!= B2)
end,
call(Disj).
flat([],L) => L=[].
flat([Bs|LBs],L) =>
L = [B|L1],
last(Bs) = B,
flat(LBs,L1).
war.pi
main => test.
test =>
war($[joint(m,5,5,5),joint(p,10,5,5),joint(s,5,1,1)],
$[street(m,s),street(p,s)],
N),
writeln(N).
war(Js,Ss,NW) =>
Js.length = N,
Ws = [W : $joint(X,_,_,_) in Js, nw(X,Js,Ss,N,W)],
sort(Ws) = [NW|_].
nw(X,Js,Ss,N,W) =>
nw(X,Js,Ss,[],N,W).
table (+,+,+,+,+,min)
nw(X,Js,_Ss,_Path,1,W) =>
(member($joint(X,Ne,In,De),Js)->true;true),
W is max(In+De,Ne).
nw(X,Js,Ss,Path,C,W) =>
( member($street(X,Y),Ss)
;
member($street(Y,X),Ss)
),
not member(Y,Path),
C1 is C-1,
nw(Y,Js,Ss,[X|Path],C1,W1),
(member($joint(X,Ne,In,De),Js)->true;true),
W is max(W1+In+De,Ne).
race.pi
main => test.
test => race($[1-1,1-2],4,4,Winner), writeln(Winner).
race(Ps,N,M,W) =>
L = [(Len,P) : P in Ps, path(P,1,1,N,M,Len)],
sort(L) = SL,
SL=[(_,W)|_].
table (+,+,+,+,+,min)
path(_,N,M,N,M,Len) => Len=0.
path(P,I,J,N,M,Len) =>
next(P,I,J,I1,J1,N,M),
path(P,I1,J1,N,M,Len1),
Len is Len1+1.
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I+D1, J1 is J+D2,
I1>=1, I1=<N,
J1>=1, J1=<M.
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I-D1, J1 is J+D2,
I1>=1, I1=<N,
J1>=1, J1=<M.
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I+D1, J1 is J-D2,
I1>=1, I1=<N,
J1>=1, J1=<M.
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I-D1, J1 is J-D2,
I1>=1, I1=<N,
J1>=1, J1=<M.
%
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I+D2, J1 is J+D1,
I1>=1, I1=<N,
J1>=1, J1=<M.
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I-D2, J1 is J+D1,
I1>=1, I1=<N,
J1>=1, J1=<M.
next(D1-D2,I,J,I1,J1,N,M) ?=>
I1 is I+D2, J1 is J-D1,
I1>=1, I1=<N,
J1>=1, J1=<M.
next(D1-D2,I,J,I1,J1,N,M) =>
I1 is I-D2, J1 is J-D1,
I1>=1, I1=<N,
J1>=1, J1=<M.
plumber.pi
main => test.
test =>
Grid = [[_,_],[$pipe(yes,yes,no,no),_]],
Pieces = $[pipe(yes,no,no,yes),pipe(no,yes,yes,no),pipe(no,no,yes,yes)],
plumber(Grid, Pieces),
writeln(Grid).
/*
Grid = [[pipe(no,yes,yes,no),pipe(no,no,yes,yes)],
[pipe(yes,yes,no,no),pipe(yes,no,no,yes)]].
*/
plumber(Grid, Ps) =>
Grid.length = N,
TagPs = [(P,_) : P in Ps],
foreach(I in 1..N, J in 1..N) place(Grid,I,J,N,TagPs) end.
place(Grid,I,J,N,Ps) =>
place_piece(Grid,I,J,Ps,P),
(I==1->no_up(P); I==N->no_down(P); true),
(J==1->no_left(P); J==N->no_right(P); true),
I1 is I+1,
(I1=<N ->
place_piece(Grid,I1,J,Ps,Pd),
match(P,Pd,down)
;
true
),
J1 is J+1,
(J1=<N ->
place_piece(Grid,I,J1,Ps,Pr),
match(P,Pr,right)
;
true
).
place_piece(Grid,I,J,Ps,P) =>
P = Grid[I,J],
(var(P) -> member((P,Tag),Ps),var(Tag),Tag=1; true).
match(pipe(X,_,_,_),pipe(_,_,X,_),down) => true.
match(pipe(_,_,_,X),pipe(_,X,_,_),right) => true.
no_up(pipe(no,_,_,_)) => true.
no_right(pipe(_,no,_,_)) => true.
no_down(pipe(_,_,no,_)) => true.
no_left(pipe(_,_,_,no)) => true.