I'm trying to solve a problem in Scheme which is demanding me to use a nested loop or a nested recursion.
e.g. I have two lists which I have to check a condition on their Cartesian product.
What is the best way to approach these types of problems? Any pointers on how to simplify these types of functions?
I'll elaborate a bit, since my intent might not be clear enough.
A regular recursive function might look lik开发者_StackOverflow社区e this:
(define (factorial n)
(factorial-impl n 1))
(define (factorial-impl n t)
(if (eq? n 0)
t
(factorial-impl (- n 1) (* t n))))
Trying to write a similar function but with nested recursion introduces a new level of complexity to the code, and I was wondering what the basic pattern is for these types of functions, as it can get very ugly, very fast.
As a specific example, I'm looking for the easiest way to visit all the items in a cartesian product of two lists.
In Scheme, The "map" function is often handy for computing one list based on another.
In fact, in scheme, map takes an "n-argument" function and "n" lists and calls the function for each corresponding element of each list:
> (map * '(3 4 5) '(1 2 3))
(3 8 15)
But a very natural addition to this would be a "cartesian-map" function, which would call your "n-argument" function with all of the different ways of picking one element from each list. It took me a while to figure out exactly how to do it, but here you go:
; curry takes:
; * a p-argument function AND
; * n actual arguments,
; and returns a function requiring only (p-n) arguments
; where the first "n" arguments are already bound. A simple
; example
; (define add1 (curry + 1))
; (add1 3)
; => 4
; Many other languages implicitly "curry" whenever you call
; a function with not enough arguments.
(define curry
(lambda (f . c) (lambda x (apply f (append c x)))))
; take a list of tuples and an element, return another list
; with that element stitched on to each of the tuples:
; e.g.
; > (stitch '(1 2 3) 4)
; ((4 . 1) (4 . 2) (4 . 3))
(define stitch
(lambda (tuples element)
(map (curry cons element) tuples)))
; Flatten takes a list of lists and produces a single list
; e.g.
; > (flatten '((1 2) (3 4)))
; (1 2 3 4)
(define flatten
(curry apply append))
; cartesian takes two lists and returns their cartesian product
; e.g.
; > (cartesian '(1 2 3) '(4 5))
; ((1 . 4) (1 . 5) (2 . 4) (2 . 5) (3 . 4) (3 . 5))
(define cartesian
(lambda (l1 l2)
(flatten (map (curry stitch l2) l1))))
; cartesian-lists takes a list of lists
; and returns a single list containing the cartesian product of all of the lists.
; We start with a list containing a single 'nil', so that we create a
; "list of lists" rather than a list of "tuples".
; The other interesting function we use here is "fold-right" (sometimes called
; "foldr" or "reduce" in other implementations). It can be used
; to collapse a list from right to left using some binary operation and an
; initial value.
; e.g.
; (fold-right cons '() '(1 2 3))
; is equivalent to
; ((cons 1 (cons 2 (cons 3 '())))
; In our case, we have a list of lists, and our binary operation is to get the
; "cartesian product" between each list.
(define cartesian-lists
(lambda (lists)
(fold-right cartesian '(()) lists)))
; cartesian-map takes a n-argument function and n lists
; and returns a single list containing the result of calling that
; n-argument function for each combination of elements in the list:
; > (cartesian-map list '(a b) '(c d e) '(f g))
; ((a c f) (a c g) (a d f) (a d g) (a e f) (a e g) (b c f)
; (b c g) (b d f) (b d g) (b e f) (b e g))
(define cartesian-map
(lambda (f . lists)
(map (curry apply f) (cartesian-lists lists))))
Without all the comments and some more compact function definition syntax we have:
(define (curry f . c) (lambda x (apply f (append c x))))
(define (stitch tuples element)
(map (curry cons element) tuples))
(define flatten (curry apply append))
(define (cartesian l1 l2)
(flatten (map (curry stitch l2) l1)))
(define cartesian-lists (curry fold-right cartesian '(()))))
(define (cartesian-map f . lists)
(map (curry apply f) (cartesian-lists lists)))
I thought the above was reasonably "elegant"... until someone showed me the equivalent Haskell definition:
cartes f (a:b:[]) = [ f x y | x <- a , y <- b ]
cartes f (a:b:bs) = cartes f ([ f x y | x <- a , y <- b ]:bs)
2 lines!!!
I am not so confident on the efficiency of my implementation - particularly the "flatten" step was quick to write but could end up calling "append" with a very large number of lists, which may or may not be very efficient on some Scheme implementations.
For ultimate practicality/usefulness you would want a version that could take "lazily evaluated" lists/streams/iterator rather than fully specified lists.... a "cartesian-map-stream" function if you like, that would then return a "stream" of the results... but this depends on the context (I am thinking of the "stream" concept as introduced in SICP)... and would come for free from the Haskell version thanks to it's lazy evaluation.
In general, in Scheme, if you wanted to "break out" of the looping at some point you could also use a continuation (like throwing an exception but it is accepted practise in Scheme for control flow).
I had fun writing this!
I'm not sure I see what the problem is. I believe the main thing you have to understand in functional programming is : build complicated functions by composing several simpler functions.
For instance, in this case:
;compute the list of the (x,y) for y in l
(define (pairs x l)
(define (aux accu x l)
(if (null? l)
accu
(let ((y (car l))
(tail (cdr l)))
(aux (cons (cons x y) accu) x tail))))
(aux '() x l))
(define (cartesian-product l m)
(define (aux accu l)
(if (null? l)
accu
(let ((x (car l))
(tail (cdr l)))
(aux (append (pairs x m) accu) tail))))
(aux '() l))
You identify the different steps: to get the cartesian product, if you "loop" over the first list, you're going to have to be able to compute the list of the (x,y)
, for y
in the second list.
There are some good answers here already, but for simple nested functions (like your tail-recursive factorial), I prefer a named let:
(define factorial
(lambda (n)
(let factorial-impl ([n n] [t 1])
(if (eq? n 0)
t
(factorial-impl (- n 1) (* t n))))))
精彩评论