I'm new to Scheme...
can someone please explain for me why the for-each statement doesn't print out the output??
I have a graph defined:
(define graph '((a (b.c)) (c (d))))
and my test code:
(define testing
(lambda (a-list)
(if (null? a-list)
"size = 0"
(for-each (lambda (i)
(cons (car i) (length (cdr i)))
(length a-list))
a-list))))
when run this (testing graph), output expected is ((a . 2) (c . 1)) but it display nothing...
The for-each procedure doesn't build a list as output, it just executes a procedure on each of the input list's elements. You're looking for map, which creates a new list with the result of applying a function to each of the elements in the input list. Also notice that there are bugs in your code regarding the creation/traversal of the graph. This should fix the problems:
(define graph
'((a (b c)) ; fixed a bug here
(c (d))))
(define testing
(lambda (a-list)
(if (null? a-list)
"size = 0"
(map (lambda (i)
(cons (car i) (length (cadr i)))) ; fixed a bug here
a-list))))
Now it works as expected:
(display (testing graph))
=> '((a . 2) (c . 1))
Related
I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.
could someone help me with clarification to one of the possible solution to exercise 3.19. the procedure mystery is infinite loop in case list cycle is given as argument. nevertheless when we use procedure eq? to check if list contains the cycle, it works and provides true value.
(define (last-pair x)
(if (null? (cdr x))
x
(last-pair (cdr x))
)
)
(define (make-cycle x)
(set-cdr! (last-pair x) x)
)
(define (mystery x)
(define (loop x y)
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x)
)
)
)
(loop x '())
)
(define t (list 1 2 3))
(define w (make-cycle t))
(eq? (mystery t) t)
it looks like magic. I would appreciate for any help.
mystery reverses an array "in-place" by repeatedly snipping off the cdr of each entry and replacing that with the cdr of the previous x.
If this list has no loop, then it will end up reversed by the time you get back to the original '(). If there is a loop, you'll have the original array's pointer.
This is definitely a tricky to understand issue. If you make a box-and-pointer diagram it will definitely help and you'll only need to draw 3 diagrams.
Automatically Generating Diagrams of Lists
In the process of doing SICP myself, I found myself wanting a way to visualize list mutation (and to skip the numerous "draw a list diagram of..." exercises). I wrote a small function for doing so and I thought you might find it helpful if I shared it.
These diagrams are an example of this function being run on x each time loop (within the mystery function) is ran.
The following code is what I used for generating these diagrams. I wrote this code as a Scheme novice, but it's very simple to use: the function (list->graphviz) accepts a parameter lst which is the list you'd like a diagram of, as well as an optional argument graph-name which gives the graph a special name.
(define* (list->graphviz lst #:optional graph-name)
"""Convert a list into a set of Graphviz instructions
`lst' is the list you'd like a diagram of
`graph-name` is an optional parameter indicating the name you'd like to give the graph."""
(define number 0)
(define result "")
(define ordinals '())
(define (result-append! str)
(set! result (string-append result str)))
(define* (nodename n #:optional cell)
(format #f "cons~a~a" n (if cell (string-append ":" cell) "")))
(define* (build-connector from to #:optional from-cell)
(format #f "\t~a -> ~a;~%" (nodename from from-cell) (nodename to)))
(define (build-shape elt)
(define (build-label cell)
(cond ((null? cell) "/");; "∅") ; null character
((pair? cell) "*");; "•") ; bullet dot character
(else (format #f "~a" cell))))
(set! number (+ number 1))
(format #f "\t~a [shape=record,label=\"<car> ~a | <cdr> ~a\"];~%"
(nodename number)
(build-label (car elt))
(build-label (cdr elt))))
(define* (search xs #:optional from-id from-cell)
(let ((existing (assq xs ordinals)))
(cond
;; if we're not dealing with a pair, don't bother making a shape
((not (pair? xs)) (result-append! "\tnothing [shape=polygon, label=\"not a pair\"]\n"))
((pair? existing)
(result-append! (build-connector from-id (cdr existing) from-cell)))
(else
(begin
(result-append! (build-shape xs))
(set! ordinals (assq-set! ordinals xs number))
(let ((parent-id number))
;; make a X->Y connector
(if (number? from-id)
(result-append! (build-connector from-id parent-id from-cell)))
;; recurse
(if (pair? (car xs)) (search (car xs) parent-id "car"))
(if (pair? (cdr xs)) (search (cdr xs) parent-id "cdr"))))))))
(search lst)
(string-append "digraph " graph-name " {\n" result "}\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Here is where `mystery' begins ;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define t '(1 2 3))
(set-cdr! (cddr t) t)
(define (mystery x)
(define (loop x y graph-num)
(display (list->graphviz x (format #f "graph~a" graph-num)))
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x (+ 1 graph-num)))))
(loop x '() 0))
(mystery t)
The code above code generates Graphviz graph description statements, which must then be processed by dot (Graphviz) to be rendered to a graphical format.
For example, you can run the code above and pipe it into dot:
$ scheme generate_box_ptr.scm | dot -o ptrs.ps -Tps
This command generates a postscript file which has the advantage of separating each list into it's own page if you've run list->graphviz more than once. dot can also output PNGs, PDFs and many other file formats as the manpage describes.
I want to sort and print out a list somewhat like this:
Apple : 1
Banana : 2
...etc (each pair is on a new line, but stackoverflow shows it like this)
I find that I can get it mostly done, but I get an error that it expects a pair, while it is given an empty list. I understand that the error is because I reached the end of my list, and that I need a base case here, but I'm not sure what is required. If I check to see if the list is null, and then return the list as my base case, it doesn't output anything.
Getting the following error:
car: contract violation expected: pair? given: ()
Thanks for checking out my problem.
(define lst '( ("Apple" 1) ("Orange" 4) ("Pear"3) ("Banana" 2)) )
(define name (lambda (m)
(car m)
))
(define priority (lambda (m)
(car (cdr m))
))
(define sortList
(lambda (lst)
(sort lst
(lambda (x y)
(<(priority x)(priority y))
)
)
)
)
(define printItem (lambda (m)
(display (name m))
(display " : ")
(display (priority m))
(display "\n")
)
)
(define printQueue
(lambda (lst)
(printItem (car(sortList lst)))
(printQueue (cdr (sortList lst)))
)
)
(printQueue lst)
You must ensure that the list is not empty for the procedure to work, that's the base case. Also avoid sorting the list twice at every iteration! try this:
(define printQueue
(lambda (lst)
(unless (null? lst)
(printItem (car lst))
(printQueue (cdr lst)))))
(printQueue (sortList lst))
By the way, it'd be more idiomatic to use a for-each in this case:
(define (printQueue lst)
(for-each printItem lst))
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))
Hi I got the error mcar: contract violationexpected: mpair? given: () while running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? list) (newline))
(#t (helpy (car listy) (cdr listy))
(print (cdr listy))))))
My code is trying to return pairs in a list. For example, when I call
(print '(a b c)) it should return ((a b) (a c) (b c)).
I just fix and update my code, now it don't return error but I can only get pair ( (a b) (a c), when running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(#t (helpy (car listy) (cdr listy)))
(print (cdr listy)))))
I think that I got something wrong with the recursion
There are a couple of problems with the code. First, by convention the "else" clause of a cond should start with an else, not a #t. Second, the null? test in print should receive listy, not list. And third, you're not doing anything with the result returned by helpy in print, you're just advancing print over the cdr of the current list without doing anything with the value returned by the recursive call. Try this instead:
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(else
(displayln (helpy (car listy) (cdr listy)))
(print (cdr listy))))))
displayln is just an example, do something else with the returned result if necessary.
I try to implement like this:
#lang racket
(define data '(a b c d))
(define (one-list head line-list)
(if (null? line-list)
null
(cons
(cons head (car line-list))
(one-list head (rest line-list)))))
(letrec ([deal-data
(lambda (data)
(if (null? data)
'()
(append
(one-list (car data) (rest data))
(deal-data (rest data)))))])
(deal-data data))
run result:
'((a . b) (a . c) (a . d) (b . c) (b . d) (c . d))