RosettaCodeData/Task/Set-puzzle/Picat/set-puzzle-1.picat
2023-07-01 13:44:08 -04:00

174 lines
3.8 KiB
Text

import util.
import cp.
%
% Solve the task in the description.
%
go ?=>
sets(1,Sets,SetLen,NumSets),
print_cards(Sets),
set_puzzle(Sets,SetLen,NumSets,X),
print_sol(Sets,X),
nl,
fail, % check for other solutions
nl.
go => true.
%
% Generate and solve a random instance with NumCards cards,
% giving exactly NumSets sets.
%
go2 =>
_ = random2(),
NumCards = 9, NumSets = 4, SetLen = 3,
generate_and_solve(NumCards,NumSets,SetLen),
fail, % prove unicity
nl.
go3 =>
_ = random2(),
NumCards = 12, NumSets = 6, SetLen = 3,
generate_and_solve(NumCards,NumSets,SetLen),
fail, % prove unicity)
nl.
%
% Solve a Set Puzzle.
%
set_puzzle(Cards,SetLen,NumWanted, X) =>
Len = Cards.length,
NumFeatures = Cards[1].length,
X = new_list(NumWanted),
foreach(I in 1..NumWanted)
Y = new_array(SetLen),
foreach(J in 1..SetLen)
member(Y[J], 1..Len)
end,
% unicity and symmetry breaking of Y
increasing2(Y),
% ensure unicity of the selected cards in X
if I > 1 then
foreach(J in 1..I-1) X[J] @< Y end
end,
foreach(F in 1..NumFeatures)
Z = [Cards[Y[J],F] : J in 1..SetLen],
(allequal(Z) ; alldiff(Z))
end,
X[I] = Y
end.
% (Strictly) increasing
increasing2(List) =>
foreach(I in 1..List.length-1)
List[I] @< List[I+1]
end.
% All elements must be equal
allequal(List) =>
foreach(I in 1..List.length-1)
List[I] = List[I+1]
end.
% All elements must be different
alldiff(List) =>
Len = List.length,
foreach(I in 1..Len, J in 1..I-1)
List[I] != List[J]
end.
% Print a solution
print_sol(Sets,X) =>
println("Solution:"),
println(x=X),
foreach(R in X)
println([Sets[R[I]] : I in 1..3])
end,
nl.
% Print the cards
print_cards(Cards) =>
println("Cards:"),
foreach({Card,I} in zip(Cards,1..Cards.len))
println([I,Card])
end,
nl.
%
% Generate a problem instance with NumSets sets (a unique solution).
%
% Note: not all random combinations of cards give a unique solution so
% it might generate a number of deals.
%
generate_instance(NumCards,NumSets,SetLen, Cards) =>
println([numCards=NumCards,numWantedSets=NumSets,setLen=SetLen]),
Found = false,
% Check that this instance has a unique solution.
while(Found = false)
if Cards = random_deal(NumCards),
count_all(set_puzzle(Cards,SetLen,NumSets,_X)) = 1
then
Found := true
end
end.
%
% Generate a random problem instance of N cards.
%
random_deal(N) = Deal.sort() =>
all_combinations(Combinations),
Deal = [],
foreach(_I in 1..N)
Len = Combinations.len,
Rand = random(1,Len),
Comb = Combinations[Rand],
Deal := Deal ++ [Comb],
Combinations := delete_all(Combinations, Comb)
end.
%
% Generate a random instance and solve it.
%
generate_and_solve(NumCards,NumSets,SetLen) =>
generate_instance(NumCards,NumSets,SetLen, Cards),
print_cards(Cards),
set_puzzle(Cards,SetLen,NumSets,X), % solve it
print_sol(Cards,X),
nl.
%
% All the 81 possible combinations (cards)
%
table
all_combinations(All) =>
Colors = [red, green, purple],
Symbols = [oval, squiggle, diamond],
Numbers = [one, two, three],
Shadings = [solid, open, striped],
All = findall([Color,Symbol,Number,Shading],
(member(Color,Colors),
member(Symbol,Symbols),
member(Number,Numbers),
member(Shading,Shadings))).
%
% From the task description.
%
% Solution: [[1,6,9],[2,3,4],[2,6,8],[5,6,7]]
%
sets(1,Sets,SetLen,Wanted) =>
Sets =
[
[green, one, oval, striped], % 1
[green, one, diamond, open], % 2
[green, one, diamond, striped], % 3
[green, one, diamond, solid], % 4
[purple, one, diamond, open], % 5
[purple, two, squiggle, open], % 6
[purple, three, oval, open], % 7
[red, three, oval, open], % 8
[red, three, diamond, solid] % 9
],
SetLen = 3,
Wanted = 4.