I have been stuck on this question for days. Apparently I need to write a better algorithm to win the algorithm below. The below code is implemented from the famous Aima file. Is there any expert here who could guide me on how to win the algorithm?
(defun find-closest (list)
(x (car (array-dimensions list)))
(y (cadr (array-dimensions list)))
(let ((elems (aref list x y)))
(dolist (e elems)
(when (eq (type-of e) type)
(return-from find-closest (list x y)))) nil))
I tried implementing a DFS but failed and I do not quite know why. Below is my code.
(defun find-closest (list)
(let ((open (list list))
(closed (list))
(steps 0)
(expanded 0)
(stored 0))
(loop while open do
(let ((x (pop open)))
(when (finished? x)
(return (format nil "Found ~a in ~a steps.
Expanded ~a nodes, stored a maximum of ~a nodes." x steps expanded stored)))
(incf steps)
(pushnew x closed :test #'equal)
(let ((successors (successors x)))
(incf expanded (length successors))
(setq successors
(delete-if (lambda (a)
(or (find a open :test #'equal)
(find a closed :test #'equal)))
successors))
(setq open (append open successors))
(setq stored (max stored (length open))))))))
Looking at the code, the function find-some-in-grid returns the first found thing of type. This will, essentially, give you O(n * m) time for an n * m world (imagine a world, where you have one dirt on each line, alternating between "left-most" and "right-most".
Since you can pull out a list of all dirt locations, you can build a shortest traversal, or at least a shorter-than-dump traversal, by instead of picking whatever dirt you happen to find first you pick the closest (for some distance metric, from the code it looks like you have Manhattan distances (that is, you can only move along the X xor the Y axis, not both at the same time). That should give you a robot that is at least as good as the dumb-traversal robot and frequently better, even if it's not optimal.
With the provision that I do NOT have the book and base implementation purely on what's in your question, something like this might work:
(defun find-closest-in-grid (radar type pos-x pos-y)
(labels ((distance (x y)
(+ (abs (- x pos-x))
(abs (- y pos-y)))))
(destructuring-bind (width height)
(array-dimensions radar)
(let ((best nil)
((best-distance (+ width height))))
(loop for x from 0 below width
do (loop for y from 0 below height
do (loop for element in (aref radar x y)
do (when (eql (type-of element) type)
(when (<= (distance x y) best-distance)
(setf best (list x y))
(setf best-distance (distance x y))))))))
best)))
Related
I'm starting to write a function to see if a queen is 'safe' from the other positions on the board, the board is in the form of (row col) and 1-indexed. Here is what I have thus far:
(define (get-row p) (car p))
(define (get-col p) (cadr p))
(define (is-equal p1 p2)
(and (= (car p1) (car p2)) (= (cadr p1) (cadr p2))))
(define (safe? k positions)
(filter
(lambda (p) (not (and (is-equal p
(list (get-row p) k))
(is-equal p
(list (+ (get-row p) (- k (get-col p)))
k
))
(is-equal p
(list (- (get-row p) (- k (get-col p)))
k
)))))
positions))
I am trying to call it something like:
(safe? 4 '((3 1) (1 2) (4 3) (2 4)))
To see if the fourth queen (in the forth column) on the board with position (2 4) is safe.
However, what I have currently is wide of the mark and returns basically all the 'other' columns instead of the one I want. What would be a better way to do this?
There are many ways to solve this problem. For starters, I'd suggest a simpler representation for the board, I chose to use a list of numbers. The indexes in the list start from one and indicate the queen's column and the value its row (origin of coordinates is on the upper-left corner, new positions are adjoined at the end of the list); all the other positions are assumed to be empty. For instance, the following board:
(. Q)
(Q .)
Would be represented by the list '(2 1). With my representation, the safe? procedure looks like this - and notice that the diagonals? check is a bit trickier to implement:
; a new queen is safe iff there are no other queens in the same
; row nor in any of the diagonals preceding its current position
; we don't need to check the column, this is the only queen on it
(define (safe? col board)
(let ((row (list-ref board (- col 1))))
(and (<= (number-occurrences row board) 1)
(diagonals? row board))))
; counts how many times an element appears on a list
(define (number-occurrences e lst)
(count (curry equal? e) lst))
; traverses the board looking for other queens
; located in one of the diagonals, going backwards
; starting from the location of the newest queen
(define (diagonals? row board)
(let loop ((lst (cdr (reverse board)))
(upper (sub1 row))
(lower (add1 row)))
(or (null? lst)
(and (not (= (car lst) upper))
(not (= (car lst) lower))
(loop (cdr lst) (sub1 upper) (add1 lower))))))
The result is as expected:
(safe? 4 '(2 4 1 3))
=> #t
You can adapt the above code to use a different origin of coordinates if you wish so, or to use pairs of coordinates to represent the queens.
I need to create a scheme code that allows me to calculate the degree of a polynomial and show it, is there a special function in scheme that allows me to treat them?
pd: What is the way to raise these types of problems?
There is no such function just like there are no functions for guns in games in the standard libraries. There isn't even one data structure for a polynomial.
As with all user defined extensions you have the power to model your data as you wish and you make an interface to work with that data. This is how you extend the language to support the data you want to play with.
;; this is not part of the interface
(define tag-point (list 'point))
;; these are the interface
(define (point x y)
(list tag-point x y))
(define point-x cadr)
(define point-y caddr)
(define (point? p)
(and (pair? p)
(eq? (car p) tag-point)))
;; implemented distance that uses the interface
(define (distance p1 p2)
;; (assert (and (point? p1) (point? p2)))
(sqrt (+ (square (- (point-x p1) (point-x p2)))
(square (- (point-y p1) (point-y p2))))))
(distance (point 3 0 ) (point 0 4)) ; ==> 5
Now you can change your data structure as long as the interface stays intact:
;; implement points using complex numbers
(define (point x y) (make-rectangular x y))
(define (point-x p) (real-part p))
(define (point-y p) (imag-part p))
(define (point? p) (complex? p))
One could just do (define point make-rectangular) but then the interface documentation would be vague.
In the SICP videos I remember they did a polynomial type. It's in part 4B. It explains pretty much the same as I do here and they actually implement polynomials as a type you can do arithmetic on. Thus it might not be what you are looking for, but their data structure can give you an idea.
I am building an AI for a game of tick-tack-toe, using the stub given in the Realm of Racket book as a basis. So far, everything has gone well. However, when I try to run my minimax function on the root of the tree, it returns a list of the lowest possible values you can get by running it (With either player as the predicate).
Here is a code dump of the function:
(define (minimax tree player depth)
(define (generate-score tree player depth)
(define won (winner (ttt-tree-board tree)))
(if (<= depth 0) 0
(+ (cond
[(equal? won player) 1]
[(false? won) 0]
[else -1])
(apply +
(for/list ([t (ttt-tree-moves tree)])
(generate-score (second t) player (sub1 depth)))))))
(for/list ([t (ttt-tree-moves tree)])
(generate-score (second t) player depth)))
This is only my minimax function, because none of the others (except for winner) need to be displayed. Here is winner:
(define (winner board)
(or
(ormap (lambda (row) (if (all-equal? row) (first row) #f)) board) ; Horizontal
(ormap (lambda (i) (if ; Vertical
(all-equal? (map (lambda (j) (list-ref (list-ref board j) i)) (stream->list (in-range (length board)))))
(list-ref (first board) i) #f))
(stream->list (in-range (length board))))
(if ; Diagonal
(all-equal? (map (lambda (i) (list-ref (list-ref board i) i)) (stream->list (in-range (length board)))))
(first (first board)) #f)
(if ; Diagonal cont.
(all-equal? (map (lambda (i) (list-ref (reverse (list-ref board i)) i)) (stream->list (in-range (length board)))))
(last (first board)) #f)))
(It is a bit sloppy, so if anyone has an idea to make it shorter, tell me your suggestion)
ttt-tree structures follow this pattern:
(ttt-tree board moves)
In which board is a 2D array corresponding to the tick-tack-toe board (with the form '((X - O) (O X -) (- X O))), and moves is a list of possible moves that can be made from that node, each of which is a list with two elements: the position that changed, and a ttt-tree which forms the next node. So (second t) refers to the next node, if t is (list-ref (ttt-tree-moves #<ttt-tree>) x)
My original thought was that there may be some error in the cond, but I'm using equal? not eq?, so I don't see how that would be a problem. The other possibility is that I'm defining winner wrong, but I have tested it many times so I don't know what could go wrong. Please help!
It turns out that the problem was that in my winner function, I never checked if the winner was "-", the empty tile. Therefore that would trigger in most cases, activating the else clause and resulting in a score of -1.
I was wondering if this is the fastest possible version of this function.
(defun foo (x y)
(cond
;if x = 0, return y+1
((zp x) (+ 1 y))
;if y = 0, return foo on decrement x and 1
((zp y) (foo (- x 1) 1))
;else run foo on decrement x and y = (foo x (- y 1))
(t (foo (- x 1) (foo x (- y 1))))))
When I run this, I usually get stack overflow error, so I am trying to figure out a way to compute something like (foo 3 1000000) without using the computer.
From analyzing the function I think it is embedded foo in the recursive case that causes the overflow in (foo 3 1000000). But since you are decrementing y would the number of steps just equal y?
edit: removed lie from comments
12 years ago I wrote this:
(defun ackermann (m n)
(declare (fixnum m n) (optimize (speed 3) (safety 0)))
(let ((memo (make-hash-table :test #'equal))
(ncal 0) (nhit 0))
(labels ((ack (aa bb)
(incf ncal)
(cond ((zerop aa) (1+ bb))
((= 1 aa) (+ 2 bb))
((= 2 aa) (+ 3 (* 2 bb)))
((= 3 aa) (- (ash 1 (+ 3 bb)) 3))
((let* ((key (cons aa bb))
(val (gethash key memo)))
(cond (val (incf nhit) val)
(t (setq val (if (zerop bb)
(ack (1- aa) 1)
(ack (1- aa) (ack aa (1- bb)))))
(setf (gethash key memo) val)
val)))))))
(let ((ret (ack m n)))
(format t "A(~d,~d)=~:d (~:d calls, ~:d cache hits)~%"
m n ret ncal nhit)
(values ret memo)))))
As you can see, I am using an explicit formula for small a and memoization for larger a.
Note, however, that this function grows so fast that it makes little sense to try to compute the actual values; you will run out of atoms in the universe faster - memoization or not.
Conceptually speaking, stack overflows don't have anything to do with speed, but they concern space usage. For instance, consider the following implementations of length. The first will run into a stack overflow for long lists. The second will too, unless your Lisp implements tail call optimization. The third will not. All have the same time complexity (speed), though; they're linear in the length of the list.
(defun length1 (list)
(if (endp list)
0
(+ 1 (length1 (rest list)))))
(defun length2 (list)
(labels ((l2 (list len)
(if (endp list)
len
(l2 (rest list) (1+ len)))))
(l2 list 0)))
(defun length3 (list)
(do ((list list (rest list))
(len 0 (1+ len)))
((endp list) len)))
You can do something similar for your code, though you'll still have one recursive call that will contribute to stack space. Since this does appear to be the Ackermann function, I'm going to use zerop instead of zp and ack instead of foo. Thus, you could do:
(defun foo2 (x y)
(do () ((zp x) (+ 1 y))
(if (zp y)
(setf x (1- x)
y 1)
(psetf x (1- x)
y (foo x (1- y))))))
Since x is decreasing by 1 on each iteration, and the only conditional change is on y, you could simplify this as:
(defun ack2 (x y)
(do () ((zerop x) (1+ y))
(if (zerop y)
(setf x (1- x)
y 1)
(psetf x (1- x)
y (ack2 x (1- y))))))
Since y is the only thing that conditionally changes during iterations, you could further simplify this to:
(defun ack3 (x y)
(do ((x x (1- x))
(y y (if (zerop y) 1 (ack3 x (1- y)))))
((zerop x) (1+ y))))
This is an expensive function to compute, and this will get you a little bit farther, but you're still not going to get, e.g., to (ackN 3 1000000). All these definitions are available for easy copying and pasting from http://pastebin.com/mNA9TNTm.
Generally, memoization is your friend in this type of computation. Might not apply as it depends on the specific arguments in the recursion; but it is a useful approach to explore.
this is possibly much of an elementary question, but I'm having trouble with a procedure I have to write in Scheme. The procedure should return all the prime numbers less or equal to N (N is from input).
(define (isPrimeHelper x k)
(if (= x k) #t
(if (= (remainder x k) 0) #f
(isPrimeHelper x (+ k 1)))))
(define ( isPrime x )
(cond
(( = x 1 ) #t)
(( = x 2 ) #t)
( else (isPrimeHelper x 2 ) )))
(define (printPrimesUpTo n)
(define result '())
(define (helper x)
(if (= x (+ 1 n)) result
(if (isPrime x) (cons x result) ))
( helper (+ x 1)))
( helper 1 ))
My check for prime works, however the function printPrimesUpTo seem to loop forever. Basically the idea is to check whether a number is prime and put it in a result list.
Thanks :)
You have several things wrong, and your code is very non-idiomatic. First, the number 1 is not prime; in fact, is it neither prime nor composite. Second, the result variable isn't doing what you think it is. Third, your use of if is incorrect everywhere it appears; if is an expression, not a statement as in some other programming languages. And, as a matter of style, closing parentheses are stacked at the end of the line, and don't occupy a line of their own. You need to talk with your professor or teaching assistant to clear up some basic misconceptions about Scheme.
The best algorithm to find the primes less than n is the Sieve of Eratosthenes, invented about twenty-two centuries ago by a Greek mathematician who invented the leap day and a system of latitude and longitude, accurately measured the circumference of the Earth and the distance from Earth to Sun, and was chief librarian of Ptolemy's library at Alexandria. Here is a simple version of his algorithm:
(define (primes n)
(let ((bits (make-vector (+ n 1) #t)))
(let loop ((p 2) (ps '()))
(cond ((< n p) (reverse ps))
((vector-ref bits p)
(do ((i (+ p p) (+ i p))) ((< n i))
(vector-set! bits i #f))
(loop (+ p 1) (cons p ps)))
(else (loop (+ p 1) ps))))))
Called as (primes 50), that returns the list (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47). It is much faster than testing numbers for primality by trial division, as you are attempting to do. If you must, here is a proper primality checker:
(define (prime? n)
(let loop ((d 2))
(cond ((< n (* d d)) #t)
((zero? (modulo n d)) #f)
(else (loop (+ d 1))))))
Improvements are possible for both algorithms. If you are interested, I modestly recommend this essay on my blog.
First, it is good style to express nested structure by indentation, so it is visually apparent; and also to put each of if's clauses, the consequent and the alternative, on its own line:
(define (isPrimeHelper x k)
(if (= x k)
#t ; consequent
(if (= (remainder x k) 0) ; alternative
;; ^^ indentation
#f ; consequent
(isPrimeHelper x (+ k 1))))) ; alternative
(define (printPrimesUpTo n)
(define result '())
(define (helper x)
(if (= x (+ 1 n))
result ; consequent
(if (isPrime x) ; alternative
(cons x result) )) ; no alternative!
;; ^^ indentation
( helper (+ x 1)))
( helper 1 ))
Now it is plainly seen that the last thing that your helper function does is to call itself with an incremented x value, always. There's no stopping conditions, i.e. this is an infinite loop.
Another thing is, calling (cons x result) does not alter result's value in any way. For that, you need to set it, like so: (set! result (cons x result)). You also need to put this expression in a begin group, as it is evaluated not for its value, but for its side-effect:
(define (helper x)
(if (= x (+ 1 n))
result
(begin
(if (isPrime x)
(set! result (cons x result)) ) ; no alternative!
(helper (+ x 1)) )))
Usually, the explicit use of set! is considered bad style. One standard way to express loops is as tail-recursive code using named let, usually with the canonical name "loop" (but it can be any name whatever):
(define (primesUpTo n)
(let loop ((x n)
(result '()))
(cond
((<= x 1) result) ; return the result
((isPrime x)
(loop (- x 1) (cons x result))) ; alter the result being built
(else (loop (- x 1) result))))) ; go on with the same result
which, in presence of tail-call optimization, is actually equivalent to the previous version.
The (if) expression in your (helper) function is not the tail expression of the function, and so is not returned, but control will always continue to (helper (+ x 1)) and recurse.
The more efficient prime?(from Sedgewick's "Algorithms"):
(define (prime? n)
(define (F n i) "helper"
(cond ((< n (* i i)) #t)
((zero? (remainder n i)) #f)
(else
(F n (+ i 1)))))
"primality test"
(cond ((< n 2) #f)
(else
(F n 2))))
You can do this much more nicely. I reformated your code:
(define (prime? x)
(define (prime-helper x k)
(cond ((= x k) #t)
((= (remainder x k) 0) #f)
(else
(prime-helper x (+ k 1)))))
(cond ((= x 1) #f)
((= x 2) #t)
(else
(prime-helper x 2))))
(define (primes-up-to n)
(define (helper x)
(cond ((= x 0) '())
((prime? x)
(cons x (helper (- x 1))))
(else
(helper (- x 1)))))
(reverse
(helper n)))
scheme#(guile-user)> (primes-up-to 20)
$1 = (2 3 5 7 11 13 17 19)
Please don’t write Scheme like C or Java – and have a look at these style rules for languages of the lisp-family for the sake of readability: Do not use camel-case, do not put parentheses on own lines, mark predicates with ?, take care of correct indentation, do not put additional whitespace within parentheses.