How to write a simple profiler for Scheme - scheme

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))

Related

Luhn algorithm in scheme

When I have a number in my list that is greater than 9 I want to separate the
digits and add them to the running sum.
The code I have is giving me and error in my sum-list definition.
(define sum-list (lst)
(if (null lst)
0
(if (>9 car lst?)
(cons ((mod (car lst) 10)) + (* (remainder (/car lst 10) 10))))
(if (>9 cdr lst?)
(cons ((mod (cdr lst)10)) + (* (remainder (/cdr lst 10) 10))))
(+ (car lst) (sum-list (cdr lst)))))
I am getting an error"Expected only one expression after the name sum-list but found one extra part.
I wrote this now in mit-scheme. I split the problem in 2 subproblems -- to conver the number to the list of digits and then to sum the digits in the resulting list.
(define n->l
(lambda (n return)
((lambda (s) (s s n return))
(lambda (s n col)
(if (zero? n)
(col '())
(s s
(quotient n 10)
(lambda (rest)
(col (cons (remainder n 10) rest)))))))))
(define sum-digits
(lambda (n)
(n->l n (lambda (l) (fold-left + 0 l)))))
(sum-digits 100)
(sum-digits 123)

Create k size permutations without to define more functions

is it possible to implement Scheme function (one function - its important) that gets a list and k, and retreive the permutations in size of k, for example: (1 2 3), k=2 will output { (1,1) , (1,2) , (1,3) , (2,1) , (2,2) , ..... } (9 options).?
Its possible to do anything without defining anything as long as you have lambda:
(define (fib n)
;; bad internal definition
(define (helper n a b)
(if (zero? n)
a
(helper (- n 1) b (+ a b))))
(helper n 0 1))
Using Z combinator:
(define Z
(lambda (f)
((lambda (g)
(f (lambda args (apply (g g) args))))
(lambda (g)
(f (lambda args (apply (g g) args)))))))
(define (fib n)
((Z (lambda (helper)
(lambda (n a b)
(if (zero? n)
a
(helper (- n 1) b (+ a b))))))
n 0 1))
Now we are never calling Z so we can substitute the value of Z for Z in the function and it will do the same:
(define (fib n)
(((lambda (f)
((lambda (g)
(f (lambda args (apply (g g) args))))
(lambda (g)
(f (lambda args (apply (g g) args))))))
(lambda (helper)
(lambda (n a b)
(if (zero? n)
a
(helper (- n 1) b (+ a b))))))
n 0 1))
There you go, Saved by Alonzo Church.
It is not only possible, it is easy. Just use a loop:
(define permute
(lambda (k lst)
(let loop ((result (map list lst))
(i 1))
(if (= i k)
result
(loop
;; code to add each element of the original list
;; to each element of the result list
(1+ i))))))

How to repeat a function call n times

I'm trying to create a function that wraps itself n times using a function called repeat
(define (repeat f n)
(if (= n 1)
f
(repeat (lambda (x) (f x)) (- n 1))))
((repeat inc 5) 2)
I'm expecting the result to be equal to
(inc (inc (inc (inc (inc 2))))) ; 7
But my result is 3
What am I doing wrong?
To be clear, I want repeat to return a function that accepts a single argument. f should not be applied until the return value of repeat is called with an argument.
e.g.,
(define inc5 (repeat inc 5))
(inc5 2) ; => 7
p.s.,
This is related but not identical to exercise 1.43 in SICP. I've solved the problem as it is presented there, but I'm curious if it can be solved this way too.
The problem with your definition is that (lambda (x) (f x)) is the same as f, i.e., your repeat repeats only once.
I think what you need is
(define (repeat f n)
(if (= n 1)
f
(lambda (x) (f ((repeat f (- n 1)) x)))))
PS. Note that you are using Scheme syntax under the Common Lisp tag; you might want to update one or the other.
Lets take a look at a similar function.
(define (repeat-exp fn ct)
(if (= ct 1)
fn
(repeat `(lambda (x) (,fn x)) (- ct 1))))
Calling it will get you
> (repeat-exp inc 5)
'(lambda (x)
((lambda (x)
((lambda (x)
((lambda (x)
((lambda (x)
(#<procedure:inc> x))
x))
x))
x))
x))
>
As you can see, your initial function only gets called once; in the innermost evaluation. If you want it to get called at each level, you need to call it there too.
(define (repeat-exp2 fn ct)
(if (= ct 1)
fn
`(lambda (x)
(,fn (,(repeat-exp2 fn (- ct 1)) x)))))
> (repeat-exp2 inc 5)
'(lambda (x)
(#<procedure:inc>
((lambda (x)
(#<procedure:inc>
((lambda (x)
(#<procedure:inc>
((lambda (x)
(#<procedure:inc>
(#<procedure:inc> x)))
x)))
x)))
x)))
>
Now you can write the numeric equivalent.
(define (repeat2 fn ct)
(if (= ct 1)
fn
(lambda (x)
(fn ((repeat2 fn (- ct 1)) x)))))
which should do what you wanted initially.
> (repeat2 inc 5)
#<procedure>
> ((repeat2 inc 5) 2)
7

Scheme - nested definition confusion

I'm currently stuck on a problem creating func and am a beginner at Scheme. In order to achieve such a result, will I have to define double inside func?
(func double 3 '(3 5 1))
would return (24 40 8) because each element is doubled 3 times.
No, double needs to be outside func because it will be passed as a parameter (bound to f) to func:
(define (double n) (* 2 n))
(define (times f e t)
(if (= t 0)
e
(times f (f e) (- t 1))))
(define (func f t lst)
(map (lambda (e) (times f e t)) lst))
then
> (func double 3 '(3 5 1))
'(24 40 8)
OTOH, in this case times could be defined inside func, but it's a reusable procedure so I'd leave it outside.
If I understand your question correctly, here's one way you can implement func:
(define (func f n lst)
(do ((n n (sub1 n))
(lst lst (map f lst)))
((zero? n) lst)))
Example usage:
> (func (lambda (x) (* x 2)) 3 '(3 5 1))
=> (24 40 8)
#lang racket
(define (repeat f x n)
(cond [(= n 0) x]
[else (f (repeat f x (- n 1)))]))
(define (func f n xs)
(map (λ(x) (repeat f x n)) xs))
(define (double x)
(* 2 x))
(func double 3 '(3 5 1))
Possibly something like this:
(define (cmap fun arg1 lst)
(map (lambda (x) (fun arg1 x)) lst))
But really you want to do this (cmap list 1 (get-some-calc x) (get-list)) but it's very difficult to make it take any curried argument and perhaps you want more than one list. You do it like this:
(let ((cval (get-come-calc x)))
(map (lambda (x) (list 1 cval x)) (get-list)))

Creating a list from conditionals during iteration

I have written a simple procedure to find the divisors of a number (not including the number itself). I have figured out how to print them, but I would like to have this function return a list containing each of the divisors.
(define (divisors n)
(do ((i 1 (+ i 1)))
((> i (floor (/ n 2))))
(cond
((= (modulo n i) 0)
(printf "~a " i)))))
My idea is to create a local list, adding elements to it where my printf expression is, and then having the function return that list. How might I go about doing that? I am new to Scheme, and Lisp in general.
Do you necessarily have to use have to use do? here's a way:
(define (divisors n)
(do ((i 1 (add1 i))
(acc '() (if (zero? (modulo n i)) (cons i acc) acc)))
((> i (floor (/ n 2)))
(reverse acc))))
But I believe it's easier to understand if you build an output list with a named let:
(define (divisors n)
(let loop ((i 1))
(cond ((> i (floor (/ n 2))) '())
((zero? (modulo n i))
(cons i (loop (add1 i))))
(else (loop (add1 i))))))
Or if you happen to be using Racket, you can use for/fold like this:
(define (divisors n)
(reverse
(for/fold ([acc '()])
([i (in-range 1 (add1 (floor (/ n 2))))])
(if (zero? (modulo n i))
(cons i acc)
acc))))
Notice that all of the above solutions are written in a functional programming style, which is the idiomatic way to program in Scheme - without using mutation operations. It's also possible to write a procedural style solution (see #GoZoner's answer), similar to how you'd solve this problem in a C-like language, but that's not idiomatic.
Just create a local variable l and extend it instead of printing stuff. When done, return it. Like this:
(define (divisors n)
(let ((l '()))
(do ((i 1 (+ i 1)))
((> i (floor (/ n 2))))
(cond ((= (modulo n i) 0)
(set! l (cons i l))))
l))
Note that because each i was 'consed' onto the front of l, the ordering in l will be high to low. Use (reverse l) as the return value if low to high ordering is needed.

Resources