sicp-ex-2.41


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.


<< Previous exercise (2.40) | Index | Next exercise (2.42) >>


eivanov

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) 
  

jz

  
 ;; 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.


mueen

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) 
  

dontbr

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)) 

atrika

  
 (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)))) 

kuan

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))))