I am busy with my research and other F# work, I haven’t written blog articles recently. But I always keep an eye on interesting things on F#. The F# version of “Write Yourself a Scheme in 48 hours” by Loca Bologonese really caught my eyes. Luca took the Haskell version and translated it into F# with the main structure remained the same. This gives me (an F# programmer) a great opportunity to learn Haskell by reading the F# and the Haskell programs side by side! It is really a good learning experience (previously I know a little Haskell).

## N-Queen in F# and Scheme

The fun part was that I wished to write a functional version of n-queen program in Scheme and see the execution speeds of the F# evaluator and the Haskell evaluator!

n-queen problem is one of my favorite puzzles. I learned depth first search/backtracking with this problem. It is a good exercise for how to write a non-trivial recursive program other than factorial or Fibonacci sequence.

As the readers of this blog are probably F# users, I gave an F# version first in case you are not familiar with Scheme. The scheme version of the program uses exactly the same idea and same data structures.

The F# version:

// check if the two queens attack each other

let conflict (i1, j1) (i2, j2) =

if i1 = i2 || j1 = j2 || abs(i1-i2) = abs(j1-j2) then

true

else

false

// check if a new position is valid to a list of other (valid) positions

let check (newPos:int*int) (posList: (int*int) list) =

posList

|> List.exists (fun pos -> conflict newPos pos)

|> not

// the backtracking procedure to get all solutions

let rec searchQueen i n sols =

if i = n then

sols

else

let newSols =

sols

|> List.map (fun sol ->

[0..n-1]

|> List.filter (fun j -> check (i,j) sol)

|> List.map (fun j -> (i,j)::sol)

)

|> List.concat

searchQueen (i+1) n newSols

let allSolutions = searchQueen 0 8 [[]]

allSolutions |> List.length

The scheme version:

;; helper functions

(define (accumulate op init seq)

(if (null? seq)

init

(op (car seq)

(accumulate op init (cdr seq)))))

(define (accumulate op init seq) (if (null? seq) init (op (car seq) (accumulate op init (cdr seq)))))

(define (flatmap proc seq)

(accumulate append '() (map proc seq)))

(define (enumerate-interval low high)

(if (> low high)

'()

(cons low (enumerate-interval (+ low 1) high))))

;; data structures and basic functions for board

(define (make-queen row col) (list row col))

(define (get-row queen) (car queen))

(define (get-col queen) (car (cdr queen)))

(define (same-col? q1 q2) (= (get-col q1) (get-col q2)))

(define (same-diag? q1 q2)

(=

(abs (- (get-row q1) (get-row q2)))

(abs (- (get-col q1) (get-col q2)))))

(define (attacks? q1 q2)

(or (same-col? q1 q2) (same-diag? q1 q2)))

(define (safe? newq qlist)

(cond

((null? qlist) #t)

((attacks? newq (car qlist)) #f)

(else (safe? newq (cdr qlist)))))

(define (safe-board? qlist)

(let

((newq (car qlist))

(rest (cdr qlist)))

(safe? newq rest)))

;; the depth-first search for queens

(define (queens board-size)

(define (queen-rows k sols)

(if (= k board-size)

sols

(queen-rows (+ k 1)

(filter

(lambda (board) (safe-board? board))

(flatmap

(lambda (rest-queens)

(map (lambda (new-col)

(cons (list k new-col) rest-queens))

(enumerate-interval 1 board-size)))

sols)))))

(queen-rows 0 (list '())))

(length (queens 8))

Here are some correspondences between the F# version and the scheme version:

1. In F#, each queen position is represented as a tuple (int * int), while in Scheme, each queen position is a list with length 2.

2. In the search procedure, the main logic is: given a list of sub-solutions (sols), expand every one with all possible columns for the new position. This gives a list of lists of lists of positions. There should be a flatten function to transform it into a list of lists of positions. In F#, it is List.concat, in Scheme, it is flatmap.

## Run n-queen in the Scheme interpreters

The fun part is to run the n-queen program in the F# version interpreter. However, throwing the above scheme program into the interpreter gives errors. (It runs well in CzScheme)

Here are the limitations that I encountered:

1. The interpreter only supports one-line definitions. Overcoming this limitation is easy – just write the functions in one-lines.

2. The interpreter does not support (let). let syntax gives a word for some expression. The easy way is to use the expression directly.

3. Some built-in functions are not included in the interpreter, e.g. abs and append. Implementing them is quite easy.

4. The interpreter uses Console.ReadLine() to read from the input, which only supports 256 characters per line by default. The following lines reset the buffer size to allow more characters per line:

let inputBuffer = Array.create 1024 0y let inputStream = Console.OpenStandardInput(inputBuffer.Length) Console.SetIn(new IO.StreamReader(inputStream))

5. Does not support nested-define. Nested-define could be implemented as let + lambda. But I didn’t solve this problem in this post. I just remove nested-defines.

Here is the runnable Scheme program:

(define (abs x) (if (negative? x) (- 0 x) x))

(define (append list1 list2) (if (null? list1) list2 (cons (car list1) (append (cdr list1) list2))))

(define (accumulate op init seq) (if (null? seq) init (op (car seq) (accumulate op init (cdr seq)))))

(define (flatmap proc seq) (accumulate append (quote ()) (map proc seq)))

(define (enumerate-interval low high) (if (> low high) '() (cons low (enumerate-interval (+ low 1) high))))

(define (make-queen row col) (list row col))

(define (get-row queen) (car queen))

(define (get-col queen) (car (cdr queen)))

(define (same-col? q1 q2) (= (get-col q1) (get-col q2)))

(define (same-diag? q1 q2) (= (abs (- (get-row q1) (get-row q2))) (abs (- (get-col q1) (get-col q2)))))

(define (attacks? q1 q2) (or (same-col? q1 q2) (same-diag? q1 q2)))

(define (safe? newq qlist) (if (null? qlist) #t (if (attacks? newq (car qlist)) #f (safe? newq (cdr qlist)))))

(define (safe-board? qlist) (safe? (car qlist) (cdr qlist)))

(define board-size 7)

(define (queen-rows k sols) (if (= k board-size) sols (queen-rows (+ k 1) (filter (lambda (board) (safe-board? board)) (flatmap (lambda (rest-queens) (map (lambda (new-col) (cons (list k new-col) rest-queens)) (enumerate-interval 1 board-size))) sols)))))

(length (queen-rows 0 (list (quote ()))))

The above program runs OK in both F# and Haskell interpreter at about the same speed. However, when board-size equals 8, F# version gets a Stackoverflow runtime error.

I think it is enough for a post, I will see if I can solve these problems

Try switching the F# compilation mode from Debug to Release. Tail-recursion optimization is off by default in debug mode, so you'll get the stackoverflow even for perfectly tail-recursive functions.

ReplyDeleteIt already runs under release mode.

ReplyDeleteyou need emacs for scheme :-)

ReplyDelete