----------------------------------------------------------------------------- -- (C)2007 Joachim Schueth, Bonn -- -- Jo's Hexadoku Solver v1.0 ----------------------------------------------------------------------------- -- This program solves Hexadoku puzzles. The puzzle has to be presented -- as an ASCII file. Hex digits can be separated by spaces. The empty fields -- of the puzzle must be represented by the character '-' in the input file. -- The name of the input file is given as a command line argument. -- -- Sample input file 'hexadoku01.txt': -- -- E--- ---A --56 -F8- -- -65- --E- 18-F -03A -- 3-7B --65 -D-- -2-- -- 8--- --B- -34- --5- -- -- ---0 7--1 9--- --2- -- 9B-- -2-0 F7-8 D--6 -- 5-E7 --FB D16- C--- -- -D-6 -3-- 2-0- -A-7 -- -- ---- D--- --C- 287- -- 73BE --9C 0A82 --6- -- --A- -1-- --7E -B9- -- 29-- --0- 64D- --A- -- -- 476- -F-- ---A 0--2 -- B-C3 A-54 80-- -EF- -- DE9- 0C2- 4-F5 --18 -- F--5 -B-- --19 -4D3 -- -- Sample run of the Hexadoku Solver: -- -- $ ./hexadokusolve hexadoku01.txt -- Input: -- E - - - - - - A - - 5 6 - F 8 - -- - 6 5 - - - E - 1 8 - F - 0 3 A -- 3 - 7 B - - 6 5 - D - - - 2 - - -- 8 - - - - - B - - 3 4 - - - 5 - -- -- - - - 0 7 - - 1 9 - - - - - 2 - -- 9 B - - - 2 - 0 F 7 - 8 D - - 6 -- 5 - E 7 - - F B D 1 6 - C - - - -- - D - 6 - 3 - - 2 - 0 - - A - 7 -- -- - - - - D - - - - - C - 2 8 7 - -- 7 3 B E - - 9 C 0 A 8 2 - - 6 - -- - - A - - 1 - - - - 7 E - B 9 - -- 2 9 - - - - 0 - 6 4 D - - - A - -- -- 4 7 6 - - F - - - - - A 0 - - 2 -- B - C 3 A - 5 4 8 0 - - - E F - -- D E 9 - 0 C 2 - 4 - F 5 - - 1 8 -- F - - 5 - B - - - - 1 9 - 4 D 3 -- Solution 1: -- E 4 D 1 3 0 7 A C 2 5 6 9 F 8 B -- C 6 5 9 4 D E 2 1 8 B F 7 0 3 A -- 3 F 7 B 1 8 6 5 A D 9 0 E 2 4 C -- 8 A 0 2 C 9 B F E 3 4 7 1 6 5 D -- -- A 8 4 0 7 6 D 1 9 B E C F 3 2 5 -- 9 B 3 C 5 2 4 0 F 7 A 8 D 1 E 6 -- 5 2 E 7 8 A F B D 1 6 3 C 9 0 4 -- 1 D F 6 E 3 C 9 2 5 0 4 8 A B 7 -- -- 0 5 1 4 D E A 6 3 9 C B 2 8 7 F -- 7 3 B E F 4 9 C 0 A 8 2 5 D 6 1 -- 6 C A D 2 1 3 8 5 F 7 E 4 B 9 0 -- 2 9 8 F B 5 0 7 6 4 D 1 3 C A E -- -- 4 7 6 8 9 F 1 D B E 3 A 0 5 C 2 -- B 1 C 3 A 7 5 4 8 0 2 D 6 E F 9 -- D E 9 A 0 C 2 3 4 6 F 5 B 7 1 8 -- F 0 2 5 6 B 8 E 7 C 1 9 A 4 D 3 -- Number of solutions: 1 -- -- Have fun! ----------------------------------------------------------------------------- with Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; procedure Hexadokusolve is RootNum: constant := 4; SideLen: constant := RootNum * RootNum; FieldSz: constant := SideLen * SideLen; type Digit_T is range 0..SideLen; Empty: constant Digit_T := Digit_T'First; package DIO is new Ada.Text_IO.Integer_IO(Digit_T); use DIO; subtype Cell_T is Integer range 1..FieldSz; type Board_T is array(Cell_T) of Digit_T; function Get_Board(Input: File_Type) return Board_T is Board: Board_T; C: Character; begin for I in Board'Range loop loop Get(Input, C); exit when (C >= '0' and C <= '9') or (C >= 'a' and C <= 'f') or (C >= 'A' and C <= 'F') or C = '-'; end loop; if C = '-' then Board(I) := Empty; elsif C >= '0' and C <= '9' then Board(I) := Character'Pos(C) - Character'Pos('0') + 1 + Empty; elsif C >= 'a' and C <= 'f' then Board(I) := Character'Pos(C) - Character'Pos('a') + 11 + Empty; elsif C >= 'A' and C <= 'F' then Board(I) := Character'Pos(C) - Character'Pos('A') + 11 + Empty; end if; end loop; return Board; end Get_Board; procedure Put_Board(Board: Board_T) is Digit_Char: constant array(Digit_T) of Character := "-0123456789ABCDEF"; begin for I in Board'Range loop if (I - Board'First) mod RootNum = 0 then Put(' '); end if; Put(' ' & Digit_Char(Board(I))); if (I - Board'First + 1) mod SideLen = 0 then New_Line; if I < Board'Last and then (I - Board'First + 1) mod (RootNum * SideLen) = 0 then New_Line; end if; end if; end loop; end; Groups: array(1..2 * SideLen + RootNum * RootNum, 1..SideLen) of Cell_T; type GKind_T is (Row, Col, Box); Groups_of_Cell: array(Cell_T, GKind_T) of Integer range Groups'Range(1); procedure Make_Groups is GIndex: Integer; Cell: Cell_T; begin GIndex := Groups'First(1); -- Rows for Y in Integer range 0..SideLen - 1 loop for I in Groups'Range(2) loop Cell := Y * SideLen + (I - Groups'First(2)) + Cell_T'First; Groups(GIndex, I) := Cell; Groups_of_Cell(Cell, Row) := GIndex; end loop; GIndex := GIndex + 1; end loop; -- Columns for X in Integer range 0..SideLen - 1 loop for I in Groups'Range(2) loop Cell := X + (I - Groups'First(2)) * SideLen + Cell_T'First; Groups(GIndex, I) := Cell; Groups_of_Cell(Cell, Col) := GIndex; end loop; GIndex := GIndex + 1; end loop; -- Squares for Xbox in Integer range 0..RootNum - 1 loop for Ybox in Integer range 0..RootNum - 1 loop for X in Integer range 0..RootNum - 1 loop for Y in Integer range 0..RootNum - 1 loop Cell := RootNum * Xbox + RootNum * SideLen * Ybox + SideLen * Y + X + Cell_T'First; Groups(GIndex, RootNum * X + Y + Groups'First(2)) := Cell; Groups_of_Cell(Cell, Box) := GIndex; end loop; end loop; GIndex := GIndex + 1; end loop; end loop; end Make_Groups; function Allowed(Board: Board_T; Digit: Digit_T; Cell: Cell_T) return Boolean is GIndex: Integer; begin if Board(Cell) /= Empty and then Board(Cell) /= Digit then return False; end if; for GType in Groups_of_Cell'Range(2) loop GIndex := Groups_of_Cell(Cell, GType); for I in Groups'Range(2) loop if Board(Groups(GIndex, I)) = Digit then return False; end if; end loop; end loop; return True; end Allowed; type DigVect is array(1..SideLen) of Digit_T; type Choices_T is record Digit: DigVect := (others => Empty); Len: Natural := 0; end record; type Choice_Board_T is array(Board_T'Range) of Choices_T; procedure Add_Choice(Choices: in out Choices_T; Digit: Digit_T) is begin Choices.Len := Choices.Len + 1; Choices.Digit(Choices.Len) := Digit; end Add_Choice; function Possibilities(Board: Board_T) return Choice_Board_T is Choice_Board: Choice_Board_T; begin for Cell in Board'Range loop if Board(Cell) = Empty then for Digit in Digit_T loop if Allowed(Board, Digit, Cell) then Add_Choice(Choice_Board(Cell), Digit); end if; end loop; end if; end loop; return Choice_Board; end Possibilities; Solution_Number: Natural := 0; procedure Solve(In_Board: in Board_T) is Board: Board_T := In_Board; Choice_Board: constant Choice_Board_T := Possibilities(Board); Board_Modified: Boolean := False; Hope: Boolean := False; Hope_Cell: Cell_T := Cell_T'First; Min_Choices: Natural := Natural'Last; Empty_Count: Natural := 0; Digit: Digit_T; begin for Cell in Cell_T loop if Board(Cell) = Empty then Empty_Count := Empty_Count + 1; if Choice_Board(Cell).Len = 0 then return; elsif Choice_Board(Cell).Len = 1 then Digit := Choice_Board(Cell).Digit(DigVect'First); if not Board_Modified or else Allowed(Board, Digit, Cell) then Board(Cell) := Digit; Empty_Count := Empty_Count - 1; Board_Modified := True; else return; end if; elsif Choice_Board(Cell).Len < Min_Choices then Min_Choices := Choice_Board(Cell).Len; Hope_Cell := Cell; Hope := True; end if; end if; end loop; if Empty_Count = 0 then Solution_Number := Solution_Number + 1; Put("Solution "); Put(Solution_Number, 0); Put(':'); New_Line; Put_Board(Board); elsif Board_Modified then Solve(Board); elsif Hope then for I in 1..Choice_Board(Hope_Cell).Len loop Board(Hope_Cell) := Choice_Board(Hope_Cell).Digit(I); Solve(Board); end loop; end if; end Solve; Board: Board_T; Input: File_Type; begin -- Hexadokusolve Make_Groups; Open(Input, In_File, Ada.Command_Line.Argument(1)); Board := Get_Board(Input); Put_Line("Input:"); Put_Board(Board); Solve(Board); Put("Number of solutions: "); Put(Solution_Number, 0); New_Line; end Hexadokusolve;