queens.jslt

// ===========================================================================
//  N-Queens problem solution in JSLT

// board is n lists of length n
//  0 => no queen
//  1 => queen

// queens(8) produces
// [
//   [ 1, 0, 0, 0, 0, 0, 0, 0 ],
//   [ 0, 0, 0, 0, 1, 0, 0, 0 ],
//   [ 0, 0, 0, 0, 0, 0, 0, 1 ],
//   [ 0, 0, 0, 0, 0, 1, 0, 0 ],
//   [ 0, 0, 1, 0, 0, 0, 0, 0 ],
//   [ 0, 0, 0, 0, 0, 0, 1, 0 ],
//   [ 0, 1, 0, 0, 0, 0, 0, 0 ],
//   [ 0, 0, 0, 1, 0, 0, 0, 0 ]
// ]

def queens(n)
  solve(0, make-board($n))

def range(length, list)
  if (size($list) < $length)
    range($length, $list + [size($list)])
  else
    $list

def zeroes(length)
  [for (range($length, [])) 0]

def make-board(n)
  [for (range($n, [])) zeroes($n)]

def solve(row, board)
  let n = size($board)
  if ($row == $n)
    $board
  else
    let tries = [for (range($n, []))
      let newboard = place-queen($row, ., $board)
      if (is-ok($newboard))
        solve($row + 1, $newboard)
      else
        null]

    filter($tries)[0]

def is-ok(board)
  rows-ok($board) and cols-ok($board) and diagonals-ok($board)

def rows-ok(board)
  all-ok([for ($board) sum(.) <= 1])

def cols-ok(board)
  // 0, 1, 2, 3, ...
  let indexes = range(size($board), [])

  // list of columns instead of list of rows
  let columns = [for ($indexes)
    let col = (.)
    [for ($board) .[$col]]
  ]

  rows-ok($columns)

def diagonals-ok(board)
  let n = size($board)
  let offsets = range($n - 1, [])[1 : ] // starts with 1

  let diagonals-right = (
    [diagonal-right($board, 0, 0)] +
    [for ($offsets) diagonal-right($board, 0, .)] +
    [for ($offsets) diagonal-right($board, ., 0)]
  )

  let diagonals-left = (
    [diagonal-left($board, 0, $n - 1)] +
    [for ($offsets) diagonal-left($board, ., $n - 1)] +
    [for ($offsets) diagonal-left($board, 0, .)]
  )

  rows-ok($diagonals-right + $diagonals-left)

def diagonal-right(board, rowoff, coloff)
  if ($rowoff >= size($board) or $coloff >= size($board))
    []
  else
    [$board[$rowoff][$coloff]] + diagonal-right($board, $rowoff+1, $coloff+1)

def diagonal-left(board, rowoff, coloff)
  if ($rowoff >= size($board) or $coloff < 0)
    []
  else
    diagonal-left($board, $rowoff + 1, $coloff - 1) + [$board[$rowoff][$coloff]]

def sum(numbers)
  if (not($numbers))
    0
  else
    $numbers[0] + sum($numbers[1 : ])

def all-ok(booleans)
  if (not($booleans))
    true
  else
    $booleans[0] and all-ok($booleans[1 : ])

def place-queen(row, col, board)
  let changerow = $board[$row]
  let newrow = $changerow[ : $col] + [1] + $changerow[$col + 1 : ]

  $board[ : $row] + [$newrow] + $board[$row + 1 : ]

def filter(array)
  if (not($array))
    []
  else if ($array[0])
    [$array[0]] + filter($array[1 : ])
  else
    filter($array[1 : ])

queens(8)