Решение упражнения 2.41 из SICP

31 January, 2008 (22:59) | Решения упражнений

Определим сначала процедуру, генерирующую все наборы различных троек. Она строится аналогично процедуре, генерирующей все уникальные пары из прошлого упражнения (можно даже использовать unique-pairs в реализации, но я этого не буду делать:

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

Теперь применим к набору троек, построенному процедурой unique-triples, фильтр, проверяющий равенство суммы элементов тройки заданному числу s:

(define (triples-with-sum s n) 
  (filter (lambda (t) (= (accumulate + 0 t) s)) 
          (unique-triples n)))

Процедура triples-with-sum является решением этого упражнения.

Это не единственное возможное решение. Как я уже писал выше, можно переиспользовать определенную ранее процедуру unique-pairs. Можно также не разбивать весь процесс на два этапа (генерацию троек и фильтрацию), а сразу строить тройки таким образом, чтобы их сумма была равна s.

Comments

Comment from nobody
Date: July 9, 2008, 8:17 pm

Когда я сначала попытался написать unique-triples так, как у вас (по аналогии с unique-pairs), я просто запутался на третьем уровне вложенности 🙂 Поэтому я написал её так:

(define (prepend-nums n seq)
  (accumulate append
              '()
             (map (lambda (elem)
                    (map (lambda (i) (cons i elem))
                         (enumerate-interval 1 n)))
                  seq))) 
                  
(define (ordered-triples n)
  (prepend-nums n
                (prepend-nums n
                              (prepend-nums n '(()) ))))

Comment from Irv
Date: June 24, 2016, 9:11 am

вариант генерации троек с начала (а не с конца, как у автора)

(define (unique-triplets n)
(flatmap
(lambda(i)
(let ((m (remove i (enumerate i n))))
(flatmap
(lambda(j)
(let ((p (remove i (remove j (enumerate j n)))))
(map (lambda(k)
(list i j k))
p)))
m)))
(enumerate 1 n)))

Comment from gumanovski
Date: July 13, 2017, 4:59 pm

(define (unique-mlets m n)
  (define (proc-make-posl-vspom tekur teklist)
    (if (= tekur m)
	(map (lambda (x)
		     (append (list x) teklist))
	     (enumerate-interval 1 (if (= tekur 1)
					n 
					(- (car teklist) 1))))
	(if (> tekur m) 
	    teklist 
	    (flatmap (lambda (x)
			      (proc-make-posl-vspom (+ 1 tekur) (append (list x) teklist)))
		         (enumerate-interval 1 (if (= tekur 1)
						               n
						               (- (car teklist) 1))))))
            )
  (proc-make-posl-vspom 1 (list))
)

Write a comment