Related
I'm arduously struggling my way through the N-queens problem in SICP (the book; I spent a few days on it -- last question here: Solving Eight-queens in scheme). Here is what I have for the helper functions:
#lang sicp
; the SICP language in Racket already defines this:
; (define nil '()
; boilerplate: filter function and range functions
(define (filter func lst)
(cond
((null? lst)
nil)
(else
(if (func (car lst))
(cons (car lst) (filter func (cdr lst)))
(filter func (cdr lst))))))
(define (range a b)
(if (> a b)
nil
(cons a (range (+ 1 a) b))))
; Selectors/handlers to avoid confusion on the (col, row) notation:
; representing it a position as (col, row), using 1-based indexing
(define (make-position col row) (cons col (list row)))
(define (col p) (car p))
(define (row p) (cadr p))
; adding a new position to a board
(define (add-new-position existing-positions p)
(append existing-positions
(list (make-position (col p) (row p)))))
; The 'safe' function
(define (any? l proc)
(cond ((null? l) #f)
((proc (car l)) #t)
(else (any? (cdr l) proc))))
(define (none? l proc) (not (any? l proc)))
(define (safe? existing-positions p)
(let ((bool (lambda (x) x)) (r (row p)) (c (col p)))
(and
; is the row safe? i.e., no other queen occupies that row?
(none? (map (lambda (p) (= (row p) r)) existing-positions)
bool)
; safe from the diagonal going up
(none? (map (lambda (p) (= r (+ (row p) (- c (col p)))))
existing-positions)
bool)
; safe from the diagonal going down
(none? (map (lambda (p) (= r (- (row p) (- c (col p)))))
existing-positions)
bool))))
And now, with that boilerplate, the actual/monstrous first working version I have of the queens problem:
(define (positions-for-col col size)
(map (lambda (ri) (make-position col ri))
(range 1 size)))
(define (queens board-size)
(define possible-positions '())
(define safe-positions '())
(define all-new-position-lists '())
(define all-positions-list '())
; existing-positions is a LIST of pairs
(define (queen-cols col existing-positions)
(if (> col board-size)
(begin
(set! all-positions-list
(append all-positions-list (list existing-positions))))
(begin
; for the column, generate all possible positions,
; for example (3 1) (3 2) (3 3) ...
(set! possible-positions (positions-for-col col board-size))
; (display "Possible positions: ") (display possible-positions) (newline)
; filter out the positions that are not safe from existing queens
(set! safe-positions
(filter (lambda (pos) (safe? existing-positions pos))
possible-positions))
; (display "Safe positions: ") (display safe-positions) (newline)
(if (null? safe-positions)
; bail if we don't have any safe positions
'()
; otherwise, build a list of positions for each safe possibility
; and recursively call the function for the next column
(begin
(set! all-new-position-lists
(map (lambda (pos)
(add-new-position existing-positions pos))
safe-positions))
; (display "All positions lists: ") (display all-new-position-lists) (newline)
; call itself for the next column
(map (lambda (positions-list) (queen-cols (+ 1 col)
positions-list))
all-new-position-lists))))))
(queen-cols 1 '())
all-positions-list)
(queens 5)
(((1 1) (2 3) (3 5) (4 2) (5 4))
((1 1) (2 4) (3 2) (4 5) (5 3))
((1 2) (2 4) (3 1) (4 3) (5 5))
((1 2) (2 5) (3 3) (4 1) (5 4))
((1 3) (2 1) (3 4) (4 2) (5 5))
To be honest, I think I did all the set!s so that I could more easily debug things (is that common?) How could I remove the various set!s to make this a proper functional-procedure?
As an update, the most 'terse' I was able to get it is as follows, though it still appends to a list to build the positions:
(define (queens board-size)
(define all-positions-list '())
(define (queen-cols col existing-positions)
(if (> col board-size)
(begin
(set! all-positions-list
(append all-positions-list
(list existing-positions))))
(map (lambda (positions-list)
(queen-cols (+ 1 col) positions-list))
(map (lambda (pos)
(add-new-position existing-positions pos))
(filter (lambda (pos)
(safe? existing-positions pos))
(positions-for-col col board-size))))))
(queen-cols 1 nil)
all-positions-list)
Finally, I think here is the best I can do, making utilization of a 'flatmap' function that helps deal with nested lists:
; flatmap to help with reduction
(define (reduce function sequence initializer)
(let ((elem (if (null? sequence) nil (car sequence)))
(rest (if (null? sequence) nil (cdr sequence))))
(if (null? sequence)
initializer
(function elem
(reduce function rest initializer)))))
(define (flatmap proc seq)
(reduce append (map proc seq) nil))
; actual
(define (queens board-size)
(define (queen-cols col existing-positions)
(if (> col board-size)
(list existing-positions)
(flatmap
(lambda (positions-list)
(queen-cols (+ 1 col) positions-list))
(map
(lambda (pos)
(add-new-position existing-positions
pos))
(filter
(lambda (pos)
(safe? existing-positions pos))
(positions-for-col col board-size))))))
(queen-cols 1 nil))
Are there any advantages of this function over the one using set! or is it more a matter of preference (I find the set! one easier to read and debug).
When you are doing the SICP problems, it would be most beneficial if you strive to adhere to the spirit of the question. You can determine the spirit from the context: the topics covered till the point you are in the book, any helper code given, the terminology used etc. Specifically, avoid using parts of the scheme language that have not yet been introduced; the focus is not on whether you can solve the problem, it is on how you solve it. If you have been provided helper code, try to use it to the extent you can.
SICP has a way of building complexity; it does not introduce a concept unless it has presented enough motivation and justification for it. The underlying theme of the book is simplification through abstraction, and in this particular section you are introduced to various higher order procedures -- abstractions like accumulate, map, filter, flatmap which operate on sequences/lists, to make your code more structured, compact and ultimately easier to reason about.
As illustrated in the opening of this section, you could very well avoid the use of such higher programming constructs and still have programs that run fine, but their (liberal) use results in more structured, readable, top-down style code. It draws parallels from the design of signal processing systems, and shows how we can take inspiration from it to add structure to our code: using procedures like map, filter etc. compartmentalize our code's logic, not only making it look more hygienic but also more comprehensible.
If you prematurely use techniques which don't come until later in the book, you will be missing out on many key learnings which the authors intend for you from the present section. You need to shed the urge to think in an imperative way. Using set! is not a good way to do things in scheme, until it is. SICP forces you down a 'difficult' path by making you think in a functional manner for a reason -- it is for making your thinking (and code) elegant and 'clean'.
Just imagine how much more difficult it would be to reason about code which generates a tree recursive process, wherein each (child) function call is mutating the parameters of the function. Also, as I mentioned in the comments, assignment places additional burden upon the programmers (and on those who read their code) by making the order of the expressions have a bearing on the results of the computation, so it is harder to verify that the code does what is intended.
Edit: I just wanted to add a couple of points which I feel would add a bit more insight:
Your code using set! is not wrong (or even very inelegant), it is just that in doing so, you are being very explicit in telling what you are doing. Iteration also reduces the elegance a bit in addition to being bottom up -- it is generally harder to think bottom up.
I feel that teaching to do things recursively where possible is one of the aims of the book. You will find that recursion is a crucial technique, the use of which is inevitable throughout the book. For instance, in chapter 4, you will be writing evaluators (interpreters) where the authors evaluate the expressions recursively. Even much earlier, in section 2.3, there is the symbolic differentiation problem which is also an exercise in recursive evaluation of expressions. So even though you solved the problem imperatively (using set!, begin) and bottom-up iteration the first time, it is not the right way, as far as the problem statement is concerned.
Having said all this, here is my code for this problem (for all the structure and readability imparted by FP, comments are still indispensable):
; the board is a list of lists - a physical n x n board, where
; empty positions are 0 and filled positions are 1
(define (queens board-size)
(let ((empty-board (empty-board-gen board-size))) ; minor modification - making empty-board available to queen-cols
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter (lambda (positions) (safe? k positions))
; the flatmap below generates a list of new positions
; by 'adjoining position'- adding 'board-size' number
; of new positions for each of the positions obtained
; recursively from (queen-cols (- k 1)), which have
; been found to be safe till column k-1. This new
; set (list) of positions is then filtered using the
; safe? function to filter out unsafe positions
(flatmap
(lambda (rest-of-queens)
; the map below adds 'board-size' number of new
; positions to 'rest-of-queens', which is an
; element of (queen-cols (- k 1))
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size)) ; end of let block
)
; add a column having a queen placed at position (new-row, col).
(define (adjoin-position new-row col rest-queens)
(let ((board-dim (length rest-queens))) ;length of board
; first create a zero 'vector', put a queen in it at position
; 'new-row', then put (replace) this new vector/column at the
; 'col' position in rest-queens
(replace-elem (replace-elem 1 new-row (gen-zero-vector board-dim)) col rest-queens)))
(define (safe? k positions) ; the safe function
(let ((row-pos-k (non-zero-index (item-at-index k positions)))) ; get the row of the queen in column k
(define (iter-check col rem) ;iteratively check if column 'col' of the board is safe wrt the kth column
(let ((rw-col (non-zero-index (car rem)))) ; get the row of 'col' in which a queen is placed
(cond ((= k 1) #t); 1x1 board is always safe
((= col k) #t); if we reached the kth column, we are done
; some simple coordinate geometry
; checks if the row of the queen in col and kth
; column is same, and also checks if the 'slope' of
; the line connecting the queens of the two columns
; is 1 (i.e. if it's a diagonal), if either is true,
; the kth queen is not safe
((or (= row-pos-k rw-col) (= (- k col) (abs (- row-pos-k rw-col)))) #f)
(else (iter-check (+ col 1) (cdr rem)))))) ; check the next column
(iter-check 1 positions))) ; start checking from the first column
; helper functions follow
(define (item-at-index n items) ; given a list, return the nth element
(define (iter idx rem)
(if (= idx n)
(car rem)
(iter (+ idx 1) (cdr rem))))
(iter 1 items))
(define (non-zero-index items)
; gives the first non-zero element from items - used for
; determining the row at which a queen is placed
(define (iter a rem)
(if (> (car rem) 0)
a
(iter (+ a 1) (cdr rem))))
(iter 1 items))
(define (empty-board-gen n) ; the empty board is n lists, each list with n zeros
(map (lambda (x) (map (lambda (y) 0) (enumerate-interval 1 n))) (enumerate-interval 1 n)))
(define (replace-elem new-elem pos items) ; replace item at position pos in items by new-elem, ultimately used for replacing an empty column with a column which has a queen
(define (iter i res rem)
(if (= i pos)
(append res (list new-elem) (cdr rem))
(iter (+ i 1) (append res (list(car rem))) (cdr rem)))) (iter 1 '() items))
(define (gen-zero-vector n) ; generate a list of length n with only zeros as elements
(define (iter a res)
(if (> a n)
res
(iter (+ a 1) (append res (list 0))))) (iter 1 '()))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (length items) ; not particularly efficient way for length of a list
(accumulate + 0 (map (lambda (x) 1) items)))
(define (accumulate op null-value seq)
(if (null? seq)
null-value
(op (car seq) (accumulate op null-value (cdr seq)))))
(define (enumerate-interval low high) ; a list of integers from low to hi
(define (iter a b res)
(if (> a b)
res
(iter (+ a 1) b (append res (cons a '())))))
(iter low high '()))
There are many ways to tackle this problem. I'll attempt to write a short and concise solution using Racket-specific procedures, explaining each step of the way. A solution using only the Scheme procedures explained in SICP is also possible, but it'll be more verbose and I'd argue, more difficult to understand.
My aim is to write a functional-programming style solution reusing as many built-in procedures as possible, and avoiding mutation at all costs - this is the style that SICP encourages you to learn. I'll deviate from the template solution in SICP if I think we can get a clearer solution by reusing existing Racket procedures (it follows then, that this code must be executed using the #lang racket language), but I've provided another answer that fits exactly exercise 2.42 in the book, implemented in standard Scheme and compatible with #lang sicp.
First things first. Let's agree on how are we going to represent the board - this is a key point, the way we represent our data will have a big influence on how easy (or hard) is to implement our solution. I'll use a simple representation, with only the minimum necessary information.
Let's say a "board" is a list of row indexes. My origin of coordinates is the position (0, 0), on the top-left corner of the board. For the purpose of this exercise we only need to keep track of the row a queen is in, the column is implicitly represented by its index in the list and there can only be one queen per column. Using my representation, the list '(2 0 3 1) encodes the following board, notice how the queens' position is uniquely represented by its row number and its index:
0 1 2 3
0 . Q . .
1 . . . Q
2 Q . . .
3 . . Q .
Next, let's see how are we going to check if a new queen added at the end of the board is "safe" with respect to the previously existing queens. For this, we need to check if there are any other queens in the same row, or if there are queens in the diagonal lines starting from the new queen's position. We don't need to check for queens in the same column, we're trying to set a single new queen and there aren't any others in this row. Let's split this task in multiple procedures.
; main procedure for checking if a queen in the given
; column is "safe" in the board; there are no more
; queens to the "right" or in the same column
(define (safe? col board)
; we're only interested in the queen's row for the given column
(let ([row (list-ref board (sub1 col))])
; the queen must be safe on the row and on the diagonals
(and (safe-row? row board)
(safe-diagonals? row board))))
; check if there are any other queens in the same row,
; do this by counting how many times `row` appears in `board`
(define (safe-row? row board)
; only the queen we want to add can be in this row
; `curry` is a shorthand for writing a lambda that
; compares `row` to each element in `board`
(= (count (curry equal? row) board) 1))
; check if there are any other queens in either the "upper"
; or the "lower" diagonals starting from the current queen's
; position and going to the "left" of it
(define (safe-diagonals? row board)
; we want to traverse the row list from right-to-left so we
; reverse it, and remove the current queen from it; upper and
; lower positions are calculated starting from the current queen
(let loop ([lst (rest (reverse board))]
[upper (sub1 row)]
[lower (add1 row)])
; the queen is safe after checking all the list
(or (null? lst)
; the queen is not safe if we find another queen in
; the same row, either on the upper or lower diagonal
(and (not (= (first lst) upper))
(not (= (first lst) lower))
; check the next position, updating upper and lower
(loop (rest lst) (sub1 upper) (add1 lower))))))
Some optimizations could be done, for example stopping early if there's more than one queen in the same row or stopping when the diagonals' rows fall outside of the board, but they'll make the code harder to understand and I'll leave them as an exercise for the reader.
In the book they suggest we use an adjoin-position procedure that receives both row and column parameters; with my representation we only need the row so I'm renaming it to add-queen, it simply adds a new queen at the end of a board:
; add a new queen's row to the end of the board
(define (add-queen queen-row board)
(append board (list queen-row)))
Now for the fun part. With all of the above procedures in place, we need to try out different combinations of queens and filter out those that are not safe. We'll use higher-order procedures and recursion for implementing this backtracking solution, there's no need to use set! at all as long as we're in the right mindset.
This will be easier to understand if you read if from the "inside out", try to grok what the inner parts do before going to the outer parts, and always remember that we're unwinding our way in a recursive process: the first case that will get executed is when we have an empty board, the next case is when we have a board with only one queen in position and so on, until we finally have a full board.
; main procedure: returns a list of all safe boards of the given
; size using our previously defined board representation
(define (queens board-size)
; we need two values to perform our computation:
; `queen-col`: current row of the queen we're attempting to set
; `board-size`: the full size of the board we're trying to fill
; I implemented this with a named let instead of the book's
; `queen-cols` nested procedure
(let loop ([queen-col board-size])
; if there are no more columns to try exit the recursion
(if (zero? queen-col)
; base case: return a list with an empty list as its only
; element; remember that the output is a list of lists
; the book's `empty-board` is just the empty list '()
(list '())
; we'll generate queen combinations below, but only the
; safe ones will survive for the next recursive call
(filter (λ (board) (safe? queen-col board))
; append-map will flatten the results as we go, we want
; a list of lists, not a list of lists of lists of...
; this is equivalent to the book's flatmap implementation
(append-map
(λ (previous-boards)
(map (λ (new-queen-row)
; add a new queen row to each one of
; the previous valid boards we found
(add-queen new-queen-row previous-boards))
; generate all possible queen row values for this
; board size, this is similar to the book's
; `enumerate-interval` but starting from zero
(range board-size)))
; advance the recursion, try a smaller column
; position, as the recursion unwinds this will
; return only previous valid boards
(loop (sub1 queen-col)))))))
And that's all there is to it! I'll provide a couple of printing procedures (useful for testing) which should be self-explanatory; they take my compact board representation and print it in a more readable way. Queens are represented by 'o and empty spaces by 'x:
(define (print-board board)
(for-each (λ (row) (printf "~a~n" row))
(map (λ (row)
(map (λ (col) (if (= row col) 'o 'x))
board))
(range (length board)))))
(define (print-all-boards boards)
(for-each (λ (board) (print-board board) (newline))
boards))
We can verify that things work and that the number of solutions for the 8-queens problem is as expected:
(length (queens 8))
=> 92
(print-all-boards (queens 4))
(x x o x)
(o x x x)
(x x x o)
(x o x x)
(x o x x)
(x x x o)
(o x x x)
(x x o x)
As a bonus, here's another solution that works with the exact definition of queens as provided in the SICP book. I won't go into details because it uses the same board representation (except that here the indexes start in 1 not in 0) and safe? implementation of my previous answer, and the explanation for the queens procedure is essentially the same. I did some minor changes to favor standard Scheme procedures, so hopefully it'll be more portable.
#lang racket
; redefine procedures already explained in the book with
; Racket equivalents, delete them and use your own
; implementation to be able to run this under #lang sicp
(define flatmap append-map)
(define (enumerate-interval start end)
(range start (+ end 1)))
; new definitions required for this exercise
(define empty-board '())
(define (adjoin-position row col board)
; `col` is unused
(append board (list row)))
; same `safe?` implementation as before
(define (safe? col board)
(let ((row (list-ref board (- col 1))))
(and (safe-row? row board)
(safe-diagonals? row board))))
(define (safe-row? row board)
; reimplemented to use standard Scheme procedures
(= (length (filter (lambda (r) (equal? r row)) board)) 1))
(define (safe-diagonals? row board)
(let loop ((lst (cdr (reverse board)))
(upper (- row 1))
(lower (+ row 1)))
(or (null? lst)
(and (not (= (car lst) upper))
(not (= (car lst) lower))
(loop (cdr lst) (- upper 1) (+ lower 1))))))
; exact same implementation of `queens` as in the book
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (rest-of-queens)
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
; debugging
(define (print-board board)
(for-each (lambda (row) (display row) (newline))
(map (lambda (row)
(map (lambda (col) (if (= row col) 'o 'x))
board))
(enumerate-interval 1 (length board)))))
(define (print-all-boards boards)
(for-each (lambda (board) (print-board board) (newline))
boards))
The above code is more in spirit with the original exercise, which asked you to implement just three definitions: empty-board, adjoin-position and safe?, thus this was more of a question about data representation. Unsurprisingly, the results are the same:
(length (queens 8))
=> 92
(print-all-boards (queens 4))
(x x o x)
(o x x x)
(x x x o)
(x o x x)
(x o x x)
(x x x o)
(o x x x)
(x x o x)
I have a problem with a function showlength which I'm programming in Scheme:
(define showlength
(lambda (m lst)
(cond ((number? m) (list (cons m lst)
(+ 1(length lst))))
((pair? m) (let* ([x (cdr m)]
[y (car m)])
(showlength x lst)
(showlength y lst))))))
The code is meant to take either a number or a pair of numbers and a list(lst) and returns a list showing all values contained in the list and the length of the list. The program works for when I have just a number of example:
(showlength 2 '())
and returns
((2) 1)
but when I try it for a problem consisting of a pair of numbers of example
(showlength (cons 2 3) ' ())
in which the returned value is meant to be
((0 . 1) 3 2) 3)
it shows
((2) 1)
What is wrong with my code?
EDIT: For those who the code isnt that clear to. When a pair of numbers is used, the code is meant to add the cdr of the pair to the list. Then its meant to add the car of the pair to the list( where the list already contains the cdr of the pair from above) and then returns the list and its length
The issue is that in your let statement, you have two independent calls to show length, and you implementation is just returning the value of the first.
In scheme a function only ever returns one value (generally, some implementation provide special mechanisms to allow a value to expect and accept multiple return values. )
My question is where in the world do you expect a zero to come from? The smallest value in the m is 2, and the smallest value that length can return of it's own volition is 1, when lst length is zero.
Whatever it is you're doing you need to step back and check your assumptions, something isn't right.
(define showlength
(lambda (m lst)
(cond ((number? m) (list (cons m lst)
(+ 1(length lst))))
((pair? m) (let* ((x (cdr m))
(y (car m)))
(cons (showlength x lst)
(showlength y lst)))))))
Tying the returns together with cons will get you a single value without losing anything, but it's not the return value you want.
I'm new to Racket and trying to learn it. I'm working through some problems that I'm struggling with. Here is what the problem is asking:
Write a definition for the recursive function occur that takes a data expression a and a list s and returns the number of times that the data expression a appears in the list s.
Example:
(occur '() '(1 () 2 () () 3)) =>3
(occur 1 '(1 2 1 ((3 1)) 4 1)) => 3 (note that it only looks at whole elements in the list)
(occur '((2)) '(1 ((2)) 3)) => 1
This is what I have written so far:
(define occur
(lambda (a s)
(cond
((equal? a (first s))
(else (occur a(rest s))))))
I'm not sure how to implement the count. The next problem is similar and I have no idea how to approach that. Here is what this problem says:
(This is similar to the function above, but it looks inside the sublists as well) Write a recursive function atom-occur?, which takes two inputs, an atom a and a list s, and outputs the Boolean true if and only if a appears somewhere within s, either as one of the data expressions in s, or as one of the data expression in one of the data expression in s, or…, and so on.
Example:
(atom-occur? 'a '((x y (p q (a b) r)) z)) => #t
(atom-occur? 'm '(x (y p (1 a (b 4)) z))) => #f
Any assistance would be appreciated. Thank you.
In Racket, the standard way to solve this problem would be to use built-in procedures:
(define occur
(lambda (a s)
(count (curry equal? a) s)))
But of course, you want to implement it from scratch. Don't forget the base case (empty list), and remember to add one unit whenever a new match is found. Try this:
(define occur
(lambda (a s)
(cond
((empty? s) 0)
((equal? a (first s))
(add1 (occur a (rest s))))
(else (occur a (rest s))))))
The second problem is similar, but it uses the standard template for traversing a list of lists, where we go down on the recursion on both the first and the rest of the input list, and only test for equality when we're in an atom:
(define atom-occur?
(lambda (a s)
(cond
((empty? s) #f)
((not (pair? s))
(equal? a s))
(else (or (atom-occur? a (first s))
(atom-occur? a (rest s)))))))
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)))
I'm having difficulty understanding what's going on with The Little Schemer's evens-only*&co example on page 145.
Here's the code:
(define evens-only*&co
(lambda (l col)
(cond
((null? l)
(col '() 1 0))
((atom? (car l))
(cond
((even? (car l))
(evens-only*&co (cdr l)
(lambda (newl product sum)
(col (cons (car l) newl)
(opx (car l) product)
sum))))
(else
(evens-only*&co (cdr l)
(lambda (newl product sum)
(col newl product (op+ (car l) sum)))))))
(else
(evens-only*&co (car l)
(lambda (newl product sum)
(evens-only*&co (cdr l)
(lambda (dnewl dproduct dsum)
(col (cons newl dnewl)
(opx product dproduct)
(op+ sum dsum))))))))))
The initial col can be:
(define evens-results
(lambda (newl product sum)
(cons sum (cons product newl))))
What I'm not getting is, with l as '((1) 2 3), it goes immediately into the final else with (car l) as (1) and (cdr l) as (2 3). Good, but my mind goes blank trying to sort out the dnewl, dproduct, dsum from the newl, product, sum. It also would be helpful if somebody could coach me on how to set up DrRacket or Chez Scheme or MIT-Scheme for running a stepper.
But maybe I'm spazzing too early. Is any beginner reading this for the first time actually supposed to understand this wild continuation?
I found this section confusing on first reading too, and only started to get it after I'd read up elsewhere about continuations and continuation-passing style (which is what this is).
At the risk of explaining something that you already get, one way of looking at it that helped me is to think of the "collector" or "continuation" as replacing the normal way for the function to return values. In the normal style of programming, you call a function, receive a value, and do something with it in the caller. For example, the standard recursive length function includes the expression (+ 1 (length (cdr list))) for the non-empty case. That means that once (length (cdr list)) returns a value, there's a computation waiting to happen with whatever value it produces, which we could think of as (+ 1 [returned value]). In normal programming, the interpreter keeps track of these pending computations, which tend to "stack up", as you can see in the first couple of chapters of the book. For example, in calculating the length of a list recursively we have a nest of "waiting computations" as many levels deep as the list is long.
In continuation-passing style, instead of calling a function and using the returned result in the calling function, we tell the function what to do when it produces its value by providing it with a "continuation" to call. (This is similar to what you have to do with callbacks in asynchronous Javascript programming, for example: instead of writing result = someFunction(); you write someFunction(function (result) { ... }), and all of the code that uses result goes inside the callback function).
Here's length in continuation-passing style, just for comparison. I've called the continuation parameter return, which should suggest how it functions here, but remember that it's just a normal Scheme variable like any other. (Often the continuation parameter is called k in this style).
(define (length/k lis return)
(cond ((null? lis) (return 0))
(else
(length/k (cdr lis)
(lambda (cdr-len)
(return (+ cdr-len 1)))))))
There is a helpful tip for reading this kind of code in an article on continuations by Little Schemer co-author Dan Friedman. (See section II-5 beginning on page 8). Paraphrasing, here's what the else clause above says:
imagine you have the result of calling length/k on (cdr lis), and
call it cdr-len, then add one and pass the result of this addition
to your continuation (return).
Note that this is almost exactly what the interpreter has to do in evaluating (+ 1 (length (cdr lis))) in the normal version of the function (except that it doesn't have to give a name to the intermediate result (length (cdr lis)). By passing around the continuations or callbacks we've made the control flow (and the names of intermediate values) explicit, instead of having the interpreter keep track of it.
Let's apply this method to each clause in evens-only*&co. It's slightly complicated here by the fact that this function produces three values rather than one: the nested list with odd numbers removed; the product of the even numbers; and the sum of the odd numbers. Here's the first clause, where (car l) is known to be an even number:
(evens-only*&co (cdr l)
(lambda (newl product sum)
(col (cons (car l) newl)
(opx (car l) product)
sum)))
Imagine that you have the results of removing odd numbers,
multiplying evens, and adding odd numbers from the cdr of the list,
and call them newl, product, and sum respectively. cons the
head of the list onto newl (since it's an even number, it should go
in the result); multiply product by the head of the list (since
we're calculating product of evens); leave sum alone; and pass these
three values to your waiting continuation col.
Here's the case where the head of the list is an odd number:
(evens-only*&co (cdr l)
(lambda (newl product sum)
(col newl product (op+ (car l) sum))))
As before, but pass the same values of newl and product to the continuation (i.e. "return" them), along with the sum of sum and the head of the list, since we're summing up odd numbers.
And here's the last one, where (car l) is a nested list, and which is slightly complicated by the double recursion:
(evens-only*&co (car l)
(lambda (newl product sum)
(evens-only*&co (cdr l)
(lambda (dnewl dproduct dsum)
(col (cons newl dnewl)
(opx product dproduct)
(op+ sum dsum))))))
Imagine you have the results from removing, summing and adding the
numbers in (car l) and call these newl, product, and sum; then
imagine you have the results from doing the same thing to (cdr l),
and call them dnewl, dproduct and dsum. To your waiting
continuation, give the values produced by consing newl and dnewl
(since we're producing a list of lists); multiplying together
product and dproduct; and adding sum and dsum.
Notice: each time we make a recursive call, we construct a new continuation for the recursive call, which "closes over" the current values of the argument, l, and the return continuation - col, in other words, you can think of the chain of continuations which we build up during the recursion as modelling the "call stack" of a more conventionally written function!
Hope that gives part of an answer to your question. If I've gone a little overboard, it's only because I thought that, after recursion itself, continuations are the second really neat, mind-expanding idea in The Little Schemer and programming in general.
The answer by Jon O. is a really great in-depth explanation of underlying concepts. Though for me (and hopefully, for some other people too), understanding of concepts like this is a lot more easier when they have a visual representation.
So, I have prepared two flow-charts (similar to ones I did for multirember&co, untangling what is happening during the call of evens-only*&co
given l is:
'((9 1 2 8) 3 10 ((9 9) 7 6) 2)
and col is:
(define the-last-friend
(lambda (newl product sum)
(cons sum (cons product newl))
)
)
One flow-chart, reflecting how variables relate in different steps of recursion:
Second flow-chart, showing the actual values, being passed:
My hope is, that this answer will be a decent addition to the Jon's explanation above.
I have been reading How To Design Programs (felleisen et.al.). I am going through the section where they define local definitions. I have written a code that implements the above evens-only&co using a local definition. Here's what I wrote:
(define (evens-only&co l)
(local ((define (processing-func sum prod evlst lst)
(cond ((null? lst) (cons sum (cons prod evlst)))
((atom? (car lst))
(cond ((even? (car lst)) (processing-func sum (* prod (car lst)) (append evlst (list (car lst))) (cdr lst)))
(else
(processing-func (+ sum (car lst)) prod evlst (cdr lst)))))
(else
(local ((define inner-lst (processing-func sum prod '() (car lst))))
(processing-func (car inner-lst) (cadr inner-lst) (append evlst (list (cddr inner-lst))) (cdr lst)))))))
(processing-func 0 1 '() l)))
For testing, when i enter (evens-only&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2)) , it returns '(38 1920 (2 8) 10 (() 6) 2) as expected in the little schemer. But, my code fails in one condition: when there are no even numbers at all, the product of evens is still shown as 1. For example (evens-only&co '((9 1) 3 ((9 9) 7 ))) returns '(38 1 () (())). I guess i will need an additional function to rectify this.
#melwasul: If you are not familiar with the local definition, sorry to post this here. I suggest you read HTDP too. It's an excellent book for beginners.
But the guys who are experts in scheme can please post their comments on my code as well. Is my understanding of the local definition correct?
In equational pseudocode (a KRC-like notation, writing f x y for the call (f x y), where it is unambiguous), this is
evens-only*&co l col
= col [] 1 0 , IF null? l
= evens-only*&co (cdr l)
( newl product sum =>
col (cons (car l) newl)
(opx (car l) product)
sum ) , IF atom? (car l) && even? (car l)
= evens-only*&co (cdr l)
( newl product sum =>
col newl product (op+ (car l) sum) ) , IF atom? (car l)
= evens-only*&co (car l)
( anewl aproduct asum =>
evens-only*&co (cdr l)
( dnewl dproduct dsum =>
col (cons anewl dnewl)
(opx aproduct dproduct)
(op+ asum dsum) ) ) , OTHERWISE
This is a CPS code which collects all evens from the input nested list (i.e. a tree) while preserving the tree structure, and also finds the product of all the evens; as for the non-evens, it sums them up:
if l is an empty list, the three basic (identity) values are passed as arguments to col;
if (car l) is an even number, the results of processing the (cdr l) are newl, product and sum, and then they are passed as arguments to col while the first two are augmented by consing ⁄ multiplying with the (car l) (the even number);
if (car l) is an atom which is not an even number, the results of processing the (cdr l) are newl, product and sum, and then they are passed as arguments to col with the third one augmented by summing with the (car l) (the non-even number atom);
if (car l) is a list, the results of processing the (car l) are anewl, aproduct and asum, and then the results of processing the (cdr l) are dnewl, dproduct and dsum, and then the three combined results are passed as arguments to col.
[], 1 and 0 of the base case are the identity elements of the monoids of lists, numbers under multiplication, and numbers under addition, respectively. This just means special values that don't change the result, when combined into it.
As an illustration, for '((5) 2 3 4) (which is close to the example in the question), it creates the calculation
evens-only*&co [[5], 2, 3, 4] col
=
col (cons [] ; original structure w only the evens kept in,
(cons 2 ; for the car and the cdr parts
(cons 4 [])))
(opx 1 ; multiply the products of evens in the car and
(opx 2 (opx 4 1))) ; in the cdr parts
(op+ (op+ 5 0) ; sum, for the non-evens
(op+ 3 0))
Similar to my other answer (to a sister question), here's another way to write this, with a patter-matching pseudocode (with guards):
evens-only*&co = g where
g [a, ...xs...] col
| pair? a = g a ( la pa sa =>
g xs ( ld pd sd =>
col [la, ...ld...] (* pa pd) (+ sa sd) ) )
| even? a = g xs ( l p s => col [ a, ...l... ] (* a p ) s )
| otherwise = g xs ( l p s => col l p (+ a s ) )
g [] col = col [] 1 0
The economy (and diversity) of this notation really makes it all much clearer, easier to just see instead of getting lost in the word salad of long names for functions and variables alike, with parens overloaded as syntactic separators for list data, clause groupings (like in cond expressions), name bindings (in lambda expressions) and function call designators all looking exactly alike. The same uniformity of S-expressions notation so conducive to the ease of manipulation by a machine (i.e. lisp's read and macros) is what's detrimental to the human readability of it.