sudoku←{                                ⍝ Solution vector for Sudoku problem ⍵.

    (⎕ML ⎕IO)←3 1                                        ⍝ basic settings

    wid←↑⍴⍵ ⋄ ⍺←wid*0.5 ⋄ grp←2⍴⍺ ⋄ set←⍳wid             ⍝ side, sudoku area and group
    inx←↓1+(,wid⊥¨(⊂grp)ׯ1+⍳⌽grp)∘.+,wid⊥¨¯1+⍳grp       ⍝ group indices
    inx,←{(↓⍵),↓⍉⍵}(⍴⍵)⍴⍳wid*2                           ⍝ row and column indices

    bas←(⍴,⍵)⍴⊂set                                       ⍝ initial state
    ↑(,⍵)∘{q←⍺[⍵] ⋄ ((q=0)/q)←⊂set~↑,/q ⋄ {0}bas[⍵]∩←,¨q}¨inx:
                                                         ⍝ ↑ cell alternatives from groups
    ∆sqz←{0∊⍴⍵:⍺ ⋄ i←↑⍵ ⋄ q←⍺                            ⍝ find the unique numbers from groups
        b←1<↑,/⍴¨⍺[i] ⋄ ~∨/b:⍺ ∇ 1↓⍵                     ⍝ any?
        q[b/i]←{c←⍵⊃q ⋄ z←c~↑,/q[i~⍵] ⋄ 1≠⍴z:c ⋄ z}¨b/i  ⍝ only choices in the group?

        r←{s←↑,/⍴¨⍵ ⋄ 2>+/s=2:s ⋄ ∧/s∊1 2:s              ⍝ two cells with equal pairs?
            k←(s=2){↑(⍸⍺)~⍵⍳∪⍺/⍵}⍵ ⋄ k=0:s               ⍝ search
            c←~⍵∊⍵[k] ⋄ q[c/i]←(c/⍵)~¨⍵[k] ⋄ ↑,/⍴¨q[i]   ⍝  and clear
        }q[i]

        0∊r:⍬ ⋄ (∧/r=1)≥1∊r:q ∇ 1↓⍵                      ⍝ no solution?
        j←(r>1)/i ⋄ q[j]←q[j]~¨,/q[i~j]                  ⍝ remove resolved cells from others
        q ∇ 1↓⍵}                                         ⍝ next group

    ∆chk←{m←⍵ ∆sqz inx ⋄ 0∊⍴m:⍬ ⋄ m≢⍵:∇ m ⋄ ⍵}           ⍝ squeeze checking

    ∆nxt←{0∊⍴⍵:⍵                                         ⍝ add next candidates to the list
        r←↑,/⍴¨⍵ ⋄ ∧/r=1:⊂⍵                              ⍝ no of choices per section
        j←↑,/{⍵[⍒{+/r[⍵]=1}¨⍵]}wid↑inx                   ⍝ balance by group tightness
        i←(r[j]⍳⌊/r~1)⊃j                                 ⍝ first unresolved cell
        ⍵∘{m←⍺ ⋄ (i⊃m)←,⍵ ⋄ m}¨i⊃⍵}                      ⍝ expand to tables

    ⍬{0∊⍴⍵:⍺                                             ⍝ main function - result?
        m←∆chk↑⍵ ⋄ 0∊⍴m:⍺ ∇ 1↓⍵                          ⍝ squeeze, if no result -> take the next
        ∨/1<↑,/⍴¨m:⍺ ∇ 1↓⍵,∆nxt m                        ⍝ not yet -> expand
        ∨/(+/set)≠{+/↑,/m[⍵]}¨inx:⍺ ∇ 1↓⍵                ⍝ not valid result -> take the next
        (⍺,⊂(2⍴wid)⍴↑,/m)∇ 1↓⍵                           ⍝ solution -> add to the result(s)
    }{0∊⍴⍵:⍵ ⋄ ⊂⍵}bas ∆sqz inx                           ⍝ initial cleaning
}

code_colours

test script

Back to: notes

Back to: Workspaces