In a screen that is divided into rows and columns using a vector of vector implementation, how do I make a character move around on keyboard input?
I already have the following to make create the coordinates for the character:
(define direction 'up)
(define (next-pos x y)
(cond ((eq? 'up direction)
(cons x (- y element-height)))
((eq? 'down direction)
(cons x (+ y element-height)))
((eq? 'left direction)
(cons (- x element-width) y))
((eq? 'right direction)
(cons (+ x element-width) y))))
Related
The task is: for given list of elements and X element, remove an element after X if it is not equal to X. Example: (a 8 2 a a 5 a) X=a, expecting (a 2 a a a).
I have code that removes an element before X, so it gives me (a 8 a a a) instead. How do I fix it?
(defun purgatory (n w)
(cond ((null w) nil)
((and (eq (cadr w) n) (not (eq (car w) (cadr w)))) (purgatory n (cdr w)))
((cons (car w) (purgatory n (cdr w))))))
You can use the destructuring of for on clauses in loop:
(defun purgatory (list x)
(cons (first list)
(loop :for (a b) :on list
:unless (and (eql a x)
(not (eql b x)))
:collect b)))
I think you are on the right lines with a recursive algorithm. I think that the algorithm works better as a tail-optimised recursion. You take an in-list and an X, and build up an out-list. The output is reversed, and so reverse needs to be applied at the end, thus:
(defparameter my-list '(a 8 2 a a 5 a))
(defun remove-after (in-list X &optional (out-list '()) (last '()))
(if (null in-list)
(reverse out-list)
(if (and (eql last X) (not (eql (car in-list) X)))
(remove-after (cdr in-list) X out-list (car in-list))
(remove-after (cdr in-list) X (cons (car in-list) out-list) (car in-list))
)))
; (A 2 A A A)
As for the non-tail algorithm, I think this does it:
(defun purgatory (n w)
(cond ((null w) nil)
((and (eq (car w) n) (not (eq n (cadr w)))) (cons (car w) (purgatory n (cddr w))))
(t (cons (car w) (purgatory n (cdr w))))
))
; (A 2 A A A)
So, if the first element is n and the next is not n, then add n at the front of the algorithm, but skip cddr the next element. Otherwise, add the first element to the front of the algorithm, no skip cdr.
NB: since you've defined the problem in terms of X, I think this should be one of your parameters, not n
I'm starting to coding in Scheme and I wan't to know if a number is "abundante". A number x is "abundante" if the sum of its dividers is greater than the double of x.
So this is my code:
#lang scheme
(define (abundante x)
(cond
((= x 0) #f)
((= x 1) #f)
((> (apply +(divisores x)) (doble x)) #t)
(else #f)
)
)
;aux functions
(define (doble x) (* x 2))
(define (divisores x)
(cond
((= x 1) '(1))
(else (cons 1 (divisores-aux x 2)))
)
)
(define (divisores-aux x y)
(cond
((= x y) '(x))
((integer? (/ x y))(cons y (divisores-aux x (+ y 1))))
(else (divisores-aux x (+ y 1)))
)
)
As you can see, I have 3 auxiliary functions:
1) Doble x: Return the double of x
2) Divisores x: Return the dividers of x
2.1) Divisores-aux x y: Check if x/y is a integer number, then goes for y+1
But I got the problem when Divisores-aux reach x = y. I want to return x because x its a divider of itself but DrRacket prints the follow error:
+: contract violation
expected: number?
given: y
argument position: 6th
other arguments...:
And indicates me that the error was produced on apply +(divisores x)
If I return null or '() everything goes fine, but obviously I don't get the correct result.
Thanks in advance
There's a bug in the base case of divisores-aux, in here:
'(x)
The above expression will return a list with the symbol x as its single member (to understand why, read about quoting in the docs). What you meant to say was this, that creates a list with the value of the x variable:
(list x)
Also, it's better to use remainder to test if a number is divided by another. This should fix the issues:
(define (divisores-aux x y)
(cond
((= x y) (list x))
((zero? (remainder x y)) (cons y (divisores-aux x (+ y 1))))
(else (divisores-aux x (+ y 1)))))
Now abundante works as expected:
(abundante 42)
=> #t
(abundante 45)
=> #f
I'm working my way through Paul Graham's "ANSI Common Lisp" (1996).
Chapter 3, exercises, qu. 2 asks for a function as stated in title of this post. I'm only using what has been taught in the book up to this point (obviously there's case construct that could clean up the if's but I'm not minding that at present).
As a first attempt I ended up writing interleave, which retains duplicates:
(defun interleave (x y)
(if (and (null x)
(null y))
nil
(if (null x)
(cons (car y)
(interleave (cdr y) x))
; where y is null, but also for any other case:
(cons (car x)
(interleave y (cdr x))))))
Following that, I had the idea to store a carry of elements which have been seen, and defer to a helper function, as below.
However, the below is obviously rather ugly and hard to understand.
I'm seeking some suggestions on directions I might take to achieve elegance.
Tips on approach & style might be just as useful at this point as providing the canonical solution. Should my number one impulse given code below be to extract another function? (or maybe I've gone in the wrong direction trying to store the carry in the first place?) Thank you fellow hackers!
(defun new-union (x y)
(new-union-helper x y '())) ; <- idea, add a carry to store what's been seen.
(defun new-union-helper (x y seen)
(if (and (null x)
(null y))
nil
(if (null x)
(if (not (member (car y) seen)) ; if first el of y hasn't yet been seen...
; cons it to the ultimate result & recur, while adding it to seen:
(cons (car y) (new-union-helper (cdr y) x (cons (car y) seen)))
; if it has been seen, just continue, (skip the duplicate):
(new-union-helper (cdr y) x seen))
(if (not (member (car x) seen))
(cons (car x) (new-union-helper y (cdr x) (cons (car x) seen)))
(new-union-helper (cdr x) y seen)))))
Update: I've attempted to replace the nested ifs with cond, having looked up cond in the index of the book. Sorry in advance, this is so ugly... but if anyone can tell me what I'm doing wrong here that would be greatly appreciated. This code works same as above, but it prints a nil as the last member of the resulting list (on some inputs), not sure why yet.
; attempt to use cond instead:
(defun new-union-helper (x y seen)
(cond ((and (null x) (null y))
nil)
((and (null x) (not (member (car y) seen)))
(cons (car y) (new-union-helper (cdr y) x (cons (car y) seen))))
((null x)
(new-union-helper (cdr y) x seen))
((not (member (car x) seen))
(cons (car x) (new-union-helper y (cdr x) (cons (car x) seen))))
(t
(new-union-helper (cdr x) y seen))))
Update 2: I've tried to adopt better indenting. The below does what I want it to do from informal tests. Any further tips on what I'm still doing wrong? (I realise I should maybe abandon this and pursue another path, but since this is a learning exercise I wanted to fix as many potential bad habits as possible, early, before continuing on a new path).
How does this rate on the ugliness stakes? :) Is it now readable to an experienced lisper?
; better (standard?) formatting
(defun new-union-helper (x y seen)
(cond ((and (null x)
(null y))
nil)
((and (null x)
(member (car y) seen)) ; replacing find with member stops duplicate nils
(new-union-helper (cdr y) x seen))
((null x)
(cons (car y)
(new-union-helper (cdr y) x
(cons (car y) seen))))
((member (car x) seen)
(new-union-helper (cdr x) y seen))
(t
(cons (car x)
(new-union-helper y (cdr x)
(cons (car x) seen))))))
(defun new-union (list1 list2 &aux (list3 (reverse list1)))
(loop for e in list2 do (pushnew e list3))
(reverse list3))
(defun new-union (list1 list2 &aux (list3 (reverse list1)))
(dolist (e list2 (reverse list3))
(pushnew e list3)))
Union takes two lists as arguments and will return a new list with the duplicates removed as you know. You want to retain the order of the original lists it appears. The specific question from the book if I recall is that if you have the lists:
(new-union '(a b c) '(b a d))
It should return:
(A B C D)
in order to maintain the proper order. So i'd imagine you need a function that takes two lists obviously, and something such as an accumulator so that you do not destructure the original lists. Union is a "non-destructuring" function. Since we are working with lists, you can use the dolist macro so that we can loop through both lists. That would lead us to the conclusion that the function below may work, as it will maintain the original structure of both lists, maintain the order of both lists, and remove duplicates:
(defun new-union(lst1 lst2)
(let((accum nil))
(dolist(x lst1)
(push x accum))
(dolist(y lst2)
(if(not(find y accum))
(push y accum)))
(nreverse accum))
We can push each element from the first list to our accumulator, and then we can iterate through the second list and ONLY push it to the list if it is not an element that has already been pushed to the accumulator. This way, we avoid duplicates, maintain the structure of both of the original lists, and maintain the proper order if we return the our accumulator with the reverse function. Let's test it in the REPL:
CL-USER> (new-union '(a b c) '(b a d))
(A B C D)
Here is a recursive implementation. It can be made faster with a few hacks. For example, a hash-table may be used to save elements that have been seen. In that case, find will be replaced with a hash-table lookup which is constant time.
(defun new-union (lst1 lst2)
"return xs U ys preserving order in originals"
(labels ((rec (xs ys acc)
(let ((x (car xs))
(xx (cdr xs))
(y (car ys))
(yy (cdr ys)))
(cond ((and (null xs) (null ys))
acc)
((null xs)
(or (and (find y acc) (rec xx yy acc))
(rec xx yy (cons y acc))))
((null ys)
(or (and (find x acc) (rec xx yy acc))
(rec xx yy (cons x acc))))
((and (find x acc) (find y acc))
(rec xx yy acc))
((and (find x acc) (not (find y acc)))
(rec xx yy (cons y acc)))
((and (not (find x acc)) (find y acc))
(rec xx yy (cons x acc)))
(t (rec xx yy (cons y (cons x acc))))))))
(nreverse (rec lst1 lst2 nil))))
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.
I'm trying to learn some functional programming and am doing project euler problems in scheme (racket) to get me started. I'm currently on problem 15 and I think I have a correct function for computing the number of paths in the lattice. Problem is that for large number of gridSize the function takes very long time to run.
(define uniqueTraverse
(lambda (x y gridSize)
(cond
((and (eq? x gridSize) (eq? y gridSize)) 1)
((eq? x gridSize) (uniqueTraverse x (+ y 1) gridSize))
((eq? y gridSize) (uniqueTraverse (+ x 1) y gridSize))
(else (+ (uniqueTraverse (+ x 1) y gridSize)
(uniqueTraverse x (+ y 1) gridSize))))))
I'm trying to figure out how to make this function tail call recursive but I don't know how to do it. I need some help getting started on how to think about optimizing functions like this using tail call optimization.
The problem is that you recompute the same results over and over again.
To solve this, you don't need tail calls - you need to remember old
results and return them without recomputing them. This technique is called memoization.
This is one solution:
#lang racket
(define old-results (make-hash))
(define uniqueTraverse
(lambda (x y gridSize)
(define old-result (hash-ref old-results (list x y) 'unknown))
(cond
; if the result is unknown, compute and remember it
[(eq? old-result 'unknown)
(define new-result
(cond
((and (eq? x gridSize) (eq? y gridSize)) 1)
((eq? x gridSize) (uniqueTraverse x (+ y 1) gridSize))
((eq? y gridSize) (uniqueTraverse (+ x 1) y gridSize))
(else (+ (uniqueTraverse (+ x 1) y gridSize)
(uniqueTraverse x (+ y 1) gridSize)))))
(hash-set! old-results (list x y) new-result)
new-result]
; otherwise just return the old result
[else old-result])))
(uniqueTraverse 0 0 2)
Memoization is one way, another is to use a different data representation.
I used the grid represented as a matrix, or vector of vectors.
Then set the value of the top row to 1 (as there is only on path on the top edge.
After that the next row ther first of the row is one, the second is the value of the entry in the column one above, plus the entry of or value before it in the row,
Recurse for each of the points in the row, and then for each row.
The answer then is the last point in the last row when you are done recursing.
For a 3x3 grid
1 1 1
1 2 3
1 3 6
6
Where the keys are very close together, (continuous, or nearly so) a vector representation is going to be more performant than a hash.
(define (make-lattice-point-square n)
(let ((lps (make-vector (+ n 1))))
(let loop ((i 0))
(if (> i n)
lps
(begin
(vector-set! lps i (make-vector (+ n 1)))
(loop (++ i)))))))
(define (lattice-ref lat x y)
;; where x is row, y is column thought it's not really important
(vector-ref (vector-ref lat y) x))
(define (lattice-set! lat x y value)
(vector-set! (vector-ref lat y) x value))
;; paths through a point are equal the the paths through the above point,
;; plus the paths through the left, those along the top and left edges
;; only have one possible path through them
(define (ways-exit-lattice n)
(let ((lps (make-lattice-point-square n)))
(letrec
((helper
(lambda (x y)
(if (or (= x 0) (= y 0))
(lattice-set! lps x y 1)
(lattice-set! lps x y
(+ (lattice-ref lps (- x 1) y)
(lattice-ref lps x (- y 1)))))))
(lattice-walker
(lambda (x y)
(cond ((and (= x n) (= y n))
(begin (helper x y) (lattice-ref lps x y)))
((= y n)
(begin
(helper x y)
(lattice-walker (++ x) 0)))
(else
(begin
(helper x y)
(lattice-walker x (++ y))))))))
(lattice-walker 0 0))))
notice all the calls to latice-walker are tail calls.
using RSR5 compliant scheme