Recursion in Drracket - recursion

I am asked to write a racket function repeat-str that consumes a string s with length of n, and produces a new list with length of n. If n is 0, the empty list is produced. If n is greater than 0, the first string in the list contains n copies of n and the second would be n-1 and so fourth.
Ex: (repeat-str "cat") => (list "catcatcat" "catcat" "cat")
what I have:
(define (repeat-str s)
(cond
[(zero? (string-length s)) empty]
[(equal? (string-length s) 1) s]
[else (make-list (string-length s) s)
(repeat-str (make-list (sub1 (string-length s)) s))]))
I am trying to recall the the function to get n-1 on the second list but I am unsure how to do the recursion part. This is so I can get 3 separate lists and then append them all at the end.
** cannot use:
- a placeholder function
- lambda
- replicate function
Using beginning student with list abbreviations
Thank you.

Here's one way:
(define (repeat-str str)
(define (sub cnt rep)
(if (zero? cnt)
null
(cons rep (sub (- cnt 1) (string-append rep str)))))
(reverse (sub (string-length str) str)))

One can also use for/list with available built-in functions:
(define (f s)
(reverse
(for/list ((i (string-length s)))
(apply string-append (make-list (add1 i) s)))))
Testing:
(f "cat")
Output:
'("catcatcat" "catcat" "cat")

Related

Racket checkerboard program that takes the size (row x column) and size of squares as args and builds a red and black checkerboard with DrRacket

Hi I'm struggling with this problem, I don't know how to add the number of square tiles and incorporate that as a user input value, I only know how to increase the size of the tiles. So I can make the squares bigger but I can't increase the number of them. The main issue is alternating the square colors red and black and having user input of the board size. If you can show me with circles or anything else how to take user input to add more I'd appreciate any help, this is due in three days and I've been working on it for a while.
Edit: In my class we haven't learned for-loops in racket so if there's an iterative/recursive way that would help me out.
Here's my code with multiple attempts:
#lang slideshow
(define (square n) (filled-rectangle n n))
(define (redblock n) (colorize(square) "red"))
(define (blackblock n) (colorize(square) "black"))
;slideshow
(define (series n)
[hc-append (* square n)]) ; contract violation, expected: number?, given: #<procedure:square>
;slideshow
(define (rb-series mk)
(vc-append
(series [lambda (sz) (colorize (mk sz) "red")])
(series [lambda (sz) (colorize (mk sz) "black")])))
(define (checker p1 p2) ;makes 2x2
(let ([p12 (hc-append p1 p2)]
[p21 (hc-append p2 p1)])
(vc-append p12 p21)))
(define (four p) ;can we get the parameter of this as any number instead of the shape?
(define two-p (hc-append p p))
(vc-append two-p two-p))
(define (checkerboard n sz)
(let* ([redblock (colorize(square sz)"red")]
[blackblock (colorize(square sz)"black")])
(define (blackred-list n)
;(define (string lst)) ;is there a way to construct an empty string to add to?
(for ([i n])
(if (even? i)
(hc-append blackblock)
(else
(hc-append (redblock)))))) ; this else part throws an error saying no hc-append
(define (redblack-list n)
(for ([i n])
(if (even? i)
(hc-append redblock)
(else (hc-append blackblock))))) ;another else with the same issue
(define (row-list n)
(for ([i n])
(if (even? i)
(vc-append blackred-list)
(else
(vc-append redblack-list)))))
(checkerboard 5 20))) ;this is just to test it, but how would I get user input?```
Let's break it down step by step:
Define function named checkerboard:
(define (checkerboard n sz) ...
With local definitions of redblock and blackblock...
(let ([redblock (colorize (filled-rectangle sz sz) "red")]
[blackblock (colorize (filled-rectangle sz sz) "black")])
With function blackred-list (I used letrec for recursive local definitions)...
(letrec ([blackred-list
(lambda (m) (cond ((zero? m) '())
((even? m) (cons blackblock (blackred-list (sub1 m))))
(else (cons redblock (blackred-list (sub1 m))))))]
With function redblack-list, which is very similar to blackred-list, so I am leaving that as work for you.
With function row-list:
[row-list (lambda (m) (map (lambda (i) (apply hc-append (reverse
(if (even? i)
(blackred-list m)
(redblack-list m)))))
(range m)))]
Then write (apply vc-append (row-list n)) inside letrec.
User input isn't mentioned in task, because you will just call (checkerboard 6 15) (or any other test) in REPL, but you surely can do this:
> (checkerboard (read) (read))
If one can confidently write and assemble small functions then the suggestions in
the exercise may be all one needs to produce a solution. But if this is a skill
that one is learning, then following a systematic design method may
help that learning process.
The design method here is HtDF (How to Design Functions): write down stub with signature and purpose, examples, and template, then edit the template to produce the required function.
(This answer uses characters to stand for blocks -- substitute eg hc-append for list->string for images)
(define redblock #\r)
(define blackblock #\b)
#;
(define (blackred-list m) ;; Natural -> ListOfBlock ; *stub* ;; *signature*
;; produce list of m alternating blocks (last one red) ; *purpose statement*
empty) ; *stub body* (valid result)
(check-expect (blackred-list 0) empty ) ; *minimal example*
#;
(define (fn n) ; *template*
(cond ;
[(zero? n) ... ] ;
[else (.... n (fn (- n 1))) ])) ;
(check-expect (blackred-list 1) (list redblock) ) ; *examples* to guide .... edit
(check-expect (blackred-list 2) (list blackblock redblock) )
(define (blackred-list m) ;; Natural -> ListOfBlock ; (edit template)
;; produce list of m alternating blocks (last one red)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
blackblock
redblock)
(blackred-list (- m 1))) ]))
(check-expect (blackred-list 3) (list redblock blackblock redblock) )
(define (redblack-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one black)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
redblock
blackblock)
(redblack-list (- m 1))) ]))
(check-expect (redblack-list 3) (list blackblock redblock blackblock) )
#;
(define (row-list m) ;; Natural -> ListOfString ; *stub*
;; produce list of m alternating strings of blocks (last one ends in red)
empty)
(check-expect (row-list 0) empty) ; *examples* (same template)
(check-expect (row-list 1) (list "r") )
(check-expect (row-list 2) (list "rb" "br") )
(define (n-strings-of-length m n) ;; Natural Natural -> ListOfString
;; produce list of n alternating length m strings of blocks (last one ends in red)
(cond
[(zero? n) empty ]
[else (cons
(if (even? n)
(list->string (redblack-list m))
(list->string (blackred-list m)))
(n-strings-of-length m (- n 1))) ]))
(define (row-list m) ;; Natural -> ListOfString
;; produce list of m alternating length m strings of blocks (last one ends in red)
(n-strings-of-length m m))
(define (display-rows los) ;; ListOfString -> ; (from natural list recursion template)
;; display los, one element per line
(cond
[(empty? los) (void) ]
[else (begin
(display (car los))
(newline)
(display-rows (cdr los))) ]))
(define (checkerboard m) ;; Natural ->
;; display checkerboard with side m
(display-rows (row-list m)))
Welcome to DrRacket, version 8.4 [cs].
Language: Advanced Student.
All 8 tests passed!
>
The functions can now be reordered to produce the solution in specified local form:
(define redblock #\r)
(define blackblock #\b)
(define (checkerboard m) ;; Natural ->
;; display checkerboard with side m
(local [
(define (blackred-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one red)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
blackblock
redblock)
(blackred-list (- m 1))) ]))
(define (redblack-list m) ;; Natural -> ListOfBlock
;; produce list of m alternating blocks (last one black)
(cond
[(zero? m) empty ]
[else (cons
(if (even? m)
redblock
blackblock)
(redblack-list (- m 1))) ]))
(define (n-strings-of-length m n) ;; Natural Natural -> ListOfString
;; produce list of n alternating length m strings of blocks (last one ends in red)
(cond
[(zero? n) empty ]
[else (cons
(if (even? n)
(list->string (redblack-list m))
(list->string (blackred-list m)))
(n-strings-of-length m (- n 1))) ]))
(define (row-list m) ;; Natural -> ListOfString
;; produce list of m alternating length m strings of blocks (last one ends in red)
(n-strings-of-length m m))
(define (display-rows los) ;; ListOfString ->
;; display los, one element per line
(cond
[(empty? los) (void) ]
[else (begin
(display (car los))
(newline)
(display-rows (cdr los))) ])) ])
(display-rows (row-list m)))
Welcome to DrRacket, version 8.4 [cs].
Language: Advanced Student.
> (checkerboard 5)
rbrbr
brbrb
rbrbr
brbrb
rbrbr
>

Recursive function in Scheme

I need to make a recursive function that takes an object and a vector and returns a list of all the objects that preceded my object parameter.
I did it using iteration like this:
(define (precedes obj vec)
(do ((i 1 (+ i 1))
(list '() (if (eqv? obj (vector-ref vec i))
(cons(vector-ref vec (- i 1)) list)
list)))
((= i (vector-length vec)) list))
)
but I'm having a lot of trouble trying to figure out how to do the same thing using recursion. I'm confused how I can keep incrementing through the vector as I recursively call. So far, all I have is this:
(define (precedes2 obj vec)
(define list '())
(if (eqv? obj (vector-ref vec i))
(cons(vector-ref vec(- i 1)) list)
list)))
I figured I would use the same logic I used before in terms of the if statement, but I'm not sure how to now call the same function with the updated vector. Any help would be great.
You're in the interesting position of moving from an iterative implementation to a recursive one; usually people go in the other direction. Fortunately, moving from a do-loop to recursion is pretty easy. In general, a do loop can be rewritten as follows:
(do ((i i-init i-step)
(j j-init j-step)
...)
(test result)
body)
becomes
(define f (i j ...)
(cond
(test result)
(else body (f i-step j-step ...))))
(f i-init j-init ...)
That translation is usually written using a named let, though:
(let f ((i i-init)
(j j-init)
...)
(cond
(test result)
(else body (f i-step j-step ...))))
So (and I haven't tested the code) your original function
(define (precedes obj vec)
(do ((i 1 (+ i 1))
(list '() (if (eqv? obj (vector-ref vec i))
(cons(vector-ref vec (- i 1)) list)
list)))
((= i (vector-length vec)) list))
)
would turn into
(define (precedes obj vec)
(let loop ((i 1)
(list '()))
(cond
((= i (vector-length vec)) list)
(else (loop (+ i 1)
(if (eqv? obj (vector-ref vec i))
(cons (vector-ref vec (- i 1)) list)
list))))))

Scheme: Counting types using recursion

Structure Definition:
(define-struct movie (title genre stars))
;; title is a nonempty string
;; genre is a nonempty string
;; stars us a list of nonempty strings
I am trying to write a scheme function that consumes a list of movies and produces the genre that occurs most often.
So far, I have the following:
(define (popular-gnere movies)
(local
[(define acc movies genre)
(cond
[(empty? movies) genre]
[(equal? genre (movie-genre (first movies)))
(acc (rest movies genre)))
I'm stuck as to how I can keep count of how many times a specific genre has appeared in a given list of movies.
I understand that accumulated recursion in this case would be most efficient but am having trouble completing my accumulator.
Why don't you fix your parentheses problem and indent the code properly. Press CRTL+i. Where the identation is wrong you probably have missing parentheses. Press Run to evaluate and you'd get proper error messages. When you have something that doesn't produce errors, update this question.
The answer your question you add more parameters to your local procedures than the global. That way you hae a parameter that can hold a count that you increase when you find the search element in the current element.eg.
(define (length lst)
(define (length-aux lst cnt)
(if (null? lst)
cnt
(length-aux (cdr lst) (add1 cnt))))
(length-aux lst 0))
Or better with named let
(define (length lst)
(let length-aux ((lst lst) (cnt 0))
(if (null? lst)
cnt
(length-aux (cdr lst) (add1 cnt)))))
EDIT
I recommend having at least 4 helper procedures that takes each their part of a problem. (Less if you make use racket's own remove, count, and argmax). Note that there are probably many other ways to solve this but this is how I would have solved it without a hash table.
Since you are only interested in genre the first thing to imagine is that you can do (map movie-genre lst) so that you get a list of genres to work with in your main helper.
In your main helper you can build up a list of cons having genre and count. To do that you use a helper count that (count 'c '(a b c d c c a) 0) ==> 3 and you just take the first genre and count the list for those as the first accumulated value, then process the result of (remove 'c '(a b c d c c a) '()) ==> (a d b a) on the rest of the list.
When processing is done you have in your accumulator ((a . 4) (b . 6) ...) and you need a helper (max-genre 'a 4 '((b . 6) (c . 20) (d . 10))) ; ==> c
The main helper would look something like this:
(define (aux lst acc)
(if (null? lst)
(max-genre (caar acc) (cdar acc) (cdr acc))
(aux (remove (car lst) lst '())
(cons (cons (car lst) (count (car lst) lst 0)) acc))))
Now you could do it a lot simpler with a hash table in one pass. You'd still have to have max-genre/argmax after reading all elements once.
First you need to settle on a key-value datatype. You could use association lists, but hash tables are a more efficient choice.
Let's start with a short list:
(define-struct movie (title genre stars))
(define films
(list
(make-movie "Godfater" "Crime" '("Marlon Brando" "Al Pacino"))
(make-movie "Rambo" "Thriller" '("Sylvester Stallone"))
(make-movie "Silence of the Lambs" "Crime" '("Jodie Foster" "Anthony Hopkins"))))
and create an empty hash table
(define h (make-hash))
Now we process every film, updating the hash table as we go:
> (for-each (lambda (e) (hash-update! h e add1 0)) (map movie-genre films))
> h
'#hash(("Thriller" . 1) ("Crime" . 2))
Now we need to find the highest count:
> (hash-values h)
'(1 2)
> (define most (foldl (lambda (e r) (if (> e r) e r)) 0 (hash-values h)))
> most
2
So 2 is our highest count. Now we create a list of all genres with count 2:
> (hash->list h)
'(("Thriller" . 1) ("Crime" . 2))
> (foldl
(lambda (e r) (if (= (cdr e) most) (cons (car e) r) r))
null
(hash->list h))
'("Crime")
Putting it all together:
(define (count-by-genre lst)
(define h (make-hash))
(for-each (lambda (e) (hash-update! h e add1 0)) (map movie-genre lst))
(define most (foldl (lambda (e r) (if (> e r) e r)) 0 (hash-values h)))
(foldl
(lambda (e r) (if (= (cdr e) most) (cons (car e) r) r))
null
(hash->list h)))
But this is quite inefficient, for several reasons:
after updating the hash table, we have to re-iterate over it, create a list and then apply foldl just to find the highest value, whereas we could have just kept note of it while updating the hash table
then again we create a full list (hash->list) and a final result list using foldl.
Lots of consing and stuff. An alternative, more efficient version using Racket-specific for constructs, could be:
(define (count-by-genre lst)
(define h (make-hash))
(define most
(for/fold ((highest 0)) ((e (in-list (map movie-genre lst))))
(define new (add1 (hash-ref h e 0)))
(hash-set! h e new)
(max highest new)))
(for/fold ((res null)) (((k v) (in-hash h)))
(if (= v most) (cons k res) res)))

Scheme: How to delete/remove element from a vector

I'm starting scheme for Gimp script-fu and I don't find a simple way to remove item from a vector.
My only solution is to:
Convert vector to list
Remove item from the list (http://stackoverflow.com/questions/1905222/how-to-delete-an-element-from-a-list-in-scheme)
Convert list to vector
Is it a simplier way?
Here is my code:
(set! myvector (list->vector (delete item (vector->list myvector))))
(define delete
(lambda (item list)
(cond
((equal? item (car list)) (cdr list))
(else (cons (car list) (delete item (cdr list)))))))
That's the way: you need to create a new vector without the element that needs to be removed, copying all the others. But in your code, you're missing the case where the element is not present in the vector, also you don't need to create an intermediate list, go from vector to vector directly. I wrote this with Racket using standard Scheme, it should be easy enough to adapt for script-fu:
(define (vector-delete vec elt)
(let ((new-vec (if (> (vector-length vec) 0)
(make-vector (- (vector-length vec) 1))
(vector))))
(define (loop i j)
(cond ((= i (vector-length vec))
new-vec)
((equal? (vector-ref vec i) elt)
(loop (+ i 1) j))
((< j (vector-length new-vec))
(vector-set! new-vec j (vector-ref vec i))
(loop (+ i 1) (+ j 1)))
(else vec)))
(loop 0 0)))
Use it like this:
(define myvector #(1 2 3))
(set! myvector (vector-delete myvector 3))
myvector
=> '#(1 2)
Or by a more intuitive way :
(define (vector-delete v i)
(vector-append (vector-take v i) (vector-drop v (+ i 1))))

how to merge two strings ordered alphabetically, using recursion

I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.

Resources