A long-run function like infinite loop:
> (define appendInf
(lambda (lst)
(appendInf (cons 1 lst)))
In Chez Scheme, make-engine can achieve the stopping after ticks:
> (define eng
(make-engine
(lambda ()
(appendInf '()))))
While of course with the scope of lst I get error when:
> (eng 50
list
(lambda (new-eng)
(set! eng new-eng)
(length lst)))
Exception: variable lst is not bound
If I want to get the value 'lst' in appendInf when the time limit is reached, I use set!:
> (define lst '())
> (define appendInf
(lambda (ls)
(set! lst (cons 1 ls))
(appendInf lst)))
now I can get:
> (eng 50
list
(lambda (new-eng)
(set! eng new-eng)
(length lst)))
8
So for every variable within the function I want to trace, a global variable needs to be added, and one more transforming by adding (set!…).
is this a correct way to handle any enclosed variables?
if yes to 1, in Scheme is there a better way to achieve this?
is there any programming language that can more easily
implement this kind of debugging?
Well. I'm using racket and it has a pretty good debugger and does standard r6rs as well as non-standard racket.
;; macro to do the heavy work
(define-syntax recdb
(syntax-rules ()
((_ thunk fun a1 ...)
(let ((orig-fun fun)(ethunk thunk))
(fluid-let ((fun (lambda args
(if (ethunk)
(apply orig-fun args) ;; set breakpoint on this
(apply orig-fun args)))))
(fun a1 ...))))))
;; a time-thunk generator
(define (period-sec sec)
(let ((time-done (+ sec (current-seconds))))
(lambda ()
(if (< time-done (current-seconds))
(begin
(set! time-done (+ sec (current-seconds)))
#t)
#f))))
;; a round-thunk generator
(define (rounds n)
(let ((rounds-to-go n))
(lambda ()
(if (zero? rounds-to-go)
(begin
(set! rounds-to-go (- n 1))
#t)
(begin
(set! rounds-to-go (- rounds-to-go 1))
#f)))))
;; my never ending procedure
(define (always n)
(always (+ n 1)))
;; one of the ones below to implement
(recdb (rounds 10) always 0))
(recdb (period-sec 1) always 0)
;; functions with auxillary procedures need to have their gut changed for it to work
(define (fib n)
(define (fib-aux n a b)
(if (= n 0)
a
(fib-aux (- n 1) b (+ a b))))
(recdb (period-sec 2) fib-aux n 0 1))
;; trying it
(fib 200000)
Now. Just run the debugger and set breakpoint (right click expression in the macro and choose "Pause at this point") where it's indicated in the code and you have a way to examine the variables every x seconds or x times.
Happy debugging :)
Related
I have a little noob question. I have to do a homework on genetic programming in scheme and the first step is to finish some given functions.
I got to a point where i have to execute a randomly generated function with all the possible parameters in a range (using map). The "function" is list like '(* (+ 1 x) (- x (* 2 3))).
How can i execute it with a given parameter? (for example x = 2). By the way, the generated function has a maximum of 1 parameter (it's x or none).
Thanks!
Here's my solution:
(define (execute expr)
(lambda (x)
(let recur ((expr expr))
(case expr
((x) x)
((+) +)
((-) -)
((*) *)
((/) /)
(else
(if (list? expr)
(apply (recur (car expr)) (map recur (cdr expr)))
expr))))))
Example usage:
> (define foo (execute '(* (+ 1 x) (- x (* 2 3)))))
> (foo 42)
=> 1548
Here is my code:
(define (squares 1st)
(let loop([1st 1st] [acc 0])
(if (null? 1st)
acc
(loop (rest 1st) (* (first 1st) (first 1st) acc)))))
My test is:
(test (sum-squares '(1 2 3)) => 14 )
and it's failed.
The function input is a list of number [1 2 3] for example, and I need to square each number and sum them all together, output - number.
The test will return #t, if the correct answer was typed in.
This is rather similar to your previous question, but with a twist: here we add, instead of multiplying. And each element gets squared before adding it:
(define (sum-squares lst)
(if (empty? lst)
0
(+ (* (first lst) (first lst))
(sum-squares (rest lst)))))
As before, the procedure can also be written using tail recursion:
(define (sum-squares lst)
(let loop ([lst lst] [acc 0])
(if (empty? lst)
acc
(loop (rest lst) (+ (* (first lst) (first lst)) acc)))))
You must realize that both solutions share the same structure, what changes is:
We use + to combine the answers, instead of *
We square the current element (first lst) before adding it
The base case for adding a list is 0 (it was 1 for multiplication)
As a final comment, in a real application you shouldn't use explicit recursion, instead we would use higher-order procedures for composing our solution:
(define (square x)
(* x x))
(define (sum-squares lst)
(apply + (map square lst)))
Or even shorter, as a one-liner (but it's useful to have a square procedure around, so I prefer the previous solution):
(define (sum-squares lst)
(apply + (map (lambda (x) (* x x)) lst)))
Of course, any of the above solutions works as expected:
(sum-squares '())
=> 0
(sum-squares '(1 2 3))
=> 14
A more functional way would be to combine simple functions (sum and square) with high-order functions (map):
(define (square x) (* x x))
(define (sum lst) (foldl + 0 lst))
(define (sum-squares lst)
(sum (map square lst)))
I like Benesh's answer, just modifying it slightly so you don't have to traverse the list twice. (One fold vs a map and fold)
(define (square x) (* x x))
(define (square-y-and-addto-x x y) (+ x (square y)))
(define (sum-squares lst) (foldl square-y-and-addto-x 0 lst))
Or you can just define map-reduce
(define (map-reduce map-f reduce-f nil-value lst)
(if (null? lst)
nil-value
(map-reduce map-f reduce-f (reduce-f nil-value (map-f (car lst))))))
(define (sum-squares lst) (map-reduce square + 0 lst))
racket#> (define (f xs) (foldl (lambda (x b) (+ (* x x) b)) 0 xs))
racket#> (f '(1 2 3))
14
Without the use of loops or lamdas, cond can be used to solve this problem as follows ( printf is added just to make my exercises distinct. This is an exercise from SICP : exercise 1.3):
;; Takes three numbers and returns the sum of squares of two larger number
;; a,b,c -> int
;; returns -> int
(define (sum_sqr_two_large a b c)
(cond
((and (< a b) (< a c)) (sum-of-squares b c))
((and (< b c) (< b a)) (sum-of-squares a c))
((and (< c a) (< c b)) (sum-of-squares a b))
)
)
;; Sum of squares of numbers given
;; a,b -> int
;; returns -> int
(define (sum-of-squares a b)
(printf "ex. 1.3: ~a \n" (+ (square a)(square b)))
)
;; square of any integer
;; a -> int
;; returns -> int
(define (square a)
(* a a)
)
;; Sample invocation
(sum_sqr_two_large 1 2 6)
I would like to write a simple profiler for Scheme that gives a count of the number of times each function in a program is called. I tried to redefine the define command like this (eventually I'll add the other forms of define, but for now I am just trying to write proof-of-concept code):
(define-syntax define
(syntax-rules ()
((define (name args ...) body ...)
(set! name
(lambda (args ...)
(begin
(set! *profile* (cons name *profile*))
body ...))))))
My idea was to record in a list *profile* each call to a function, then later to examine the list and determine function counts. This works, but stores the function itself (that is, the printable representation of the function name, which in Chez Scheme is #<procedure f> for a function named f), but then I can't count or sort or otherwise process the function names.
How can I write a simple profiler for Scheme?
EDIT: Here is my simple profiler (the uniq-c function that counts adjacent duplicates in a list comes from my Standard Prelude):
(define *profile* (list))
(define (reset-profile)
(set! *profile* (list)))
(define-syntax define-profiling
(syntax-rules ()
((_ (name args ...) body ...)
(define (name args ...)
(begin
(set! *profile*
(cons 'name *profile*))
body ...)))))
(define (profile)
(uniq-c string=?
(sort string<?
(map symbol->string *profile*)))))
As a simple demonstration, here is a function to identify prime numbers by trial division. Function divides? is broken out separately because the profiler only counts function calls, not individual statements.
(define-profiling (divides? d n)
(zero? (modulo n d)))
(define-profiling (prime? n)
(let loop ((d 2))
(cond ((= d n) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
(define-profiling (prime-pi n)
(let loop ((k 2) (pi 0))
(cond ((< n k) pi)
((prime? k) (loop (+ k 1) (+ pi 1)))
(else (loop (+ k 1) pi)))))
> (prime-pi 1000)
168
> (profile)
(("divides?" . 78022) ("prime-pi" . 1) ("prime?" . 999))
And here is an improved version of the function, which stops trial division at the square root of n:
(define-profiling (prime? n)
(let loop ((d 2))
(cond ((< (sqrt n) d) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
> (reset-profile)
> (prime-pi 1000)
168
> (profile)
(("divides?" . 5288) ("prime-pi" . 1) ("prime?" . 999))
I'll have more to say about profiling at my blog. Thanks to both #uselpa and #GoZoner for their answers.
Change your line that says:
(set! *profile* (cons name *profile*))
to
(set! *profile* (cons 'name *profile*))
The evaluation of name in the body of a function defining name is the procedure for name. By quoting you avoid the evaluation and are left with the symbol/identifier. As you had hoped, your *profile* variable will be a growing list with one symbol for each function call. You can count the number of occurrences of a given name.
Here's a sample way to implement it. It's written in Racket but trivial to transform to your Scheme dialect.
without syntax
Let's try without macros first.
Here's the profile procedure:
(define profile
(let ((cache (make-hash))) ; the cache memorizing call info
(lambda (cmd . pargs) ; parameters of profile procedure
(case cmd
((def) (lambda args ; the function returned for 'def
(hash-update! cache (car pargs) add1 0) ; prepend cache update
(apply (cadr pargs) args))) ; call original procedure
((dmp) (hash-ref cache (car pargs))) ; return cache info for one procedure
((all) cache) ; return all cache info
((res) (set! cache (make-hash))) ; reset cache
(else (error "wot?")))))) ; unknown parameter
and here's how to use it:
(define test1 (profile 'def 'test1 (lambda (x) (+ x 1))))
(for/list ((i 3)) (test1 i))
=> '(1 2 3)
(profile 'dmp 'test1)
=> 3
adding syntax
(define-syntax define!
(syntax-rules ()
((_ (name args ...) body ...)
(define name (profile 'def 'name (lambda (args ...) body ...))))))
(define! (test2 x) (* x 2))
(for/list ((i 4)) (test2 i))
=> '(0 2 4 6)
(profile 'dmp 'test2)
=> 4
To dump all:
(profile 'all)
=> '#hash((test2 . 4) (test1 . 3))
EDIT applied to your last example:
(define! (divides? d n) (zero? (modulo n d)))
(define! (prime? n)
(let loop ((d 2))
(cond ((< (sqrt n) d) #t)
((divides? d n) #f)
(else (loop (+ d 1))))))
(define! (prime-pi n)
(let loop ((k 2) (pi 0))
(cond ((< n k) pi)
((prime? k) (loop (+ k 1) (+ pi 1)))
(else (loop (+ k 1) pi)))))
(prime-pi 1000)
=> 168
(profile 'all)
=> '#hash((divides? . 5288) (prime-pi . 1) (prime? . 999))
I'm working through the streams section of the scip and am stuck on how to define a stream.
The following is my code:
(define (memo-func function)
(let ((already-run? false)
(result false))
(lambda ()
(if (not already-run?)
(begin (set! result (function))
(set! already-run? true)
result)
result))))
(define (delay exp)
(memo-func (lambda () exp)))
(define (force function)
(function))
(define the-empty-stream '())
(define (stream-null? stream) (null? stream))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define (cons-stream a b) (cons a (memo-func (lambda () b))))
If I define integers the way that the book descibes:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
(define integers (integers-starting-from 1))
I get a message saying: Aborting!: maximum recursion depth exceeded.
I'm guessing that the delay function is not working but I don't know how to fix it. I am running the MIT scheme on my Mac.
update 1
So now with cons-stream as a macro, the integers can be defined.
But then I've got another error.
(define (stream-take n s)
(cond ((or (stream-null? s)
(= n 0)) the-empty-stream)
(else (cons-stream (stream-car s)
(stream-take (- n 1) (stream-cdr s))))))
(stream-take 10 integers)
;ERROR - Variable reference to a syntactic keyword: cons-stream
update 2
Please ignore update 1 above
cons-stream needs to be a macro in order for your sample code to work correctly. Otherwise the invocation of cons-stream will evaluate all its arguments eagerly.
Try this (not tested):
(define-syntax cons-stream
(syntax-rules ()
((cons-stream a b)
(cons a (memo-func (lambda () b))))))
P.S. Your delay needs to be a macro also, for similar reasons. Then after you fix delay, you can make your cons-stream use delay directly.
You cannot define delay as a function, since prior to calling it, Scheme will evaluate its argument - which is exactly what you're trying to postpone. SICP says this explicitly that delay should be a special form.
(define-record-type car-ivars
(fields efficiency (mutable gas-in-tank)))
(define-record-type car-methods
(fields drive! get-gas-in-tank refuel))
(define refuel (lambda (c g) ((car-methods-refuel c) g)))
(define get-gas-level
(lambda (c) ((car-methods-get-gas-in-tank c))))
(define drive!
(lambda (c distance) ((car-methods-drive! c) distance)))
(define make-car
(lambda (efficiency)
(let ([car1 (make-car-ivars efficiency 0)])
(let ([set-gas-level!
(lambda (gas) (car-ivars-gas-in-tank-set! car1 gas))]
[gas-level
(lambda () ((car-ivars-gas-in-tank car1)))])
(make-car-methods
;;drive!
(lambda (distance)
(set-gas-level!
(- (get-gas-level)
(/ efficiency distance)))
;;get-gas-level
(get-gas-levels)
;;refuel
(lambda (gas1)
(set-gas-level!
(+ (get-gas-level) gas1)))))))))
Ok, so I have this code. When i try to run my test case of (define hybrid (make-car 50))
I get an Exception: incorrect number of arguments to #procedure constructor
error. And I'm not quite sure where it is coming from.
Your definition of the drive part in make-car is missing a right parenthesis, which means that make-car-methods only gets one argument.
Re-indenting in Emacs made this pretty obvious:
(define make-car
(lambda (efficiency)
(let ([car1 (make-car-ivars efficiency 0)])
(let ([set-gas-level!
(lambda (gas) (car-ivars-gas-in-tank-set! car1 gas))]
[gas-level
(lambda () ((car-ivars-gas-in-tank car1)))])
(make-car-methods
;;drive!
(lambda (distance)
(set-gas-level!
(- (get-gas-level)
(/ efficiency distance)))
;;get-gas-level
(get-gas-levels)
;;refuel
(lambda (gas1)
(set-gas-level!
(+ (get-gas-level) gas1)))))))))