sudoku.html

Sudoku als constraint satisfaction problem

> restart:

> read "C:/#Stuff/maple/_sudoku/LogicProblem.mpl":

> interface(rtablesize = 30):

> num_cols_per_box := 3:
num_rows_per_box := 3:
n := num_cols_per_box * num_rows_per_box:

> V := ['place','value']:
(Problem besteht aus zwei Mengen: Plaetze und Werte)

> place := [p||(1..n^2)]: value := [$0..n^2-1]:
(Alle Plaetze durchnummerieren; die Werte entsprechen im Modulo der gesetzten Zahl-1 und bekommen die
zugeordnete Zeile-1 mal Anzahl moeglicher Zahlen als Offset [zur Unterscheidung der verschiedenen Instanzen einer Zahl])

> Sudoku := LogicProblem(V):

> with(Sudoku):

Warning, Sudoku is not a correctly formed package - option `package' is missing

> infolevel['Constraints'] := 1: infolevel['TC'] := 1: CollectStats := true:

> rowidx := (nr,elem) -> (nr-1)*n + elem:

> colidx := (nr,elem) -> nr + (elem-1)*n:

> boxidx := (nr,elem) -> irem(nr-1,num_rows_per_box)*num_cols_per_box + n*iquo(nr-1, num_rows_per_box)*num_rows_per_box + irem(elem-1,num_cols_per_box) + n*iquo(elem-1,num_cols_per_box) + 1:
(Hilfsfunktionen fuer die Zuordnung Gruppennr. + Elementnr. -> Index des Feldes in place[])

> for i to n do row||i := {place[rowidx(i,j)] $ j=1..n} end do:

> for i to n do col||i := {place[colidx(i,j)] $ j=1..n} end do:

> for i to n do box||i := {place[boxidx(i,j)] $ j=1..n} end do:
(Aus place[] die Teilmengen der Zeilen, Spalten und Boxen extrahieren)

> rows := [row||(1..n)]:

> cols := [col||(1..n)]:

> boxs := [box||(1..n)]:
(Alle Zeilen, Spalten und Boxen zusammenfassen)

> rowconstr := Rel(DifferentBlock, [v+n*k $ k=0..n-1], place, rows) $ v=0..n-1:

> colconstr := Rel(DifferentBlock, [v+n*k $ k=0..n-1], place, cols) $ v=0..n-1:

> boxconstr := Rel(DifferentBlock, [v+n*k $ k=0..n-1], place, boxs) $ v=0..n-1:
(Sudokuregel implementieren: Jede Zahl ist einmalig in ihrer Zeile, Spalte und Box. Rest ergibt sich automatisch.)

> uniqueconstr := Rel(SameBlock, [v*n+k $ k=0..n-1], place, rows) $ v=0..n-1:
(Zusatzbedingungen, dadurch sind Permutationen der Einsen etc. untereinander ausgeschlossen.
Ansonsten waere die gefundene Loesung fuer Maple nicht eindeutig.)

> sv := (row,col,num) -> (num-1) + (row-1)*n = p||(col + (row-1)*n):
(Generierung einer "Zahl gesetzt"-Bedingung aus Zeile, Spalte und gesetzter Zahl)

> setconstr :=
sv(1,1,2),sv(1,4,4),sv(1,6,1),sv(1,9,6),
sv(2,2,7),sv(2,5,3),sv(2,8,2),
sv(3,4,2),sv(3,6,8),
sv(4,3,9),sv(4,5,8),sv(4,7,5),
sv(5,2,3),sv(5,3,8),sv(5,4,5),sv(5,6,6),sv(5,7,2),sv(5,8,4),
sv(6,3,7),sv(6,5,2),sv(6,7,6),
sv(7,4,8),sv(7,6,9),
sv(8,2,6),sv(8,5,4),sv(8,8,7),
sv(9,1,3),sv(9,4,6),sv(9,6,7),sv(9,9,5):
(Einige Felder vorgebenen: sv(Zeile, Spalte, Zahl); Beispielsudoku aus P.M. Sudoku Trainer 9/2006, #6)

> constraints := [_rowconstr,_colconstr,_boxconstr,_uniqueconstr,_setconstr]:
(Alle Bedingungen zusammenfassen)

> Reinitialize():

$Okay$

> st := time():
Satisfy(subs(_rowconstr=rowconstr,_colconstr=colconstr,_boxconstr=boxconstr,
_uniqueconstr=uniqueconstr,_setconstr=setconstr,constraints)):
time() - st;
(Problem loesen ...)

Satisfy:

$Attempting to fulfill unsatisfied constraints by guessing.$

Satisfy:

$Attempting to fulfill unsatisfied constraints by guessing.$

Rel/Check:   Constraint   Rel(DifferentBlock,8,71,1,[{p1, p10, p19, p73, p64, p37, p55, p28, p46}, {p2, p11, p20, p29, p38, p74, p65, p56, p47}, {p3, p12, p21, p30, p39, p75, p66, p57, p48}, {p4, p13, p22, p67, p76, p40, p31, p58, p49}, {p5, p14, p41, p59, p32, p23, p68, p77, p50}, {p6, p15, p42, p60, p33, p24, p69, p78, p51}, {p7, p16, p70, p34, p25, p43, p52, p61, p79}, {p8, p17, p44, p62, p26, p80, p53, p71, p35}, {p9, p18, p45, p63, p27, p81, p54, p72, p36}])   contradicted.

Rel/Check:   Constraint   Rel(DifferentBlock,7,70,1,[{p1, p10, p19, p73, p64, p37, p55, p28, p46}, {p2, p11, p20, p29, p38, p74, p65, p56, p47}, {p3, p12, p21, p30, p39, p75, p66, p57, p48}, {p4, p13, p22, p67, p76, p40, p31, p58, p49}, {p5, p14, p41, p59, p32, p23, p68, p77, p50}, {p6, p15, p42, p60, p33, p24, p69, p78, p51}, {p7, p16, p70, p34, p25, p43, p52, p61, p79}, {p8, p17, p44, p62, p26, p80, p53, p71, p35}, {p9, p18, p45, p63, p27, p81, p54, p72, p36}])   contradicted.

$Unique solution:$

$Set interface(rtablesize) to a higher value to see solution chart inline.$

$18.777$

> conv_result := (nr) -> irem(op(2,&?(p||nr))[1],n)+1:
(Zu einer Feldnummer den zugehoerigen Wert extrahieren und in die gesetzte Zahl umrechnen)

> result := map(conv_result, [$1..n^2]);

$result := [2, 8, 3, 4, 7, 1, 9, 5, 6, 4, 7, 6, 9, 3, 5, 8, 2, 1, 9, 5, 1, 2, 6, 8, 7, 3, 4, 6, 2, 9, 7, 8, 4, 5, 1, 3, 1, 3, 8, 5, 9, 6, 2, 4, 7, 5, 4, 7, 1, 2, 3, 6, 9, 8, 7, 1, 4, 8, 5, 9, 3, 6, 2, 8, 6, 5, 3, 4, 2, 1, 7, 9, 3, 9, 2, 6, 1, 7, 4, 8, 5]$

> &? ShowStats;

$Sets = 32, Unsets = 2492, RuleOuts = 256, Elims = 9011, Transfers = 0, Pivots = 0, MaxLevel = 206, Guesses = 2, MaxDepth = 2$

>