Impuzzable in Picat

impuzzable.pi

% Impuzzable
% https://nrich.maths.org/1388

import cp.
import util.

main =>
  puzzle(Pieces),
  time2(Arrangements = find_all_arrangements(Pieces)),

  foreach(Solution in Arrangements)
    [Rows, Rotations] = Solution,
    foreach(Row in Rows)
      Pieces2 = [P2 : P in Row, P2 = (P - 1) // 4 + 1],
      writeln(Pieces2)
    end,
    foreach(RotRow in Rotations)
      writeln(RotRow)
    end,
    println('')
  end,
  printf("%w solutions\n", Arrangements.length)
  .

find_all_arrangements(Pieces) = Solutions =>
  Solutions = findall([Positions, Rotations], arrange(Pieces, Positions, Rotations)).

arrange(Pieces, Positions, Rotations) =>
  FlatPieces = flatten(Pieces),
  Size = ceiling(sqrt(Pieces.length)),
  Positions = new_array(Size, Size),
  Indexes = [J : I in 0 .. (Size*Size-1), J = I * 4 + 1],
  Positions :: Indexes,

  all_different(array_matrix_to_list(Positions)),

  Rotations = new_array(Size, Size),
  Rotations :: 0 .. 3,
  Center = Size // 2 + 1,
  Rotations[Center, Center] = 0, % Symmetry breaking

  Top = 0, Right = 1, Bottom = 2, Left = 3,

  % Right
  foreach(Row in 1..Size)
    foreach(Col in 1..(Size - 1))
      PieceIndex = Positions[Row, Col],
      PieceIndex2 = Positions[Row, Col + 1],

      Rotation1 = Rotations[Row, Col],
      RR #= Right + Rotation1,
      RightIndex #= cond(RR #>= 4, RR - 4, RR),

      Rotation2 = Rotations[Row, Col + 1],
      RR2 #= Left + Rotation2,
      LeftIndex #= cond(RR2 #>= 4, RR2 - 4, RR2),

      ThisRight #= RightIndex + PieceIndex,
      OtherLeft #= LeftIndex + PieceIndex2,

      constrain(ThisRight, OtherLeft, FlatPieces),
    end,
  end,

  % Down
  foreach(Row in 1..(Size - 1))
    foreach(Col in 1..Size)
      PieceIndex = Positions[Row, Col],
      PieceIndex2 = Positions[Row + 1, Col],

      Rotation1 = Rotations[Row, Col],
      RR #= Bottom + Rotation1,
      BottomIndex #= cond(RR #>= 4, RR - 4, RR),

      Rotation2 = Rotations[Row + 1, Col],
      RR2 #= Top + Rotation2,
      TopIndex #= cond(RR2 #>= 4, RR2 - 4, RR2),

      ThisBottom #= BottomIndex + PieceIndex,
      OtherTop #= TopIndex + PieceIndex2,

      constrain(ThisBottom, OtherTop, FlatPieces),
    end,
  end,

  solve(Positions ++ Rotations)
  .

constrain(I1, I2, L) =>
  element(I1, L, Side1),
  element(I2, L, Side2),
  Side1 + Side2 #= 0
  .

puzzle(Pieces) =>
  HeP = 1, HeN = -1,
  DiP = 2, DiN = -2,
  ClP = 3, ClN = -3,
  SpP = 4, SpN = -4,

  Pieces = [
    [HeN, DiN, HeP, ClP],
    [DiP, ClP, SpN, DiN],
    [SpP, DiP, HeN, DiN],

    [ClN, ClN, SpP, SpN],
    [SpN, SpP, DiP, ClN],
    [ClP, ClN, DiN, DiP],

    [HeP, ClP, DiN, ClN],
    [HeN, SpN, DiP, HeP],
    [SpN, HeP, HeP, DiN]
  ].