Sudoku solver: Difference between revisions

From Opasnet
Jump to navigation Jump to search
(→‎Formula: first step works but solution is not found)
(→‎Formula: new clearly better version that also works)
Line 186: Line 186:
=== Formula ===
=== Formula ===


<rcode>
<rcode variables="name:userdata|description:Enter sudoku as a string, with spaces in empty cells|type:text">
data <- "8          3 6      7  9  2    5    7        4 5 7      1    3    1    6 8  8 5    1  9    4  "


# Maailman vaikein


data <- data.frame(
data <- "
SudRow = rep(1:9, each = 9),
8       
SudCol = rep(1:9, times = 9),
  36   
dataResult = strsplit(data, split=" ")[[1]]
7  9 2 
)
5  7 
    457 
  1  3
  1   68
  85  1  
9   4 
"


data <- "
data <- "
Line 219: Line 225:
   3 2  6  
   3 2  6  
"
"
data <- data.frame(
 
SudRow = rep(1:9, each = 9),
data <- "
SudCol = rep(1:9, times = 9),
  45  81
dataResult = gsub(" ", "", strsplit(gsub("\n", "", data), split = "")[[1]])
  2 6 5 4
)
1  
9
89 2 45
  5  8  9
  6  2
1 7 9
35  41 
"
 
# Neljä tähteä
 
data <- "
  23 9 
    5 6
9  76  5
  6  38
4  523  7
39  4 
2  94  8
4 3   
  5 72 
"
 
if(!is.null(userdata)) data <- userdata
data


hypotheses <- data.frame(
hypotheses <- data.frame(
Line 234: Line 264:
library(OpasnetUtils)
library(OpasnetUtils)


#hypotheses <- tidy(opbase.data("Op_en5817.hypotheses"))
hypotheses <- tidy(opbase.data("Op_en5817.hypotheses"))
#for(i in 1:3) {
for(i in 1:3) {
# hypotheses[[i]] <- ifelse(hypotheses[[i]] == "", NA, as.integer(as.character(hypotheses[[i]])))
hypotheses[[i]] <- ifelse(hypotheses[[i]] == "", NA, as.integer(as.character(hypotheses[[i]])))
#}
}


#hypotheses <- unique(fillna(hypotheses, marginals = c(1, 2, 3)))
hypotheses <- unique(fillna(hypotheses, marginals = c(1, 2, 3)))
hypotheses$SudCell = as.factor(as.numeric(hypotheses$SudRow) + (as.numeric(hypotheses$SudCol) - 1) * 9)
hypotheses$SudArea = as.factor(ceiling(as.numeric(hypotheses$SudRow) / 3) + (ceiling(as.numeric(hypotheses$SudCol) / 3) - 1) * 3)
hypotheses$Result <- as.logical(hypotheses$Result)


# Get the sudoku data
# Get the sudoku data


# data <- tidy(opbase.data("Op_en5817.sudoku"), objname="data")
# data <- tidy(opbase.data("Op_en5817.sudoku"), objname="data")
# data$SudRow <- as.numeric(data$SudRow)
# data$SudCol <- as.numeric(data$SudCol)


out <- merge(hypotheses, data)
SudMake <- function(hypotheses, data) {
out$dataResult <- as.character(out$dataResult)
 
out$Result <- ifelse(out$dataResult == "", out$Result, (as.character(out$dataResult) == as.character(out$Hypothesis)))
hypotheses$SudRow <- as.numeric(hypotheses$SudRow)
hypotheses$SudCol <- as.numeric(hypotheses$SudCol)
hypotheses$SudCell = hypotheses$SudRow + (hypotheses$SudCol - 1) * 9
hypotheses$SudArea = ceiling(hypotheses$SudRow / 3) + (ceiling(hypotheses$SudCol / 3) - 1) * 3
hypotheses$Result <- as.logical(hypotheses$Result)
 
data <- data.frame(
SudRow = rep(1:9, each = 9),
SudCol = rep(1:9, times = 9),
dataResult = gsub(" ", "", strsplit(gsub("\n", "", data), split = "")[[1]])
)
 
# oprint(tapply(data["Hypothesis"], data[c("SudRow", "SudCol")], function(x) paste(x, sep = "", collapse = "")))
 
out <- merge(hypotheses, data)
out$dataResult <- as.character(out$dataResult)
out$Result <- ifelse(out$dataResult == "", out$Result, (as.character(out$dataResult) == as.character(out$Hypothesis)))
return(out)
}


SudSolve <- function(sudoku) {
SudSolve <- function(sudoku) {


temp <- sudoku["Result"]
ykköskarsinta <- function(out2, condition) {
for(m in 1:nrow(sudoku)) {
 
a <- sudoku[m , ]
valinta <- as.data.frame(as.table(tapply(out2$Result, out2[c("Hypothesis", condition)], sum) == 1)) # haetaan ehto-hypoteesikombinaatiot
if(a$Result) {
valinta <- valinta[valinta$Freq, colnames(valinta) != "Freq"] # rajataan ainoisiin ratkaisuihin
temp[[m]] <- ifelse(a$SudRow == sudoku$SudRow & a$Hypothesis == sudoku$Hypothesis, FALSE, sudoku$Result)
valinta <- merge(valinta, out2) # yhdistetään SudCell-tietoon
temp[[m]] <- ifelse(a$SudCol == sudoku$SudCol & a$Hypothesis == sudoku$Hypothesis, FALSE, temp[[m]])
valinta <- valinta[valinta$Result , ] # poistetaan turhat
temp[[m]] <- ifelse(a$SudArea == sudoku$SudArea & a$Hypothesis == sudoku$Hypothesis, FALSE, temp[[m]])
out2[out2$SudCell %in% valinta$SudCell , ]$Result <- FALSE #hylätään aluksi kaikki hypoteesit ykkösruuduista
} else {
out2[paste(out2$Hypothesis, out2$SudCell) %in% paste(valinta$Hypothesis, valinta$SudCell) , ]$Result <- TRUE # palautetaan oikea vastaus ykkösruutuihin
temp[[m]] <- FALSE
return(out2)
}
temp[[m]] <- ifelse(a$SudCell == sudoku$SudCell, NA, temp[[m]])
}
}


temp2 <- data.frame(Result = rep(NA, 9^2))
# temp <- sudoku["Result"]
temp3 <- rep(NA, 9^3)
# for(m in 1:nrow(sudoku)) {
# a <- sudoku[m , ]
# if(a$Result) {
# temp[[m]] <- ifelse(a$SudRow == sudoku$SudRow & a$Hypothesis == sudoku$Hypothesis, FALSE, sudoku$Result)
# temp[[m]] <- ifelse(a$SudCol == sudoku$SudCol & a$Hypothesis == sudoku$Hypothesis, FALSE, temp[[m]])
# temp[[m]] <- ifelse(a$SudArea == sudoku$SudArea & a$Hypothesis == sudoku$Hypothesis, FALSE, temp[[m]])
# } else {
# temp[[m]] <- FALSE
# }
# temp[[m]] <- ifelse(a$SudCell == sudoku$SudCell, NA, temp[[m]])
# }
 
for(i in 1:5) {
samerow <- matrix(sudoku$SudRow, nrow = nrow(sudoku), ncol = nrow(sudoku))
samerow <- samerow == t(samerow)
 
samecol <- matrix(sudoku$SudCol, nrow = nrow(sudoku), ncol = nrow(sudoku))
samecol <- samecol == t(samecol)
 
samearea <- matrix(sudoku$SudArea, nrow = nrow(sudoku), ncol = nrow(sudoku))
samearea <- samearea == t(samearea)
 
samehypo <- matrix(sudoku$Hypothesis, nrow = nrow(sudoku), ncol = nrow(sudoku))
samehypo <- samehypo == t(samehypo)
 
samecell <- matrix(sudoku$SudCell, nrow = nrow(sudoku), ncol = nrow(sudoku))
samecell <- samecell == t(samecell)
 
rule1 <- ! (samerow & samehypo)
rule2 <- ! (samecol & samehypo)
rule3 <- ! (samearea & samehypo)
# rule4 <- ifelse(samecell, NA, TRUE)
 
temp <- sudoku$Result & rule1 & rule2 & rule3 #& rule4
temp <- ifelse(samecell, NA, temp) # Tämän säännön täytyy ajaa yli kaikkien muiden.
 
# temp2 <- data.frame(Result = rep(NA, 9^2))
# temp3 <- rep(NA, 9^3)
# temp <- as.data.frame(temp)
# for(m in 1:nrow(sudoku)) {temp2[m] <- tapply(temp[[m]], sudoku$SudCell, any)}


for(m in 1:nrow(sudoku)) {temp2[m] <- tapply(temp[[m]], sudoku$SudCell, any)}
temp2 <- apply(temp, 2, function(x) tapply(x, sudoku$SudCell, any))
for(n in 1:nrow(sudoku)) {
 
temp2[[n]] <- ifelse(is.na(temp2[[n]]), TRUE, temp2[[n]])
# for(n in 1:nrow(sudoku)) {
temp3[n] <- all(temp2[[n]])
# temp2[[n]] <- ifelse(is.na(temp2[[n]]), TRUE, temp2[[n]])
# temp3[n] <- all(temp2[[n]])
# }
 
temp3 <- apply(temp2, 2, function(x) {
x <- ifelse(is.na(x), TRUE, x)
return(all(x))
})
 
sudoku$Result <- ifelse(sudoku$Result, temp3, sudoku$Result)
sudoku <- ykköskarsinta(sudoku, "SudCol")
sudoku <- ykköskarsinta(sudoku, "SudRow")
sudoku <- ykköskarsinta(sudoku, "SudArea")
}
}
sudoku$Result <- temp3
return(sudoku)
return(sudoku)
}
}
Line 294: Line 392:
}
}


oprint(SudShow(out))
oprint(SudShow(SudSolve(SudMake(hypotheses, data))))
out2 <- SudSolve(out)
oprint(SudShow(out2))
 
#    ah and bh are sub-vectors of A in such a way that ah = Ah,m and bh = Ah,n, where m and n (m < n) are values from index l.
 
 
#    Compare two cells a and b in the sudoku. Make a for-loop for the first cell a: for(m in 1:nrow(l))).
#        Make another for-loop for the second cell b: for(n in (m+1):nrow(l)).
#            Make a third for-loop for the hypotheses of a: for(h in 1:nrow(a))
#                Make a fourth for-loop for the rules: for(r in 1:nrow(rules)).
#                    Test for the rule with the pair of cells, creating a set of plausible hypothesis for the other cell b conditional on the first cell a.
#                    If the set of plausible hypotheses for b is empty, the condition is implausible; remove the condition and thus that hypothesis from the first cell a.
#                    Take the union of plausible hypothesis for b (which then covers all plausible hypotheses unconditionally) and replace the current hypotheses of b with the new hypotheses.
#            Do the third for-loop again but now with the other cell b.
#    Do the second and first loops for all values of m and n.
#    Do another set of loops for each row, column, and area to test whether there is exactly one cell where each hypothesis is plausible. (Remember, that in sudoku, unlike in most parts of the world, we know that each hypothesis is correct at exactly one cell). If a unique cell is found, remove all other hypotheses from that cell.
#        Make a loop for each row and then hypothesis.
#        Make a loop for each column and then hypothesis.
#        Make a loop for each area and then hypothesis.
#    If a unique solution was not found and if the current set of hypotheses is not the same as the previous set, save the current set as "previous set" and go to number 2.
#    Calculate the number of different solutions still plausible and print it.
#    If the number is smaller than 100, print also the solutions.
 


</rcode>
</rcode>
{{attack|# |Not all the loops are needed. One row can be compared to all rows simultaneously, and then plausible hypotheses can be searched for using tapply.|--[[User:Jouni|Jouni]] 23:57, 2 May 2013 (EEST)}}


==See also==
==See also==

Revision as of 07:52, 5 May 2013



Question

How to describe a sudoku and the sudoku rules in Opasnet so that it can be solved automatically?

Answer

You need the following tables.

Hypotheses
Row Column Result Description
All All 1,2,3,4,5,6,7,8,9 For all row and column locations it applies that the plausible hypotheses are a single integer between 1 and 9 (unless more information is available).


Area descriptions
Row Column Area
1 1 A
1 2 A
1 3 A
1 4 B
2 1 A
4 1 D
9 9 I


Rules of exclusion when comparing two cells.
Property1 Condition1 Property2 Condition2 Rule Description
Row Same Column Different Same integer not allowed Two cells with the same row and different column are not allowed to have the same integer.
Row Different Column Same Same integer not allowed Two cells with the different row and same column are not allowed to have the same integer.
Area Same Column Different Same integer not allowed Two cells with the same area and different column are not allowed to have the same integer.
Area Same Row Different Same integer not allowed Two cells with the same area and different row are not allowed to have the same integer.
The sudoku data (this example is "the most difficult sudoku in the world")
Row Column
1 2 3 4 5 6 7 8 9
1 8
2 3 6
3 7 9 2
4 5 7
5 4 5 7
6 1 3
7 1 6 8
8 8 5 1
9 9 4

Procedure

The following terms are used:

  • The possible space of solutions is described by a logical vector A, which contains all possible values given the current information. A is indexed by h, i, j, k, and l. A develops in time, when more information occurs or is processed. In the beginning, all hypotheses are considered as potentially TRUE.
  • h = {1, 2, ..., 9}, i = {1, 2, ..., 9}, j = {1, 2, ..., 9}, k = {1, 2, ..., 9}, l = {1, 2, ..., 81} are indices for hypothesis, row, column, area, and cell, respectively. Note l is just another way to say (i,j), as l = i + (j-1)*9. Also, k is known if (i,j) is known, as k = ceiling(i/3) + (ceiling(j/3)-1)*3. However, k does not contain all information that (i,j) or l contains.
  • ah and bh are sub-vectors of A in such a way that ah = Ah,m and bh = Ah,n, where m and n (m < n) are values from index l.


  1. Expand the missing index values of the Hypotheses table to create the full A.
  2. Take the sudoku data table and replace hypotheses with data, if available.
  3. Compare two cells a and b in the sudoku. Make a for-loop for the first cell a: for(m in 1:nrow(l))).
    1. Make another for-loop for the second cell b: for(n in (m+1):nrow(l)).
      1. Make a third for-loop for the hypotheses of a: for(h in 1:nrow(a))
        1. Make a fourth for-loop for the rules: for(r in 1:nrow(rules)).
          1. Test for the rule with the pair of cells, creating a set of plausible hypothesis for the other cell b conditional on the first cell a.
          2. If the set of plausible hypotheses for b is empty, the condition is implausible; remove the condition and thus that hypothesis from the first cell a.
          3. Take the union of plausible hypothesis for b (which then covers all plausible hypotheses unconditionally) and replace the current hypotheses of b with the new hypotheses.
      2. Do the third for-loop again but now with the other cell b.
  4. Do the second and first loops for all values of m and n.
  5. Do another set of loops for each row, column, and area to test whether there is exactly one cell where each hypothesis is plausible. (Remember, that in sudoku, unlike in most parts of the world, we know that each hypothesis is correct at exactly one cell). If a unique cell is found, remove all other hypotheses from that cell.
    1. Make a loop for each row and then hypothesis.
    2. Make a loop for each column and then hypothesis.
    3. Make a loop for each area and then hypothesis.
  6. If a unique solution was not found and if the current set of hypotheses is not the same as the previous set, save the current set as "previous set" and go to number 2.
  7. Calculate the number of different solutions still plausible and print it.
  8. If the number is smaller than 100, print also the solutions.

Rationale

Data

This table will be expanded by fillna to be a 9*9*9 array (formatted as data.frame). As default, each hypothesis is assumed to be true unless shown otherwise.

Hypotheses(Boolean)
ObsSudRowSudColHypothesisResult
11TRUE
22TRUE
33TRUE
44TRUE
55TRUE
66TRUE
77TRUE
88TRUE
99TRUE
101TRUE
112TRUE
123TRUE
134TRUE
145TRUE
156TRUE
167TRUE
178TRUE
189TRUE
191TRUE
202TRUE
213TRUE
224TRUE
235TRUE
246TRUE
257TRUE
268TRUE
279TRUE
Sudoku data
Sudoku(-)
ObsSudRow123456789
118
2236
33792
4457
55457
6613
77168
88851
9994

Formula

Enter sudoku as a string, with spaces in empty cells:

+ Show code

See also

Keywords

References


Related files

<mfanonymousfilelist></mfanonymousfilelist>