I've been teaching myself functional programming, and I'm currently writing different higher order functions using folds. I'm stuck implementing scan (also known as prefix sum). My map implementation using fold looks like:
(define (map op sequence)
(fold-right (lambda (x l) (cons (op x) l)) nil sequence))
And my shot at scan looks like:
(define (scan sequence)
(fold-left (lambda (x y) (append x (list (+ y (car (reverse x)))))) (list 0) sequence))
My observation being that the "x" is the resulting array so far, and "y" is the next element in the incoming list. This produces:
(scan (list 1 4 8 3 7 9)) -> (0 1 5 13 16 23 32)
But this looks pretty ugly, with the reversing of the resulting list going on inside the lambda. I'd much prefer to not do global operations on the resulting list, since my next attempt is to try and parallelize much of this (that's a different story, I'm looking at several CUDA papers).
Does anyone have a more elegant solution for scan?
BTW my implementation of fold-left and fold-right is:
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest)) (cdr rest))))
(iter initial sequence))
(define (fold-right op initial sequence)
(if (null? sequence)
initial
(op (car sequence) (fold-right op initial (cdr sequence)))))
Imho scan is very well expressible in terms of fold.
Haskell example:
scan func list = reverse $ foldl (\l e -> (func e (head l)) : l) [head list] (tail list)
Should translate into something like this
(define scan
(lambda (func seq)
(reverse
(fold-left
(lambda (l e) (cons (func e (car l)) l))
(list (car seq))
(cdr seq)))))
I wouldn’t do this. fold can actually be implemented in terms of scan (last element of the scanned list). But scan and fold are in fact orthogonal operations. If you’ve read the CUDA papers you’ll notice that a scan consists of two phases: the first yields the fold result as a by-product. The second phase is only used for the scan (of course, this only counts for parallel implementations; a sequential implementation of fold is more efficient if it doesn’t rely on scan at all).
imho Dario cheated by using reverse since the exercise was about expressing in terms of fold not a reverse fold. This, of course, is a horrible way to express scan but it is a fun exercise of jamming a square peg into a round hole.
Here it is in haskell, I don't know lisp
let scan f list = foldl (\ xs next -> xs++[f (last xs) next]) [0] list
scan (+) [1, 4, 8, 3, 7, 9]
[0,1,5,13,16,23,32]
of course, using teh same trick as Dario one can get rid of that leading 0:
let scan f list = foldl (\ xs next -> xs++[f (last xs) next]) [head list] (tail list)
scan (+) [1, 4, 8, 3, 7, 9]
[1,5,13,16,23,32]
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 can't figure out how can I make this tail recursive Scheme function not tail recursive anymore. Anyone can help me?
(define (foldrecl f x u)
(if (null? x)
u
(foldrecl f (cdr x) (f (car x) u))))
left folds are inheritly iterative, but you can easily make them recursive by adding a continuation. eg.
(let ((value expresion-that-calculates))
value)
So in your case:
(define (foldrecl f x u)
(if (null? x)
u
(let ((result (foldrecl f (cdr x) (f (car x) u))))
result)))
While this looks promising it does not guarantee that a smart Scheme implementation figures out that result is just returned and make it a tail call instead. Right folds are easier since they are inherently recursive:
(define (fold-right proc tail lst)
(if (null? lst)
tail
(proc (car lst)
(fold-right proc tail (cdr lst)))))
Here you clearly see the recursive part needs to become a argument to cons and thus never in tail position unless it is the base case.
Also notice it's slightly simpler to see what arguments goes where when the procedure is called proc, the tail of the result tail and the list argument lst. You don't even need to read my code to know how to use it, but yours I have no idea what x and u and ti doesn't help that the argument order doesn't follow any fold implementations known in Scheme.
The recursive call is in tail position, so put it inside another procedure call like this:
(define (identity x) x)
(define (foldrecl f x u)
(if (null? x)
u
(identity (foldrecl f (cdr x) (f (car x) u)))))
now the recursive call is not in tail position, it is not tail recursive anymore.
A compiler is allowed to optimize away the identity function if it knows that it does nothing but hopefully it wont.
Instead of doing, compose a plan for doing it; only in the end, do:
(define (foldreclr f xs a)
(define (go xs)
(if (null? xs)
(lambda (a) a)
(let ((r (go (cdr xs)))) ; first, recursive call;
(lambda ; afterwards, return a plan:
(a) ; given an a, to
(r ; perform the plan for (cdr xs)
(f (car xs) a)))))) ; AFTER processing (car x) and a.
((go xs) ; when the overall plan is ready,
a)) ; use it with the supplied value
The internal function go follows the right fold pattern. It makes the recursive call first, and only afterwards it composes and returns a value, the plan to first combine the list's head element with the accumulator value, and then perform the plan for the list's tail -- just like the original foldrecl would do.
When the whole list is turned into a plan of action, that action is finally performed to transform the supplied initial accumulator value -- performing the same calculation as the original foldrecl left fold.
This is known as leaning so far right you come back left again.(*)
> (foldreclr - (list 1 2 3 4) 0) ; 4-(3-(2-(1-0)))
2
> (foldreclr - (list 4 3 2 1) 0) ; 1-(2-(3-(4-0)))
-2
See also:
Foldl as foldr
(*) Evolution of a Haskell programmer (fun read)
(sorry, these are in Haskell, but Haskell is a Lisp too.)
Can someone help me to break down exactly the order of execution for the following versions of flatten? I'm using Racket.
version 1, is from racket itself, while version two is a more common? implementation.
(define (flatten1 list)
(let loop ([l list] [acc null])
(printf "l = ~a acc = ~a\n" l acc)
(cond [(null? l) acc]
[(pair? l) (loop (car l) (loop (cdr l) acc))]
[else (cons l acc)])))
(define (flatten2 l)
(printf "l = ~a\n" l)
(cond [(null? l) null]
[(atom? l) (list l)]
[else (append (flatten2 (car l)) (flatten2 (cdr l)))]))
Now, running the first example with '(1 2 3) produces:
l = (1 2 3) acc = ()
l = (2 3) acc = ()
l = (3) acc = ()
l = () acc = ()
l = 3 acc = ()
l = 2 acc = (3)
l = 1 acc = (2 3)
'(1 2 3)
while the second produces:
l = (1 2 3)
l = 1
l = (2 3)
l = 2
l = (3)
l = 3
l = ()
'(1 2 3)
The order of execution seems different. In the first example, it looks like the second loop (loop (cdr l) acc) is firing before the first loop since '(2 3) is printing right away. Whereas in the second example, 1 prints before the '(2 3), which seems like the first call to flatten inside of append is evaluated first.
I'm going through the Little Schemer but these are more difficult examples that I could really use some help on.
Thanks a lot.
Not really an answer to your question (Chris provided an excellent answer already!), but for completeness' sake here's yet another way to implement flatten, similar to flatten2 but a bit more concise:
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (flatten lst)
(if (atom? lst)
(list lst)
(apply append (map flatten lst))))
And another way to implement the left-fold version (with more in common to flatten1), using standard Racket procedures:
(define (flatten lst)
(define (loop lst acc)
(if (atom? lst)
(cons lst acc)
(foldl loop acc lst)))
(reverse (loop lst '())))
The main difference is this:
flatten1 works by storing the output elements (first from the cdr side, then from the car side) into an accumulator. This works because lists are built from right to left, so working on the cdr side first is correct.
flatten2 works by recursively flattening the car and cdr sides, then appending them together.
flatten1 is faster, especially if the tree is heavy on the car side: the use of an accumulator means that there is no extra list copying, no matter what. Whereas, the append call in flatten2 causes the left-hand side of the append to be copied, which means lots of extra list copying if the tree is heavy on the car side.
So in summary, I would consider flatten2 a beginner's implementation of flatten, and flatten1 a more polished, professional version. See also my implementation of flatten, which works using the same principles as flatten1, but using a left-fold instead of the right-fold that flatten1 uses.
(A left-fold solution uses less stack space but potentially more heap space. A right-fold solution uses more stack and usually less heap, though a quick read of flatten1 suggests in this case that the heap usage is about the same as my implementation.)
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.
The function is supposed to be tail-recursive and count from 1 to the specified number. I think I'm fairly close. Here's what I have:
(define (countup l)
(if (= 1 l)
(list l)
(list
(countup (- l 1))
l
)
)
)
However, this obviously returns a list with nested lists. I've attempted to use the append function instead of the second list to no avail. Any guidance?
Here's an incorrect solution:
(define (countup n)
(define (help i)
(if (<= i n)
(cons i (help (+ i 1)))
'()))
(help 1))
This solution:
uses a helper function
recurses over the numbers from 1 to n, cons-ing them onto an ever-growing list
Why is this wrong? It's not really tail-recursive, because it creates a big long line of cons calls which can't be evaluated immediately. This would cause a stack overflow for large enough values of n.
Here's a better way to approach this problem:
(define (countup n)
(define (help i nums)
(if (> i 0)
(help (- i 1)
(cons i nums))
nums)))
(help n '()))
Things to note:
this solution is better because the calls to cons can be evaluated immediately, so this function is a candidate for tail-recursion optimization (TCO), in which case stack space won't be a problem.
help recurses over the numbers backwards, thus avoiding the need to use append, which can be quite expensive
You should use an auxiliar function for implementing a tail-recursive solution for this problem (a "loop" function), and use an extra parameter for accumulating the answer. Something like this:
(define (countup n)
(loop n '()))
(define (loop i acc)
(if (zero? i)
acc
(loop (sub1 i) (cons i acc))))
Alternatively, you could use a named let. Either way, the solution is tail-recursive and a parameter is used for accumulating values, notice that the recursion advances backwards, starting at n and counting back to 0, consing each value in turn at the beginning of the list:
(define (countup n)
(let loop ((i n)
(acc '()))
(if (zero? i)
acc
(loop (sub1 i) (cons i acc)))))
Here a working version of your code that returns a list in the proper order (I replaced l by n):
(define (countup n)
(if (= 1 n)
(list n)
(append (countup (- n 1)) (list n))))
Sadly, there is a problem with this piece of code: it is not tail-recursive. The reason is that the recursive call to countup is not in a tail position. It is not in tail position because I'm doing an append of the result of (countup (- l 1)), so the tail call is append (or list when n = 1) and not countup. This means this piece of code is a normal recusrive function but to a tail-recursive function.
Check this link from Wikipedia for a better example on why it is not tail-recusrive.
To make it tail-recursive, you would need to have an accumulator responsible of accumulating the counted values. This way, you would be able to put the recursive function call in a tail position. See the difference in the link I gave you.
Don't hesitate to reply if you need further details.
Assuming this is for a learning exercise and you want this kind of behaviour:
(countup 5) => (list 1 2 3 4 5)
Here's a hint - in a tail-recursive function, the call in tail position should be to itself (unless it is the edge case).
Since countup doesn't take a list of numbers, you will need an accumulator function that takes a number and a list, and returns a list.
Here is a template:
;; countup : number -> (listof number)
(define (countup l)
;; countup-acc : number, (listof number) -> (listof number)
(define (countup-acc c ls)
(if ...
...
(countup-acc ... ...)))
(countup-acc l null))
In the inner call to countup-acc, you will need to alter the argument that is checked for in the edge case to get it closer to that edge case, and you will need to alter the other argument to get it closer to what you want to return in the end.