(define-struct school (name students))
;; An SchoolChart is a (make-school Str (listof SchoolChart))
;; names are unique
I have a school chart say
(define s-chart (make-school "Tom" (list
(make-school "James" empty)
(make-school "Claire"
(make-school "David" empty)
(make-school "Travis" empty))
(make-school "Timmy" empty))))
This is a general tree, say I define a function
(define (find-name name school)) ;;produces true if found/false if not.
How do I go about the recursion? This specific case is fine, but each child can have infinite children? I just need a hint
There can only be a finite amount of children.
The amount is arbitrary and only bounded by your machine's memory, but it can't be infinite.
(And your s-chart is ill-formed, since "Claire"'s children are not a list.)
The recursion can be pretty simple.
Here's a depth-first search:
(define (find-name name school)
(or (string=? name (school-name school))
(any (lambda (s) (find-name name s)) (school-students school))))
where (any p ls) is #t if and only if (p e) is #t for at least one element e of the list ls.
Now all that remains is to write any...
Following recursively checks all items and, if found, add the name to a list outside the loop. However, it needs to use set!. It uses string-prefix? instead of string=? for demonstration purposes (to get more names in the current structure):
(define-struct school (name students))
(define s-chart
(make-school "Tom"
(list
(make-school "James" empty)
(make-school "Claire" (list
(make-school "David" empty)
(make-school "Travis" empty)))
(make-school "Timmy" empty))))
(define (find-name name school)
(define ol '())
(let loop ((s school))
(cond
[(list? s)
(when (not(empty? s))
(begin (loop (first s))
(loop (rest s))))]
[else
(when (string-prefix? (school-name s) name)
(set! ol (cons (school-name s) ol)))
(loop (school-students s))
]))
ol
)
(find-name "T" s-chart)
Output:
'("Timmy" "Travis" "Tom")
Related
I'm having a tough time figuring out why my function buildList-aux does not return the correct contents of the list Z.
When I run debug mode, and pause on the if statement above return Z, I can see that the value in racket is correct and as expected, however the actual contents that gets returned and printed have some sort of error (overflow? or something) and prints (shared ((-1- (list 'abc))) (list -1- -1-)).
I'm running DrRacket 6.11, Advanced Student language.
(define buildList-aux
(lambda (E Z count)
(if (<= count 0)
Z
(if (not (list? E))
(buildList-aux E (append (list E) Z) (- count 1))
(buildList-aux E (cons E Z) (- count 1))))))
(define buildList
(lambda (N E)
(buildList-aux E '() N)))
(buildList 5 '())
(buildList 3 'A)
(buildList 2 '(abc))
(buildList 3 '(A))
Expected Output:
(list '() '() '() '() '())
(list 'A 'A 'A)
(list (list 'abc) (list 'abc))
(list (list 'A) (list 'A) (list 'A))
Actual Output:
(list '() '() '() '() '())
(list 'A 'A 'A)
(shared ((-1- (list 'abc))) (list -1- -1-))
(shared ((-1- (list 'A))) (list -1- -1- -1-))
Your code is correct, it's just the way a list gets displayed in "Advanced Student". To see the correct output, do as #JohnClements suggests and go to "Language Details", and uncheck "Show Sharing in Values" box. Alternatively, switch to "Detect language from source" and specify #lang racket at the top of the file. Either way, the output will be as expected:
'(() () () () ())
'(A A A)
'((abc) (abc))
'((A) (A) (A))
But let's take a look at that weird output:
(shared ((-1- (list 'abc))) (list -1- -1-))
The above is stating that the result is:
(list -1- -1-)
Think of the -1- as a "variable" representing shared data, with a value of (list 'abc). If we substitute the "variable" with its value we get the more familiar:
(list (list 'abc) (list 'abc))
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.
For my programming languages class I'm supposed to write a function in Scheme to reverse a list without using the pre-made reverse function. So far what I got was
(define (reverseList lst)
(COND
((NULL? lst) '())
(ELSE (CONS (reverseList(CDR lst)) (CAR lst)))
))
The problem I'm having is that if I input a list, lets say (a b c) it gives me (((() . c) . b) . a).
How am I supposed to get a clean list without multiple sets of parenthesis and the .'s?
The problem with your implementation is that cons isn't receiving a list as its second parameter, so the answer you're building isn't a proper list, remember: a proper list is constructed by consing an element with a list, and the last list is empty.
One possible workaround for this is to use a helper function that builds the answer in an accumulator parameter, consing the elements in reverse - incidentally, this solution is tail recursive:
(define (reverse lst)
(reverse-helper lst '()))
(define (reverse-helper lst acc)
(if (null? lst)
acc
(reverse-helper (cdr lst) (cons (car lst) acc))))
(reverse '(1 2 3 4 5))
=> '(5 4 3 2 1)
You are half way there. The order of the elements in your result is correct, only the structure needs fixing.
What you want is to perform this transformation:
(((() . c) . b) . a) ; input
--------------------
(((() . c) . b) . a) () ; trans-
((() . c) . b) (a) ; for-
(() . c) (b a) ; mation
() (c b a) ; steps
--------------------
(c b a) ; result
This is easy to code. The car and cdr of the interim value are immediately available to us. At each step, the next interim-result is constructed by (cons (cdr interim-value) interim-result), and interim-result starts up as an empty list, because this is what we construct here - a list:
(define (transform-rev input)
(let step ( (interim-value input) ; initial set-up of
(interim-result '() ) ) ; the two loop variables
(if (null? interim-value)
interim-result ; return it in the end, or else
(step (car interim-value) ; go on with the next interim value
(cons ; and the next interim result
(... what goes here? ...)
interim-result )))))
interim-result serves as an accumulator. This is what's known as "accumulator technique". step represents a loop's step coded with "named-let" syntax.
So overall reverse is
(define (my-reverse lst)
(transform-rev
(reverseList lst)))
Can you tweak transform-rev so that it is able to accept the original list as an input, and thus skip the reverseList call? You only need to change the data-access parts, i.e. how you get the next interim value, and what you add into the interim result.
(define (my-reverse L)
(fold cons '() L)) ;;left fold
Step through the list and keep appending the car of the list to the recursive call.
(define (reverseList lst)
(COND
((NULL? lst) '())
(ELSE (APPEND (reverseList(CDR lst)) (LIST (CAR lst))))
))
Instead of using cons, try append
(define (reverseList lst)
(if (null? lst)
'()
(append (reverseList (cdr lst)) (list (car lst)) )
)
)
a sample run would be:
1]=> (reverseList '(a b c 1 2 + -))
>>> (- + 2 1 c b a)
car will give you just one symbol but cdr a list
Always make sure that you provide append with two lists.
If you don't give two lists to the cons it will give you dotted pair (a . b) rather than a list.
See Pairs and Lists for more information.
(define (walk-list lst fun) ;;walk-list(list, fun)
(if (not(null? lst)) ;;IF the list isn't NULL
(begin
(if (list? lst) ;;&& the list is actually a list , THEN{
(begin
(if (equal? (car lst) '()) ;;IF the first element in the list is empty
(fun lst) ;;THEN call the function on the list (funct is supose to get each word)
(if (not (null? lst)) ;;ELSE IF the first item isn't a list
(begin ;;{
(walk-list (car lst) fun) ;;walk-list((car lst),fun)
(walk-list (cdr lst) fun))))))))) ;;walk-list((cdr lst),fun)
(walk-list test-document display) ;;walk through the list with the given document
The will look something like this:
(define test-document '(
((h e l l o));;paragraph1
((t h i s)(i s)(t e s t));;paragraph2
))
I'm trying to get each individual word into the document have a function applied to it. Where is says (fun list). But the function is never called.
First off. begin is if you need to do more than one expression. The first expression then needs to have side effects or else it's just a waste of processing power.
Ie.
(begin
(display "hello") ; display is a side effect
(something-else))
When you don't have more than one expression begin isn't needed. if has 3 parts. They are:
(if predicate-expression ; turnas into something true or #f (the only false value)
consequent-expression ; when predicate-expression evalautes to anything but #f
alternative-expression) ; when predicate-expression evaluates to #f this is done
You should ident your code properly. Here is the code idented with DrRacket IDE, with reduncant begin removed and missing alternative-expressions added so you see where they return:
(define (walk-list lst fun) ;;walk-list(list, fun)
(if (not (null? lst)) ;;IF the list isn't NULL
(if (list? lst) ;; && the list is actually a list , THEN{
(if (equal? (car lst) '()) ;; IF the first element in the list is empty
(fun lst) ;; THEN call the function on the list (funct is supose to get each word)
(if (not (null? lst)) ;; ELSE IF the first item isn't a list
(begin ;; Here begin is needed
(walk-list (car lst) fun) ;; walk-list((car lst),fun)
(walk-list (cdr lst) fun)) ;; walk-list((cdr lst),fun)
'undfined-return-1)) ;; stop recursion, return undefined value
'undefined-return-2) ;; stop recursion, return undefined value
'undefined-return-3)) ;; stop recursion, return undefined value
So when does (fun lst) get called? Never! There is no () in any car in (((h e l l o))((t h i s) (i s) (t e s t))) and (equal? (car lst) '()) which is (null? (car lst)) will always be #f. Since we know (not (null? lst)) is #t so it will walk car and cdr where either 'undefined-return-2 or 'undefined-return-3 will be evaluated and the procedure stops when everything is visited and nothing processed.
You haven't shown what (walk-list test-document display) should have displayed but I make a wild guess that you want it for every element except pairs and null, thus I would have written this like this:
(accumulate-tree test-document display (lambda (a d) 'return) '())
accumulate-tree you'll find in this SICP handout. It demonstrates many uses for it as well. For completeness I'll supply it here:
(define (accumulate-tree tree term combiner null-value)
(cond ((null? tree) null-value)
((not (pair? tree)) (term tree))
(else (combiner
(accumulate-tree (car tree)
term
combiner
null-value)
(accumulate-tree (cdr tree)
term
combiner
null-value)))))
Judging from you code you are an Algol programmer learning your first Lisp. I advice you to look at the SICP videoes and book.
I'm a beginner with very basic knowledge in scheme and have a bit of trouble with understanding how to solve an exercise. Given a similar to the following list of structures:
(define-struct swimmer (name country time))
(define list-swimmers
(list
(make-swimmer "Hans" 'Germany 187.34)
(make-swimmer "Fred" 'USA 209.12)
(make-swimmer "Bianca" 'France 192.01)
(make-swimmer "Adolf" 'Germany 186.79)
I have to create a procedure that consumes the name of a country and the name of a list and produces the best time out of every swimmer from that country and another procedure which consumes a list of countries and produces a result with the countries, followed by the best respective time i.e
(listof swimmer) (listof symbol) -> (listof (list symbol number))
I'm having a lot of trouble with the exercise and so far only managed to write a procedure which checks if a country name exists in the list and returns true/false:
(define (contains-country? c a-list-of-swimmers)
(cond
[(empty? a-list-of-swimmers) false]
[(cons? a-list-of-swimmers)
(cond
[(symbol=? (swimmer-country (first a-list-of-swimmers))c) true]
[else
(contains-country? c (rest a-list-of-swimmers))])]))
(define (best-time-by-country (contains-country? c a-list-of-swimmers)))
I have no clue where I should go from here. Any help is much appreciated. Thanks in advance.
This exercise is quite easy to solve with the basic map, filter, and apply procedures:
(define (best-of slist country)
(apply min ; take the minimum
(map swimmer-time ; of the times
(filter ; from every entry from the selected country
(lambda (s) (eq? country (swimmer-country s)))
slist))))
(best-of list-swimmers 'Germany)
=> 186.79
and, building on that:
(define (best-of-list slist countries)
(map
(lambda (c) (list c (best-of slist c)))
countries))
(best-of-list list-swimmers '(USA France))
=> '((USA 209.12) (France 192.01))
EDIT
Given that you need to use the "Beginning Student with List Abbreviations" language in Racket which I am not familiar with, I've skimmed through the relevant doc and came up with this; I hope this is somehow in line with what you've been taught:
(define (best-of-helper slist country max-value)
(if (null? slist)
max-value
(if (eq? country (swimmer-country (car slist)))
(best-of-helper (cdr slist)
country
(if (number? max-value)
(min max-value (swimmer-time (car slist)))
(swimmer-time (car slist))))
(best-of-helper (cdr slist) country max-value))))
(define (best-of slist country)
(best-of-helper slist country #f))
(best-of list-swimmers 'Germany)
=> 186.79
and
(define (best-of-list slist countries)
(if (null? countries)
'()
(cons
(list (car countries) (best-of slist (car countries)))
(best-of-list slist (cdr countries)))))
(best-of-list list-swimmers '(USA France))
=> (list (list 'USA 209.12) (list 'France 192.01))