Skip to content

Instantly share code, notes, and snippets.

@righ1113
Last active July 5, 2023 19:56
Show Gist options
  • Save righ1113/79f075202dd8691688c42a58d865a9fa to your computer and use it in GitHub Desktop.
Save righ1113/79f075202dd8691688c42a58d865a9fa to your computer and use it in GitHub Desktop.
数独 in Egison
;; > egison -N
;; > loadFile("sudoku-N.egi")
def parse(str) = map(read, map(1#pack([%1]),
match S.replace(".", "0", str) as string
| loop($i, (1, 81, _), <cons $x_i ...>, <nil>) -> map(($i -> x_i), 1..81) ))
;; checkHintPattern
def chp(n, str) = let hintValue = nth(n, parse(str)) in
if hintValue == 0 then patternFunction([pat], 'pat)
else patternFunction([pat], ('pat and hintValue))
def sumDigit?(a, b, c, d, e, f, g, h, i) = +(a, b, c, d, e, f, g, h, i) == 45
def solveSudoku(str) =
match [1..9, 1..9, 1..9, 1..9, 1..9, 1..9, 1..9, 1..9, 1..9] as list(multiset(integer))
| (chp( 1, str)[$x11] <:> chp( 2, str)[$x12] <:> chp( 3, str)[$x13] <:> chp( 4, str)[$x14] <:> chp( 5, str)[$x15] <:> chp( 6, str)[$x16] <:> chp( 7, str)[$x17] <:> chp( 8, str)[$x18] <:> chp( 9, str)[$x19] <:> <nil>) <:>
(chp(10, str)[$x21] <:> chp(11, str)[$x22] <:> chp(12, str)[$x23] <:> chp(13, str)[$x24] <:> chp(14, str)[$x25] <:> chp(15, str)[$x26] <:> chp(16, str)[$x27] <:> chp(17, str)[$x28] <:> chp(18, str)[$x29] <:> <nil>) <:>
(chp(19, str)[$x31] <:> chp(20, str)[$x32] <:> (?sumDigit?(x11, x12, x13, x21, x22, x23, x31, x32, $) and chp(21, str)[$x33]) <:>
chp(22, str)[$x34] <:> chp(23, str)[$x35] <:> (?sumDigit?(x14, x15, x16, x24, x25, x26, x34, x35, $) and chp(24, str)[$x36]) <:>
chp(25, str)[$x37] <:> chp(26, str)[$x38] <:> (?sumDigit?(x17, x18, x19, x27, x28, x29, x37, x38, $) and chp(27, str)[$x39]) <:> <nil>) <:>
(chp(28, str)[$x41] <:> chp(29, str)[$x42] <:> chp(30, str)[$x43] <:> chp(31, str)[$x44] <:> chp(32, str)[$x45] <:> chp(33, str)[$x46] <:> chp(34, str)[$x47] <:> chp(35, str)[$x48] <:> chp(36, str)[$x49] <:> <nil>) <:>
(chp(37, str)[$x51] <:> chp(38, str)[$x52] <:> chp(39, str)[$x53] <:> chp(40, str)[$x54] <:> chp(41, str)[$x55] <:> chp(42, str)[$x56] <:> chp(43, str)[$x57] <:> chp(44, str)[$x58] <:> chp(45, str)[$x59] <:> <nil>) <:>
(chp(46, str)[$x61] <:> chp(47, str)[$x62] <:> (?sumDigit?(x41, x42, x43, x51, x52, x53, x61, x62, $) and chp(48, str)[$x63]) <:>
chp(49, str)[$x64] <:> chp(50, str)[$x65] <:> (?sumDigit?(x44, x45, x46, x54, x55, x56, x64, x65, $) and chp(51, str)[$x66]) <:>
chp(52, str)[$x67] <:> chp(53, str)[$x68] <:> (?sumDigit?(x47, x48, x49, x57, x58, x59, x67, x68, $) and chp(54, str)[$x69]) <:> <nil>) <:>
(chp(55, str)[$x71] <:> chp(56, str)[$x72] <:> chp(57, str)[$x73] <:> chp(58, str)[$x74] <:> chp(59, str)[$x75] <:> chp(60, str)[$x76] <:> chp(61, str)[$x77] <:> chp(62, str)[$x78] <:> chp(63, str)[$x79] <:> <nil>) <:>
(chp(64, str)[$x81] <:> chp(65, str)[$x82] <:> chp(66, str)[$x83] <:> chp(67, str)[$x84] <:> chp(68, str)[$x85] <:> chp(69, str)[$x86] <:> chp(70, str)[$x87] <:> chp(71, str)[$x88] <:> chp(72, str)[$x89] <:> <nil>) <:>
((?sumDigit?(x11, x21, x31, x41, x51, x61, x71, x81, $) and chp(73, str)[$x91]) <:>
(?sumDigit?(x12, x22, x32, x42, x52, x62, x72, x82, $) and chp(74, str)[$x92]) <:>
(?sumDigit?(x13, x23, x33, x43, x53, x63, x73, x83, $) and ?sumDigit?(x71, x72, x73, x81, x82, x83, x91, x92, $) and chp(75, str)[$x93]) <:>
(?sumDigit?(x14, x24, x34, x44, x54, x64, x74, x84, $) and chp(76, str)[$x94]) <:>
(?sumDigit?(x15, x25, x35, x45, x55, x65, x75, x85, $) and chp(77, str)[$x95]) <:>
(?sumDigit?(x16, x26, x36, x46, x56, x66, x76, x86, $) and ?sumDigit?(x74, x75, x76, x84, x85, x86, x94, x95, $) and chp(78, str)[$x96]) <:>
(?sumDigit?(x17, x27, x37, x47, x57, x67, x77, x87, $) and chp(79, str)[$x97]) <:>
(?sumDigit?(x18, x28, x38, x48, x58, x68, x78, x88, $) and chp(80, str)[$x98]) <:>
(?sumDigit?(x19, x29, x39, x49, x59, x69, x79, x89, $) and ?sumDigit?(x77, x78, x79, x87, x88, x89, x97, x98, $) and chp(81, str)[$x99]) <:> <nil>) <:> <nil>
-> [[x11, x12, x13, x14, x15, x16, x17, x18, x19],
[x21, x22, x23, x24, x25, x26, x27, x28, x29],
[x31, x32, x33, x34, x35, x36, x37, x38, x39],
[x41, x42, x43, x44, x45, x46, x47, x48, x49],
[x51, x52, x53, x54, x55, x56, x57, x58, x59],
[x61, x62, x63, x64, x65, x66, x67, x68, x69],
[x71, x72, x73, x74, x75, x76, x77, x78, x79],
[x81, x82, x83, x84, x85, x86, x87, x88, x89],
[x91, x92, x93, x94, x95, x96, x97, x98, x99]]
;; > egison -N sudoku-N.egi
def main(args) = print(show(
;; solveSudoku("859612437723854169164379528986147352375268914241593786432981675617425893598736241") ))
;; 15個の空白に対して、約2分・使用メモリ2Gで解ける。ここが限界。
solveSudoku("859612437723854169164379528986147352375268914241593786432981675617...............") ))
;;解けない solveSudoku("6..2....1.8.9.4.2...9.1.3...9.8.1.35..3...7..45.3.7.6...7.4.2...6.7.9.1.9....2..3") ))
;;解けない solveSudoku("..53.....8......2..7..1.5..4....53...1..7...6..32...8..6.5....9..4....3......97..") ))
;; > egison -N
;; > loadFile("sudoku2-N.egi")
def parse(str) = map(read, map(1#pack([%1]),
match S.replace(".", "0", str) as string
| loop($i, (1, 81, _), <cons $x_i ...>, <nil>) -> map(($i -> x_i), 1..81) ))
;; checkHintPattern
def chp(n, str) = let hintValue = nth(n, parse(str)) in
if hintValue == 0 then patternFunction([pat], 'pat)
else patternFunction([pat], ('pat and hintValue))
def sumDigit?(a, b, c, d, e, f, g, h, i) = +(a, b, c, d, e, f, g, h, i) == 45
def widthAnswer(y, str) =
matchAll 1..9 as multiset(integer)
| loop($i, (1, 9, _), <cons chp(9*(y-1)+i, str)[$x_i] ...>, <nil>) -> map(($i -> x_i), 1..9)
def solveSudoku(str) =
match [widthAnswer(1, str),
widthAnswer(2, str),
widthAnswer(3, str),
widthAnswer(4, str),
widthAnswer(5, str),
widthAnswer(6, str),
widthAnswer(7, str),
widthAnswer(8, str),
widthAnswer(9, str)] as list(list(list(integer)))
| (_ <++> (($x11 <:> $x12 <:> $x13 <:> $x14 <:> $x15 <:> $x16 <:> $x17 <:> $x18 <:> $x19 <:> <nil>) <:> _)) <:>
(_ <++> (($x21 <:> $x22 <:> $x23 <:> $x24 <:> $x25 <:> $x26 <:> $x27 <:> $x28 <:> $x29 <:> <nil>) <:> _)) <:>
(_ <++> (($x31 <:> $x32 <:> (?sumDigit?(x11, x12, x13, x21, x22, x23, x31, x32, $) and $x33) <:>
$x34 <:> $x35 <:> (?sumDigit?(x14, x15, x16, x24, x25, x26, x34, x35, $) and $x36) <:>
$x37 <:> $x38 <:> (?sumDigit?(x17, x18, x19, x27, x28, x29, x37, x38, $) and $x39) <:> <nil>) <:> _)) <:>
(_ <++> (($x41 <:> $x42 <:> $x43 <:> $x44 <:> $x45 <:> $x46 <:> $x47 <:> $x48 <:> $x49 <:> <nil>) <:> _)) <:>
(_ <++> (($x51 <:> $x52 <:> $x53 <:> $x54 <:> $x55 <:> $x56 <:> $x57 <:> $x58 <:> $x59 <:> <nil>) <:> _)) <:>
(_ <++> (($x61 <:> $x62 <:> (?sumDigit?(x41, x42, x43, x51, x52, x53, x61, x62, $) and $x63) <:>
$x64 <:> $x65 <:> (?sumDigit?(x44, x45, x46, x54, x55, x56, x64, x65, $) and $x66) <:>
$x67 <:> $x68 <:> (?sumDigit?(x47, x48, x49, x57, x58, x59, x67, x68, $) and $x69) <:> <nil>) <:> _)) <:>
(_ <++> (($x71 <:> $x72 <:> $x73 <:> $x74 <:> $x75 <:> $x76 <:> $x77 <:> $x78 <:> $x79 <:> <nil>) <:> _)) <:>
(_ <++> (($x81 <:> $x82 <:> $x83 <:> $x84 <:> $x85 <:> $x86 <:> $x87 <:> $x88 <:> $x89 <:> <nil>) <:> _)) <:>
(_ <++> (((?sumDigit?(x11, x21, x31, x41, x51, x61, x71, x81, $) and $x91) <:>
(?sumDigit?(x12, x22, x32, x42, x52, x62, x72, x82, $) and $x92) <:>
(?sumDigit?(x13, x23, x33, x43, x53, x63, x73, x83, $) and ?sumDigit?(x71, x72, x73, x81, x82, x83, x91, x92, $) and $x93) <:>
(?sumDigit?(x14, x24, x34, x44, x54, x64, x74, x84, $) and $x94) <:>
(?sumDigit?(x15, x25, x35, x45, x55, x65, x75, x85, $) and $x95) <:>
(?sumDigit?(x16, x26, x36, x46, x56, x66, x76, x86, $) and ?sumDigit?(x74, x75, x76, x84, x85, x86, x94, x95, $) and $x96) <:>
(?sumDigit?(x17, x27, x37, x47, x57, x67, x77, x87, $) and $x97) <:>
(?sumDigit?(x18, x28, x38, x48, x58, x68, x78, x88, $) and $x98) <:>
(?sumDigit?(x19, x29, x39, x49, x59, x69, x79, x89, $) and ?sumDigit?(x77, x78, x79, x87, x88, x89, x97, x98, $) and $x99) <:> <nil>) <:> _)) <:> <nil>
-> [[x11, x12, x13, x14, x15, x16, x17, x18, x19],
[x21, x22, x23, x24, x25, x26, x27, x28, x29],
[x31, x32, x33, x34, x35, x36, x37, x38, x39],
[x41, x42, x43, x44, x45, x46, x47, x48, x49],
[x51, x52, x53, x54, x55, x56, x57, x58, x59],
[x61, x62, x63, x64, x65, x66, x67, x68, x69],
[x71, x72, x73, x74, x75, x76, x77, x78, x79],
[x81, x82, x83, x84, x85, x86, x87, x88, x89],
[x91, x92, x93, x94, x95, x96, x97, x98, x99]]
;; > egison -N sudoku2-N.egi
def main(args) = print(show(
;; solveSudoku("859612437723854169164379528986147352375268914241593786432981675617425893598736241") ))
;; 解けなくなった。(悪化してる)
;; solveSudoku("859612437723854169164379528986147352375268914241593786432981675617425893.........") ))
;; これなら解ける
solveSudoku("85961243.72385416.16437952.98614735.37526891.24159378.43298167.61742589.59873624.") ))
;;1h/5Gでギブ solveSudoku("6..2....1.8.9.4.2...9.1.3...9.8.1.35..3...7..45.3.7.6...7.4.2...6.7.9.1.9....2..3") ))
;;解けない solveSudoku("..53.....8......2..7..1.5..4....53...1..7...6..32...8..6.5....9..4....3......97..") ))
;; > egison -N
;; > loadFile("sudoku4-N.egi")
;; 4*4 sudoku mini
def parse(size, str) = map(read, map(1#pack([%1]),
match S.replace(".", "0", str) as string
| loop($i, (1, size, _), <cons $x_i ...>, <nil>) -> map(($i -> x_i), 1..size) ))
def chpMini(n, str) = let hintValue = nth(n, parse(16, str)) in
if hintValue == 0 then patternFunction([pat], 'pat)
else patternFunction([pat], ('pat and hintValue))
def sumDigitMini?(a, b, c, d) = +(a, b, c, d) == 10
def widthAnswerMini(y, str) =
matchAll 1..4 as multiset(integer)
| loop($i, (1, 4, _), <cons chpMini(4*(y-1)+i, str)[$x_i] ...>, <nil>) -> map(($i -> x_i), 1..4)
def solveSudoku1Mini(str) =
matchAll [1..4, 1..4, 1..4, 1..4] as list(multiset(integer))
| ($x11 <:> $x12 <:> $x13 <:> $x14 <:> <nil>) <:>
($x21 <:> (?sumDigitMini?(x11, x12, x21, $) and $x22) <:>
$x23 <:> (?sumDigitMini?(x13, x14, x23, $) and $x24) <:> <nil>) <:>
($x31 <:>
$x32 <:>
$x33 <:>
$x34 <:> <nil>) <:>
($x41 <:>
(?sumDigitMini?(x31, x32, x41, $) and $x42) <:>
($x43) <:>
(?sumDigitMini?(x33, x34, x43, $) and $x44) <:> <nil>) <:> <nil>
-> [[x11, x12, x13, x14],
[x21, x22, x23, x24],
[x31, x32, x33, x34],
[x41, x42, x43, x44]]
def solveSudoku2Mini(str) =
matchAll [widthAnswerMini(1, str),
widthAnswerMini(2, str),
widthAnswerMini(3, str),
widthAnswerMini(4, str)] as list(list(list(integer)))
| ((_ <++> (($x11 <:> $x12 <:> $x13 <:> $x14 <:> <nil>) <:> _)) <:>
(_ <++> (((!x11 and $x21) <:> (?sumDigitMini?(x11, x12, x21, $) and $x22) <:>
(!x13 and $x23) <:> (?sumDigitMini?(x13, x14, x23, $) and $x24) <:> <nil>) <:> _)) <:>
(_ <++> (((!x11 and !x21 and $x31) <:>
$x32 <:>
(!x13 and !x23 and $x33) <:>
$x34 <:> <nil>) <:> _)) <:>
(_ <++> ( ($x41) <:>
(?sumDigitMini?(x31, x32, x41, $) and $x42) <:>
($x43) <:>
(?sumDigitMini?(x33, x34, x43, $) and $x44) <:> <nil>) <:> _) <:> <nil> )
-> [[x11, x12, x13, x14],
[x21, x22, x23, x24],
[x31, x32, x33, x34],
[x41, x42, x43, x44]]
;; > egison -N sudoku4-N.egi
def main(args) = print(show(
;; solveSudokuMini("1...43.121.3.412") ))
;;解候補2つ solveSudoku2Mini("1...43.1...3.4..") ))
;;解候補いっぱい
solveSudoku2Mini("..3...2.....34..") ))
;; > egison -N
;; > loadFile("sudoku5-N.egi")
;; 4*4 sudoku mini
pMW = 1..16 ;; width
pMH = [1, 5, 9, 13, 2, 6, 10, 14, 3, 7, 11, 15, 4, 8, 12, 16] ;; height
pMB = [1, 2, 5, 6, 3, 4, 7, 8, 9, 10, 13, 14, 11, 12, 15, 16] ;; block
def parseMini(str, colle) = map(read, map(1#pack([%1]),
match S.replace(".", "0", str) as string
| loop($i, (1, 16, _), <cons $x_i ...>, <nil>) -> map(($i -> x_i), colle) ))
def chpMini(n, str, colle) = let hintValue = nth(n, parseMini(str, colle)) in
if hintValue == 0 then patternFunction([pat], 'pat)
else patternFunction([pat], ('pat and hintValue))
def lineMini(y, str, colle) =
matchAll 1..4 as multiset(integer)
| loop($i, (1, 4, _), <cons chpMini(4*(y-1)+i, str, colle)[$x_i] ...>, <nil>) -> map(($i -> x_i), 1..4)
def CandidateMiniWidth(str) =
matchAll [lineMini(1, str, pMW),
lineMini(2, str, pMW),
lineMini(3, str, pMW),
lineMini(4, str, pMW)] as list(list(list(integer)))
| ((_ <++> (($x11 <:> $x12 <:> $x13 <:> $x14 <:> <nil>) <:> _)) <:>
(_ <++> (($x21 <:> $x22 <:> $x23 <:> $x24 <:> <nil>) <:> _)) <:>
(_ <++> (($x31 <:> $x32 <:> $x33 <:> $x34 <:> <nil>) <:> _)) <:>
(_ <++> (($x41 <:> $x42 <:> $x43 <:> $x44 <:> <nil>) <:> _)) <:> <nil> )
-> [[x11, x12, x13, x14],
[x21, x22, x23, x24],
[x31, x32, x33, x34],
[x41, x42, x43, x44]]
def CandidateMiniHeight(str) =
matchAll [lineMini(1, str, pMH),
lineMini(2, str, pMH),
lineMini(3, str, pMH),
lineMini(4, str, pMH)] as list(list(list(integer)))
| ((_ <++> (($x11 <:> $x12 <:> $x13 <:> $x14 <:> <nil>) <:> _)) <:>
(_ <++> (($x21 <:> $x22 <:> $x23 <:> $x24 <:> <nil>) <:> _)) <:>
(_ <++> (($x31 <:> $x32 <:> $x33 <:> $x34 <:> <nil>) <:> _)) <:>
(_ <++> (($x41 <:> $x42 <:> $x43 <:> $x44 <:> <nil>) <:> _)) <:> <nil> )
-> [[x11, x21, x31, x41],
[x12, x22, x32, x42],
[x13, x23, x33, x43],
[x14, x24, x34, x44]]
def CandidateMiniBlock(str) =
matchAll [lineMini(1, str, pMB),
lineMini(2, str, pMB),
lineMini(3, str, pMB),
lineMini(4, str, pMB)] as list(list(list(integer)))
| ((_ <++> (($x11 <:> $x12 <:> $x13 <:> $x14 <:> <nil>) <:> _)) <:>
(_ <++> (($x21 <:> $x22 <:> $x23 <:> $x24 <:> <nil>) <:> _)) <:>
(_ <++> (($x31 <:> $x32 <:> $x33 <:> $x34 <:> <nil>) <:> _)) <:>
(_ <++> (($x41 <:> $x42 <:> $x43 <:> $x44 <:> <nil>) <:> _)) <:> <nil> )
-> [[x11, x12, x21, x22],
[x13, x14, x23, x24],
[x31, x32, x41, x42],
[x33, x34, x43, x44]]
def answerMini(str) = intersect(intersect(CandidateMiniWidth(str), CandidateMiniHeight(str)), CandidateMiniBlock(str))
;; そもそもアルゴリズムに不備があるのか......
;; ->【二つ目は、解が複数ある問題でした。】
;; > answerMini("1...43.121.3.412")
;; {{{1 2 3 4} {4 3 2 1} {2 1 4 3} {3 4 1 2}}}
;; > answerMini("..3...2.....34..")
;; {{{1 2 3 4} {4 3 2 1} {2 1 4 3} {3 4 1 2}} {{2 1 3 4} {4 3 2 1} {1 2 4 3} {3 4 1 2}} {{4 2 3 1} {1 3 2 4} {2 1 4 3} {3 4 1 2}}}
-- Egison Version == 3.10.3
-- $ egison -N
-- > loadFile "sudoku6.egins"
-- 4*4 sudoku mini
--
-- Utils
--
pMW := [1..16] -- width
pMH := [1, 5, 9, 13, 2, 6, 10, 14, 3, 7, 11, 15, 4, 8, 12, 16] -- height
pMB := [1, 2, 5, 6, 3, 4, 7, 8, 9, 10, 13, 14, 11, 12, 15, 16] -- block
parseMini str colle :=
map read
(map 1#(pack [%1])
(match S.replace(".", "0", str) as string with
| loop $i (1, 16) ($x_i :: ...) [] -> map (\i -> x_i) colle) )
-- pattern function
chpMini n str colle :=
let hintValue := nth n (parseMini str colle) in
if hintValue = 0 then \pat => ~pat
else \pat => (~pat & #hintValue)
lineMini y str colle :=
matchAll [1..4] as multiset integer with
| loop $i (1, 4) ( (chpMini (4*(y-1)+i) str colle) $x_i :: ...) [] -> map (\i -> x_i) [1..4]
-- pattern function
defPatt :=
\x11 x12 x13 x14 x21 x22 x23 x24 x31 x32 x33 x34 x41 x42 x43 x44 =>
( (_ ++ ((~x11 :: ~x12 :: ~x13 :: ~x14 :: []) :: _)) ::
(_ ++ ((~x21 :: ~x22 :: ~x23 :: ~x24 :: []) :: _)) ::
(_ ++ ((~x31 :: ~x32 :: ~x33 :: ~x34 :: []) :: _)) ::
(_ ++ ((~x41 :: ~x42 :: ~x43 :: ~x44 :: []) :: _)) :: [] )
--
-- Codes
--
candidateMiniWidth str :=
matchAll [lineMini 1 str pMW,
lineMini 2 str pMW,
lineMini 3 str pMW,
lineMini 4 str pMW] as list (list (list integer)) with
| defPatt $x11 $x12 $x13 $x14 $x21 $x22 $x23 $x24 $x31 $x32 $x33 $x34 $x41 $x42 $x43 $x44 ->
[[x11, x12, x13, x14],
[x21, x22, x23, x24],
[x31, x32, x33, x34],
[x41, x42, x43, x44]]
candidateMiniHeight str :=
matchAll [lineMini 1 str pMH,
lineMini 2 str pMH,
lineMini 3 str pMH,
lineMini 4 str pMH] as list (list (list integer)) with
| defPatt $x11 $x12 $x13 $x14 $x21 $x22 $x23 $x24 $x31 $x32 $x33 $x34 $x41 $x42 $x43 $x44 ->
[[x11, x21, x31, x41],
[x12, x22, x32, x42],
[x13, x23, x33, x43],
[x14, x24, x34, x44]]
candidateMiniBlock str :=
matchAll [lineMini 1 str pMB,
lineMini 2 str pMB,
lineMini 3 str pMB,
lineMini 4 str pMB] as list (list (list integer)) with
| defPatt $x11 $x12 $x13 $x14 $x21 $x22 $x23 $x24 $x31 $x32 $x33 $x34 $x41 $x42 $x43 $x44 ->
[[x11, x12, x21, x22],
[x13, x14, x23, x24],
[x31, x32, x41, x42],
[x33, x34, x43, x44]]
answerMini str :=
intersect (intersect (candidateMiniWidth str) (candidateMiniHeight str)) (candidateMiniBlock str)
--
-- Tests
--
-- $ egison -N -t sudoku6.egins
assertEqual "answer1"
(answerMini "1...43.121.3.412")
[[[1, 2, 3, 4], [4, 3, 2, 1], [2, 1, 4, 3], [3, 4, 1, 2]]]
assertEqual "answer2" -- 2min
(answerMini "..3...2.....34..")
[[[1, 2, 3, 4], [4, 3, 2, 1], [2, 1, 4, 3], [3, 4, 1, 2]], [[2, 1, 3, 4], [4, 3, 2, 1], [1, 2, 4, 3], [3, 4, 1, 2]], [[4, 2, 3, 1], [1, 3, 2, 4], [2, 1, 4, 3], [3, 4, 1, 2]]]
-- Egison Version == 4.1.0
-- $ egison
-- > loadFile "sudoku7.egi"
-- 4*4 sudoku mini
--
-- Utils
--
def pMW := [1..16] -- width
def pMH := [1, 5, 9, 13, 2, 6, 10, 14, 3, 7, 11, 15, 4, 8, 12, 16] -- height
def pMB := [1, 2, 5, 6, 3, 4, 7, 8, 9, 10, 13, 14, 11, 12, 15, 16] -- block
def parseMini str colle :=
map read
(map 1#(pack [%1])
(match (S.replace "." "0" str) as string with
| loop $i (1, 16) ($x_i :: ...) [] -> map (\i -> x_i) colle) )
-- pattern function
def chpMini n _ colle :=
let
str := head colle
colle2 := tail colle
hintValue := nth n (parseMini str colle2)
in
if hintValue = 0 then
\pat => ~pat
else
\pat => (~pat & #hintValue)
def lineMini y str colle :=
let colle3 := str :: colle in
matchAll [1..4] as multiset integer with
| loop $i (1, 4) ( (chpMini (4 * (y - 1) + i) "" colle3) $x_i :: ...) [] -> map (\i -> x_i) [1..4]
-- pattern function
def defPatt :=
\x11 x12 x13 x14 x21 x22 x23 x24 x31 x32 x33 x34 x41 x42 x43 x44 =>
( (_ ++ ((~x11 :: ~x12 :: ~x13 :: ~x14 :: []) :: _)) ::
(_ ++ ((~x21 :: ~x22 :: ~x23 :: ~x24 :: []) :: _)) ::
(_ ++ ((~x31 :: ~x32 :: ~x33 :: ~x34 :: []) :: _)) ::
(_ ++ ((~x41 :: ~x42 :: ~x43 :: ~x44 :: []) :: _)) :: [] )
--
-- Codes
--
def candidateMiniWidth str :=
matchAll [lineMini 1 str pMW,
lineMini 2 str pMW,
lineMini 3 str pMW,
lineMini 4 str pMW] as list (list (list integer)) with
| defPatt $x11 $x12 $x13 $x14 $x21 $x22 $x23 $x24 $x31 $x32 $x33 $x34 $x41 $x42 $x43 $x44 ->
[[x11, x12, x13, x14],
[x21, x22, x23, x24],
[x31, x32, x33, x34],
[x41, x42, x43, x44]]
def candidateMiniHeight str :=
matchAll [lineMini 1 str pMH,
lineMini 2 str pMH,
lineMini 3 str pMH,
lineMini 4 str pMH] as list (list (list integer)) with
| defPatt $x11 $x12 $x13 $x14 $x21 $x22 $x23 $x24 $x31 $x32 $x33 $x34 $x41 $x42 $x43 $x44 ->
[[x11, x21, x31, x41],
[x12, x22, x32, x42],
[x13, x23, x33, x43],
[x14, x24, x34, x44]]
def candidateMiniBlock str :=
matchAll [lineMini 1 str pMB,
lineMini 2 str pMB,
lineMini 3 str pMB,
lineMini 4 str pMB] as list (list (list integer)) with
| defPatt $x11 $x12 $x13 $x14 $x21 $x22 $x23 $x24 $x31 $x32 $x33 $x34 $x41 $x42 $x43 $x44 ->
[[x11, x12, x21, x22],
[x13, x14, x23, x24],
[x31, x32, x41, x42],
[x33, x34, x43, x44]]
def answerMini str :=
intersect (intersect (candidateMiniWidth str) (candidateMiniHeight str)) (candidateMiniBlock str)
--
-- Tests
--
-- $ egison -t sudoku7.egi
assertEqual "answer1"
(answerMini "1...43.121.3.412")
[[[1, 2, 3, 4], [4, 3, 2, 1], [2, 1, 4, 3], [3, 4, 1, 2]]]
assertEqual "answer2" -- 2min
(answerMini "..3...2.....34..")
[[[1, 2, 3, 4], [4, 3, 2, 1], [2, 1, 4, 3], [3, 4, 1, 2]], [[2, 1, 3, 4], [4, 3, 2, 1], [1, 2, 4, 3], [3, 4, 1, 2]], [[4, 2, 3, 1], [1, 3, 2, 4], [2, 1, 4, 3], [3, 4, 1, 2]]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment