Here is what the function should do:
I am giving it list of "pairs" that look like (((a . b) . c) ((a . b) . c) ((a. b) . c) ...)
where:
a means if the vertex is visited 1 for yes 0 for no
b means what is the value of the shortest path to the vertex so far (if it is -1 it is infinity)
c is the number of the parent (if it has so far if it doesn't it is the number of the pair if you count the first pair for 1 second for 2 and etc.)
The function should return the number of the next unvisited pair (vertex) with the lowest cost of the path so far.
Example:
(((0 . 10) . 1) ((0 . 4) . 2) ((1 . 3) . 5) ...) here it should return the number 2.
Here is the code
(define (chooseNextLowest pairs num retV pointer)
(if (null? pairs)
retV
(if (checkIfPairVis (caar pairs))
(chooseNextLowest (cdr pairs) num retV (+ 1 pointer))
(if (= -1 num)
(chooseNextLowest (cdr pairs) (cdaar pairs) pointer (+ 1 pointer))
(if (not (= -1 (cdaar pairs)))
(if (< (cdaar pairs) num)
(chooseNextLowest (cdr pairs) (cdaar pairs) pointer (+ 1 pointer))
(chooseNextLowest (cdr pairs) num retV (+ 1 pointer))))))))
I have used some function that are predefined but I think it's clear by their names what they do.
I call it with num = -1 , retV = -1 and pointer = 1, since I use -1 for infinity and I am sure retV will be changed at least 1 time because everytime I call this function will be at least 1 unvisited pair.
They work fine also this function seems to work fine when I use it with some testPairs but when I use pairs that are returned from other function (since I have to choose everytime the lowest cost unvisited vertex after I update the information in the pairs) it doesnt return any value.
Maybe you will ask to see the other function too but I can't give it at the moment since if I give it I have to give the whole sorce code to make sense so I hope the mistake is somewhere here but I can't find it.
The other function return normal pairs in the type I want them ((a . b ) . c) and etc.
Thank you very much. I am sure I didn't make some things clear so If you have questions feel free to ask me.
After formatting the code it's obvious that in the second deepest if you are lacking a alternative. if without alternative is very new in Scheme but:
(if #f 'true) ;; ==> #undefined
Looking at your code, specially checkIfPairVis it seems you do caar and that's ok for the object, but not for the list with an object. The best way to eliminate such things would be to make accessors in your code which also will make your code easier to read:
(define (choose-next-lowest pairs num ret-v pointer)
;; accessor based on object
(define vertex-visited caar)
(define vertex-shortest cdar)
(define vertex-parents cdr)
(if (null? pairs)
ret-v
(let ((obj (car pairs)))
(cond
((check-if-pair-vis (vertex-visited obj))
(choose-next-lowest (cdr pairs) num ret-v (+ 1 pointer)))
...))))
After fixing that accessor I get 2 as you predicted.
It could be other things wrong of course. Seems to me you need to debug. In DrRacket IDE you could step through your code to ensure it works as designed.
PS: A named let will add accumulators and variables you don't need to expose:
(define (choose-next-lowest pairs)
(define vertex-visited caar)
(define vertex-shortest cdar)
(define vertex-parents cdr)
(define (vertex-visited? v)
(= 1 (vertex-visited v)))
(let rec ((pairs pairs) (num -1) (ret-v -1) (pointer 1))
(if (null? pairs)
ret-v
(let ((obj (car pairs)))
(cond
((vertex-visited? obj) (rec (cdr pairs) num ret-v (+ 1 pointer)))
((= -1 num) (rec (cdr pairs) (vertex-shortest obj) pointer (+ 1 pointer)))
((= -1 (vertex-shortest obj)) 'undefined) ;; something wrong here?
((< (vertex-shortest obj) num) (rec (cdr pairs) (vertex-shortest obj) pointer (+ 1 pointer)))
(else (rec (cdr pairs) num ret-v (+ 1 pointer))))))))
(choose-next-lowest '(((0 . 10) . 1) ((0 . 4) . 2) ((1 . 3) . 5))) ; ==> 2
Your conditional at (if (not (= -1 (cdaar pairs))) ... only has a consequent clause. Without an alternate clause the return of if is undefined (officially). Specifically:
(if (not (= -1 (cdaar pairs)))
(if (< (cdaar pairs) num)
(chooseNextLowest (cdr pairs) (cdaar pairs) pointer (+ 1 pointer))
(chooseNextLowest (cdr pairs) num retV (+ 1 pointer)))
<something here>)))))
Illustrating how if has an undefined return:
> (if #f 'yes 'no)
no
> (if #f 'yes)
> ; <= nothing printed as a return, just a prompt displayed.
Related
I'm new to scheme and trying to learn functions. I want to create a function where I can count all occurrences of the atom "a" in an argument. This is what I have written so far. I'm not sure what to write in the third condition. Please help out.
(define (count-a arg)
(COND
((null? arg) 0)
((eq? arg 'a) 1)
((list? arg) ( ___ + ( ___ count-a arg)))
(else 0)
))
This is the output i want:
(count-a 'a)
1
(count-a 'aa)
0
(count-a '(a))
1
(count-a '(ab c)
0
(count-a '(a (b c) (c (d a) a) (((a b)))))
5
(___ + ( ___ count-a arg)) doesn't seem right to me. Remember Scheme is a prefix language. It's (+ 1 2 3) instead of 1 + 2 + 3.
In the third one you have two lists parts. eg. '(a a) so you need to call count-a on the car and on the cdr of the list and add the results together. eg. (count-a '(a a)) should give the same result as (+ (count-a 'a) (count-a '(a))
Good luck
Welcome to Stack Overflow!
Solution:
(define (count-a arg)
(cond ((null? arg) 0)
((not (pair? arg))
(if (equal? arg 'a)
1
0))
;; At this point we know arg is a pair, and we recurse.
(else (+ (count-a (car arg)) (count-a (cdr arg))))))
Test:
Here are the tests you specified, compressed into a single line.
;; Chibi-Scheme REPL - other implementations might look different.
> (map count-a '(a aa (a) (ab c) (a (b c) (c (d a) a) (((a b))))))
(1 0 1 0 4)
You didn't say what you want to happen if arg is a dotted pair. But let's check it out just for fun.
> (map count-a '((ab . '()) (ab . a) (a . a)))
(0 1 2)
So when I run your last test on my code, it yields 4 where you expected 5. I maintain that my code is correct and your test specification is incorrect, as there are only four instances of 'a in the argument of count-a.
Discussion:
You specified in your headline that the thing the count-a function will be counting is an atom. So you have to check whether arg is an atom or not. Since Scheme doesn't have an atom? function, I'll assume that an atom is anything that's not '() and not a pair. (This is consistent with the atom function of Common Lisp, as well as other Lisp dialects.)
Since your code already deals with arg being '(), we only have to deal with arg being, or not being a pair.
If arg is not a pair and (equal? arg 'a), then (count-a arg) equals 1. Else, it equals 0.
If arg is a pair, we can recurse into car arg) and (cdr arg), however deeply nested arg may be, and increase our count whenever we find an atom that equals a.
Hope that helps.
I am making a console Lisp survival game and I am trying to add a function where until a = b, show "." every second. Then, when a = b, set a "hurt" variable to true, and if/when that variable is true, subtract "health" by 1 until the "use-medkit" function is invoked by the user and the "hurt" variable is set false and you exit both loops.
The problem I am having is when I am prompted to use the "use-medkit" function and I type it in, it doesn't evaluate anything that I input and keeps subtracting 1 from "health". How can I call a user-inputted function while a loop is running?
Here is my code:
(setq a (random 11)) ; Random from 0 - 10
(setq b (random 11)) ; ^^^^^^^^^^^^^^^^^^
(setq hurt 0)
(setq repair 0)
(setq health 999)
(defun use-medkit ()
(setq repair 1))
(defun get-hurt ()
(loop
(progn
(setq a (random 11))
(setq b (random 11))
(progn
(princ ".")
(sleep 1)))
(if (eq a b) (progn
(setq hurt 1)
(when (eq hurt 1) (progn
(format t "~%You are hurt!~%You will lose 1 hp every 10 seconds~%~%Type use-medkit to stop the bleeding~%")
(loop
(progn
(- 1 health)
(sleep 10))
;(format t "health: ~A~%" health)
(when (eq repair 1) (progn
(return "You stopped the bleeding") (setq hurt 0) (setq repair 0))))))))))
So a program can’t do two things at once. In particular if you’re busy printing dots, sleeping and subtracting 1 from 999 then you won’t pause to see if there’s another command coming.
Unfortunately solving this problem is hard. The nicest solution in a terminal would probably use something like ncurses. Additionally there is no standard way to control input buffering. In lieu of that, here is a simple way you can do a bit of concurrency and some prompts. You might want to use a proper async library instead.
(defun maybe-read (input-stream recording-stream)
(when (listen input-stream)
(let ((char (read-char input-stream)))
(if (char= char #\Newline)
t
(progn (write-char char recording-stream) (maybe-read))))))
(defun make-partial-reader (input-stream)
(list input-stream (make-string-output-stream)))
(defun partial-read (reader)
(when (apply #'maybe-read reader)
(get-output-stream-string (second reader))))
(defun how-long-until (time)
(let ((gap
(/ (- time (get-internal-run-time)) internal-time-units-per-second)))
(cond ((< gap 0) (values 0 :late))
((<= gap 0.001) (values 0 :now))
(T (values (- gap 0.001) :soon)))))
(defun sleep-until (time)
(multiple-value-bind (span type)
(how-long-until time)
(when (> span 60) (warn “long wait!”)
(case type
(:late nil)
(:now t)
(:soon
(sleep span)
(unless (sleep-until time) (warn “poor timekeeping”))
t))))
(defmacro with-prompt-and-scheduler ((schedule) (line &optional (input *standard-input*)) &body handle-line-input)
(let ((reader (gensym)) (insched (gensym)))
`(let ((,reader (make-partial-reader ,input) (,insched)))
(flet ((,schedule (in fun &aux (at (+ (get-internal-run-time) (* in internal-time-units-per-second))))
(if (null ,insched) (push (cons at fun) schedule)
(loop for s on ,insched
for ((at2) . y) = s
if (< at at2)
do (psetf (car s) (cons at fun)
(cdr s) (cons (car s) (cdr s)))
(finish-loop)
unless y do (setf (cdr s) (acons at fun nil)) (finish-loop)))))
(loop
(if ,insched
(let ((,insched (pop ,insched)))
(when (sleep-until (car ,insched))
(let ((,line (partial-read ,reader)))
(when ,line ,#handle-line-input)))
(funcall (cdr ,insched)))
(let ((,line (concatenate 'string (get-output-stream-string (second ,reader)) (read-line (first ,reader)))))
,#handle-line))))))))
And then you could use it like:
(let ((count 0))
(with-prompt-and-scheduler (schedule) (line)
(let ((n (read-from-string line)))
(when (realp n)
(schedule n (let ((x (incf count))) (lambda () (format t "Ding ~a ~a~%" x count) (finish-output))))))))
And after running that input 10, then on the next line 5. If you do that quickly you’ll get:
Ding 2 2
Ding 1 2
With the first line appearing after 5 seconds and the second after 10. If you are slow you should get:
Ding 1 1
Ding 2 2
With the first line coming 10 seconds after you enter 10 and the second line coming 5 seconds after you enter 5.
Hopefully this can give you an idea of how to make a program seem to do two things at once.
I have writte a list reverse function in lisp and I wanted to test it but I had an error and I couldn't solve it
the function and calling is below :
(defun myreverse (list)
(cond((null list) nil))
(cons (myreverse(cdr list) (car list))))
(myreverse '(1 2 3))
any help will be appreciated...
The arguments when you defun myreverse are (list), thus when you call it (myreverse '(1 2 3)) list gets bound to (1 2 3).
Since the list is not null you suddenly do (myreverse '(2 3) 1) and list gets bound to (2 3), but what do 1 get bound to? You have no more than one argument thus the call is invalid and warrants an error.
Hint1: There is a way to make optional arguments:
(defun test (a &optional (b 0) (c 0))
(+ a b c))
(test 10) ; ==> 10
(test 10 1 2) ; ==> 13
Hint2: You need to build a list not just pass a bare element. The passed list will be the tail of the next round until the every element is added.
The bad answer (or one of the bad answers):
(defun reverse (list)
(cond ((null list) list)
(t (append (reverse (cdr list)) (cons (car list) nil)))))
A better answer:
(defun reverse (list)
(reverse-aux list nil))
(defun reverse-aux (list result)
(cond ((null list) result)
(t (reverse-aux (cdr list) (cons (car list) result)))))
It's the basic example we use in comparison to the definition of 'append' in lessons to differentiate tail recursion.
I'm having a hard time converting this rather simple Scheme function, into a function that returns another function taking in a list and applying the former function to all elements on that list.
This function
(define (operList op i lis)
(if (= 0 (length lis)) '()
(cons (op i (car lis)) (operList op i (cdr lis))))
)
Can be called like this
(operList + 2 '(1 1 1))
and returns '(3 3 3)
However, how can I edit this function so that I can call it in the following manner
((operList + 2) '(1 1 1))
with the same results
You have to return a new function that receives the list. I took the liberty of fixing the indentation and the base case (that's not how you should ask if a list if empty!); pay special attention to the way the recursion is called now:
(define (operList op i)
(lambda (lis)
(if (null? lis)
'()
(cons (op i (car lis))
((operList op i) (cdr lis))))))
It works as expected:
((operList + 2) '(1 1 1))
=> '(3 3 3)
You could also use map:
(define operList
(lambda (op i)
(lambda (lst)
(map
(lambda (x) (op i x))
lst))))
I'm new to lisp, trying to understand how lisp works, and I don't know how exactly to work with a local variable inside a large function.
here I have a little exc that I send a number to a function and if it is divisible by 3, 5 and 7 I must return a list of (by3by5by7), if only by 7, return (by7) and so on....
here is my code:
(defun checknum(n)
let* (resultt '() ) (
if(not(and(plusp n ) (integerp n))) (cons nil resultt) (progn
(if (zerop (mod n 7)) (cons 'by7 resultt) (cons nil resultt))
(if (zerop (mod n 5)) (cons 'by5 resultt) (cons nil resultt))
(if (zerop (mod n 3)) (cons 'by3 resultt) (cons nil resultt) )) ))
but if i send 21 for ex, I only get nil, instead of (by3by7) I guess the local variable is not affected by my if statements and I don't know how to do it...
(cons x y) creates a new cons cell and disposes of the result. To change the value of a variable you need to use setq, setf, push or the like, for example:
(defun checknum (n)
(let ((resultt nil))
(when (and (plusp n) (integerp n))
(when (zerop (mod n 7)) (push 'by7 resultt))
(when (zerop (mod n 5)) (push 'by5 resultt))
(when (zerop (mod n 3)) (push 'by3 resultt)))
resultt))
or perhaps, more elegantly using an internal function to factor out the repetition:
(defun checknum (n)
(when (and (plusp n) (integerp n))
(labels ((sub (d nsym res)
(if (zerop (mod n d))
(cons nsym res)
res)))
(sub 7 'by7
(sub 5 'by5
(sub 3 'by3 nil)))))
Testing:
CL-USER> (checknum 12)
(BY3)
CL-USER> (checknum 15)
(BY3 BY5)
CL-USER> (checknum 105)
(BY3 BY5 BY7)
CL-USER> (checknum 21)
(BY3 BY7)
Most lisp forms/functions don't modify their arguments. The ones that do will be explicitly documented as doing so. See adjoin and pushnew, for instance, or remove and delete.
To the point of 'trying to understand how lisp works', writing the same function in various different ways helped me a lot, so you might want to think about how you can write your function without modifying a variable at all, and why and when you would want to / not want to use destructive modifications.
Something like the below makes two passes, and will be too slow if there are a large quantity of numbers you need to check, but doesn't destructively modify anything.
(defun checknum (n)
(remove nil
(mapcar #'(lambda (m sym)
(when (zerop (mod n m)) sym))
'(7 5 3)
'(by7 by5 by3))))
The above approach can be written to not require two passes, etc.