Scheme: Counting types using recursion - 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)))

Related

Taking groups of elements randomly in scheme

How do I implement a program in Scheme taking the elements of a given list and returning a new list where the elements are random gatherings of the previous list? I would like it to work for any length. For example:
Input: '(a e i o u), output: '((a e) (i o) (u)) for length 2.
My attempts (making use of for/list) are being clumsy and based on recursion. I have divided the tasks as suggested by Óscar:
Select n elements randomly from a list l:
(define (pick-n-random l n)
(take (shuffle l) n))
Remove a list l2 from a list l1:
(define (cut l1 l2)
(cond ((null? l1)
'())
((not (member (car l1) l2))
(cons (car l1) (cut (cdr l1) l2)))
(else
(cut (cdr l1) l2))))
Then, and that is my problem: how do I recurse over this process to get the intended program? Should I use for/list to paste all sublists got by this process 1. and 2.?
It's easier if we split the problem into chunks. First, let's write a couple of procedures that will allow us to take or drop n elements from a list, with appropriate results if there are not enough elements left in the list (if not for this, we could have used the built-in take and drop):
(define (take-up-to lst n)
(if (or (<= n 0) (null? lst))
'()
(cons (car lst) (take-up-to (cdr lst) (sub1 n)))))
(define (drop-up-to lst n)
(if (or (<= n 0) (null? lst))
lst
(drop-up-to (cdr lst) (sub1 n))))
With the above two procedures in place, it's easy to create another procedure to group the elements in a list into n-sized sublists:
(define (group lst n)
(if (null? lst)
'()
(cons (take-up-to lst n)
(group (drop-up-to lst n) n))))
Finally, we combine our grouping procedure with shuffle, which randomizes the contents of the list:
(define (random-groups lst n)
(group (shuffle lst) n))
It works as expected:
(random-groups '(a e i o u) 2)
=> '((e a) (u i) (o))

Number of same atomic elements in a list like (a (a b) (b c))

I would like to ask you for help with the following:
When I apply a procedure number-of-elements on the list, I need to get a list of pairs, where on the first place in the pair is the element and on the second place (after the dot) there is a number of elements occurred in the list.
For example, when typing this:
(number-of-elements '((a b c) a (b c) c (a b b)))
I got this:
((a . 3) (b . 4) (c . 3))
So far I have a code working on regular list (a b a d).
(define number-of-elements
(lambda (lst)
(define exclude
(lambda (sznm key)
(foldr (lambda (ass result)
(if (equal? (car ass) key)
result
(cons ass result)))
'()
sznm)))
(foldr (lambda (key bag)
(cond ((assoc key bag)
=> (lambda (old)
(let ((new (cons key (+ (cdr old) 1))))
(cons new (exclude bag key)))))
(else (let ((new (cons key 1)))
(cons new bag)))))
'()
lst)))
But if I use it on:
(number-of-elements '((a b c) a (b c) c (a b b)))
I got this:
(((a b c) . 1) (a . 1) ((b c) . 1) (c . 1) ((a b b) . 1))
I know I need to use a deep recursion, but I do not know, how to implement it into the code I actually have.
You already did most of the work counting the elements - but see the different implementations of bagify for a simpler implementation. One straightforward solution for dealing with nested sublists would be to flatten the input list before counting the elements:
(number-of-elements
(flatten
'((a b c) a (b c) c (a b b))))
=> '((a . 3) (b . 4) (c . 3))
If your interpreter doesn't define flatten, it's easy to implement:
(define (flatten lst)
(if (not (list? lst))
(list lst)
(apply append (map flatten lst))))
This is the idiomatic way to think about solutions in Scheme: decompose the problem in parts, then use built-in procedures to solve each subpart, and finally combine them.

Code of filter that works with constants not symbols

(define-struct pizza (size toppings))
;; Constants for testing
(define (meat item)
(symbol=? 'meat item))
(define (tomatoes item)
(symbol=? 'tomatoes item))
(define (cheese item)
(symbol=? 'cheese item))
(define (pepperoni item)
(symbol=? 'pepperoni item))
(define (hot-peppers item)
(symbol=? 'hot-peppers item))
(define (count-toppings order topping)
(cond [(empty? order) 0]
[else
(local
[(define (single-pizza-tops pizza top)
(length (filter top (pizza-toppings pizza))))
(define (list-of-nums lop tops)
(list (single-pizza-tops (first lop) tops)
(single-pizza-tops (first (rest lop)) tops)
(single-pizza-tops (first (rest (rest lop))) tops)))]
(foldr + 0 (list-of-nums order topping)))]))
Turns out my code works fine with the defined constants, but count-toppings wont work with a symbol for 'topping?
Does anyone know a way to modify my filter function so that if I input a symbol for toppings, this code will work the same way?
Map and filter can be implemented in terms of foldr and cons. Since you aren't building a list you can disregard filter and map. In general though to map recursion to higher-order function you can look at type signatures. The more difficult way is to manually match your code to that of the functions.
Map takes a list, a function or arity one, and returns a list of the function mapped to each element of the list or (a -> b) -> [a] -> [b] in Haskell notaion.
(define (map f L) ;niave implementation pared down for simplicity
(if (null? L)
'()
(cons (f (car L)) (map f (cdr L)))))
Filter takes a predicate of arity one, and a list, and returns a list that safisfies that predicate. or (a -> bool) -> [a] -> [a] in Haskell.
(define (filter pred L) ;dirro
(cond ((null? L) '())
((pred (car L))
(cons (car L)
(filter pred (cdr L))))
(else (filter pred (cdr L)))))
Foldr takes an a function that that has arity two, an accumulator value, and a list and returns the accumulator. or (a -> b -> b) -> b -> [a] -> b in haskell.
(define (foldr kons knil L) ;ditto
(if (null? L)
knil
(kons (car L) (foldr kons knil (cdr L)))))
So the trick of it at first is assuaging the argument from your function to fit. In both your funcitons you have a cond clause [(empty? topping-list) 0], which suggests knil should be 0.
In count-topping's else statement you call +, which at first glance suggests kons should be a +, however your list isn't numbers directly, meaning youll have to wrap in in a lambda statement, or create a helper function. (lambda (x acc) (+ (single-pizza-toppings (pizza-toppings x) atop) acc))
To put it together
(define (count-topping alop atop)
(foldr (lambda (x acc)
(+ (single-pizza-toppings (pizza-toppings x) atop)
acc))
0
alop))
Now the interesting one, single-pizza-toppings will look very similar. Execpt that the lambda statement will contain an if statment that returns 1 if x is a symbol equal to topping and 0 otherwise. Or you can do something even simpler.
(define (single-pizza-toppings topping-list topping)
(foldr (lambda (x acc)
(+ 1 acc))
0
(filter (lammba (x) (symbol=? x topping))
topping-list)))
That filter filter insures every x going to the foldr is a topping so you can just ignore it and add to the accumulator.
Assuming that we have the first, we can define the second by
Count the occurrences of the topping in each pizza using the first function, by way of map
Compute the sum of the resulting list
That is,
(define (count-toppings pizzas topping)
(sum (map (lambda (p) (single-pizza-toppings (pizza-toppings p) topping)) pizzas)))
For the first function, we can use filter to get a list of all occurrences of the given topping.
The number of occurrences is the length of the result:
(define (single-pizza-toppings toppings topping)
(length (filter (lambda (t) (symbol=? t topping)) toppings)))
Both functions consist of a transformation of the input into the data we're interested in, map and filter, followed by a "reduction", sum and length.
This is a very common pattern.
And if you don't have sum:
(define (sum ts)
(foldr (lambda (x acc) (+ x acc)) 0 ts))
Looks like your first step will be to put together a complete set of test cases. If you're using DrRacket, you might want to enable "Syntactic Test Suite Coverage" in the "Choose Language..." menu to make sure you have a good set of tests. That's the first step....

Sum of values in a list squared in Scheme

I'm trying to have the following program work, but for some reason it keeps telling me that my input doesnt contain the correct amount of arguments, why? here is the program
(define (sum f lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(f(sum (f car lst))) (f(sum (f cdr lst)))))
(else
(+ (f(car lst)) (f(sum (f cdr lst)))))))
and here is my input: (sum (lambda (x) (* x x)) '(1 2 3))
Thanks!
btw I take no credit for the code, Im just having fun with this one (http://groups.engin.umd.umich.edu/CIS/course.des/cis400/scheme/listsum.htm)
You're indeed passing the wrong number of arguments to the procedures sum and f, notice that the expressions (sum (f car lst)), (sum (f cdr lst)) are wrong, surely you meant (sum f (car lst)), (sum f (cdr lst)) - you don't want to apply f (a single-parameter procedure) to the two parameters that you're passing, and sum expects two arguments, but only one is passed. Try this instead:
(define (sum f lst)
(cond ((null? lst)
0)
((pair? (car lst))
(+ (sum f (car lst)) (sum f (cdr lst))))
(else
(+ (f (car lst)) (sum f (cdr lst))))))
More important: you're calling the f procedure in the wrong places. Only one call is needed in the last line, for the case when (car lst) is just a number and not a list - in the other places, both (car lst) and (cdr lst) are lists that need to be traversed; simply pass f around as a parameter taking care of correctly advancing the recursion.
Let's try the corrected procedure with a more interesting input - as it is, the procedure is capable of finding the sum of a list of arbitrarily nested lists:
(sum (lambda (x) (* x x)) '(1 (2) (3 (4)) 5))
> 55
You should take a look at either The Little Schemer or How to Design Programs, both books will teach you how to structure the solution for this kind of recursive problems over lists of lists.

Scheme: function, returning the list of numbers

Write a function (pick-numbers-simple L).
L is a simple list, which does not contain nested lists.
The result of the function is a list of the numbers in L.
The appearance order of the numbers in the result list should be the same as that in L. For example, the result of (pick-numbers-simple (list a b 1 2 c 3 d)) should be (1 2 3).
I have a whole lot of them to write, i just need a head start. If I can get a help on this one, I can do the rest.
number? should tell you whether a particular item is a number.
Once you have that, it should be pretty simple: the return value is a list composed of the current item (if and only if its a number) followed the same function operating on the remainder of the list.
To elaborate on #Jerry Coffin's answer, and because the question tagged "homework", you could write pick-numbers-simple like:
(define (pick-numbers-simple xs)
(let loop ((acc (list))
(xs xs))
(cond
((empty? xs)
(reverse acc))
((number? (car xs))
(loop (cons (car xs) acc) (cdr xs)))
(else
(loop acc (cdr xs))))))
Or using the function filter:
(define (pick-numbers-simple xs)
(filter number? xs))
Example:
> (pick-numbers-simple (list 666 'foo 13 42 'bar))
(666 13 42)
This should help:
http://see.stanford.edu/materials/icsppcs107/30-Scheme-Functions.pdf
And:
http://en.wikipedia.org/wiki/Scheme_%28programming_language%29

Resources