How to solve n-queens in scheme - vector

I'm trying to solve the n-queens problem in scheme. I was told by my professor to use a single vector as the chess board where the ith element of the vector represents the ith column of the board. The value of that element is the row on which sits a queen, or -1 if the column is empty. So, [0 1 2 -1 -1] has two columns with no queen and three queens placed illegally.
When I run this code: (place-n-queens 0 4 #(-1 -1 -1 -1)) I get #(0 1 2 3) which obviously has all four queens placed illegally. I think the issue is that I don't check enough things in the cond in place-queen-on-n but I'm not sure what to add to solve the issue of getting queens on the same diagonal.
(define (return-row vector queen)
(vector-ref vector (return-col vector queen)))
(define (return-col vector queen)
(remainder queen (vector-length vector)))
(define (checkrow vector nq oq)
(cond
((= (vector-ref vector nq) -1) #f)
((= (vector-ref vector oq) -1) #f)
(else (= (return-row vector nq) (return-row vector oq)))))
(define (checkcol vector nq oq)
(= (return-col vector nq) (return-col vector oq)))
(define (checkdiagonal vector nq oq)
(cond
((= (vector-ref vector nq) -1) #f)
((= (vector-ref vector oq) -1) #f)
(else (= (abs (- (return-row vector nq) (return-row vector oq)))
(abs (- (return-col vector nq) (return-col vector oq)))))))
(define (checkdiagonalagain vector r c oq)
(= (abs (- r (return-row vector oq)))
(abs (- c (return-col vector oq)))) )
(define (checkrowagain vector r oq)
(= r (return-row vector oq)))
(define (checkinterference vector nq oq)
(or (checkrow vector nq oq) (checkcol vector nq oq) (checkdiagonal vector nq oq)))
(define (place-queen-on-n vector r c)
(local ((define (foo x)
(cond
((checkrowagain vector r x) -1)
((= c x) r)
((checkinterference vector c x) -1)
((map (lambda (y) (eq? (vector-ref vector x) y))
(build-list (vector-length vector) values)) (vector-ref vector x))
((eq? (vector-ref vector x) -1) -1)
(else -1))))
(build-vector (vector-length vector) foo)))
(define (place-a-queen vector)
(local ((define (place-queen collist rowlist)
(cond
((empty? collist) '())
((empty? rowlist) '())
(else (append (map (lambda (x) (place-queen-on-n vector x (car collist))) rowlist)
(try vector (cdr collist) rowlist)))
)))
(place-queen (get-possible-col vector) (get-possible-row (vector->list vector) vector))))
(define (try vector collist rowlist)
(cond
((empty? collist) '())
((empty? rowlist) '())
(else (append (map (lambda (x) (place-queen-on-n vector x (car collist))) rowlist)
(try vector (cdr collist) rowlist)))))
(define (get-possible-col vector)
(local ((define (get-ava index)
(cond
((= index (vector-length vector)) '())
((eq? (vector-ref vector index) -1)
(cons index (get-ava (add1 index))))
(else (get-ava (add1 index))))))
(get-ava 0)))
;list is just vector turned into a list
(define (get-possible-row list vector)
(filter positive? list)
(define (thislist) (build-list (vector-length vector) values))
(remove* list (build-list (vector-length vector) values))
)
(define (place-n-queens origination destination vector)
(cond
((= origination destination) vector)
(else (local ((define possible-steps
(place-n-queens/list (add1 origination)
destination
(place-a-queen vector))))
(cond
((boolean? possible-steps) #f)
(else possible-steps))))))
(define (place-n-queens/list origination destination boards)
(cond
((empty? boards) #f)
(else (local ((define possible-steps
(place-n-queens origination destination (car boards))))
(cond
((boolean? possible-steps) (place-n-queens/list origination destination (cdr boards)))
(else possible-steps))
))))
Any help is appreciated to get this working!!

That's hard to follow. Generally n-queens is done with some sort of backtracking and I'm not seeing where you backtrack. The hard part is managing the side effects when using a vector. You have to set the board the the previous state before going back.
(define (n-queens size)
(let ((board (make-vector size -1)))
(let loop ((col 0) (row 0))
(cond ((= col size) board)
((= row size) ;;dead end
(if (= col 0) ;;if first collumn
#f ;;then no solutions
(begin (vector-set! board (- col 1) -1))
#f)))
;;else undo changes made by previous level and signal the error
((safe? col row board)
(vector-set! board col row)
(or (loop (+ col 1) 0)
;;only precede to next column if a safe position is found
(loop col (+ row 1))))
;; keep going if hit a dead end.
(else (loop col (+ row 1)))))))
Writing safe? is up to you though.
Also not sure why you are moving from vector to list. It's just really clogging up the logic so I'm having trouble following. Plus you should be comfortable moving through vectors on their own. In place-queen-on-n you use build-list on a vector just so you can map over it.
Whereas a vector-fold of some sort may be more appropriate. Additionally that map will always return a list which is always not false, meaning any code after that in the cond will never get hit. Is that your problem, I don't know but it is a problem.

Related

Pascal's Triangle in Racket

I am trying to create Pascal's Triangle using recursion. My code is:
(define (pascal n)
(cond
( (= n 1)
list '(1))
(else (append (list (pascal (- n 1))) (list(add '1 (coresublist (last (pascal (- n 1))))))
)))) ;appends the list from pascal n-1 to the new generated list
(define (add s lst) ;adds 1 to the beginning and end of the list
(append (list s) lst (list s))
)
(define (coresublist lst) ;adds the subsequent numbers, takes in n-1 list
(cond ((= (length lst) 1) empty)
(else
(cons (+ (first lst) (second lst)) (coresublist (cdr lst)))
)))
When I try to run it with:
(display(pascal 3))
I am getting an error that says:
length: contract violation
expected: list?
given: 1
I am looking for someone to help me fix this code (not write me entirely new code that does Pascal's Triangle). Thanks in advance! The output for pascal 3 should be:
(1) (1 1) (1 2 1)
We should start with the recursive definition for a value inside Pascals' triangle, which is usually expressed in terms of two parameters (row and column):
(define (pascal x y)
(if (or (zero? y) (= x y))
1
(+ (pascal (sub1 x) y)
(pascal (sub1 x) (sub1 y)))))
There are more efficient ways to implement it (see Wikipedia), but it will work fine for small values. After that, we just have to build the sublists. In Racket, this is straightforward using iterations, but feel free to implement it with explicit recursion if you wish:
(define (pascal-triangle n)
(for/list ([x (in-range 0 n)])
(for/list ([y (in-range 0 (add1 x))])
(pascal x y))))
It'll work as expected:
(pascal-triangle 3)
=> '((1) (1 1) (1 2 1))

Is there a more efficient way to write this recursive process?

I was asked to write a procedure that computes elements of Pascal's triangle by means of a recursive process. I may create a procedure that returns a single row in the triangle or a number within a particular row.
Here is my solution:
(define (f n)
(cond ((= n 1) '(1))
(else
(define (func i n l)
(if (> i n)
l
(func (+ i 1) n (cons (+ (convert (find (- i 1) (f (- n 1))))
(convert (find i (f (- n 1)))))
l))))
(func 1 n '()))))
(define (find n l)
(define (find i n a)
(if (or (null? a) (<= n 0))
'()
(if (>= i n)
(car a)
(find (+ i 1) n (cdr a)))))
(find 1 n l))
(define (convert l)
(if (null? l)
0
(+ l 0)))
This seems to work fine but it gets really inefficient to find elements of a larger row starting with (f 8). Is there a better procedure that solves this problem by means of a recursive process?
Also, how would I write it, if I want to use an iterative process (tail-recursion)?
There are several ways to optimize the algorithm, one of the best would be to use dynamic programming to efficiently calculate each value. Here is my own solution to a similar problem, which includes references to better understand this approach - it's a tail-recursive, iterative process. The key point is that it uses mutation operations for updating a vector of precomputed values, and it's a simple matter to adapt the implementation to print a list for a given row:
(define (f n)
(let ([table (make-vector n 1)])
(let outer ([i 1])
(when (< i n)
(let inner ([j 1] [previous 1])
(when (< j i)
(let ([current (vector-ref table j)])
(vector-set! table j (+ current previous))
(inner (add1 j) current))))
(outer (add1 i))))
(vector->list table)))
Alternatively, and borrowing from #Sylwester's solution we can write a purely functional tail-recursive iterative version that uses lists for storing the precomputed values; in my tests this is slower than the previous version:
(define (f n)
(define (aux tr tc prev acc)
(cond ((> tr n) '())
((and (= tc 1) (= tr n))
prev)
((= tc tr)
(aux (add1 tr) 1 (cons 1 acc) '(1)))
(else
(aux tr
(add1 tc)
(cdr prev)
(cons (+ (car prev) (cadr prev)) acc)))))
(if (= n 1)
'(1)
(aux 2 1 '(1 1) '(1))))
Either way it works as expected for larger inputs, it'll be fast for n values in the order of a couple of thousands:
(f 10)
=> '(1 9 36 84 126 126 84 36 9 1)
There are a number of soluitons presented already, and they do point out that usign dynamic programming is a good option here. I think that this can be written a bit more simply though. Here's what I'd do as a straightforward list-based solution. It's based on the observation that if row n is (a b c d e), then row n+1 is (a (+ a b) (+ b c) (+ c d) (+ d e) e). An easy easy to compute that is to iterate over the tails of (0 a b c d e) collecting ((+ 0 a) (+ a b) ... (+ d e) e).
(define (pascal n)
(let pascal ((n n) (row '(1)))
(if (= n 0) row
(pascal (- n 1)
(maplist (lambda (tail)
(if (null? (cdr tail)) 1
(+ (car tail)
(cadr tail))))
(cons 0 row))))))
(pascal 0) ;=> (1)
(pascal 1) ;=> (1 1)
(pascal 2) ;=> (1 2 1)
(pascal 3) ;=> (1 3 3 1)
(pascal 4) ;=> (1 4 6 4 1)
This made use of an auxiliary function maplist:
(define (maplist function list)
(if (null? list) list
(cons (function list)
(maplist function (cdr list)))))
(maplist reverse '(1 2 3))
;=> ((3 2 1) (3 2) (3))

Vectors in Scheme

How would I write a vector-to-list function without using the built in (vector->list) function. Specifically I am looking to learn how to access values within vectors as I have not previously worked with them.
Is there a more straightforward implementation than this:
(define (vector-to-list vec)
(define (helper k lst)
(if (= k (vector-length vec))
lst
(helper (+ k 1) (cons (vector-ref vec k) lst))))
(reverse (helper 0 '())))
(vector-to-list #(1 2 3 4))
?
No, that is a sound implementation. One could write it a bit more idiomatically using 'named-let' as:
(define (vector-to-list vec)
(let ((len (vector-length vec)))
(let looping ((k 0) (lst '())
(if (= k len)
(reverse lst)
(looping (+ k 1)
(cons (vector-ref vec k) lst)))))
You could avoid the use of reverse by constructing the list from back to front:
(define (vector-to-list vec)
(let looping ((k (- (vector-length vec) 1)) (lst '())
(if (< k 0)
lst
(looping (- k 1)
(cons (vector-ref vec k) lst)))))

Counting Change in Scheme using a list of denominations

I am writing a function to count the number of ways to make change in scheme given a list of denominations and an amount. My code is as follows, but it does not work as intended. Should I be using cons instead of the + operator? Should the third line down's base case be the empty list?
(define (change k l)
(cond ((= k 0) 1)
((or (< k 0) (null? l)) 0)
(else (+ (change k (cdr l))
(change (- k (car l))
(cdr l))))))
Test:
(change 11 (list 1 5 10 25))
If the returned value is just a number then forget about cons and '() for building the output, and only use car, cdr, null? for processing the input. Other than that, be aware that there's a small mistake in the last line of your code, here's the fixed version:
(define (change k l)
(cond ((= k 0) 1)
((or (< k 0) (null? l)) 0)
(else
(+ (change k (cdr l))
(change (- k (car l)) l))))) ; don't do (cdr l) here
Now it works as expected:
(change 11 (list 1 5 10 25))
=> 4

Scheme: How to delete/remove element from a vector

I'm starting scheme for Gimp script-fu and I don't find a simple way to remove item from a vector.
My only solution is to:
Convert vector to list
Remove item from the list (http://stackoverflow.com/questions/1905222/how-to-delete-an-element-from-a-list-in-scheme)
Convert list to vector
Is it a simplier way?
Here is my code:
(set! myvector (list->vector (delete item (vector->list myvector))))
(define delete
(lambda (item list)
(cond
((equal? item (car list)) (cdr list))
(else (cons (car list) (delete item (cdr list)))))))
That's the way: you need to create a new vector without the element that needs to be removed, copying all the others. But in your code, you're missing the case where the element is not present in the vector, also you don't need to create an intermediate list, go from vector to vector directly. I wrote this with Racket using standard Scheme, it should be easy enough to adapt for script-fu:
(define (vector-delete vec elt)
(let ((new-vec (if (> (vector-length vec) 0)
(make-vector (- (vector-length vec) 1))
(vector))))
(define (loop i j)
(cond ((= i (vector-length vec))
new-vec)
((equal? (vector-ref vec i) elt)
(loop (+ i 1) j))
((< j (vector-length new-vec))
(vector-set! new-vec j (vector-ref vec i))
(loop (+ i 1) (+ j 1)))
(else vec)))
(loop 0 0)))
Use it like this:
(define myvector #(1 2 3))
(set! myvector (vector-delete myvector 3))
myvector
=> '#(1 2)
Or by a more intuitive way :
(define (vector-delete v i)
(vector-append (vector-take v i) (vector-drop v (+ i 1))))

Resources