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

83 lines
2 KiB
Text

go4 =>
NumCards = 18,
NumWanted = 9,
SetLen = 3,
time(generate_instance2(NumCards,NumWanted, SetLen,Sets)),
print_cards(Sets),
println(setLen=SetLen),
println(numWanted=NumWanted),
SetsConv = convert_sets_to_num(Sets),
set_puzzle_cp(SetsConv,SetLen,NumWanted, X),
println(x=X),
foreach(Row in X)
println([Sets[I] : I in Row])
end,
nl,
fail, % more solutions?
nl.
set_puzzle_cp(Cards,SetLen,NumWanted, X) =>
NumFeatures = Cards[1].len,
NumSets = Cards.len,
X = new_array(NumWanted,SetLen),
X :: 1..NumSets,
foreach(I in 1..NumWanted)
% ensure unicity of the selected sets
all_different(X[I]),
increasing_strict(X[I]), % unicity and symmetry breaking of Y
foreach(F in 1..NumFeatures)
Z = $[ S : J in 1..SetLen, matrix_element(Cards, X[I,J],F, S) ],
% all features are different or all equal
(
(sum([ Z[J] #!= Z[K] : J in 1..SetLen, K in 1..SetLen, J != K ])
#= SetLen*SetLen - SetLen)
#\/
(sum([ Z[J-1] #= Z[J] : J in 2..SetLen]) #= SetLen-1)
)
end
end,
% Symmetry breaking (lexicographic ordered rows)
lex2(X),
solve($[ff,split],X).
%
% Symmetry breaking
% Ensure that the rows in X are lexicographic ordered
%
lex2(X) =>
Len = X[1].length,
foreach(I in 2..X.length)
lex_lt([X[I-1,J] : J in 1..Len], [X[I,J] : J in 1..Len])
end.
%
% Convert sets of "verbose" instances to integer
% representations.
%
convert_sets_to_num(Sets) = NewSets =>
Maps = new_map([
red=1,green=2,purple=3,
1=1,2=2,3=3,
one=1,two=2,three=3,
oval=1,squiggle=2,squiggles=2,diamond=3,
solid=1,open=2,striped=3
]),
NewSets1 = [],
foreach(S in Sets)
NewSets1 := NewSets1 ++ [[Maps.get(T) : T in S]]
end,
NewSets = NewSets1.
%
% Plain random problem instance, no check of solvability.
%
generate_instance2(NumCards,_NumSets,_SetLen, Cards) =>
Cards = random_deal(NumCards).