<< Previous exercise (2.40) | Index | Next exercise (2.42) >>
Wow, that was a very nice solution, even if it went far above and beyond the scope of the exercise in the book. Here is code for anyone here searching for a more concise solution:
(define (ordered-triples-sum n s)
(filter (lambda (list) (= (accumulate + 0 list) s))
(flatmap
(lambda (i)
(flatmap (lambda (j)
(map (lambda (k) (list i j k))
(enumerate-interval 1 (- j 1))))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n))))
If you are having a hard time understanding this problem, study the above implementation of build-tuples.
A short note to the answer before: DO NOT USE LIST as your variable name. It is an awful habit. In this case, you cannot use (list ...) since list is your variable. ps. you never how long I debug a scheme program when I use list to name one variable... ps2. sorry for inserting these words here, but I think everyone should be cautious about this.
This solution is O(n^2) and a little optimized (doesn't check cases, when there are no triples for given i). For n=s=90 runs 10 times faster, than the one on the top of the page.
(define (find-ordered-triples-sum n s) (define (k-is-distinkt-in-triple? triple) (let ((i (car triple)) (j (cadr triple)) (k (car (cdr (cdr triple))))) (and (> k j) (> k i)))) (filter k-is-distinkt-in-triple? (flatmap (lambda (i) (map (lambda (j) (list i j (- n (+ i j) ) )) ; j + k = n - i and k and j >= 1 (enumerate (+ i 1) (- n (+ i 1)) ))) (enumerate 1 (- n 2))))) ; n - 2: j and k at least 1 (i_max + 1 + 1 = n)
;; Supporting functions: (define nil '()) (define (filter predicate sequence) (cond ((null? sequence) nil) ((predicate (car sequence)) (cons (car sequence) (filter predicate (cdr sequence)))) (else (filter predicate (cdr sequence))))) (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (enumerate-interval low high) (if (> low high) nil (cons low (enumerate-interval (+ low 1) high)))) (define (flatmap proc seq) (accumulate append nil (map proc seq))) ;; Here's the unique-pairs from the chapter: (define (unique-pairs n) (flatmap (lambda (i) (map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n))) ;; We need to make triples (i j k). The following will do: (define (unique-triples n) (flatmap (lambda (i) (flatmap (lambda (j) (map (lambda (k) (list i j k)) (enumerate-interval 1 (- j 1)))) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n)))
Having solved this in an ugly way (without using flatmap), I got to thinking about how to generate tuples of arbitrary size (note that I started thinking about this before I clued into using flatmap, and the ugly function that appeared seemed to suggest a more general approach was required ... so some time wasted). I wanted to be able to say something like (make-tuple size max-number). A quick solution (I hope): the lists could be added by adding a number onto a list of arbitrary length, where each number is less than the number to its right (new numbers are added to the front of the list). By calling this function recursively, lists of arbitrary length can be created.
;; Code to build tuples of arbitrary length. Strays from the problem ;; stated in the text! ;; Example: (add-num-less-than-first (list 3 4)) will cons the numbers ;; 1 and 2 to two new copies of (list 3 4), giving (list 1 3 4) and ;; (list 2 3 4). Note that 1 and 2 are less than 3. Similarly, ;; calling this with (list 7 25) would give 6 new lists, 1 through 6 ;; appended to copies of (list 7 25). (define (add-num-less-than-first tuple) (map (lambda (x) (cons x tuple)) (enumerate-interval 1 (- (car tuple) 1)))) ;; We need to have the source tuples seeded with at least one number, ;; so we'll assume those are present. (define (build-tuples seed-tuples count-items-left-to-add) (cond ((= count-items-left-to-add 0) seed-tuples) (else (flatmap (lambda (t) (build-tuples (add-num-less-than-first t) (- count-items-left-to-add 1))) seed-tuples)))) ;; Building the seed lists through a map, and we have 1 fewer item ;; to add to each: (define (unique-tuples max-integer item-count) (build-tuples (map list (enumerate-interval 1 max-integer)) (- item-count 1))) ;; Test: (unique-tuples 7 3) (unique-tuples 3 7) ;; empty set, as expected (unique-tuples 5 5) ;; ((1 2 3 4 5))
Solving this took me many hours (an embarrassing number), with lots of false starts. I still think there's a better way to do it, but this will do for now. Any other ideas?
Now that we have this, the rest is easy. If the permutations are required, we can just use the function given in the chapter.
(define (unique-sets-summing-to-k set-size max-number k) (filter (lambda (tuple) (= (accumulate + 0 tuple) k)) (make-unique-tuples max-number set-size))) ;; Test: (unique-sets-summing-to-k 5 10 21) (unique-sets-summing-to-k 3 7 10)
Note that this solution is generalized, which a good salaried programmer shouldn't do (unnecessary generalizaion = happy programmer + late project). However, for my own pain, I decided to do it.
I haven't looked at the first solution in detail.
The second solution (right above this comment) is the cleanest and simplest, but has O(n^3) complexity, when the solution can be brought down to O(n^2) by making use of the constraint that they must all add up to s.
My solution:
;; First get all pairs of distinct integers (i,j) that add up to s - ;; without permuting (i < j) (define (make-pairs n s) (map ; Create the list of pairs (lambda (x) (list (- s x) x)) (filter ; Keep only values such that the other term in the pair is ; smaller than x. (lambda (x) (and (< (- s x) x) (> (- s x) 0))) (enumerate-interval 2 n)))) ;; Now do it for triples, making use of the above function. (define (make-triple n s) (flatmap ; Create all permutations. permutations (flatmap ; Create the triples by making use of make-pairs. (lambda (k) (map ; Convert each pair to a triple. (lambda (x) (cons k x)) (make-pairs (- k 1) (- s k)))) (filter ; Keep only values such that the other terms will be less than x. (lambda (x) (<= (- s x) (- (* 2 x) 3))) (enumerate-interval 3 n))))) (make-triple 10 15)
Apologies if there are any similarities between this solution and the others; I've just glanced at the ones above!
;;; Limiting ourselves to this specific exercise. ;; In accordance to the code reutilization spirit of the book, ;; this solution builds on the previous exercise (2.40), given ;; below for reference. (define (unique-pairs n) (flatmap (lambda (i) (map (lambda (j) (list i j)) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n))) ;; Let a (k,n)-tuple be an ordered n-tuple whose elements are at ;; most k. Then, we build (k,3)-tuples by concatenating ;; p = 1,2,3,...,k with (p-1,2)-tuples. (define (unique-triples n) (flatmap (lambda (k) (map (lambda (pair) (cons k pair)) (unique-pairs (- k 1)))) (enumerate-interval 1 n))) ;; Finally, we run the tuplelist above through a simple filter ;; that accumulates/sums the elements of a given tuple and ensures ;; the resulting value is the one passed to the procedure. (define (unique-triples-that-sum-to value max-element) (filter (lambda (triple) (= value (accumulate + 0 triple))) (unique-triples max-element))) ;; Examples: (unique-triples 4) ;; => ((3 2 1) (4 2 1) (4 3 1) (4 3 2)) (unique-triples-that-sum-to 7 4) ;; => ((4 2 1)) ;;; This can readily be generalized to (k,n)-tuples for any ;;; given n. ;; Here we create (k,n)-tuples through the following recursion: ;; ;; 1) We define a (k,1)-tuple to be (k). Thus, if 'order' = 1, ;; we return the tuplelist ((1), (2), ..., (k)); ;; 2) Otherwise, we build (k,n)-tuples by concatenating ;; p = 1,2,...k with (p-1,n-1)-tuples. (define (unique-tuples order max-element) (if (= order 1) (map (lambda (x) (list x)) (enumerate-interval 1 max-element)) (flatmap (lambda (first) (map (lambda (rest) (cons first rest)) (unique-tuples (- order 1) (- first 1)))) (enumerate-interval 1 max-element)))) ;; Finally, we define a filter analogously to the one above. (define (unique-tuples-that-sum-to value tuple-order max-element) (filter (lambda (tuple) (= value (accumulate + 0 tuple))) (unique-tuples tuple-order max-element))) ;; Examples: (unique-tuples 6 7) ;; => ((6 5 4 3 2 1) (7 5 4 3 2 1) ...) (unique-tuples-that-sum-to 22 6 7) ;; => ((7 5 4 3 2 1)) (unique-tuples 3 4) ;; => ((3 2 1) (4 2 1) (4 3 1) (4 3 2)) (unique-tuples-that-sum-to 7 3 4) ;; => ((4 2 1))
(define (perm n seq) (if (= 0 n) (list '()) (flatmap (lambda (elem) (map (lambda (next) (cons elem next)) (perm (- n 1) (remove elem seq)))) seq))) (define (ordered-trips-that-sum n s) (filter (lambda (x) (= s (accumulate + 0 x))) (perm 3 (enumerate-interval 1 n))))
dontbr?, I think your unique-tuples can be simplified as below code.
(define (unique-tuple size max-number)
(if (= size 0)
(list '())
(flatmap (lambda (i)
(map (lambda (t) (cons i t))
(unique-tuple (- size 1) (- i 1))))
(enumerate-interval 1 max-number))))
Adds sum to the triple (doesn't do a separate accumulation).
(define (find-triplets-aggregate n s)
(define (equal? triplet)
(= (cadr triplet) s))
(define (build-triplet-with-sum i j k)
(list (list i j k) (+ i j k)))
(flatmap (lambda(k)
(flatmap (lambda(j)
(filter equal?
(map (lambda(i) (build-triplet-with-sum i j k))
(enumerate-interval 1 (1- j)))))
(enumerate-interval 1 (1- k))))
(enumerate-interval 1 n)))
Solution similar to Kuan's to generate tuples.
(define (tuples nb max-int)
(define (iter size)
(if (= size nb) (map list (enumerate-interval nb max-int))
(flatmap (lambda (i)
(map (lambda (j) (cons j i)) (enumerate-interval size (- (car i) 1))))
(iter (+ size 1)))))
(iter 1))
I decided to try to get away without filtering at all, more in line with an example of generating permuations. In order to do so, we need a function that generates an ordered (by descending) list of unique positive numbers less than or equal to M that sum to a given S. We just need to generate an enumeration of all the plausible first numbers of a list and flatmap it to the recursive call result for a (length - 1) and (sum - first-item). Thus we can only generate those lists that fits task criteria and don't need a filter at all. (Written in DrRacket)
#lang Scheme ; ↓↓↓↓↓ Functions from the book ↓↓↓↓↓ (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (enumerate-interval low high) (if (> low high) null (cons low (enumerate-interval (+ low 1) high)))) (define (flatmap proc seq) (accumulate append null (map proc seq))) (define (decrease x) (- x 1)) ; ↑↑↑↑↑ Functions from the book ↑↑↑↑↑ ; ↓↓↓↓↓ SOLUTION ↓↓↓↓↓ (define (get-triplets-that-sum-equals-to sum max-value) ; Gets the sum of values of a list (n n-1 n-2 ... 2 1) of a given length (define (sum-enum len) (accumulate + 0 (enumerate-interval 1 len))) ; If we want to create an ordered (by descending) list of unique positive integers, ; we need to make sure it's starting with at least the value of its length. ; I.e. if we need a list of three items, first value should be at least 3: (3 2 1). ; If we start with 2, we will paint ourselves into a corner: (2 1 ehm 0 isn't positive) ; ; We would also need to make sure our values add up to desired sum. If we start too low ; and all the further numbers in our list should be even lower, we can't guarantee we will ; ever amass the required sum in the end of a list. E.g. if we need to make a list of 3 ; values that sum up to 10, we need to start at least with 5, because if we start with 4 ; the biggest list we can get is (4 3 2) which sums to 9. ; Therefore, for a list of 3 values we can find the minimum value `x` of a first item ; like this: x + (x - 1) + (x - 2) >= sum, e.g. 3x - sum-enum(2) >= sum. Generally, for ; a list of a length L it should be: ; Lx - sum-enum(L - 1) >= sum ; x >= (sum + sum-enum(L - 1)) / L ; In this function we take whatever is biggest: length or x (define (get-lower-bound-for-interval len sum) (define m (ceiling (/ (+ sum (sum-enum (decrease len))) len))) (if (> m len) m len)) ; Top value for an interval can be more than max-value by definition of a task. ; It also can't be higher than (sum - sum-enum(L - 1)) where L is the length of a current ; sequence. E.g. if we want to create an ordered (by descending) list of unique positive ; integers that sums up to 10 and we start with 7, we can only follow up with 2 and 1, as ; 7 + 2 + 1 = 10. If we start with 8, we can't create such a list. ; x + sum-enum(L - 1) <= sum ; x <= sum - sum-enum(L - 1) (define (get-upper-bound-for-interval len sum max-value) (define m (- sum (sum-enum (decrease len)))) (if (< m max-value) m max-value)) ; Gets new max value for a next item of a list (define (get-new-max-value first-item max-value) (define decreased-first-item (decrease first-item)) (if (< decreased-first-item max-value) decreased-first-item max-value)) ; Slight generalization of original task. Finds an ordered (by descending) list of `length` ; distinct positive integers less than or equal to a `max-value` that sum to a given integers. (define (get-list-that-sum-equals-to sum len max-value) (if (= len 0) (list null) (flatmap (lambda (first-item) (map (lambda (next-items) (cons first-item next-items)) (get-list-that-sum-equals-to (- sum first-item) (decrease len) (get-new-max-value first-item max-value)))) (enumerate-interval (get-lower-bound-for-interval len sum) (get-upper-bound-for-interval len sum max-value))))) (get-list-that-sum-equals-to sum 3 max-value)) (get-triplets-that-sum-equals-to 20 10)
A simple solution where all concerns are fully separated into independent stages; a) Enumerate all unique triples (i,j,k) such that 1≤k<j<i≤n and b) Filter out those where i+j+k=s. I used apply instead of accumulate for no particular reason:
(define (unique-triples n) (flatmap (lambda (i) (flatmap (lambda (j) (map (lambda (k) (list i j k)) (enumerate-interval 1 (- j 1)))) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n))) (define (sum-to? numbers s) (= (apply + numbers) s)) (define (ordered-triples-less-than-n-that-sum-to-s n s) (filter (lambda (triple) (sum-to? triple s)) (unique-triples n)))
After comparing master's solution above to mine below I guess I understand why flatmap is called flatmap ;-)
Even though there are simpler solutions, here is what I came up with:
(define (atom? x) (and (not (pair? x)) (not (null? x)))) ; needed in (collect-triplets lst) (define (list-of-atoms? l) (cond ((null? l) #t) ((atom? (car l)) (list-of-atoms? (cdr l))) (else #f))) (define (triplet-sum t) (+ (car t) (cadr t) (caddr t))) (define (triplet-sum-eq-s? t s) (= (triplet-sum t) s)) ; this is ugly (define (collect-triplets lst) (cond ((null? lst) nil) ((null? (car lst)) (collect-triplets (cdr lst))) ((and (list-of-atoms? (car (car lst))) (null? (cdr (car lst)))) (cons (car (car lst)) (collect-triplets (cdr lst)))) (else (append (car lst) (collect-triplets (cdr lst)))))) (define (make-ordered-triplets-summing-to-s s n) (filter (lambda (t) (triplet-sum-eq-s? t s)) (collect-triplets (flatmap (lambda (i) (map (lambda (j) (map (lambda (k) (list i j k)) (enumerate-interval 1 (- j 1)))) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n))))) (make-ordered-triplets-summing-to-s 20 30)
The obvious solution is use the flatmap and unique-pairs, though Woofy's (unique-tuples n k) function is awesome, the idea is similar with "Exercise 2.32" and "Example: Counting change" in chapter1.2.2. Here is my simple solution.
(define (unique-triple n) (flatmap (lambda (pair) (let ((k (car pair)) (j (cadr pair))) (map (lambda (i) (list k j i)) (enumerate-interval 1 (- j 1))))) (unique-pairs n))) (assert (unique-triple 3) '((3 2 1))) (assert (unique-triple 4) '((3 2 1) (4 2 1) (4 3 1) (4 3 2))) (define (make-sum-eql-below s n) (filter (lambda (triple) (= s (+ (car triple) (cadr triple) (caddr triple)))) (unique-triple n))) (assert (make-sum-eql-below 12 15) '((5 4 3) (6 4 2) (6 5 1) (7 3 2) (7 4 1) (8 3 1) (9 2 1)))
(define (ordered-tuples s options n-items) (cond [(and (= s 0) (= n-items 0)) (list null)] [(< s 0) null] [(= n-items 0) null] [(> n-items (length options)) null] [else (flatmap (lambda (x) (map (lambda (y) (cons x y)) (ordered-tuples (- s x) (remove x options) (- n-items 1)))) options ) ] ) ) (define (ordered-triplets s n) (ordered-tuples s (enumerate-interval 1 n) 3) )
IMO the following solution is the simplest possible(?). It's all about a simple recursive formulation of the problem...but not a single person above managed to write a concise english-language description of the recursive step! Tsk, tsk.
"Siphon my knowledge into your brain. Assimilate my sensibilities to your spine." - Xah Lee
(define (enumerate-interval lo hi) (if (> lo hi) '() (cons lo (enumerate-interval (+ 1 lo) hi)))) ;; enumerate all unique k-tuples whose elements are distinct and in [1, n] (define (unique-tuples k n) (if (= k 0) (list '()) ;; recursive case: for each possible last element i, generate ;; all size k-1 tuples with smaller max elements and append i to each. (flatmap (lambda (i) (map (lambda (tuple) (append tuple (list i))) (unique-tuples (- k 1) (- i 1)))) (enumerate-interval 1 n))))
My approach to generalizing to k tuples. Need thinking a bit about the leaf cases.
Aternative approach. More close to the exercise's style.
(define (unique-tuples n k) (define (iter m k) (if (= k 0) (list nil) (flatmap (lambda (j) (map (lambda (tuple) (cons j tuple)) (iter (+ j 1) (- k 1)))) (enumerate-interval m n)))) (iter 1 k))