⍝ NOTE: This version is still under development.
'pco' ⎕CY 'dfns'
⍝ --- Logic Games Library ---
filter ← {⍵/⍨⍺⍺¨⍵}
filter_valid_pos ← {(∧/1∘≤,≤∘⍺) filter ⍵}
gen ← {⍺←0 ⋄ ⍺⍴⍨⍵⍴⍨2⌈≢⍵}
fill ← {⍺@⍵⊢⍺⍺}
mul_fill ← {0=≢⍵: ⍬ ⋄ ⍺ (⍺⍺ fill)∘⊆¨⍵}
COLS ← (¯1 0)(0 1)(1 0)(0 ¯1)
DIAG ← (¯1 1)(1 1)(1 ¯1)(¯1 ¯1)
DIRS ← COLS (,,⍤0) DIAG
adj ← {⍺←1 ⋄ ⍺⍺ filter_valid_pos ⍵+DIRS/⍨(2|⍺)=⍺⌊8⍴1 0}
⍝ --- End Logic Games Library ---
solver ← {
q_adj ← s⍴2∘(s adj)∘⊂¨,⍳s←⍴⍵
(q_adj q_solver) ⍵
}
q_solver ← {
m ← ⍵
q_adj ← ⍺⍺
⍝ Find repeated numbers in rows
g←⊃⊂∨.=⊂⌽⍨¨⍳∘(1-⍨≢)
⍝ Differentiate repeated numbers in rows (m1) and column (m2)
primes ← 1↓{⍵,4 pco ¯1↑⍵}⍣(≢m)⊢ ≢m
m1←primes×⍤¯1⊢m×g m
m2←primes×⍤1⊢m×⍉g ⍉m
⍝ Position of repeated numbers grouped
b←⊃,/{((1,2≠/⊢)∘{⍵[⍋⍵]}⊂((⍸0≠⍵)⌷⍨∘⊂⍋))0~⍨,⍵}¨m1 m2
⍝ For each row/column with repeated numbers, list all combinations of
⍝ cells to try to delete in order to keep only unique numbers in that
⍝ row/column.
b←{⍵∘~¨⊂¨⍵}¨b
⍝ Since I'm assuming that I'm adding a black cell in a valid solution,
⍝ I cannot add two of them and use the same check function, so I blacken a
⍝ cell at a time.
t_f ← {⍺ {⍵/⍨⍥,⍺ (q_adj check)¨ ⍤¯1 ⊢⍵} ⍺∘.{0@⍺⊢⍵}⍵}
f ← {⊃,/,⍺∘.{⊃,/t_f / (⊂¨¨⊂¨⍺),⊂⊂⍵}⍵}
∪⊃,/f/(⌽b),⊂⊂m
}
check ← {
q_adj ← ⍺⍺
∧/0=,⍵: 0
⍝ Check that there aren't two orthogonally adjacent black cells.
1∊(⍵⍷⍨⍪0 0)∨0 0⍷⍵: 0
⍝ Initialized before each check
num_borders ← 0
⍝ Checks if the last blackened cell doesn't isolate a group of white cells.
⍝ Traverse the black cells starting from the last blackenend one,
⍝ throught the diagonally adjacent cells.
⍝ A group of white cells is isolated if the line touches the border
⍝ two times or if it re-touches the starting cell.
sub_check ← {
lp cp ← ⍺ ⍝ Last Position and Current Position
sp ← ⍺⍺ ⍝ Starting Position
⍝ Dyagonally adjacent numbers to current cell
near ← ⊃cp⌷q_adj
⍝ Update the number of borders touched by the line.
num_borders +← 4≠⍴near
⍝ If the line touches the border twice, the solution isn't valid.
2=num_borders: 0
⍝ Keep only the next blackened cell of the line, except the starting position.
nxt ← (⊂lp)~⍨near/⍨0=near⌷¨⊂⍵
⍝ If the only adjacent cell is the last position, it means that I reached
⍝ the end of the line. I've already saved the number of boreders touched,
⍝ in case I'm actually in a border, and I can actually exit.
0=≢nxt: 1
⍝ If the starting cell is one of the next ones, I reached a loop, grouping
⍝ some white cells inside. So the solution isn't valid.
sp∊nxt: 0
⍝ Recurse on each next blackened cell.
⍝ nxt ∧.(⊢∇⍨cp,⍥⊆⊣) ⊂⍵
((⊂cp),⍥⊂¨nxt) ∧.∇ ⊂⍵
}
⍺ ∧.{
num_borders ⊢← 0
(0 0,⍥⊂⍺) ((⊂⍺) sub_check) ⍵
} ⊂⍵
}
creator ← {
n←⍵
⍝ Precompute the adjacent cells for each position,
⍝ to speed up the check function.
q_adj ← s⍴2∘(s adj)∘⊂¨,⍳s←n n
x ← ⌈.5×n
min max ← x × x - 2 0
n_z ← 1-⍨min+?1+max-min
⍝ Create a boolean mask with a maximum of ⍺ zeros, by placing a 0 in a
⍝ random position and marking out the cells around with a ¯1,
⍝ until there's no more space or it placed the required number of zeros.
mask ← 0≠{
n←≢m←⍵
p ← (?⍤≢⊃⊢)⍸1=m
pp ← (n n adj) ⊂p
¯1@pp⊢0@(⊂p)⊢m
}⍣{(~1∊⍺)∨(n_z=+/0=,⍺)}⊢ 1 gen n
⍝ Random matrix with unique values in rows and columns
mat ← 1+n|∘.+⍨?⍨n
inp ← {⊃(2?n)~⍵}¨@(⊆⍸~mask)⊢mat
res ← (q_adj q_solver) inp
fix ← {
inp ← ⍵
res ← solver inp
1=≢res: inp ⍝ already unique
0=≢res: inp ⍝ no solution — needs mask-level fix, give up
s1 s2 ← 2↑res
⍝ Find a cell that is black in s1 but white in s2
cell ← ⊃{
diff ← ⍸(0=s1)>0=s2
0=≢diff: (⍸(0=s1)>0=s2) ⊣ s2 s1⊢←s1 s2
diff
} ⍬
⍝ Values in the same row/col as cell in s2
row2 ← (⊃cell)⌷s2
col2 ← (2⊃cell)⌷⍤1⊢s2
⍝ Pick a value that creates a conflict in s2, keeping s1 valid
candidates ← (row2∪col2)~(0,cell⌷inp)
0=≢candidates: inp
((?∘≢⊃⊢)candidates)@(⊂cell) ⊢ inp
}
r_inp ← fix⍣n⊢ inp
r_res ← solver r_inp
1=≢r_res: (⊂r_inp),r_res
∇⍵
}