Results 1 to 3 of 3

Thread: Stuck trying to implement a Backtracing Sudoku Solver in Lape

  1. #1
    Join Date
    Apr 2016
    Location
    New Zealand
    Posts
    76
    Mentioned
    0 Post(s)
    Quoted
    32 Post(s)

    Default Stuck trying to implement a Backtracing Sudoku Solver in Lape

    Simba Code:
    program SudokuSolver;

    var
      Puzzle, FinishedPuzzle: Array [0..8] of Array [0..8] of Integer;
      gRow, gColumn: Integer;

    function FindUnassignedLocation(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Row, Column: Integer): Boolean;
    begin
      for Row := 0 to 8 do
      begin
        for Column := 0 to 8 do
        begin
          if PuzzleGrid[Row][Column] = 0 then
          begin
            gRow := Row;
            gColumn := Column;
            Result := True;
            Exit;
          end;
        end;
      end;
      Result := False;
    end;

    function UsedInRow(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Row, Number: Integer): Boolean;
    var
      Column: Integer
    begin
      for Column := 0 to 8 do
      begin
        if PuzzleGrid[Row][Column] = Number then
        begin
          Result := True;
          Exit;
        end;
      end;
      Result := False;
    end;

    function UsedInColumn(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Column, Number: Integer): Boolean;
    var
      Row: Integer
    begin
      for Row := 0 to 8 do
      begin
        if PuzzleGrid[Row][Column] = Number then
        begin
          Result := True;
          Exit;
        end;
      end;
      Result := False;
    end;

    function UsedInBox(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; BoxStartRow, BoxStartColumn, Number: Integer): Boolean;
    var
      Row, Column: Integer
    begin
      for Row := 0 to 2 do
      begin
        for Column := 0 to 2 do
        begin
          if PuzzleGrid[Row + BoxStartRow][Column + BoxStartColumn] = Number then
          begin
            Result := True;
            Exit;
          end;
        end;
      end;
      Result := False;
    end;

    function IsSafe(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Row, Column, Number: Integer): Boolean;
    begin
      Result := not UsedInRow(PuzzleGrid, Row, Number) and not UsedInColumn(PuzzleGrid, Column, Number) and not UsedInBox(PuzzleGrid, Row - (Row MOD 3) , Column - (Column MOD 3), Number);
    end;


    function SolvePuzzle(PuzzleGrid: Array [0..8] of Array [0..8] of Integer): Boolean
    var
      Number: Integer;
    begin
      if not FindUnassignedLocation(PuzzleGrid, gRow, gColumn) then
      begin
        Result := True;
        FinishedPuzzle := PuzzleGrid;
        Exit;
      end;
      //Writeln(gRow);
      //Writeln(gColumn);
      for Number := 1 to 9 do
      begin
        //Writeln('Loop ' + IntToStr(Number));
        //Writeln(UsedInRow(PuzzleGrid, gRow, Number));
        //Writeln(UsedInColumn(PuzzleGrid, gColumn, Number));
        //Writeln(UsedInBox(PuzzleGrid, gRow - (gRow MOD 3) , gColumn - (gColumn MOD 3), Number));
        if IsSafe(PuzzleGrid, gRow, gColumn, Number) then
        begin
          //Writeln('Safe');
          PuzzleGrid[gRow][gColumn] := Number;
          //Writeln(PuzzleGrid);
          if SolvePuzzle(PuzzleGrid) then
          begin
            FinishedPuzzle := PuzzleGrid;
            Result := True;
            Exit;
          end;
          PuzzleGrid[gRow][gColumn] := 0;
        end;
      end;
      Result := False;
    end;

    begin

      Puzzle := [[3, 0, 6, 5, 0, 8, 4, 0, 0],
                [5, 2, 0, 0, 0, 0, 0, 0, 0],
                [0, 8, 7, 0, 0, 0, 0, 3, 1],
                [0, 0, 3, 0, 1, 0, 0, 8, 0],
                [9, 0, 0, 8, 6, 3, 0, 0, 5],
                [0, 5, 0, 0, 9, 0, 6, 0, 0],
                [1, 3, 0, 0, 0, 0, 2, 5, 0],
                [0, 0, 0, 0, 0, 0, 0, 7, 4],
                [0, 0, 5, 2, 0, 6, 3, 0, 0]];

      if SolvePuzzle(Puzzle) then
        Writeln(FinishedPuzzle)
      else
        Writeln('No Solution');
    end.

    And the code I am trying to get to work:

    http://www.geeksforgeeks.org/backtracking-set-7-suduku/


    Am I missing something obvious?

    Edit: Seems like the backtracking isn't working as intended, as it doesn't seem to reset the very last cell back to 0.
    Last edited by Dissimulo; 06-28-2016 at 01:01 PM.

  2. #2
    Join Date
    Apr 2016
    Location
    New Zealand
    Posts
    76
    Mentioned
    0 Post(s)
    Quoted
    32 Post(s)

    Default

    Got some working code now

    Simba Code:
    program SudokuSolver;

    var
      Puzzle: Array [0..8] of Array [0..8] of Integer;

    function FindNextCellToFill(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Row, Column: Integer): Array [0..1] of Integer;
    var
      x, y: Integer;
    begin
      for x := Row to 8 do
        for y := Column to 8 do
          if PuzzleGrid[x][y] = 0 then
          begin
            Result := [x, y];
            Exit;
          end;

      for x := 0 to 8 do
        for y := 0 to 8 do
          if PuzzleGrid[x][y] = 0 then
          begin
            Result := [x, y];
            Exit;
          end;

      Result := [-1, -1];
    end;

    function IsValid(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Row, Column, Test: Integer): Boolean;
    var
      x, y: Integer;
    begin
      for y := 0 to 8 do
        if Test = PuzzleGrid[Row][y] then
        begin
          Result := False;
          Exit;
        end;

      for x := 0 to 8 do
        if Test = PuzzleGrid[x][Column] then
        begin
          Result := False;
          Exit;
        end;

      for x := 0 to 2 do
      begin
        for y := 0 to 2 do
        begin
          if PuzzleGrid[x + Row - (Row MOD 3)][y + Column - (Column MOD 3)] = Test then
          begin
            Result := False;
            Exit;
          end;
        end;
      end;

      Result := True;
    end;

    function SolveSudoku(PuzzleGrid: Array [0..8] of Array [0..8] of Integer; Row, Column: Integer = 0): Boolean;
    var
      Test: Integer;
    begin
      Row := FindNextCellToFill(PuzzleGrid, Row, Column)[0];
      Column := FindNextCellToFill(PuzzleGrid, Row, Column)[1];

      if Row = -1 then
      begin
        Puzzle := PuzzleGrid;
        Result := True;
        Exit;
      end;

      for Test := 1 to 9 do
        if IsValid(PuzzleGrid, Row, Column, Test) then
        begin
          PuzzleGrid[Row][Column] := Test;
          if SolveSudoku(PuzzleGrid, Row, Column) then
          begin
            Result := True;
            Exit;
          end;
          PuzzleGrid[Row][Column] := 0;
        end;

      Result := False;
    end;


    begin
      ClearDebug;

      {
      Puzzle := [[3, 0, 6, 5, 0, 8, 4, 0, 0],
                [5, 2, 0, 0, 0, 0, 0, 0, 0],
                [0, 8, 7, 0, 0, 0, 0, 3, 1],
                [0, 0, 3, 0, 1, 0, 0, 8, 0],
                [9, 0, 0, 8, 6, 3, 0, 0, 5],
                [0, 5, 0, 0, 9, 0, 6, 0, 0],
                [1, 3, 0, 0, 0, 0, 2, 5, 0],
                [0, 0, 0, 0, 0, 0, 0, 7, 4],
                [0, 0, 5, 2, 0, 6, 3, 0, 0]];
      }


      Puzzle := [[5, 1, 7, 6, 0, 0, 0, 3, 4],
                [2, 8, 9, 0, 0, 4, 0, 0, 0],
                [3, 4, 6, 2, 0, 5, 0, 9, 0],
                [6, 0, 2, 0, 0, 0, 0, 1, 0],
                [0, 3, 8, 0, 0, 6, 0, 4, 7],
                [0, 0, 0, 0, 0, 0, 0, 0, 0],
                [0, 9, 0, 0, 0, 0, 0, 7, 8],
                [7, 0, 3, 4, 0, 0, 5, 6, 0],
                [0, 0, 0, 0, 0, 0, 0, 0, 0]];

      if SolveSudoku(Puzzle) then
        Writeln(Puzzle)
      else
        Writeln('No Solution');
    end.

    A lot cleaner, and I learned a bit about the variable scope in terms of recursion.

    My last implementation would take the gRow and gColumn (due to the global scope), of previous recursions, and not take into account that the algorithm had back tracked, thus causing the checks on the back track grid to be checking incorrect numbers, thus giving no solution.

    I'll start working on the OSRS implementation of this code, though I'll probably have to try and write a constraint based approach in order to get an antiban system to work.

  3. #3
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Was bored, wrote another implementation using Lape's type methods and new features in Simba 1.2

    Simba Code:
    program new;

    type
      TSudokuNumber = 0..9;
      TSudokuRow = array[0..8] of TSudokuNumber;
      TSudokuGrid = array[0..8] of TSudokuRow;

    function TSudokuGrid.inRow(const value, row: UInt8): Boolean; constref;
    var
      I: UInt8;
    begin
      Result := False;
      for I in Self[row] do
        if (I = value) then
          Exit(True);
    end;

    function TSudokuGrid.inColumn(const value, column: UInt8): Boolean; constref;
    var
      I: array[0..8] of UInt8;
    begin
      Result := False;
      for I in Self do
        if (I[column] = value) then
          Exit(True);
    end;

    function TSudokuGrid.inSubGrid(const value, subGrid: UInt8): Boolean; constref;
    var
      x, y: UInt8;
    begin
      Result := False;
      for y := subGrid div 3 * 3 to subGrid div 3 * 3 + 2 do
        for x := subGrid mod 3 * 3 to subGrid mod 3 * 3 + 2 do
          if (Self[y][x] = value) then
            Exit(True);
    end;

    function TSudokuGrid.getNext(var row, col: UInt8): boolean; constref;
    begin
      Result := False;

      if (row > 0) and (col > 0) then
        for row := row to 8 do
          for col := col to 8 do
            if (Self[row][col] = 0) then
              Exit(True);

      for row := 0 to 8 do
        for col := 0 to 8 do
          if (Self[row][col] = 0) then
            Exit(True);
    end;

    function TSudokuGrid.isValid(const i, row, col: UInt8): boolean; constref;
    begin
      Result := (not (inRow(i, row) or inColumn(i, col) or inSubGrid(i, (row div 3) * 3 + (col div 3))))
    end;

    function TSudokuGrid.Solve(row: UInt8 = 0; col: UInt8 = 0): boolean;
    var
      x, y: UInt8;
      i: TSudokuNumber;
      Grid: TSudokuGrid;
    begin
      Result := True;

      while (getNext(row, col)) do
      begin
        for i := 1 to 9 do
          if (isValid(i, row, col)) then
          begin
            Grid := Self;
            Grid[row][col] := i;

            if (Grid.Solve(row, col)) then
            begin
              Self := Grid;
              Exit(True);
            end;
          end;

        Exit(False);
      end;
    end;

    var
      Sudoku: TSudokuGrid = [[5, 1, 7, 6, 0, 0, 0, 3, 4],
                             [2, 8, 9, 0, 0, 4, 0, 0, 0],
                             [3, 4, 6, 2, 0, 5, 0, 9, 0],
                             [6, 0, 2, 0, 0, 0, 0, 1, 0],
                             [0, 3, 8, 0, 0, 6, 0, 4, 7],
                             [0, 0, 0, 0, 0, 0, 0, 0, 0],
                             [0, 9, 0, 0, 0, 0, 0, 7, 8],
                             [7, 0, 3, 4, 0, 0, 5, 6, 0],
                             [0, 0, 0, 0, 0, 0, 0, 0, 0]];

    begin
      ClearDebug();
      WriteLn(Sudoku.Solve());
      WriteLn(Sudoku);
    end.
    Last edited by Dgby714; 07-17-2016 at 03:39 PM.

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •