Sudoku Programmers Forum Index

 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister   ProfileProfile   Log inLog in          Games  Calendar

Log in to check your private messagesLog in to check your private messages   

Last step in generating Sudoku Puzzles
Goto page 1, 2  Next
 
Post new topic   Reply to topic    Sudoku Programmers Forum Index -> Programming sudoku
View previous topic :: View next topic  
Author Message
DT31

Joined: 07 May 2009
Posts: 1
:

Items
PostPosted: Thu May 07, 2009 11:19 am    Post subject: Last step in generating Sudoku Puzzles Reply with quote

I have some code here that I need some help finishing. This code generates a random Sudoku Puzzle, problem is though that the one thing it is currently not checking for is having only one of each number in a set of three. I'm not quite sure on how to code that. Any help would be appreciated.

import java.util.*;

// produce a Sudoku grid
public class SudokuGenerator {

// the grid with the numbers
private int[][] grid;
// a single row
private int[] row;
// random and aray list
private Random ran;
private ArrayList<Integer> al;
// number of row and column
private int size;

// size of the Sudoku grid is received as parameter
SudokuGenerator(int size) {
this.size = size;
// this this the grid that we will fill
grid = new int[size][size];
// this is to store a row that we are trying to build
row = new int[size];
// random number generator
ran = new Random();
// arraylist that will contain the possible values for every case in the grid
al = new ArrayList<Integer>();

// now let's fill the grid row by row
for(int i = 0; i < size; i++)
fillRow(i);
}

// will call genRow() to fill row
// then will copy that row into the grid... the main reason for this method is to display debug info
private void fillRow(int n) {
genRow(n); // get a new row
// ok i can copy the row into the grid
System.out.print("Row " + n + ":");
for(int i = 0; i < size; i++) {
grid[n][i] = row[i];
System.out.print(" " + row[i]); // optional debug statement
}
System.out.println();

}
// fill the instance variable row with a new row
private void genRow(int n) {
// will be used to flag which values are available or not
boolean[] used = new boolean[size];
// it might take more than one trial to fill a row
// imagine the following case
// 1 2 3 4
// 2 3 4 1
// now if I add for the third row
// 3 then
// 3 4 then
// 3 4 2 then
// the only possible case for the last column is 1 but 1 is invalid in the last column
// so we'll have to try again
boolean conflict = true; // assume we have conflict to enter the while loop
while(conflict) {
conflict = false; // assume it worked
// loop for each column of the row
for(int i = 0; i < size; i++) {
// initialized that all number form 0 to size are not used and are available
for(int j = 0; j < size; j++)
used[j] = false;
// i cannot use any previous number used on that row so I set to true
// all the already allocated numbers in that row
for(int j = 0; j < i; j++)
used[row[j]] = true;
// i cannot use neither the numbers used in the same column in the previous rows already filled
for(int j = 0; j < n; j++)
used[grid[j][i]] = true;
// fill the array list with the possible values
al.clear(); // empty the arraylist
for(int j = 0; j < size; j++) { // fill it with the permitted values
if(!used[j]) { // if number not used
al.add(j); // add it to arraylist
}
}
// now case explained in comment for variable conflict
// in that case no number would have been entered in the arraylist so its size would be 0
if(al.size() == 0) {
// if it is the case flag that there is a conflict
conflict = true;
break; // no need to continue the loop
}
// pickup a number randomly from the arraylist
row[i] = al.remove(ran.nextInt(al.size()));
}
}
}

// to retreive the grid
public int[][] getGrid() {
return grid;
}
// to print the grid (numbers are from 0 to size-1)
// but for regular user we will display from 1 to size
public String toString() {
String str = "";
for(int i = 0; i < size; i++) { // for every row
for(int j = 0; j < size; j++) { // and column
str += " " + (grid[i][j] + 1); // add value to String
}
str += "\n"; // end of line
}
return str;
}


public static void main(String[] arg) {
SudokuGenerator s = new SudokuGenerator(9);
System.out.print(s);
}
}
Back to top
View user's profile Send private message
Puzzler

Joined: 04 May 2009
Posts: 36
:

Items
PostPosted: Thu May 07, 2009 3:13 pm    Post subject: Reply with quote

The clincher in generating grids is that you have to use a brute force method that just keeps trying different combination until they work.

Here's the way I did it. I got a bit lazy and allowed for 100's of backtracking loops, but I don't think they ever get executed more than a few times. I've never reached "stop"

Other programmers have implemented much more sophisticated techniques that include symmetry.

Actually, after writing this code I realized that much brighter people than me had spent more time than me generating grids and then published their results and/or their generators. Search for "top50000.zip" and you'll find 50,000 pretty challenging ones.

Funnily enough in 20 years of programming I never had to use Gotos until I started coding Sudoku where I found that the levels of nesting required become so complex it's just easier to bug out of the middle of a deep nest. I wish VB had an "Continue" or "Break" command instead!

Cheers

Code:
 
Public Sub CreateCompletedGrid()

        'This routine creates a completed, valid Suduko grid
        Dim IsNumberFound(0 To 9) As Boolean
        Dim rnd As New Random
        Dim intNumberToPlace As Integer
        Dim fNbrFound As Boolean
        Dim intNbrOfTrys As Integer
        Dim fPlaced As Boolean
        Dim intBoxNbr As Integer
        Dim intRowNbr As Integer
        Dim intColNbr As Integer

5:      Randomize()

        For intRowNbr = 0 To 8
            intNbrOfTrys = 0
10:         ReDim IsNumberFound(0 To 9)
            For intCountOfNumbersToPlace As Integer = 1 To 9

                'Find a number in the range 1 to 9, that we haven't placed yet
                fNbrFound = False
                Do While fNbrFound = False
                    intNumberToPlace = rnd.Next(1, 10)
                    If IsNumberFound(intNumberToPlace) = False Then
                        IsNumberFound(intNumberToPlace) = True
                        fNbrFound = True
                    End If
                Loop

                'When we get to here, we have found a number that has not yet been placed
                'We need to place it somewhere in the row
                For intColNbr = 0 To 8
                    intBoxNbr = GetBoxNbr(intRowNbr, intColNbr)
                    fPlaced = False
                    If MyCells(intRowNbr, intColNbr).Value = 0 Then
                        If Me.IsValueInRow(intRowNbr, intNumberToPlace) = False Then
                            If Me.IsValueInColumn(intColNbr, intNumberToPlace) = False Then
                                If Me.IsValueInBox(intBoxNbr, intNumberToPlace) = False Then
                                    MyCells(intRowNbr, intColNbr).Value = intNumberToPlace
                                    fPlaced = True
                                    Exit For
                                End If
                            End If
                        End If
                    End If
                Next intColNbr

                If fPlaced = False Then
                    intNbrOfTrys = intNbrOfTrys + 1
                    Select Case intNbrOfTrys
                        Case 1 To 100
                            'backtrack to see if we can fix the current row
                            For i As Integer = 0 To intColNbr - 1
                                MyCells(intRowNbr, i).Value = -1
                            Next i
                            GoTo 10
                        Case 101 To 150
                            'backtrack two rows
                            If intRowNbr = 0 Then
                                For i As Integer = 0 To 8
                                    MyCells(0, i).Value = -1
                                Next i
                                GoTo 10
                            Else
                                For i As Integer = intRowNbr To intRowNbr - 1 Step -1
                                    For j As Integer = 0 To 8
                                        MyCells(i, j).Value = -1
                                    Next j
                                Next i
                                intRowNbr = intRowNbr - 1
                                GoTo 10
                            End If
                        Case 151 To 200
                            'backtrack three rows
                            If intRowNbr = 0 Then
                                For i As Integer = 0 To intColNbr - 1
                                    MyCells(intRowNbr, i).Value = -1
                                Next i
                                GoTo 10
                            Else
                                If intRowNbr = 0 Then GoTo 10
                                For i As Integer = intRowNbr To intRowNbr - 2 Step -1
                                    For j As Integer = 0 To 8
                                        MyCells(i, j).Value = -1
                                    Next j
                                Next i
                                intRowNbr = intRowNbr - 2
                                GoTo 10
                            End If
                        Case Else
                            'We have some serious debugging to do
                            Stop
                    End Select
                End If
            Next intCountOfNumbersToPlace
        Next intRowNbr
        Return
    End Sub

 Public Function IsValueInRow(ByVal theRowNbr As Integer, ByVal theElementValue As Integer) As Boolean

        For intColNbr As Integer = 0 To 8
            If MyCells(theRowNbr, intColNbr).Value = theElementValue Then
                Return True
            End If
        Next intColNbr

        Return False

    End Function

    Public Function IsValueInColumn(ByVal theColNbr As Integer, ByVal theElementValue As Integer) As Boolean

        For intRowNbr As Integer = 0 To 8
            If MyCells(intRowNbr, theColNbr).Value = theElementValue Then
                Return True
            End If
        Next intRowNbr
        Return False

    End Function

    Public Function IsValueInBox(ByVal theBoxNbr As Integer, ByVal theElementValue As Integer) As Boolean

        Dim intStartRow As Integer
        Dim intStartCol As Integer

        intStartRow = BoxTopRow(theBoxNbr)
        intStartCol = BoxLeftColumn(theBoxNbr)

        For intRowNbr = intStartRow To intStartRow + 2
            For intColNbr = intStartCol To intStartCol + 2
                If MyCells(intRowNbr, intColNbr).Value = theElementValue Then
                    Return True
                End If
            Next intColNbr
        Next intRowNbr
        Return False

    End Function
Back to top
View user's profile Send private message
Lunatic

Joined: 11 Mar 2007
Posts: 166
:
Location: Ghent - Belgium

Items
PostPosted: Sun May 10, 2009 11:38 am    Post subject: Reply with quote

Puzzler wrote:
I wish VB had an "Continue" or "Break" command instead!


You can use:
Exit For to break out of a For....Next
Exit Do to break out of a Do....Loop

And of course, you can exit subs or functions too by using Exit Sub or Exit Function

There is allways a way to avoid the GoTo statement, it sometimes requires more code like combining Do...Loops with Select Case, for example.
_________________
Marc
~~~<><~~~<><~~~<><~~~<><~~~
Back to top
View user's profile Send private message Send e-mail Visit poster's website
Puzzler

Joined: 04 May 2009
Posts: 36
:

Items
PostPosted: Mon May 11, 2009 2:33 pm    Post subject: Iterate Reply with quote

Hey Marc

One of the challenges I had with the deep levels of nesting was that without the goto, I'd have needed even MORE nesting. At some point the code is clarified by simply bugging out, rather than trying to wrap more endifs and nexts.

I look at Gotos as a chainsaw. Ok to use if you know what you're doing, but dangerous in the hands of a novice.

"Exit For" is the equivalent of "Break", but there's no "Iterate" command that equates to the "Continue" statement. That said, in 20 years, I can't say I've missed it before. It's just this funky (and fun) sudoku analysis stuff!

cheers
Back to top
View user's profile Send private message
Lunatic

Joined: 11 Mar 2007
Posts: 166
:
Location: Ghent - Belgium

Items
PostPosted: Mon May 11, 2009 4:16 pm    Post subject: Re: Iterate Reply with quote

Puzzler wrote:
"Exit For" is the equivalent of "Break", but there's no "Iterate" command that equates to the "Continue" statement.


You're right about the "Continue" statement, there's no equivalent, but even among some c programmers, using the "Continue" statement is considered to be poorly structured code. It is after all compairable with a VisualBasic "GoTo" statement to jump to the end of the current loop.

To be honest, i used the GoTo statement too in my Sudoku Program Embarassed , because i was just to lazy at the time to work around it.

Arrow Arrow Arrow
Code:
Function SolveSudoku() As Boolean

Dim CellsToSolve As Integer
Dim ResultFunction As Integer

SudokuLevel = 0
CellsToSolve = 0
For i = 0 To 80
    If Cell(i) = 0 Then CellsToSolve = CellsToSolve + 1
Next i

SolveSudoku = False

SolveLoop:

'check if cell exists with no solution and no candidates left
If EmptyCell Then Exit Function
   
'Level 1
If SudokuLevel < 1 Then SudokLevel = 1 'Easy
If HiddenSingle Then
    CellsToSolve = CellsToSolve - 1
    If CellsToSolve = 0 Then
        SolveSudoku = True
        Exit Function
    Else
        GoTo SolveLoop
    End If
End If

If NakedSingle Then
    CellsToSolve = CellsToSolve - 1
    If CellsToSolve = 0 Then
        SolveSudoku = True
        Exit Function
    Else
        GoTo SolveLoop
    End If
End If

'Level 2
If SudokuLevel < 2 Then SudokLevel = 2 'Medium
If PointingPair Then GoTo SolveLoop
If BoxLine Then GoTo SolveLoop

'Level 3
If SudokuLevel < 3 Then SudokLevel = 3 'Hard
'True = check for naked subset
'False = check for hidden subset
'2 = pair, 3 = triple, and so on...
If NakedHidden(True, 2) Then GoTo SolveLoop
If NakedHidden(True, 3) Then GoTo SolveLoop
If NakedHidden(False, 2) Then GoTo SolveLoop
If NakedHidden(True, 4) Then GoTo SolveLoop
If NakedHidden(False, 3) Then GoTo SolveLoop
If NakedHidden(True, 5) Then GoTo SolveLoop

'Level 4
If SudokuLevel < 4 Then SudokLevel = 4 'Crazy
If XWing Then GoTo SolveLoop
If SwordFish Then GoTo SolveLoop
If MultiXWing Then GoTo SolveLoop
If EmptyRectangle Then GoTo SolveLoop

'Level 5
If SudokuLevel < 5 Then SudokLevel = 5 'Insane
If XYWing Then GoTo SolveLoop
If TwoStringKite Then GoTo SolveLoop
If Skyscraper Then GoTo SolveLoop
If XYZWing Then GoTo SolveLoop
If SimpleColoring Then GoTo SolveLoop

'Level 6
If SudokuLevel < 6 Then SudokLevel = 6 'Kamikaze
If JellyFish Then GoTo SolveLoop
If WXYZWing Then GoTo SolveLoop
ResultFunction = MultiColor
If ResultFunction > -1 Then
    CellsToSolve = CellsToSolve - ResultFunction
    GoTo SolveLoop
End Select
If FinnedXWing Then GoTo SolveLoop
If SueDeCoq Then GoTo SolveLoop
If APE Then GoTo SolveLoop
If UniqueRectangle Then GoTo SolveLoop
If AvoidableRectangle Then GoTo SolveLoop
If ExtendedAPE Then GoTo SolveLoop
If BUG Then GoTo SolveLoop
If NiceLoops(6) > 0 Then GoTo SolveLoop
If AIC(10, 6) > 0 Then GoTo SolveLoop

'Level 7
If SudokuLevel < 7 Then SudokLevel = 7 'Extreme
If XYChain Then GoTo SolveLoop
If ATE Then GoTo SolveLoop
If NiceLoops(7) > 0 Then GoTo SolveLoop
If AIC(20, 7) > 0 Then GoTo SolveLoop
If ALSxz Then GoTo SolveLoop

'Level 8
If SudokuLevel < 8 Then SudokLevel = 8 'Mayhem
If ExtendedATE Then GoTo SolveLoop
If AIC(30, 8) > 0 Then GoTo SolveLoop
If Bifurcation Then
    CellsToSolve = CellsToSolve - 1
    GoTo SolveLoop
End If

SudokuLevel = 9 'Outlaw (not solved by the program logic)

End Function

_________________
Marc
~~~<><~~~<><~~~<><~~~<><~~~
Back to top
View user's profile Send private message Send e-mail Visit poster's website
Puzzler

Joined: 04 May 2009
Posts: 36
:

Items
PostPosted: Mon May 11, 2009 5:08 pm    Post subject: Simple Coloring Reply with quote

Hey Marc

Could you help me out with the simple coloring algorithm? I've studied (and studied, and studied) your code but I'm just not understanding the sequence that the cells get colored

I've tried :
Following the chain of conjugations, flipping the color at each joint.
Following the chain by row/column sequence, setting the color based on surrounding cells.

In both cases I come to the end of a chain and have to make a decision what color to paint the starting cell of the next chain. In every case I would logically chose green, not blue for cell R1,C9.

Simple Sudoku correctly chooses Blue, so it must be using a different sequence but there's no pattern that I can discern.

Can you point me in the right direction?

Here's the puzzle I'm flummoxed with:
Code:

*-----------*
 |548|..3|...|
 |.67|4.9|835|
 |9..|857|6..|
 |---+---+---|
 |.9.|.38|257|
 |3..|57.|4..|
 |875|294|163|
 |---+---+---|
 |689|745|312|
 |...|9..|5..|
 |.51|3.2|...|
 *-----------*

 
 *-----------------------------------------------------------*
 | 5     4     8     | 16    126   3     | 79    279   19    |
 | 12    6     7     | 4     12    9     | 8     3     5     |
 | 9     123   23    | 8     5     7     | 6     24    14    |
 |-------------------+-------------------+-------------------|
 | 14    9     46    | 16    3     8     | 2     5     7     |
 | 3     12    26    | 5     7     16    | 4     89    89    |
 | 8     7     5     | 2     9     4     | 1     6     3     |
 |-------------------+-------------------+-------------------|
 | 6     8     9     | 7     4     5     | 3     1     2     |
 | 247   23    234   | 9     168   16    | 5     478   468   |
 | 47    5     1     | 3     68    2     | 79    4789  4689  |
 *-----------------------------------------------------------*
Back to top
View user's profile Send private message
Puzzler

Joined: 04 May 2009
Posts: 36
:

Items
PostPosted: Mon May 11, 2009 5:48 pm    Post subject: EUREKA! Reply with quote

Hey Marc

I found the problem.

I was using {r1,c4} as my starting cell.

I finally realized that this couldn't be a starting cell, because it's part of three occurrences in Box 2. Once I added some code to ignore three-occurrence cells, it all came together.

Man, I've struggled with this one. I swear, I'm not a dummy, but I've just had a mental block.

Thanks for your help
Back to top
View user's profile Send private message
Lunatic

Joined: 11 Mar 2007
Posts: 166
:
Location: Ghent - Belgium

Items
PostPosted: Mon May 11, 2009 7:20 pm    Post subject: Re: EUREKA! Reply with quote

Puzzler wrote:
I was using {r1,c4} as my starting cell.

I finally realized that this couldn't be a starting cell, because it's part of three occurrences in Box 2. Once I added some code to ignore three-occurrence cells, it all came together.


I can't see why {r1,c4} couldn't be used as starting cell, as it is conjugating over column 4 with {r4,c4}.

If i follow the strong links in row/column order, starting with cell {r1,c4} then the chain is formed as follow:
{r1,c4} green
column
{r4,c4} blue
row
{r4,c1} green
column
{r2,c1} blue
row
{r2,c5} green => collides with {r1,c4} so green is wrong color

No more nodes can be linked to that chain if you don't link over boxes as well: {r4,c4} conjugates with {r5,c6} in the centre box:
{r4,c4} allready blue
box
{r5,c6} green
row
{r5,c2} blue
column
{r3,c2} green
row
{r3,c9} blue
column
{r1,c9} green => collides with {r1,c4} too

....and {r5,c6} conjugates with {r8,c6} in column 6:
{r5,c6} allready green
column
{r8,c6} blue
row
{r8,c5} green => collides with {r2,c5} (of course green, as it allready turned out to be the wrong color)

In my code, a list is made of all cells that conjugate with another cell, but that list won't tell you the way that cell is conjugating (by row and/or column and/or box). Thats why i keep boolean flags indicating in wich row, column and box conjugating pairs are present.

To make the first chain (NumberOfChains = 1), i take the first available cell in the list and assign it an ODD number, number 1 (in fact it equals (NumberOfChains * 2) - 1) representing a color, let's say GREEN.

Then i will loop over and over again (untill no cells could be added to the current chain) through the other cells until i found every cell that could be linked with any of the cells allready linked to the current chain, assigning them the opposite number regarding to the cell it conjugates with.

How? Well, for each cell that is still not linked to a chain, GridLinkCellType() is still 0. Such cell, as it is in the list, it must somehow conjugate with another cell over a row and/or column and/or box.
If it conjugates within a row then i will check its opponent if he is allready part of the chain by checking that cell's value in GridLinkCellType(). If so, then i can chain the cell under examination giving it the opposite value of its opponent. If the Row failed, then the Column is tried, and if that fails the Box is tried.

It's obvious that at first, when only one cell is assigned to the chain, with an ODD number (GREEN), the next cell then will have an EVEN number (the opposite color BLUE), as it only can be linked with that first cell.

The following cells however, are not necceserily linked with the first cell, they can be linked with any other cell belonging to the chain, and therefore will be assigned the opposite number/color regarding the number/color of the cell, allready belonging to the chain, it is conjugating with.

If no more cells are added to the current chain, then CellChained will still be False after the For...Next, and if there are still UnchainedCells, a next chain can be made, and the loop is restarted for the next chain, and so on...

I use this same way of collecting chains in my MultiColoring function, as it will give me all possible seperate chains to compare them.

The values in GridLinkCellType() are ODD/GREEN or EVEN/BLUE
For the first chain ODD = 1, EVEN = 2
For the second chain ODD = 3, EVEN = 4
For the third chain ODD = 5, EVEN = 6
and so on...
Hence the statement GridLinkCellType(k) = (NumberOfChains * 2) - 1 whenever a new chain is started with the first available unchained cell from the list, assigning it the ODD number (GREEN).
_________________
Marc
~~~<><~~~<><~~~<><~~~<><~~~
Back to top
View user's profile Send private message Send e-mail Visit poster's website
m_b_metcalf

Joined: 13 Mar 2006
Posts: 210
:
Location: Berlin

Items
PostPosted: Wed May 13, 2009 5:48 pm    Post subject: Reply with quote

Lunatic wrote:
Puzzler wrote:
I wish VB had an "Continue" or "Break" command instead!


You can use:
Exit For to break out of a For....Next
Exit Do to break out of a Do....Loop

And of course, you can exit subs or functions too by using Exit Sub or Exit Function

There is allways a way to avoid the GoTo statement, it sometimes requires more code like combining Do...Loops with Select Case, for example.

I was intrigued by the fact that no-one mentioned recursion in the brief discussion on language features. I don't use it in my usual grid generation program, but knocked together the example below to test the principle. As written, it produces 100,000 9x9 grids in 20s, 1000 16x16 in 24s, and a 25x25 in ~100s. (In fact, for larger than 9x9 it can get bogged down in a deadlock and I've written extra code to handle that, not shown.) The procedure of interest is cell, where only the cycle is used to take the next iteration, and the return to go back up the calling chain when a grid is found. The grids are random and independent; the program restarts each time from scratch rather than looking for the 'next' one in a sequence.

Regards,
Mike Metcalf

Code:

program grid 
implicit none
integer, parameter              :: box = 3, size = box*box, size2 = size*size
integer, dimension(size2)       :: sudoku
integer, dimension(size, size2) :: order
integer                         :: cell_index, j, ll
logical                         :: complete

do ll = 1, 10           
   complete = .false.
   cell_index = 0
   sudoku = 0
   do j = 1, size2
      order(:, j) = scatter(size)
   end do   
   call cell
end do

contains

   recursive subroutine cell
      integer :: ii
! Finds next valid value for this cell, and backs up one cell otherwise   
      cell_index = cell_index + 1 
      do ii = 1, size
         if(.not.valid(order(ii, cell_index))) cycle
         sudoku(cell_index) = order(ii, cell_index)
         if(cell_index == size2) then
            complete = .true.
            return
         else
            call cell      !!! <--------------The recursive call
            if(complete) return
         end if   
      end do   
      sudoku(cell_index) = 0
      cell_index = cell_index - 1
   end subroutine cell
   
   logical function valid(value)
      integer, intent(in) :: value
      integer             :: r_ind, c_ind, b_ind, bb, ncols
! Checks the row/column/box constaints     
      valid = .true.
      r_ind = ((cell_index - 1)/size) * size
      c_ind = cell_index - r_ind
      ncols = mod(cell_index, size)
      if(ncols == 0) ncols = size
      if(any(sudoku(r_ind + 1 : r_ind + ncols - 1) == value)) then
         valid = .false.
         return
      else if(any(sudoku(c_ind : c_ind + ((cell_index - 1)/size-1)*size : size) == value)) then
         valid = .false.
         return   
      else
         b_ind = ((cell_index -1)/(size*box))*size*box + c_ind
         b_ind =  ((b_ind - 1)/box)*box + 1
         do bb = 0, box - 2       
            if(any(sudoku(b_ind + bb * size : b_ind + bb * size + box - 1) == value)) then
               valid = .false.
               return
            end if
         end do     
      end if   
   end function valid   
   
   function scatter(num)
      integer, intent(in) :: num
      integer             :: scatter(num), ii, index
      real                :: numbers(num)
! Array-valued function that returns the integer values 1 to num in random order     
      call random_number(numbers)
      do ii = 1, num
         index = minloc(numbers, dim=1)
         scatter(ii) = index
         numbers(index) = 2.0
      end do
   end function scatter
   
end program grid


Last edited by m_b_metcalf on Sat May 16, 2009 3:39 pm; edited 2 times in total
Back to top
View user's profile Send private message
Puzzler

Joined: 04 May 2009
Posts: 36
:

Items
PostPosted: Wed May 13, 2009 7:45 pm    Post subject: Recursion Reply with quote

Like bumblebee flight, how helicopters stay in the air and Bit-masking, recursion is something I think of as being the devils work Very Happy

It creates very compact code like yours (nice code by the way) but debugging can be a bear. I haven't used it much in the past, but since starting this pesky project have encountered all manner of freaky things - including (shudder) goto's Rolling Eyes

I use a recursive call to check incoming puzzles for solvability and uniqueness, and I used recursion to color the chains in my Simple Coloring algorithm (which I finally got working!).

I was pleased with the results and happy to know I was smart enough to use recursion after all!

Cheers

Kevin
Back to top
View user's profile Send private message
PIsaacson

Joined: 17 Jan 2006
Posts: 47
:
Location: Campbell, CA

Items
PostPosted: Wed May 13, 2009 10:49 pm    Post subject: Re: Iterate Reply with quote

Lunatic wrote:
Code:
'Level 7
If SudokuLevel < 7 Then SudokLevel = 7 'Extreme
...
If ATE Then GoTo SolveLoop

'Level 8
If SudokuLevel < 8 Then SudokLevel = 8 'Mayhem
If ExtendedATE Then GoTo SolveLoop


Marc,

Okay, I'll bite. What's "ATE" stand for? I found what appears to be your topic on http://www.sudoku.org.uk/SudokuThread.asp?fid=4&sid=8152&p1=6&p2=12, but the page is vacant. From the title, it sounds like an extension to APE beyond what has been described as "Extended APE"? Can you repost or recreate your original presentation? Many postings on sudoku.org.uk Eureka forums seem to experience this same disappearing act, and if they are truly gone for good, then it's a tragic loss for the sudoku world.

Cheers,
Paul
Back to top
View user's profile Send private message
Lunatic

Joined: 11 Mar 2007
Posts: 166
:
Location: Ghent - Belgium

Items
PostPosted: Thu May 14, 2009 8:15 am    Post subject: Re: Iterate Reply with quote

PIsaacson wrote:
Okay, I'll bite. What's "ATE" stand for?


ATE stands for Aligned Triple Exclusion.
so Extended ATE then stands for (obviously) Extended Aligned Triple Exclusion.

Part of what was discussed on the eureka forum about APE, ATE and their Extended versions is still available in my on-line MPQ-Sudoku Help file:

http://users.telenet.be/mpq/sudoku/help

Or more specific:

http://users.telenet.be/mpq/sudoku/help/aligned_pair_exclusion.html

http://users.telenet.be/mpq/sudoku/help/extended_aligned_pair_exclusion.html

http://users.telenet.be/mpq/sudoku/help/aligned_triple_exclusion.html

http://users.telenet.be/mpq/sudoku/help/extended_aligned_triple_exclusion.html
_________________
Marc
~~~<><~~~<><~~~<><~~~<><~~~
Back to top
View user's profile Send private message Send e-mail Visit poster's website
m_b_metcalf

Joined: 13 Mar 2006
Posts: 210
:
Location: Berlin

Items
PostPosted: Thu May 14, 2009 10:51 am    Post subject: Re: Recursion Reply with quote

Puzzler wrote:
Like bumblebee flight, how helicopters stay in the air and Bit-masking, recursion is something I think of as being the devils work Very Happy

You're right, of course. Nevertheless, I put some print statements in the code to watch it running for 25x25. It took surprisingly long to build row 4 but, when you think about it, there are a vast number of combinations available, most of them invalid. So I added code to the function valid that, on row 4 (box-1 in the general case), keeps a count of the number of remaining distinct values available, taking account of those already used in the first 3 rows of the box 5. If, at any point along the row, there are fewer than 5 values left available (they'll be needed for row 4 of box 5) we can back up staightaway. This brought the time to produce a 25x25 down from 155s to 11s Exclamation

Regards,

Mike Metcalf
Back to top
View user's profile Send private message
gsf

Joined: 18 Aug 2005
Posts: 411
:
Location: NJ USA

Items
PostPosted: Thu May 14, 2009 12:55 pm    Post subject: Re: Recursion Reply with quote

m_b_metcalf wrote:
So I added code to the function valid that, on row 4 (box-1 in the general case), keeps a count of the number of remaining distinct values available, taking account of those already used in the first 3 rows of the box 5. If, at any point along the row, there are fewer than 5 values left available (they'll be needed for row 4 of box 5) we can back up staightaway. This brought the time to produce a 25x25 down from 155s to 11s Exclamation

this is a form of forward checking
it can be worthwhile depending on the domain
doing it at every move usually doesn't pay off
but you found a neat way to do it for groups of moves in the sudoku domain

re: recursion vs goto
there's another alternative: roll your own stack via arrays
(the way fortran programmers used to do it:)
that's what I used in sudocoo
it has one goto, only because there is only one function main()
that deeply nested goto acts like return from a function
Back to top
View user's profile Send private message Visit poster's website
PIsaacson

Joined: 17 Jan 2006
Posts: 47
:
Location: Campbell, CA

Items
PostPosted: Thu May 14, 2009 10:51 pm    Post subject: Reply with quote

Marc,

Thanks for the links to your MPQ solver. Very nicely done!!! An impressive set of features and techniques! The ALS-XZ help states that it is not yet implemented. Any projected dates for completion??? I only ask because ALS chains and Death Blossom are my (current) special area of interest.

BTW: I had a hard time seeing the help examples in FireFox due to the back-slashed file names for the gifs. They display just fine in IE, but I had to download a special add-on to "fix" urls containing back-slashes before they would appear in FireFox. Apparently this is a "known feature" of FF, but it's still my browser of choice...

Thanks again,
Paul
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Sudoku Programmers Forum Index -> Programming sudoku All times are GMT
Goto page 1, 2  Next
Page 1 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
Sudoku Programmers topic RSS feed 


Powered by phpBB © 2001, 2005 phpBB Group

Igloo Theme Version 1.0 :: Created By: Andrew Charron