I'm receiving a SBCL compiler warning message, which I don't understand:
; file: D:/Users Data/Dave/SW Library/AI/Planning/DAB Planner/support.lisp
; in: DEFUN UPDATE-HAPPENINGS
; (SORT PLANNER-PKG::HAP-UPDATES #'< :KEY #'CAR)
; ==>
; (SB-IMPL::STABLE-SORT-LIST LIST
; (SB-KERNEL:%COERCE-CALLABLE-TO-FUN
; SB-C::PREDICATE)
; (IF SB-C::KEY
; (SB-KERNEL:%COERCE-CALLABLE-TO-FUN SB-C::KEY)
; #'IDENTITY))
;
; caught STYLE-WARNING:
; The return value of STABLE-SORT-LIST should not be discarded.
;
; caught STYLE-WARNING:
; The return value of STABLE-SORT-LIST should not be discarded.
The source function generating this is as follows:
(defun update-happenings (state act-state)
"Updates act-state with happenings up through the action completion time
for all happenings, and checks for constraint violation along the way."
(declare (problem-state state act-state) (special *happenings*))
(when (null *happenings*)
(return-from update-happenings act-state))
(let* ((hap-state (copy-problem-state state)) ;initialization
(net-state (copy-problem-state act-state)) ;initialization
(obj-hap-updates (iter (for object in *happenings*)
(collect (get-object-happening-update object state
(problem-state-time act-state)))))
(next-hap-update (iter (for obj-update in obj-hap-updates)
(finding obj-update maximizing (second (car obj-update)))))
(hap-updates (iter (for obj-update in obj-hap-updates)
(append (cdr obj-update)))))
(setf (problem-state-happenings net-state) (car next-hap-update))
(setf hap-updates (sort hap-updates #'< :key #'car))
(iter (for hap-update in hap-updates) ;compute final net-state
(revise (problem-state-db net-state) (cdr hap-update)))
(iter (for hap-update in hap-updates)
(revise (problem-state-db hap-state) (cdr hap-update))
(when (constraint-violated act-state hap-state net-state)
(return-from update-happenings nil)) ;cancel action and exit
(finally (return net-state))))) ;no constraint violations encountered
All of the compiler optimization parameters are set to 1. Does anyone have an explanation or suggestions for troubleshooting this further?
Note: Edited to include entire function.
SORT may have destructive and unwanted side-effects when sorting a list.
For example here we sort a list (10 10 9 10)
CL-USER> (funcall (lambda (&aux (a (list 10 10 9 10)))
(sort a #'<)
a))
; in: FUNCALL (LAMBDA (&AUX (A (LIST 10 10 9 10))) (SORT A #'<) A)
; (SORT A #'<)
; ==>
; (SB-IMPL::STABLE-SORT-LIST LIST
; (SB-KERNEL:%COERCE-CALLABLE-TO-FUN
; SB-C::PREDICATE)
; (IF SB-C::KEY
; (SB-KERNEL:%COERCE-CALLABLE-TO-FUN SB-C::KEY)
; #'IDENTITY))
;
; caught STYLE-WARNING:
; The return value of STABLE-SORT-LIST should not be discarded.
;
; caught STYLE-WARNING:
; The return value of STABLE-SORT-LIST should not be discarded.
;
; compilation unit finished
; caught 2 STYLE-WARNING conditions
(10 10 10)
You can see that the list pointed to by a is not the result and its contents have been altered.
You can see the differences:
CL-USER> (funcall (lambda (&aux (a (list 10 10 9 10)))
(values (sort a #'<)
a)))
(9 10 10 10) ; this is the result from SORT
(10 10 10) ; this is the side-effected value of A
SBCL warns that the code does not use the result value. It's also wrong to use the side-effected list after sorting.
You should check the code and see if that is the case.
Related
I'm working on this project in Scheme and these errors on these three particular methods have me very stuck.
Method #1:
; Returns the roots of the quadratic formula, given
; ax^2+bx+c=0. Return only real roots. The list will
; have 0, 1, or 2 roots. The list of roots should be
; sorted in ascending order.
; a is guaranteed to be non-zero.
; Use the quadratic formula to solve this.
; (quadratic 1.0 0.0 0.0) --> (0.0)
; (quadratic 1.0 3.0 -4.0) --> (-4.0 1.0)
(define (quadratic a b c)
(if
(REAL? (sqrt(- (* b b) (* (* 4 a) c))))
((let ((X (/ (+ (* b -1) (sqrt(- (* b b) (* (* 4 a) c)))) (* 2 a)))
(Y (/ (- (* b -1) (sqrt(- (* b b) (* (* 4 a) c)))) (* 2 a))))
(cond
((< X Y) (CONS X (CONS Y '())))
((> X Y) (CONS Y (CONS X '())))
((= X Y) (CONS X '()))
)))#f)
Error:
assertion-violation: attempt to call a non-procedure [tail-call]
('(0.0) '())
1>
assertion-violation: attempt to call a non-procedure [tail-call]
('(-4.0 1.0) '())
I'm not sure what it is trying to call. (0.0) and (-4.0 1.0) is my expected output so I don't know what it is trying to do.
Method #2:
;Returns the list of atoms that appear anywhere in the list,
;including sublists
; (flatten '(1 2 3) --> (1 2 3)
; (flatten '(a (b c) ((d e) f))) --> (a b c d e f)
(define (flatten lst)
(cond
((NULL? lst) '())
((LIST? lst) (APPEND (CAR lst) (flatten(CDR lst))))
(ELSE (APPEND lst (flatten(CDR lst))))
)
)
Error: assertion-violation: argument of wrong type [car]
(car 3)
3>
assertion-violation: argument of wrong type [car]
(car 'a)
I'm not sure why this is happening, when I'm checking if it is a list before I append anything.
Method #3
; Returns the value that results from:
; item1 OP item2 OP .... itemN, evaluated from left to right:
; ((item1 OP item2) OP item3) OP ...
; You may assume the list is a flat list that has at least one element
; OP - the operation to be performed
; (accumulate '(1 2 3 4) (lambda (x y) (+ x y))) --> 10
; (accumulate '(1 2 3 4) (lambda (x y) (* x y))) --> 24
; (accumulate '(1) (lambda (x y) (+ x y))) --> 1
(define (accumulate lst OP)
(define f (eval OP (interaction-environment)))
(cond
((NULL? lst) '())
((NULL? (CDR lst)) (CAR lst))
(ELSE (accumulate(CONS (f (CAR lst) (CADR lst)) (CDDR lst)) OP))
)
)
Error:
syntax-violation: invalid expression [expand]
#{procedure 8664}
5>
syntax-violation: invalid expression [expand]
#{procedure 8668}
6>
syntax-violation: invalid expression [expand]
#{procedure 8672}
7>
syntax-violation: invalid expression [expand]
#{procedure 1325 (expt in scheme-level-1)}
This one I have no idea what this means, what is expand?
Any help would be greatly appreciated
code has (let () ...) which clearly evaluates to list? so the extra parentheses seems odd. ((let () +) 1 2) ; ==> 3 works because the let evaluates to a procedure, but if you try ((cons 1 '()) 1 2) you should get an error saying something like application: (1) is not a procedure since (1) isn't a procedure. Also know that case insensitivity is deprecated so CONS and REAL? are not future proof.
append concatenates lists. They have to be lists. In the else you know since lst is not list? that lst cannot be an argument of append. cons might be what you are looking for. Since lists are abstraction magic in Scheme I urge you to get comfortable with pairs. When I read (1 2 3) I see (1 . (2 . (3 . ()))) or perhaps (cons 1 (cons 2 (cons 3 '()))) and you should too.
eval is totally inappropriate in this code. If you pass (lambda (x y) (+ x y)) which evaluates to a procedure to OP you can do (OP 1 2). Use OP directly.
I have just started studying Racket/Scheme continuations and found a helpful resource - Matt Mights page. I understood everything till the nondeterministic Amb example. Can anyone explain me how continuations work in this example? Currently looks like black magic for me.
; current-continuation : -> continuation
(define (current-continuation)
(call-with-current-continuation
(lambda (cc)
(cc cc))))
; fail-stack : list[continuation]
(define fail-stack '())
; fail : -> ...
(define (fail)
(if (not (pair? fail-stack))
(error "back-tracking stack exhausted!")
(begin
(let ((back-track-point (car fail-stack)))
(set! fail-stack (cdr fail-stack))
(back-track-point back-track-point)))))
; amb : list[a] -> a
(define (amb choices)
(let ((cc (current-continuation)))
(cond
((null? choices) (fail))
((pair? choices)
(let ((choice (car choices)))
(set! choices (cdr choices))
(set! fail-stack (cons cc fail-stack))
choice)))))
; (assert condition) will cause
; condition to be true, and if there
; is no way to make it true, then
; it signals and error in the program.
(define (assert condition)
(if (not condition)
(fail)
#t))
; The following prints (4 3 5)
(let ((a (amb (list 1 2 3 4 5 6 7)))
(b (amb (list 1 2 3 4 5 6 7)))
(c (amb (list 1 2 3 4 5 6 7))))
; We're looking for dimensions of a legal right
; triangle using the Pythagorean theorem:
(assert (= (* c c) (+ (* a a) (* b b))))
(display (list a b c))
(newline)
; And, we want the second side to be the shorter one:
(assert (< b a))
; Print out the answer:
(display (list a b c))
(newline))
Oh boy...this code looks like its trying to use continuations to do proper error handling. Which is...technically...possible. But honestly, since you said you were doing this in Racket and not just scheme, it would be much better to just use Racket's exception handling mechanism directly.
But I will break down the pieces of the program.
First, the general algorithm is:
Assume a, b, and c are the first item in their respective lists.
If when running code, you reach an assert that fails, go back in time and assume that c is actually the next thing in the list.
If you've gone back in time enough to the point where you have run out of c possibilities, try the second item for b. Repeat until you run out of possibilities for b, then do the same for a.
Basically, its just a backtracking search algorithm that uses continuations in an attempt to look fancy.
The function
(define (current-continuation)
(call-with-current-continuation
(lambda (cc)
(cc cc))))
Just grabs the current continuation. Basically you can think of it as a snapshot in time, which you can access by calling it as a function. So you can do:
(let ([cc (current-continuation)])
...)
Now in that block calling cc will rewind the computation to that point, replacing cc with what you passed into it. So if you were to, say, pass cc into it, like:
(let ([cc (current-continuation)])
(cc cc))
your program would loop.
(define fail-stack '())
; fail : -> ...
(define (fail)
(if (not (pair? fail-stack))
(error "back-tracking stack exhausted!")
(begin
(let ((back-track-point (car fail-stack)))
(set! fail-stack (cdr fail-stack))
(back-track-point back-track-point)))))
; (assert condition) will cause
; condition to be true, and if there
; is no way to make it true, then
; it signals and error in the program.
(define (assert condition)
(if (not condition)
(fail)
#t))
This just keeps a stack of continuations to call when an assert fails.
; amb : list[a] -> a
(define (amb choices)
(let ((cc (current-continuation)))
(cond
((null? choices) (fail))
((pair? choices)
(let ((choice (car choices)))
(set! choices (cdr choices))
(set! fail-stack (cons cc fail-stack))
choice)))))
This sets up the space that can be explored.
; The following prints (4 3 5)
(let ((a (amb (list 1 2 3 4 5 6 7)))
(b (amb (list 1 2 3 4 5 6 7)))
(c (amb (list 1 2 3 4 5 6 7))))
; We're looking for dimensions of a legal right
; triangle using the Pythagorean theorem:
(assert (= (* c c) (+ (* a a) (* b b))))
(display (list a b c))
(newline)
; And, we want the second side to be the shorter one:
(assert (< b a))
; Print out the answer:
(display (list a b c))
(newline))
And this does the actual search, and prints out the results.
In scheme, I would like to be able to have a list of procedures that I could use on lists of numbers via map.
For example, say I have the procedure
(define (overten? x) (> x 10))
Why does this work when called with (foo '(1 2 11 12) '()) ?
(define (foo lst proc)
(map overten? lst)
)
But this gives an error called with (foo '(1 2 11 12) '(overten?)) ?
(define (foo lst proc)
(map (car proc) lst)
)
With the error being
The object overten? is not applicable.
Because '(overten?) is a list containing a symbol. Only if you evaluated overten? you would get back the procedure. You need to write (list overten?) so that arguments to list are evaluated (unlike quote).
See Why does Scheme have both list and quote?
'(overten?) is not a list with procedures. It's a list with a symbol that has nothing to do with procedures bound to that name in any scope
You need to think evaluation:
overten?
; ==> {procedure overten? blabla}
; (a implementation dependent representation of a procedure object
'overten
; ==> overten?
; (just a symbol with name "overten?", nothing to do with the procedure object above)
(list overten? 'overten?)
; ==> ({procedure overten? blabla} overten)
a list where the first element is a procedure and the second a symbol with name "overten?"
(define another-name-quoted 'overten?)
; ==> undefined
; 'overten? evaluated to a symbol, them bound to another-name-quoted
(define another-name overten?)
; ==> undefined
; overten? evaluated to a procedure, then bound to another-name
The procedure overten? is not more overten? than it is another-name.
Here is an example where we use lists of procedures. It's an implementation of the compose procedure:
(define (my-compose . procs)
(let* ((rprocs (if (zero? (length procs))
(list values)
(reverse procs)))
(proc-init (car rprocs))
(proc-list (cdr rprocs)))
(lambda args
(foldl (lambda (proc acc)
(proc acc))
(apply proc-init args)
proc-list))))
(define sum-square-sub1-sqrt
(my-compose inexact->exact
floor
sqrt
sub1
(lambda (x) (* x x))
+))
(sum-square-sub1-sqrt 1 2 3) ; 5
The function below is intended to compare every number in a list (2nd parameter) with the first parameter and for every num in the list that is greater than the second param, count it and return the total amount of elements in the list that were greater than the 'threshold'
The code I have doesn't run because I have tried to learn how recursion in Dr. Racket works, but I can't seem to understand. I am just frustrated so just know the code below isn't supposed to be close to working; functional programming isn't my thing, haha.
(define (comp-list threshold list-nums)
(cond [(empty? list-nums) 0]
[(cons? list-nums) (let {[my-var 0]}
(map (if (> threshold (first list-nums))
threshold 2) list-nums ))]))
The following doesn't use lambda of foldl (and is recursive) - can you understand how it works?
(define (comp-list threshold list-nums)
(cond [(empty? list-nums) 0]
[else
(cond [(> (car list-nums) threshold) (+ 1 (comp-list threshold (cdr list-nums)))]
[else (comp-list threshold (cdr list-nums))])]))
Tested:
> (comp-list 1 '(1 1 2 2 3 3))
4
> (comp-list 2 '(1 1 2 2 3 3))
2
> (comp-list 3 '(1 1 2 2 3 3))
0
map takes a procedure as first argument and applied that to every element in the given list(s). Since you are counting something making a list would be wrong.
foldl takes a procedure as first argument, the starting value as second and one or more lists. It applies the procedure with the elements and the starting value (or the intermediate value) and the procedure get to decide the next intermediate value. eg. you can use it to count a list:
(define (my-length lst)
(foldl (lambda (x acc) (+ acc 1))
0
lst))
(my-length '(a b c)) ; ==> 3
You can easily change this to only count when x is greater than some threshold, just evaluate to acc to keep it unchanged when you are not increasing the value.
UPDATE
A recursive solution of my-length:
(define (my-length lst)
;; auxiliary procedure since we need
;; an extra argument for counting
(define (aux lst count)
(if (null? lst)
count
(aux (cdr lst)
(+ count 1))))
;; call auxiliary procedure
(aux lst 0))
The same alteration to the procedure to foldl have to be done with this to only count in some circumstances.
(define (comp-list threshold list-nums)
(cond
[(empty? list-nums) ; there are 0 elements over the threshold in an empty list
0]
[(cons? list-nums) ; in a constructed list, we look at the the first number
(cond
[(< threshold (first list-nums))
(+ 1 ; the first number is over
(comp-list threshold (rest list-nums))] ; add the rest
[else
(comp-list threshold (rest list-nums))])])) ; the first number is lower
A simple functional start
#lang racket
(define (comp-list threshold list-nums)
(define (my-filter-function num)
(< num threshold))
(length (filter my-filter-function list-nums)))
Replacing define with lambda
#lang racket
(define (comp-list threshold list-nums)
(length (filter (lambda (num) (< num threshold))
list-nums)))
Racket's implementation of filter
In DrRacket highlighting the name of a procedure and right clicking and selecting "jump to definition in other file" will allow review of the source code. The source code for filter is instructive:
(define (filter f list)
(unless (and (procedure? f)
(procedure-arity-includes? f 1))
(raise-argument-error 'filter "(any/c . -> . any/c)" f))
(unless (list? list)
(raise-argument-error 'filter "list?" list))
;; accumulating the result and reversing it is currently slightly
;; faster than a plain loop
(let loop ([l list] [result null])
(if (null? l)
(reverse result)
(loop (cdr l) (if (f (car l)) (cons (car l) result) result)))))
I would like to have a parallel-map function implemented in Racket. Places seem like the right thing to build off of, but they're uncharted territory for me. I'm thinking the code should look something like shown below.
#lang racket
; return xs split into n sublists
(define (chunk-into n xs)
(define N (length xs))
(cond [(= 1 n) (list xs)]
[(> n N)
(cons empty
(chunk-into (sub1 n) xs))]
[else
(define m (ceiling (/ N n)))
(cons (take xs m)
(chunk-into (sub1 n) (drop xs m)))]))
(module+ test
(check-equal? (length (chunk-into 4 (range 5))) 4)
(check-equal? (length (chunk-into 2 (range 5))) 2))
(define (parallel-map f xs)
(define n-cores (processor-count))
(define xs* (chunk-into n-cores xs))
(define ps
(for/list ([i n-cores])
(place ch
(place-channel-put
ch
(map f
(place-channel-get ch))))))
(apply append (map place-channel-put ps xs*)))
This gives the error:
f: identifier used out of context in: f
All of the examples I've seen show a design pattern of providing a main function with no arguments which somehow get's used to instantiate additional places, but that's really cumbersome to use, so I'm actively trying to avoid it. Is this possible?
Note: I also tried to make a parallel-map using futures. Unfortunately, for all my tests it was actually slower than map (I tried testing using a recursive process version of fib), but here it is in case you have any suggestions for making it faster.
(define (parallel-map f xs)
(define xs** (chunk-into (processor-count) xs))
(define fs (map (λ (xs*) (future (thunk (map f xs*)))) xs**))
(apply append (map touch fs)))
I have used places before but never had to pass a function as a parameter to a place. I was able to come up with the following, rather crufty code, which uses eval:
#!/usr/bin/env racket
#lang racket
(define (worker pch)
(define my-id (place-channel-get pch)) ; get worker id
(define wch-w (place-channel-get pch)) ; get work channel (shared between controller and all workers) - worker side
(define f (place-channel-get pch)) ; get function
(define ns (make-base-namespace)) ; for eval
(let loop ()
(define n (place-channel-get wch-w)) ; get work order
(let ((res (eval `(,f ,n) ns))) ; need to use eval here !!
(eprintf "~a says ~a\n" my-id res)
(place-channel-put wch-w res) ; put response
(loop)))) ; loop forever
(define (parallel-map f xs)
(define l (length xs))
(define-values (wch-c wch-w) (place-channel)) ; create channel (2 endpoints) for work dispatch (a.k.a. shared queue)
(for ((i (in-range (processor-count))))
(define p (place pch (worker pch))) ; create place
(place-channel-put p (format "worker_~a" i)) ; give worker id
(place-channel-put p wch-w) ; give response channel
(place-channel-put p f)) ; give function
(for ((n xs))
(place-channel-put wch-c n)) ; create work orders
(let loop ((i 0) (res '())) ; response loop
(if (= i l)
(reverse res)
(let ((response (sync/timeout 10 wch-c))) ; get answer with timeout (place-channel-get blocks!)
(loop
(+ i 1)
(if response (cons response res) res))))))
(module+ main
(displayln (parallel-map 'add1 (range 10))))
Running in a console gives, for example:
worker_1 says 1
worker_1 says 3
worker_1 says 4
worker_1 says 5
worker_1 says 6
worker_1 says 7
worker_1 says 8
worker_1 says 9
worker_1 says 10
worker_0 says 2
(1 3 4 5 6 7 8 9 10 2)
As I said, crufty. All suggestions are welcome!