Logic games in APL: Trees

Rules

Source code

⍝ NOTE: This version is still under development.

'cmat' 'cache' 'memo' ⎕CY 'dfns'

∆cmat ← cache ''
qcmat ← cmat memo ∆cmat

tid ← ⍬
KillAfter←{
  ⍝ Kill (global) tid after some time
  0::
  0=⍵:
  ⎕TKILL tid⊣⎕DL ⍵ ⍝ Job done!
}

check ← {
  ⍺⍺=1: ∧/⍺⍺≥(+/,+⌿)⍵>0
  (∧/⍺⍺≥(+/,+⌿)⍵>0)>(0 1)(1 1)(1 0)∊⍨|-/⍺
}

f ← {
  x ← ⍵
  n ← ⍺
  y ← ({⊃⍤⍋⊢∘≢⌸⍵}⌷∪)0~⍨,⍺⍺×0=x
  area ← y=⍺⍺
  n>≢vec ← ⍸(0≤⍵)∧area: ⍬
  vec ← ↓vec[n qcmat≢vec]
  res ← {1@⍵⊢x}¨vec
  res ← res/⍨vec(n check)¨res
  adj ← {×⍵-¯1 ¯1↓1 1↓⊃∨/⊃,/4 ¯4↑¨⊂,¯1 0 1∘.⊖¯1 0 1⌽¨⊂0(,∘⌽∘⍉⍣4)1=⍵}¨res
  cr  ← {(⊢-⊢<(n≤+/)∘.∨n≤+⌿)1=⍵}¨res
  (⊢-(⊂area)∧0∘=)adj⌊cr
}

createTree ← {
  mat ← (?⍨×⍤1⍳∘.=?⍨) ⍵
  {⍵+(0=⍵)×{(?∘≢⌷⊢)5↑∪,⍺↓⍵×3 3⍴0 1}⌺3 3⊢⍵}⍣(~0∊⊢)⊢mat
}

filter_valid_pos ← {⍵/⍨(∧/1∘≤,≤∘⍺)¨⍵}

COLS ← (¯1 0)(0 1)(1 0)(0 ¯1)

nbor ← {⍺×⍵∨(0 1↓⍵,0)∨(1↓⍵⍪0)∨(0 ¯1↓0,⍵)∨¯1↓0⍪⍵}
all_connected ← {⍵≡⍵∘nbor⍣≡⊢1@(⊂⊃⍸⍵)⊢0⍴⍨⍴⍵}

lim_solver ← {
  ⍝ ⍵: Inputs to solve

  MAX_SOLS ← ⍺

  6:: ⍬

  n ← 4 9⍸≢ m ← ⍵

  ⍝ Set timeout based on the largest input
  kid ← KillAfter& {⍵≤10 : 2 ⋄ 3} ≢m

  ⍝ DFS
  res ← ⎕TSYNC tid ⊢← {
    sols ⊣ {
      ⍝ If solution is found, add it
      (n×≢m)=+/,1=⍵: sols ,← ⊂1=⍵

      ⍝ Early exit if there are no empty space
      (MAX_SOLS≤≢sols) ∨ 0=+/,0=⍵: ⍬

      ⍝ Early exit if there's no possible solution in this branch
      0=≢ next ← n (m f) ⍵: ⍬

      ∇¨ next
    } 0⍨¨m ⊣ sols←⍬
  }& m

  res ⊣ ⎕TKILL kid
}

creator ← {
  dim ← ⍵

  MAX_SOLS ← {⍵≤10 : 27 ⋄ 100} ⍵

  mat ← createTree ⍵
  sols ← MAX_SOLS lim_solver mat

  ⍝ If it has no solution or a lot (more than 27), retry
  (0∘=∨MAX_SOLS∘≤)≢sols: ∇⍵

  ⍝ Set maximum of attempts in case of loop
  ⍝ TODO: Understand why of the loop
  MAX ← 7
  attempts ← 0

  sols (∇{
    m ← ⍵

    ⍝ If unique solution, return input and solution
    1=≢⍺: ⍵ (⊃⍺)

    ⍝ Try to fix:
    ⍝ Idea: If I find the differences between the solutions, I could
    ⍝   try to fix one place that introduces a change and hope that
    ⍝   it'll remove the doubt.
    candidates ← ⊃,/{
      (⍵{⍵@(⊂⍺⍺) ⊢m})¨ (⍵⌷m)~⍨∪((⍴m) filter_valid_pos COLS+⊂⍵)⌷¨⊂m
    }¨⍸×(≢⍺)|⊃+/⍺ ⍝ ⊃∨/{⍵/⍨(0∘≠)+/⍤,¨⍵}∪,∘.≠⍨⍺ ⍝ (⊢=0⌊/⍤~⍨⊢) or (0∘≠)

    attempts +← 1
    (MAX=attempts): ⍺⍺ ≢⍵ ⍝ ⊣ ⎕← 'Lot attempts'

    ⍝ If the fixed is empty, mat didn't change; so it can't be fixed.
    ⍝  (Choosing the one with the least number of solutions)
    0=≢candidates: ⍺⍺ ≢⍵ ⍝ ⊣ ⎕← 'Cond 1'

    candidates ← {⍵/⍨{∧/all_connected⍤2⊢(⍳≢⍵)∘.=⍵}¨⍵}candidates

    ⍝ There's no fixed input without disconnectivity
    0=≢candidates: ⍺⍺ ≢⍵ ⍝ ⊣ ⎕← 'Cond 2'

    ⍝ Else, continue fixing
    ss ← MAX_SOLS∘lim_solver¨ candidates

    0=≢ss: ⍺⍺ ≢⍵

    ⍝ Filter out if it has no solution or a lot (more than 27)
    (ss candidates) ← (ss candidates)/⍨¨⊂~(0∘=∨MAX_SOLS∘≤)≢¨ss

    0=≢candidates: ⍺⍺ ≢⍵

    i ← ⊃⍋≢¨ss

    ss ∇⍥(i∘⊃) candidates ⍝ Should I recurse with ss ∇¨ fixed?
  }) mat
}