Racket Rainbow Shape Recursion - recursion

I am trying to make a recursive function in Racket where from a list of colours, the function will print out multiple shapes in that order of colours. However, the function is not printing anything but "Empty List".
#lang slideshow
(require 2htdp/image)
(define a (list "red" "Orange" "Yellow" "Green" "Blue" "Purple"))
(define (Rainbow lst)
(cond
[(empty? lst) "Empty List"]
[else (circle 20 "solid" (first lst))
(Rainbow (rest lst))]))
(Rainbow a)

The displaying in REPL is done when a function returns an image. Your call (Rainbow a) can be rewritten as sequence of (begin (circle 20 "solid" ...) ...) (cond has implicit begin, so in each recursive step, one begin is added), finished with "Empty List" and begin returns last expression, so "Empty List" is finally returned:
> (begin (circle 20 "solid" "Red")
(begin (circle 20 "solid" "Orange")
(begin (circle 20 "solid" "Yellow")
"Empty List")))
"Empty List"
But you can use print and print that image into REPL:
#lang slideshow
(require 2htdp/image)
(define a (list "Red" "Orange" "Yellow" "Green" "Blue" "Purple"))
(define (Rainbow lst)
(cond
[(empty? lst) (void)]
[else (print (circle 20 "solid" (first lst)))
(Rainbow (rest lst))]))
(Rainbow a)
Note that I used void, so my REPL contains only colored circles and no other text.

Related

Scheme Lexical Parser

New to scheme and currently working on a lexical analyzer. Below is my code and I am getting the error
map: contract violation
expected: list?
given: #
argument position: 2nd
other arguments...:
#
#lang racket
(define tokens '((dog noun)
(cat noun)
(chases verb)
(the article)))
(define (getToken word)
(cadr (assq word tokens)))
(define ttw (lambda (l)
(map getToken l)))
(define (parse-sentence list)
(article list))
(define (article list)
(if (eq? (car list) 'article)
(begin
(display "Article: ")
(display (car list))
(noun (cdr list))
)
(begin
(display "Not an Article!!!")
(display (car list)))
))
(define (noun list)
(if (eq? (car list) 'noun)
(begin
(display "Noun:")
(display (car list))
(noun (cdr list))
)
"Not a noun!!!")
)
(begin
(display "Enter a Sentance in (): ")
(let ((input (read)))
(ttw (parse-sentence input))))
My input is (the dog chases the cat)
Running the program, I see that DrRacket colors this expression red:
(map getToken l)
which is part of the function
(define ttw (lambda (l)
(map getToken l)))
and since the error is
map: contract violation
expected: list?
given: #<void>
argument position: 2nd
other arguments...:
we now know that ttw is called with void as input and not a list as expected.
Where is ttw called? Clicking the "Check Syntax" icon (the check mark with the magnifying glass) and then hovering the mouse over ttw shows all uses.
The only use is in:
(ttw (parse-sentence input))
This means that parse-sentence returned void. Let's see the definition of parse-sentence:
(define (parse-sentence list)
(article list))
Okay, so the error must be in article:
(define (article list)
(if (eq? (car list) 'article)
(begin
(display "Article: ")
(display (car list))
(noun (cdr list))
)
(begin
(display "Not an Article!!!")
(display (car list)))
))
And here we see this:
(if ...
...
(begin
(display "Not an Article!!!")
(display (car list))))
The construct begin returns the value of the last expression. Here (display ...) returns void.
Checking the output, we see right before the error message:
Not an Article!!!the
So the problem is that article returns something other than a list.
However since you have found an error, I suggest you look into the function error. Something like: (error 'article (~a "Not an article, got: " (car list)). If you use error DrRacket will directly show you that an error has been found in article.

Racket recursive variable?

Fig. 65 in "How to Design Programs" is as follows:
; Nelon -> Number
; determines the smallest number on l
(define (inf l)
(cond
[(empty? (rest l)) (first l)]
[else
(local ((define smallest-in-rest (inf (rest l))))
(cond
[(< (first l) smallest-in-rest) (first l)]
[else smallest-in-rest]))]))
Can somebody explain how variable smallest-in-rest works. I get recursion in a function but a variable has me confused
It's just a shorthand (longhand ;-)) for the following:
(let ((smallest-in-rest (inf (rest l))))
(cond
[(< (first l) smallest-in-rest) (first l)]
[else smallest-in-rest]))
The let should make it clear that we're just storing the result of the (inf (rest l)) so that it only has to be written once in the code, rather than once for each branch of the cond.

Scheme syntax error when recursing

I'm writing a recursive function that will convert an expression from prefix to infix. However, I need to add in a check to make sure part of the input is not already in infix.
For example, I may get input like (+ (1 + 2) 3).
I want to change this to ((1 + 2) + 3)
Here is what I have so far:
(define (finalizePrefixToInfix lst)
;Convert a given s-expression to infix notation
(define operand (car lst))
(define operator1 (cadr lst))
(define operator2 (caddr lst))
(display lst)
(cond
((and (list? lst) (symbol? operand));Is the s-expression a list?
;It was a list. Recusively call the operands of the list and return in infix format
(display "recursing")
(list (finalizePrefixToInfix operator1) operand (finalizePrefixToInfix operator2))
)
(else (display "not recursing") lst);It was not a list. We can not reformat, so return.
)
)
However, this is giving me syntax errors but I cant figure out why. Any help?
You have to check to see if the lst parameter is a list at the very beginning (base case), otherwise car and friends will fail when applied to an atom. Try this:
(define (finalizePrefixToInfix lst)
(cond ((not (pair? lst)) lst)
(else
(define operand (car lst))
(define operator1 (cadr lst))
(define operator2 (caddr lst))
(cond
((symbol? operand)
(list (finalizePrefixToInfix operator1)
operand
(finalizePrefixToInfix operator2)))
(else lst)))))

Graph all child nodes common lisp

I need to find all nodes that are children of selected node. Graph is created like this:
(setq graf1 '((A(B C)) (B(D E)) (C (F G )) (D (H)) (E(I)) (F(J)) (G(J)) (H()) (I(J)) (J())))
So, all children from node B are (on first level) D,E, on 2nd H,I, third J.
Here's the code for finding first level children, but as i'm begineer in lisp i cant make it work for other ones.
(defun sledG (cvor graf obradjeni)
(cond ((null graf) '())
((equal (caar graf) cvor)
(dodaj (cadar graf) obradjeni))
(t(sledG cvor (cdr graf) obradjeni)))
(defun dodaj (potomci obradjeni)
(cond ((null potomci) '())
((member (car potomci) obradjeni)
(dodaj (cdr potomci) obradjeni )
(t(cons (car potomci)
(dodaj (cdr potomci) obradjeni) ))))
(setq graf1 '((A(B C)) (B(D E)) (C (F G )) (D (H)) (E(I)) (F(J)) (G(J)) (H()) (I(J)) (J())))
Using alexandria package:
(defvar *graf*
'((a (b c)) (b (d e)) (c (f g)) (d (h)) (e (i)) (f (j)) (g (j)) (h nil) (i (j)) (j nil)))
(defun descendants (tree label)
(let ((generation
(mapcan #'cadr
(remove-if-not
(alexandria:compose (alexandria:curry #'eql label) #'car)
tree))))
(append generation (mapcan (alexandria:curry #'descendants tree) generation))))
;; (D E H I J)
I believe, this is what you wanted to do. This will work for acyclic graphs, but it will recur "forever", if you have a cycle in it. If you wanted to add depth counter, you could add it as one more argument to descendants or in the last mapcan transform the resulting list by inserting the depth counter.
With depth included:
(defun descendants (tree label)
(labels ((%descendants (depth label)
(let ((generation
(mapcan #'cadr
(remove-if-not
(alexandria:compose
(alexandria:curry #'eql label) #'car)
tree))))
(append (mapcar (alexandria:compose
#'nreverse
(alexandria:curry #'list depth))
generation)
(mapcan (alexandria:curry #'%descendants (1+ depth))
generation)))))
(%descendants 0 label)))
;; ((D 0) (E 0) (H 1) (I 1) (J 2))
As I read it, the graph is a directed graph. So to find the children (directed edges) of the graph (in the example),
(defun children (node graph) (second (assoc node graph)))
then
(children 'b graf1) ; with graf1 from the OP
returns (D E). All you have to do then is to loop over the children, something like (very quick and dirty)
(defun all-children (node graph)
(let ((c (children node graph)))
(if (null c) nil
(union c (loop for x in c appending (all-children x graph))))))
This returns (J I H D E) as children of B.

Replace in a list of lists in scheme

So I have a function that replaces an element of a list with the corespondent element in a list o pairs for example if i have this : (i have a list) and ((have not) (list queue)) it will return (i not a queue)
(define replacecoresp
(lambda (ls a-list)
(map (lambda (x)
(let ((lookup (assq x a-list)))
(if lookup
(cadr lookup)
x)))
ls)))
unfortunately it doesn't work for a list of lists of lists etc what I want is to do this :
if I have a list (i have ( a list) of (list ( list and list ))) and ((list queue) (have not)) the result should be (I not (a queue) of (queue (queue and queue))) I hope you got the idea :) thanks a lot!
Try this:
(define (replacecoresp ls a-list)
(cond ((null? ls) '())
((not (list? ls))
(cond ((assq ls a-list) => cadr)
(else ls)))
(else (cons (replacecoresp (car ls) a-list)
(replacecoresp (cdr ls) a-list)))))
It works as expected:
(replacecoresp '(I have (a list) of (list (list and list)))
'((list queue) (have not)))
> (I not (a queue) of (queue (queue and queue)))
Explanation: When traversing a list of lists (say, ls) you need to consider three cases:
ls is empty, return the empty list
ls is an atom not a list, process the element
ls is a list, invoke the recursion on both the car and the cdr
of the list and combine the results
In the particular case of your question, cons is used in the third step for combining the solution; and the second case is the part where we check to see if the current symbol is in the association list, replacing it if it was found or leaving the symbol untouched if not. I used a shortcut for writing less code in this step, but you can replace the inner cond with this snippet of code if it's clearer:
(let ((lookup (assq ls a-list)))
(if lookup
(cadr lookup)
ls))
Another way to express the solution is to use a map on the list like this:
(define(replacecoresp ls a-list)
(if (not (list? ls))
(cond ((assq ls a-list) => cadr)
(else ls))
(map (lambda (l) (replacecoresp l a-list)) ls)))

Resources