|
View previous topic :: View next topic |
Author |
Message |
| Puzzler
| Joined: 04 May 2009 | Posts: 36 | : | | Items |
|
Posted: Mon May 04, 2009 9:15 am Post subject: VB Code for Coloring Technique |
|
|
Hello
I have built a Solving game in vb net 2008 and have the usual solving algorithms (Naked & Hidden Pairs,Trips,Quads, X Wing, X-Y wing, X-Y-Z Wing and Swordfish).
Thank you to the many contributors to this forum and others. I have enjoyed learning from your work.
The next technique I would like to implement is the Coloring technique, but I'm just stumped on how to even approach this problem. Does anyone have any VB code they would be willing to share with me? I have looked at the Lummox JR C code, but not being a C programmer, it's tough going.
Many thanks for your help |
|
Back to top |
|
|
| hobiwan
| Joined: 11 Feb 2008 | Posts: 83 | : | | Items |
|
Posted: Mon May 04, 2009 4:37 pm Post subject: |
|
|
The only thing I can offer is Java code that relies heavily on bitmaps. |
|
Back to top |
|
|
| Lunatic
| Joined: 11 Mar 2007 | Posts: 166 | : | Location: Ghent - Belgium | Items |
|
Posted: Mon May 04, 2009 7:02 pm Post subject: |
|
|
I can offer VB6 code, I'm currently working on it (translating the comments from Dutch to English), be patient... _________________ Marc
~~~<><~~~<><~~~<><~~~<><~~~ |
|
Back to top |
|
|
| Lunatic
| Joined: 11 Mar 2007 | Posts: 166 | : | Location: Ghent - Belgium | Items |
|
Posted: Mon May 04, 2009 8:32 pm Post subject: |
|
|
Here it comes...
Two functions:
1) SimpleColoring
2) CandidateRemoved (a sub-function used by SimpleColoring)
Some brief comment...
Except for the array CandidateAtCell() all other variables and arrays are local.
The array CandidateAtCell() is a boolean array with two dimensions
The first dimension adresses the candidates (1 to 9)
The second dimension adresses the cells (0 to 80)
Therefore this array is declared as follow:
Dim CandidateAtCell(1 To 9, 0 To 80) As Boolean
This array is allways kept up-to-date through the solving process
If you use another array, or another way of adressing the cells (row, column) and checking available candidates then you will have to change things to meet with your existing code.
The places where candidates are to be removed are marked within two lines with asterisks. I removed the original code, as it surely will not meet your code.
Code: | Function SimpleColoring() As Boolean
Dim SCRow(0 To 8, 1 To 9) As Integer 'counter for each row / each candidate
Dim SCCol(0 To 8, 1 To 9) As Integer 'counter for each col / each candidate
Dim SCBox(0 To 8, 1 To 9) As Integer 'counter for each box / each candidate
Dim RowLink(0 To 8, 1 To 9) As Boolean 'conjugating indicator for each row / each candidate
Dim RowLinkCells(0 To 8, 1 To 9, 1 To 2) As Integer 'adresses conjugating cells for each row / each candidate
Dim ColLink(0 To 8, 1 To 9) As Boolean 'conjugating indicator for each col / each candidate
Dim ColLinkCells(0 To 8, 1 To 9, 1 To 2) As Integer 'adresses conjugating cells for each col / each candidate
Dim BoxLink(0 To 8, 1 To 9) As Boolean 'conjugating indicator for each box / each candidate
Dim BoxLinkCells(0 To 8, 1 To 9, 1 To 2) As Integer 'adresses conjugating cells for each box / each candidate
Dim IsGridLinkCell(0 To 80, 1 To 9) As Boolean 'indicator listed cells for each cell / each candidate
Dim GridLinkCell(0 To 80, 1 To 9) As Integer 'node cell list for each candidate
Dim NumberGridLinkCells(1 To 9) As Integer 'node cell list counter for each candidate
Dim GridLinkCellType(0 To 80, 1 To 9) As Integer 'link type indicator for listed cells / each candidate
'link type values:
' 0 = not linked
' 1 = ODD node in chain 1
' 2 = EVEN node in chain 1
' 3 = ODD node in chain 2
' 4 = EVEN node in chain 2
' 5 = ODD node in chain 3
' 6 = EVEN node in chain 3
' and so on ....
Dim NumberOfChains As Integer 'chain counter
Dim UnchainedCells As Integer 'unchained cell counter
Dim CellChained As Boolean 'flag
Dim CHRow As Integer
Dim CHCol As Integer
Dim CHBox As Integer
Dim CHLB As Integer
'reset return value
SimpleColoring = False
'reset counters
For i = 0 To 8
For j = 1 To 9
SCRow(i, j) = 0
SCCol(i, j) = 0
SCBox(i, j) = 0
Next j, i
'collect info about conjugating cells (strong links) for each candidate
For ii% = 1 To 9 'loop through all candidates
NumberGridLinkCells(ii%) = -1 'reset node cell list counter
For i = 0 To 80 'loop through all cells
IsGridLinkCell(i, ii%) = False 'set cell as not listed
GridLinkCellType(i, ii%) = 0 'reset link type indicator: 0 = not linked
'check if current candidate (ii%) is present at current cell (i)
If CandidateAtCell(ii%, i) Then
'candidate present
SCRow(Int(i / 9), ii%) = SCRow(Int(i / 9), ii%) + 1 'increase according row counter
SCCol(i Mod 9, ii%) = SCCol(i Mod 9, ii%) + 1 'increase according col counter
SCBox((Int(i / 27) * 3) + Int((i Mod 9) / 3), ii%) = SCBox((Int(i / 27) * 3) + Int((i Mod 9) / 3), ii%) + 1 'increase according box counter
End If
Next i
For i = 0 To 8 'loop through all row/col/box looking for conjugating candidate
'Inspect row
'if current candidate appears twice in current row, then set conjugating indicator as true
If SCRow(i, ii%) = 2 Then RowLink(i, ii%) = True Else RowLink(i, ii%) = False
'if indicator is true (conjugating pair in current row) then collect adresses from those two cells
If RowLink(i, ii%) Then
linkcell = 0 'reset counter for conjugating cells (link cell)
For j = 0 To 8 'loop through cells in current row
'check if current candidate is present at current cell
If CandidateAtCell((i * 9) + j, ii%) Then
'candidate present
linkcell = linkcell + 1 'increase link cell counter
'save current cell adress
RowLinkCells(i, ii%, linkcell) = (i * 9) + j
'check if current cell is not allready listed as link cell
If Not IsGridLinkCell(RowLinkCells(i, ii%, linkcell), ii%) Then
'cell is not listed yet, mark cell as listed
IsGridLinkCell(RowLinkCells(i, ii%, linkcell), ii%) = True
'increase list counter
NumberGridLinkCells(ii%) = NumberGridLinkCells(ii%) + 1
'place cell number in list
GridLinkCell(NumberGridLinkCells(ii%), ii%) = RowLinkCells(i, ii%, linkcell)
End If
End If
Next j
End If
'Inspect column (similar as row)
If SCCol(i, ii%) = 2 Then ColLink(i, ii%) = True Else ColLink(i, ii%) = False
If ColLink(i, ii%) Then
linkcell = 0
For j = 0 To 8
If CandidateAtCell((j * 9) + i, ii%) Then
linkcell = linkcell + 1
ColLinkCells(i, ii%, linkcell) = (j * 9) + i
If Not IsGridLinkCell(ColLinkCells(i, ii%, linkcell), ii%) Then
IsGridLinkCell(ColLinkCells(i, ii%, linkcell), ii%) = True
NumberGridLinkCells(ii%) = NumberGridLinkCells(ii%) + 1
GridLinkCell(NumberGridLinkCells(ii%), ii%) = ColLinkCells(i, ii%, linkcell)
End If
End If
Next j
End If
'inspect box (similar as row/column)
If SCBox(i, ii%) = 2 Then BoxLink(i, ii%) = True Else BoxLink(i, ii%) = False
If BoxLink(i, ii%) Then
linkcell = 0
For j = 0 To 8
'calculate current cellnumber in box
boxcell = (Int(i / 3) * 27) + ((i Mod 3) * 3) + (Int(j / 3) * 9) + (j Mod 3)
If CandidateAtCell(boxcell, ii%) Then
linkcell = linkcell + 1
BoxLinkCells(i, ii%, linkcell) = boxcell
If Not IsGridLinkCell(BoxLinkCells(i, ii%, linkcell), ii%) Then
IsGridLinkCell(BoxLinkCells(i, ii%, linkcell), ii%) = True
NumberGridLinkCells(ii%) = NumberGridLinkCells(ii%) + 1
GridLinkCell(NumberGridLinkCells(ii%), ii%) = BoxLinkCells(i, ii%, linkcell)
End If
End If
Next j
End If
Next i
Next ii%
'at this point, for each candidate:
' - all strong linked (conjugating) cells are collected in the list called GridLinkCell(counter,candidate)
' - NumberGridLinkCells(candidate) indicates the number of cells in that list
' - GridLinkCellType(counter,candidate) is set to 0 (not linked) for all cells listed in GridLinkCell(counter,candidate)
' - RowLink(row,candidate) = true if there is a conjugating pair (strong link) in row, and then
' RowLinkCells(row,candidate,1) and RowLinkCells(row,candidate,2) are holding the adresses of those two cells
' - ColLink(col,candidate) = true if there is a conjugating pair (strong link) in col, and then
' ColLinkCells(col,candidate,1) and ColLinkCells(col,candidate,2) are holding the adresses of those two cells
' - BoxLink(box,candidate) = true if there is a conjugating pair (strong link) in box, and then
' BoxLinkCells(box,candidate,1) and BoxLinkCells(box,candidate,2) are holding the adresses of those two cells
'try making chains
For ii% = 1 To 9 'for each candidate
'check if there are cells listed for the current candidate
If NumberGridLinkCells(ii%) <> -1 Then
'start with first chain
NumberOfChains = 1 'set chain counter to 1
'set down-counter for cells to chain
UnchainedCells = NumberGridLinkCells(ii%) 'number of cells that can be chained
'set first cell in list as type 1 (= ODD node in chain 1)
GridLinkCellType(0, ii%) = 1
'try to chain cells as long as there are unchained cells
Do While UnchainedCells > 0
'set flag that no cell is chained in current loop
CellChained = False
'loop through all listed cells, except the first cell
For i = 1 To NumberGridLinkCells(ii%)
'check if current listed cell is not chained
If GridLinkCellType(i, ii%) = 0 Then
'current listed cell is not chained
'get adress of listed cell
j = GridLinkCell(i, ii%)
'TRY TO CHAIN WITHIN ROW
'Calculate row of this cell
CHRow = Int(j / 9)
'check if this row has a conjugating pair, if so than this cell is part of it
If RowLink(CHRow, ii%) Then
'is it cell 1 ?
If RowLinkCells(CHRow, ii%, 1) = j Then
'search in list for cell 2
For k = 0 To NumberGridLinkCells(ii%)
'check if current cell in list is cell 2, and check if cell 2 is chained
If (GridLinkCell(k, ii%) = RowLinkCells(CHRow, ii%, 2)) And (GridLinkCellType(k, ii%) > 0) Then
'cell 2 is found and is allready chained
'check cell 2 link type
If (GridLinkCellType(k, ii%) Mod 2) = 1 Then
'if cell 2 is set as type 1 (= ODD node) then set cell 1 as type 2 (= EVEN node)
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) + 1
Else
'if cell 2 is set as type 2 (= EVEN node) then set cell 1 as type 1 (= ODD node)
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) - 1
End If
'set flag that a cell was chained in current loop
CellChained = True
'Decrease number of cells to chain
UnchainedCells = UnchainedCells - 1
'stop searching
Exit For
End If
Next k
Else 'it's not cell 1, must be cell 2
'search in list for cell 1 (similar as for cell 2
For k = 0 To NumberGridLinkCells(ii%)
If (GridLinkCell(k, ii%) = RowLinkCells(CHRow, ii%, 1)) And (GridLinkCellType(k, ii%) > 0) Then
If (GridLinkCellType(k, ii%) Mod 2) = 1 Then
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) + 1
Else
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) - 1
End If
CellChained = True
UnchainedCells = UnchainedCells - 1
Exit For
End If
Next k
End If
End If
'check if cell is still not chained
If GridLinkCellType(i, ii%) = 0 Then
'TRY TO CHAIN WITHIN COLUMN (similar as ROW)
CHCol = j Mod 9
If ColLink(CHCol, ii%) Then
If ColLinkCells(CHCol, ii%, 1) = j Then
For k = 0 To NumberGridLinkCells(ii%)
If (GridLinkCell(k, ii%) = ColLinkCells(CHCol, ii%, 2)) And (GridLinkCellType(k, ii%) > 0) Then
If (GridLinkCellType(k, ii%) Mod 2) = 1 Then
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) + 1
Else
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) - 1
End If
CellChained = True
UnchainedCells = UnchainedCells - 1
Exit For
End If
Next k
Else
For k = 0 To NumberGridLinkCells(ii%)
If (GridLinkCell(k, ii%) = ColLinkCells(CHCol, ii%, 1)) And (GridLinkCellType(k, ii%) > 0) Then
If (GridLinkCellType(k, ii%) Mod 2) = 1 Then
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) + 1
Else
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) - 1
End If
CellChained = True
UnchainedCells = UnchainedCells - 1
Exit For
End If
Next k
End If
End If
End If
'check if cell is still not chained
If GridLinkCellType(i, ii%) = 0 Then
'TRY TO CHAIN WITHIN BOX (similar as ROW/COLUMN)
CHBox = (Int(j / 27) * 3) + Int((j Mod 9) / 3)
If BoxLink(CHBox, ii%) Then
If BoxLinkCells(CHBox, ii%, 1) = j Then
For k = 0 To NumberGridLinkCells(ii%)
If (GridLinkCell(k, ii%) = BoxLinkCells(CHBox, ii%, 2)) And (GridLinkCellType(k, ii%) > 0) Then
If (GridLinkCellType(k, ii%) Mod 2) = 1 Then
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) + 1
Else
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) - 1
End If
CellChained = True
UnchainedCells = UnchainedCells - 1
Exit For
End If
Next k
Else
For k = 0 To NumberGridLinkCells(ii%)
If (GridLinkCell(k, ii%) = BoxLinkCells(CHBox, ii%, 1)) And (GridLinkCellType(k, ii%) > 0) Then
If (GridLinkCellType(k, ii%) Mod 2) = 1 Then
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) + 1
Else
GridLinkCellType(i, ii%) = GridLinkCellType(k, ii%) - 1
End If
CellChained = True
UnchainedCells = UnchainedCells - 1
Exit For
End If
Next k
End If
End If
End If
End If
Next i
'check if no cell was chained in current loop and there are still cells to chain
If (Not CellChained) And (UnchainedCells > 0) Then
'start new chain
NumberOfChains = NumberOfChains + 1
'decrease unchained cells
UnchainedCells = UnchainedCells - 1
'search through list
For k = 0 To NumberGridLinkCells(ii%)
'check if current listed cell is not chained
If GridLinkCellType(k, ii%) = 0 Then
'set type as ODD node in current chain
GridLinkCellType(k, ii%) = (NumberOfChains * 2) - 1
'stop searching
Exit For
End If
Next k
End If
Loop
'AT THIS POINT ALL CELLS IN THE LIST ARE CHAINED IN ONE OR MORE CHAINS
For i = 1 To NumberOfChains 'check all chains, one by one
'check for any contradiction first
'for each two cells in the list
For k = 0 To (NumberGridLinkCells(ii%) - 1) 'first of those two cells
For l = (k + 1) To NumberGridLinkCells(ii%) 'second of those two cells
'check type of first of those two cells
Select Case GridLinkCellType(k, ii%)
Case ((i * 2) - 1) 'ODD node in current chain
'check if second cell is the same type in same chain
If GridLinkCellType(l, ii%) = ((i * 2) - 1) Then 'ODD node in current chain
'check if both cells share the same row, column or box
If (Int(GridLinkCell(k, ii%) / 9) = Int(GridLinkCell(l, ii%) / 9)) _
Or ((GridLinkCell(k, ii%) Mod 9) = (GridLinkCell(l, ii%) Mod 9)) _
Or ((Int(GridLinkCell(k, ii%) / 27) * 3) + Int((GridLinkCell(k, ii%) Mod 9) / 3) = (Int(GridLinkCell(l, ii%) / 27) * 3) + Int((GridLinkCell(l, ii%) Mod 9) / 3)) Then
'two cells both ODD node in same chain = contradiction
'loose candidate ii% in all ODD node cells belonging to that same chain
For j = 0 To NumberGridLinkCells(ii%)
If GridLinkCellType(j, ii%) = ((i * 2) - 1) Then
'***************************************************
'REMOVE CANDIDATE ii% FROM CELL GridLinkCell(j, ii%)
'***************************************************
End If
Next j
'set return value
SimpleColoring = True
'end function
Exit Function
End If
End If
Case (i * 2) 'EVEN node in current chain
'check if second cell is the same type in same chain
If GridLinkCellType(l, ii%) = (i * 2) Then 'EVEN node in current chain
'check if both cells share the same row, column or box
If (Int(GridLinkCell(k, ii%) / 9) = Int(GridLinkCell(l, ii%) / 9)) _
Or ((GridLinkCell(k, ii%) Mod 9) = (GridLinkCell(l, ii%) Mod 9)) _
Or ((Int(GridLinkCell(k, ii%) / 27) * 3) + Int((GridLinkCell(k, ii%) Mod 9) / 3) = (Int(GridLinkCell(l, ii%) / 27) * 3) + Int((GridLinkCell(l, ii%) Mod 9) / 3)) Then
'two cells both EVEN node in same chain = contradiction
'loose candidate ii% in all EVEN node cells belonging to that same chain
For j = 0 To NumberGridLinkCells(ii%)
If GridLinkCellType(j, ii%) = (i * 2) Then
'***************************************************
'REMOVE CANDIDATE ii% FROM CELL GridLinkCell(j, ii%)
'***************************************************
End If
Next j
'set return value
SimpleColoring = True
'end function
Exit Function
End If
End If
End Select
Next l, k
'no contradictions found
'check for removable candidates seen by both an ODD and EVEN node from same chain
'for each two cells in the list
For k = 0 To (NumberGridLinkCells(ii%) - 1) 'first of those two cells
For l = (k + 1) To NumberGridLinkCells(ii%) 'second of those two cells
'check type of first of those two cells
Select Case GridLinkCellType(k, ii%)
Case ((i * 2) - 1) 'ODD node in current chain
'check if second cell is different type in same chain
If GridLinkCellType(l, ii%) = (i * 2) Then 'EVEN node in current chain
'two different types of node (ODD and EVEN) within the same chain
'any cell seen by both these nodes holding candidate ii% will loose candidate ii%
'check for cells where candidate ii% can be removed, and remove candidate
If CandidateRemoved(GridLinkCell(k, ii%), GridLinkCell(l, ii%), ii%) Then
'candidate removal succesful, set return value
SimpleColoring = True
'end function
Exit Function
End If
End If
Case (i * 2) 'EVEN node in current chain
'check if second cell is different type in same chain
If GridLinkCellType(l, ii%) = ((i * 2) - 1) Then 'ODD node in current chain
'two different types of node (ODD and EVEN) within the same chain
'any cell seen by both these nodes holding candidate ii% will loose candidate ii%
'check for cells where candidate ii% can be removed
If CandidateRemoved(GridLinkCell(k, ii%), GridLinkCell(l, ii%), ii%) Then
'candidate removal succesful, set return value
SimpleColoring = True
'end function
Exit Function
End If
End If
End Select
Next l, k
Next i
End If
Next ii%
End Function |
and...
Code: | Function CandidateRemoved(Cell1 As Integer, Cell2 As Integer, Candidate As Integer) As Boolean
Dim Row1 As Integer
Dim Row2 As Integer
Dim Col1 As Integer
Dim Col2 As Integer
Dim Box1 As Integer
Dim Box2 As Integer
Dim Cell As Integer
Dim CellStatus(0 To 80) As Integer
'CellStatus values:
' 0 = not seen by neither Cell1 or Cell2
' 1 = seen by either Cell1 or Cell2
' 2 = seen by both Cell1 and Cell2
'clear return value
CandidateRemoved = False
'clear cell status
For i = 0 To 80
CellStatus(i) = 0
Next i
'calculate row, col and box from Cell1
Row1 = Int(Cell1 / 9)
Col1 = Cell1 Mod 9
Box1 = (Int(Cell1 / 27) * 27) + (Int((Cell1 Mod 9) / 3) * 3)
'increase status for all cells seen by Cell1
For i = 0 To 8
'in same row
Cell = (Row1 * 9) + i
If CellStatus(Cell) = 0 Then CellStatus(Cell) = 1
'in same col
Cell = (i * 9) + Col1
If CellStatus(Cell) = 0 Then CellStatus(Cell) = 1
Next i
For i = 0 To 2
For j = 0 To 2
'in same box
Cell = Box1 + (i * 9) + j
If CellStatus(Cell) = 0 Then CellStatus(Cell) = 1
Next j, i
'calculate row, col and box from Cell2
Row2 = Int(Cell2 / 9)
Col2 = Cell2 Mod 9
Box2 = (Int(Cell2 / 27) * 27) + (Int((Cell2 Mod 9) / 3) * 3)
'increase status for all cells seen by Cell2
For i = 0 To 8
'in same row
Cell = (Row2 * 9) + i
If CellStatus(Cell) = 1 Then CellStatus(Cell) = 2
'in same col
Cell = (i * 9) + Col2
If CellStatus(Cell) = 1 Then CellStatus(Cell) = 2
Next i
For i = 0 To 2
For j = 0 To 2
'in same box
Cell = Box2 + (i * 9) + j
If CellStatus(Cell) = 1 Then CellStatus(Cell) = 2
Next j, i
'check all cells
For i = 0 To 80
'for any cell with status = 2 (except Cell1 and Cell2)
If CellStatus(i) = 2 And i <> Cell1 And i <> Cell2 Then
'check if candidate is present
If CandidateAtCell(Candidate, i) Then
'***************************************
'REMOVE CANDIDATE Candidate FROM CELL i
'***************************************
'set return value
CandidateRemoved = True
End If
End If
Next i
End Function |
Succes. _________________ Marc
~~~<><~~~<><~~~<><~~~<><~~~ |
|
Back to top |
|
|
| Puzzler
| Joined: 04 May 2009 | Posts: 36 | : | | Items |
|
Posted: Mon May 04, 2009 10:36 pm Post subject: Thanks! |
|
|
This will help me tremendously!
I'll review the code so can make the translations into my program.
Having at least some sense of how to tackle the problem is invaluable
Thank you very much! |
|
Back to top |
|
|
| daj95376
| Joined: 05 Feb 2006 | Posts: 349 | : | | Items |
|
Posted: Tue May 05, 2009 4:57 pm Post subject: |
|
|
1) Take a candidate grid and fill a Strong Links list from it.
Code: | +-----------------------------------+
| . . 7 | . . . | 7 . . |
| . . 7 | . . 7 | . . 7 |
| . . . | . 7 . | 7 . . |
|-----------+-----------+-----------|
| . . . | . 7 7 | 7 . . |
| 7 . . | . . . | . . . |
| . . . | . 7 . | . 7 7 |
|-----------+-----------+-----------|
| . . . | 7 . . | . 7 . |
| . . . | 7 . . | 7 7 . |
| . 7 . | . . . | . . . |
+-----------------------------------+
Strong Links
-------------------------------
[r1c3] : [r1c7]
[r1c3] : [r2c3]
[r2c6] : [r3c5]
[r2c6] : [r4c6]
[r2c9] : [r6c9]
[r3c5] : [r3c7]
[r7c4] : [r7c8]
[r7c4] : [r8c4]
|
2) Terminate checking this candidate when the Strong Links list is empty. Otherwise, clear a Colors list and move the first entry from the Strong Links list to it and initialize coloring.
Code: | Strong Links Colors
------------------------------- -------------------------------
[r1c3] : [r2c3] Blue [r1c3] : [r1c7] Green
[r2c6] : [r3c5]
[r2c6] : [r4c6]
[r2c9] : [r6c9]
[r3c5] : [r3c7]
[r7c4] : [r7c8]
[r7c4] : [r8c4]
|
3) Repeatedly move entries from the Strong Links list to the Colors list until no cells in the Colors list appear in the Strong Links list.
Code: | Strong Links Colors
------------------------------- -------------------------------
[r2c6] : [r3c5] Blue [r1c3] : [r1c7] Green
[r2c6] : [r4c6] [r1c3] : [r2c3]
[r2c9] : [r6c9]
[r3c5] : [r3c7]
[r7c4] : [r7c8]
[r7c4] : [r8c4]
|
4) Iteratively color all cells in the Colors list based on coloring already assigned. Once a color is assigned to a cell, you're done with coloring that cell.
Code: | Strong Links Colors
------------------------------- -------------------------------
[r2c6] : [r3c5] Blue [r1c3] : [r1c7] Green
[r2c6] : [r4c6] Blue [r1c3] : [r2c3] Green
[r2c9] : [r6c9]
[r3c5] : [r3c7]
[r7c4] : [r7c8]
[r7c4] : [r8c4]
|
5) Check to see if any two cells with the same color see each other. If so, then you have a contradiction and can eliminate the candidate from the cells with this color. Terminate checking this candidate after you perform eliminations.
6) Any uncolored cells that see a Blue cell and a Green cell can be eliminated. Terminate checking this candidate after you perform eliminations.
There is another check that can be performed for Colors, but it's not been used in any solutions that I've seen since Angus Johnson mentioned it a long time ago. I will include it for completeness.
7) If a house/unit has only uncolored candidate cells, check to see if these cells are seen by cells with the same color. If so, then the candidate can be eliminated in the cells with that color. Terminate checking this candidate after you perform eliminations.
Return to (2) if no eliminations performed.
=====
(2)+(3)+(4): Performed on Strong Links list remaining from above.
Code: | Strong Links Colors
------------------------------- -------------------------------
[r2c9] : [r6c9] Blue [r2c6] : [r3c5] Green
[r7c4] : [r7c8] Blue [r2c6] : [r4c6] Green
[r7c4] : [r8c4] Green [r3c5] : [r3c7] Blue
|
(5): No contradiction detected.
(6): Uncolored candidate cell [r4c7] sees Green cell [r4c6] and Blue cell [r3c7]. Elimination [r4c7]<>7 is performed. No other uncolored candidate cells qualify. Terminate checking for Colors on this candidate (for now).
Last edited by daj95376 on Wed May 06, 2009 5:40 pm; edited 1 time in total |
|
Back to top |
|
|
| hobiwan
| Joined: 11 Feb 2008 | Posts: 83 | : | | Items |
|
Posted: Wed May 06, 2009 5:22 am Post subject: |
|
|
daj95376 wrote: | 7) If a house/unit has any uncolored candidate cells, check to see if these cells are seen by cells with the same color. If so, then the candidate can be eliminated in the cells with that color. |
Interesting! I never thought about that. I presume I have to read it as "If a house has only uncolored candidate cells"? |
|
Back to top |
|
|
| Draco
| Joined: 27 Jun 2008 | Posts: 3 | : | | Items |
|
Posted: Wed May 06, 2009 6:40 am Post subject: |
|
|
hobiwan wrote: | daj95376 wrote: | 7) If a house/unit has any uncolored candidate cells, check to see if these cells are seen by cells with the same color. If so, then the candidate can be eliminated in the cells with that color. |
Interesting! I never thought about that. I presume I have to read it as "If a house has only uncolored candidate cells"? |
I am trying to grok this. For illustrative purposes (and brevity) let's pick a digit: 4. Let's also pick a house: b4, and say all of b4's 4's are all uncolored, does that mean:
(a) If any colored 4 intersects with a 4 in b4 then that color is invalid? OR
(b) If two cells with 4's of the same color intersect with a 4 in b4, that color is invalid?
... or something else entirely? If it helps, here's a grid with colored 4's in b2 and nowhere else. They intersect with 4's in b1 and b3: Code: | 1258 6 248 | 38 14 9 | 348 7 245
3 478 2478 | 78 5 6 | 489 289 1
1578 1478 9 | 378 14 2 | 6 38 45
---------------+--------------+------------
4 5 1 | 9 368 38 | 78 28 267
68 2 3 | 4 7 5 | 89 1 69
678 9 78 | 2 68 1 | 5 4 3
---------------+--------------+------------
178 1478 5 | 6 389 3478 | 2 39 479
9 47 6 | 1 2 347 | 347 5 8
278 3 2478 | 5 89 478 | 1 6 479 |
Thx...
- drac |
|
Back to top |
|
|
| hobiwan
| Joined: 11 Feb 2008 | Posts: 83 | : | | Items |
|
Posted: Wed May 06, 2009 8:43 am Post subject: |
|
|
Draco,
I think I got that wrong in my post above. The principle behind coloring is of course that all candidates with color 1 or all candidates with color 2 have to be true. That said we get three cases:
1. A house contains two candidates with opposite colors plus uncolored candidates: None of the uncolored candidates can be true (special variant of daj's case 6).
2. A house contains one candidate with color 1 plus uncolored candidates, that all see candidates with color 2: All candidates with color 2 have to be false.
3. A house contains uncolored candidates only that all see candidates with the same color: that color has to be false
My cases 2 and 3 correspond to daj's case (7) (with "any" and not with "only"), provided that my case 1 has already been checked.
Prove: One of the candidates in the house has to be true. If all are uncolored and see color 2 each, one instance of color 2 has to be false, thus all must be false. If one candidate with color 1 is in the house as well, either that candidate is true, then all candidates with color 2 are false, or it is false then we have the same case as above.
Your cases (a) and (b) are invalid IMO: All uncolored cells of a house have to see candidates with the same color. |
|
Back to top |
|
|
| daj95376
| Joined: 05 Feb 2006 | Posts: 349 | : | | Items |
|
Posted: Wed May 06, 2009 4:45 pm Post subject: |
|
|
hobiwan wrote: | daj95376 wrote: | 7) If a house/unit has any uncolored candidate cells, check to see if these cells are seen by cells with the same color. If so, then the candidate can be eliminated in the cells with that color. |
Interesting! I never thought about that. I presume I have to read it as "If a house has only uncolored candidate cells"? |
Yes, I extended the concept too far by allowing colored cells in the house/unit.
Angus Johnson post |
|
Back to top |
|
|
| Puzzler
| Joined: 04 May 2009 | Posts: 36 | : | | Items |
|
Posted: Wed May 06, 2009 9:07 pm Post subject: Almost there! |
|
|
I have most of the coding done but I'm experiencing frustration with the coloring cycle.
It seems that the collision chains work sometimes but not others and I think it has to do with the starting color for broken chains.
I implemented the code as a linked list, and maybe that was my first mistake.
I've written about 6 billion lines of code, when I think a smarter programmer could do it in three lines of code, two of which are comments.
If anyone has the time to be a second pair of eyes for me, this is the code:
My object definition is:
Code: |
Public Class clsCellChainLink
Inherits clsCellAddress
Public Color As Integer = -1
Public Candidates As String
Public ConjugateRowLink As clsCellChainLink
Public ConjugateColLink As clsCellChainLink
Public ConjugateBoxLink As clsCellChainLink
Public Sub New(ByVal intRowNbr As Integer, ByVal inColNbr As Integer)
MyBase.New(intRowNbr, inColNbr)
End Sub
Public Overloads Shared Operator <>(ByVal theCell As clsCellChainLink, ByVal theCompareCell As clsCellChainLink) As Boolean
If theCell.RowNbr = theCompareCell.RowNbr And theCell.ColNbr = theCompareCell.ColNbr Then
Return False
Else
Return True
End If
End Operator
Public Overloads Shared Operator =(ByVal theCell As clsCellChainLink, ByVal theCompareCell As clsCellChainLink) As Boolean
If theCell.RowNbr = theCompareCell.RowNbr And theCell.ColNbr = theCompareCell.ColNbr Then
Return True
Else
Return False
End If
End Operator
End Class
|
In my main routine I populate the cell chain and correctly assign the strong links to each object. So far, so good
Here's the main routine:
Code: |
Public Function SimpleColoring() As List(Of clsHintProfile)
Dim HintProfiles As List(Of clsHintProfile)
Dim ChainLinks As New List(Of clsCellChainLink)
Dim ChainLink As clsCellChainLink
Dim theCandidate As Integer
InitializeSearchArrays()
For intCandidate As Integer = 1 To 9
ChainLinks = New List(Of clsCellChainLink)
theCandidate = intCandidate
'Get a list of all cells in the Grid that have 2 or 3 candidates and that contain the candidate
Dim AllCells = From clsCell In MyGrid.Grid _
Select clsCell Where clsCell.CandidateList.contains(theCandidate) And _
(clsCell.CandidateList.Count = 2 Or clsCell.CandidateList.Count = 3)
For Each Cell As clsCell In AllCells
ChainLink = New clsCellChainLink(Cell.RowNbr, Cell.ColNbr)
ChainLink.Candidates = Cell.CandidateList_ToString
ChainLinks.Add(ChainLink)
Next Cell
'Set up the pointers between the strong links
'Row conjugates
For Each ChainLink In ChainLinks
If ChainLink.ConjugateRowLink Is Nothing Then
'If there are two occurances of the candidate in the row, the cell is conjugating
If CountRowOccurances(ChainLink.RowNbr, intCandidate) = 2 Then
ChainLink.ConjugateRowLink = GetNextChainLink(ChainLinks, RANGE_ROW, ChainLink, intCandidate)
'Set the reciprocal pointer in the conjugating cell
If ChainLink.ConjugateRowLink IsNot Nothing Then
ChainLink.ConjugateRowLink.ConjugateRowLink = ChainLink
End If
End If
End If
'Column conjugates
If ChainLink.ConjugateColLink Is Nothing Then
'If there are two occurances of the candidate in the col, the cell is conjugating
If CountColOccurances(ChainLink.ColNbr, intCandidate) = 2 Then
ChainLink.ConjugateColLink = GetNextChainLink(ChainLinks, RANGE_COL, ChainLink, intCandidate)
'Set the reciprocal pointer in the conjugating cell
If ChainLink.ConjugateColLink IsNot Nothing Then
ChainLink.ConjugateColLink.ConjugateColLink = ChainLink
End If
End If
End If
'Box conjugates
If ChainLink.ConjugateBoxLink Is Nothing Then
'If there are two occurances of the candidate in the col, the cell is conjugating
ChainLink.ConjugateBoxLink = GetNextChainLink(ChainLinks, RANGE_BOX, ChainLink, intCandidate)
'Set the reciprocal pointer in the conjugating cell
If ChainLink.ConjugateBoxLink IsNot Nothing Then
ChainLink.ConjugateBoxLink.ConjugateBoxLink = ChainLink
End If
End If
Next ChainLink
'remove the links that don't form part of any chain
For i As Integer = ChainLinks.Count - 1 To 0 Step -1
If ChainLinks(i).ConjugateRowLink Is Nothing And _
ChainLinks(i).ConjugateColLink Is Nothing Then
ChainLinks.RemoveAt(i)
End If
Next i
ChainLinks = ColorChain(ChainLinks)
'look for contradictions/collisions
HintProfiles = GetCollidingCellsHintProfiles(ChainLinks, intCandidate)
If HintProfiles IsNot Nothing Then
Return HintProfiles
End If
'look for Trapped Cells
HintProfiles = GetTrappedCellsHintProfiles(ChainLinks, intCandidate)
If HintProfiles IsNot Nothing Then
Return HintProfiles
End If
Next intCandidate
Return Nothing
End Function
|
The line that starts the coloring process is:
Code: |
ChainLinks = ColorChain(ChainLinks)
|
which looks like this:
Code: |
Private Function ColorChain(ByVal theChain As List(Of clsCellChainLink)) As List(Of clsCellChainLink)
'color the cells in the chain
Dim LinksLeftToColor = From clsCellChainLink In theChain Select clsCellChainLink _
Where clsCellChainLink.Color = UNCOLORED
Dim StartColor As Integer
Do While LinksLeftToColor.Count > 0
For Each Link As clsCellChainLink In theChain
If Link.Color = UNCOLORED Then
StartColor = GetStartingCellColor(theChain, Link)
ColorCell(theChain, Link, StartColor)
End If
Next
Loop
Return theChain
End Function
|
The routine "ColorCell" is a recursive routine that walks the list, flip-flopping it's way along until it comes to the end of a chain :
Code: |
Private Function ColorCell(ByVal theChain As List(Of clsCellChainLink), ByVal theCell As clsCellChainLink, ByVal theCellColor As Integer) As clsCellChainLink
'Recursively walk the cell chain
Dim theReciprocalColor As Integer
If theCellColor = GREEN Then
theReciprocalColor = BLUE
ElseIf theCellColor = BLUE Then
theReciprocalColor = GREEN
End If
If theCell.Color = UNCOLORED Then
theCell.Color = theCellColor
'if the reciprocal row link is already colored, ignore it
If theCell.ConjugateRowLink IsNot Nothing Then
If theCell.ConjugateRowLink.Color = UNCOLORED Then
ColorCell(theChain, theCell.ConjugateRowLink, theReciprocalColor)
End If
End If
If theCell.ConjugateColLink IsNot Nothing Then
If theCell.ConjugateColLink.Color = UNCOLORED Then
ColorCell(theChain, theCell.ConjugateColLink, theReciprocalColor)
End If
End If
If theCell.ConjugateBoxLink IsNot Nothing Then
If theCell.ConjugateBoxLink.Color = UNCOLORED Then
If theChain.Contains(theCell.ConjugateBoxLink) Then
ColorCell(theChain, theCell.ConjugateBoxLink, theReciprocalColor)
End If
End If
End If
Else
If theCell.ConjugateBoxLink IsNot Nothing Then
'if the ConjugateBoxLink cell is not in the chain, ignore it
If theChain.Contains(theCell.ConjugateBoxLink) Then
If theCell.ConjugateBoxLink.Color = UNCOLORED Then
ColorCell(theChain, theCell.ConjugateBoxLink, theReciprocalColor)
End If
End If
End If
End If
Return theCell
End Function
|
I try to find the starting color for each new chain through the "GetStartingColor" routine
Code: |
Private Function GetStartingCellColor(ByVal theChain As List(Of clsCellChainLink), ByVal theCell As clsCellChainLink) As Integer
Dim RecipBox As Integer
Dim StartingColor As Integer
Dim RecipColor As Integer
Dim BlueBoxCells = From clsCellChainLink In theChain Select clsCellChainLink _
Where clsCellChainLink.BoxNbr = theCell.BoxNbr And _
clsCellChainLink.Color = BLUE
Dim GreenBoxCells = From clsCellChainLink In theChain Select clsCellChainLink _
Where clsCellChainLink.BoxNbr = theCell.BoxNbr And _
clsCellChainLink.Color = GREEN
Dim RecipBlueBoxCells = From clsCellChainLink In theChain Select clsCellChainLink _
Where clsCellChainLink.BoxNbr = RecipBox And _
clsCellChainLink.Color = BLUE
Dim RecipGreenBoxCells = From clsCellChainLink In theChain Select clsCellChainLink _
Where clsCellChainLink.BoxNbr = RecipBox And _
clsCellChainLink.Color = GREEN
If BlueBoxCells.Count > 0 Then
StartingColor = GREEN
ElseIf GreenBoxCells.Count > 0 Then
StartingColor = BLUE
Else
StartingColor = BLUE
End If
If theCell.ConjugateRowLink IsNot Nothing Then
RecipBox = theCell.ConjugateRowLink.BoxNbr
ElseIf theCell.ConjugateColLink IsNot Nothing Then
RecipBox = theCell.ConjugateColLink.BoxNbr
ElseIf theCell.ConjugateBoxLink IsNot Nothing Then
RecipBox = theCell.ConjugateBoxLink.BoxNbr
Else
Return StartingColor
End If
If RecipBlueBoxCells.Count > 0 Then
RecipColor = GREEN
ElseIf RecipGreenBoxCells.Count > 0 Then
RecipColor = BLUE
Else
RecipColor = BLUE
End If
'We've established the color of the cell, but we have to make sure that it's recipcrocal has not already been set
'to a colliding color
GetNewCellColors(StartingColor, RecipColor, StartingColor, RecipColor)
Return StartingColor
End Function
|
and
Code: |
Private Sub GetNewCellColors(ByVal theBoxColor As Integer, ByVal theRecipColor As Integer, _
ByRef theNewCellColor As Integer, ByRef theNewRecipCellColor As Integer)
'Establish the color of the cells we're inserting based on the following truth table
'BoxColor RecipColor Box Result Recip Result
'None None Blue Green
'None Blue Blue Green
'None Green Green Blue
'None Purple Blue collision - make Green
'Blue None Green Blue
'Blue Blue Green collision - make blue
'Blue Green Green Blue
'Blue Purple Green collision - make blue
'Green None Blue Green
'Green Blue Blue Green
'Green Green Blue collision - make Green
'Green Purple Blue collision - make Green
'Purple None collision - make Blue Green
'Purple Blue collision - make Blue Green
'Purple Green collision - make Green Blue
'Purple Purple collision - make Blue collision - make Green
'None None Blue Green
If theBoxColor = UNCOLORED And theRecipColor = UNCOLORED Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'None Blue Blue Green
ElseIf theBoxColor = UNCOLORED And theRecipColor = BLUE Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'None Green Green Blue
ElseIf theBoxColor = UNCOLORED And theRecipColor = GREEN Then
theNewCellColor = GREEN
theNewRecipCellColor = BLUE
'None Purple Blue collision - make Green
ElseIf theBoxColor = UNCOLORED And theRecipColor = PURPLE Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Blue None Green Blue
ElseIf theBoxColor = BLUE And theRecipColor = UNCOLORED Then
theNewCellColor = GREEN
theNewRecipCellColor = BLUE
'Blue Blue Green collision - make blue
ElseIf theBoxColor = BLUE And theRecipColor = BLUE Then
theNewCellColor = GREEN
theNewRecipCellColor = BLUE
'Blue Green Green Blue
ElseIf theBoxColor = BLUE And theRecipColor = GREEN Then
theNewCellColor = GREEN
theNewRecipCellColor = BLUE
'Blue Purple Green collision - make blue
ElseIf theBoxColor = BLUE And theRecipColor = PURPLE Then
theNewCellColor = GREEN
theNewRecipCellColor = BLUE
'Green None Blue Green
ElseIf theBoxColor = GREEN And theRecipColor = UNCOLORED Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Green Blue Blue Green
ElseIf theBoxColor = GREEN And theRecipColor = BLUE Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Green Green Blue collision - make Green
ElseIf theBoxColor = GREEN And theRecipColor = GREEN Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Green Purple Blue collision - make Green
ElseIf theBoxColor = GREEN And theRecipColor = PURPLE Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Purple None collision - make Blue Green
ElseIf theBoxColor = PURPLE And theRecipColor = UNCOLORED Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Purple Blue collision - make Blue Green
ElseIf theBoxColor = PURPLE And theRecipColor = BLUE Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
'Purple Green collision - make Green Blue
ElseIf theBoxColor = PURPLE And theRecipColor = GREEN Then
theNewCellColor = GREEN
theNewRecipCellColor = BLUE
'Purple Purple collision - make Blue collision - make Green
ElseIf theBoxColor = PURPLE And theRecipColor = PURPLE Then
theNewCellColor = BLUE
theNewRecipCellColor = GREEN
End If
End Sub
|
This code works some of the time, but not all of the time, depending on the configuration of the cells to be colored.
Very frustrating! I think I've looked at the code too closely and aren't see in the problem anymore, or I just need to scrap it and start over. Grr!
Any help much appreciated! |
|
Back to top |
|
|
|
|
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
|
Powered by phpBB © 2001, 2005 phpBB Group
Igloo Theme Version 1.0 :: Created By: Andrew Charron
|