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

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

Книга СИКП абсолютно великолепна кругом затрагиваемых вопросов. В упражнении 2.29 нас знакомят с понятием мобиля, которое интересно само по себе как демонстрация физических явлений. Баланс и устойчивое равновесие неустойчивой фигуры завораживает. Недаром мобилями весьма интересуются дети в самом раннем возрасте. Почитать про мобили и кинетическую скульптуру в целом можно в английской википедии.

neuromobile.jpg

Приступим к упражнению.

Часть А.

Определение селекторов не представляет особого труда:

(define (left-branch mobile) 
  (car mobile))
(define (right-branch mobile) 
  (cadr mobile))
(define (branch-length branch) 
  (car branch))
(define (branch-structure branch) 
  (cadr branch))

Обратите внимание, как выделяется второй элемент списка. Это не то же, что выделение второго элемента пары!

Часть Б.

Мы предполагаем, что вес стержней нулевой, вес мобиля тогда равен сумме весов всех гирь. Для удобства вводим понятие веса ветви как веса ее структуры (гири либо подмобиля). Процедуру, вычисляющую вес мобиля, можно определить так:

(define (branch-weight branch) 
  (let ((struct (branch-structure branch))) 
    (if (pair? struct) 
        (total-weight struct) 
        struct)))
(define (total-weight mobile) 
  (+ (branch-weight (left-branch mobile)) 
     (branch-weight (right-branch mobile))))

Часть В.

Запишем предикат проверки сбалансированности мобиля как конъюнкцию трех перечисленных в определении сбалансированности условий:

  1. сбалансированность левой ветви мобиля;
  2. сбалансированность правой ветви мобиля;
  3. равенство вращательных моментов левой и правой ветвей.

Я предлагаю сделать это таким образом (здесь используются результаты предыдущей части упражнения):

(define (balanced? mobile) 
  (define (branch-balanced? branch) 
    (if (pair? (branch-structure branch)) 
        (balanced? (branch-structure branch)) 
        true)) 
  (define (torque branch) 
    (* (branch-length branch) (branch-weight branch))) 
  (let ((left (left-branch mobile)) 
        (right (right-branch mobile))) 
    (and (branch-balanced? left) 
         (branch-balanced? right) 
         (= (torque left) (torque right)))))

Часть Г.

Прелесть удачно расставленных барьеров абстракции позволяет нам приизменении внутреннего представления мобилей изменить только селекторы, не касаясь операций над самими мобилями, такими как total-weight или balanced?. В данном случае нуждаются в замене только селекторы для правой ветви и структуры:

(define (right-branch mobile) 
  (cdr mobile))
(define (branch-structure branch) 
  (cdr branch))

Весь остальной код из первых частей упражнения остается неизменным.

Comments

Comment from thror
Date: February 13, 2008, 11:02 pm

Замечательное упражнение. И не только потому что мобили =) А еще и потому что наводит на размышления. В комментариях к этому упражнению я расскажу о том почему предложенное решение стоит усовершенствовать и о расширениях абстракции process-tree, позволяющих это сделать. Комментариев будет несколько, потому что каждый из них будет не маленький =)

Comment from thror
Date: February 13, 2008, 11:18 pm

Здесь собственно я излагаю вовсе не более краткое или правильное решение. Здесь—идеи, к которым приводит это упражнение. Зачастую они более важны чем само решение.

Первое, о чем пойдет речь—более естественное для обработки древовидной структуры представление процедуры total-weight и о порождаемом ей первом расширении абстракции process-tree.

(define (total-weight mobile)
  (cond ((null? mobile) 0)
        ((not (pair? mobile)) mobile)
        (else (+ (total-weight (branch-structure (left-branch mobile)))
                 (total-weight (branch-structure (right-branch mobile)))))))

Напомню, что речь идет об абстракции обобщенной обработки дерева process-tree:

(define (process-tree combiner quux null-value tree)
  (cond ((null? tree) null-value)
        ((not (pair? tree)) (quux tree))
        (else (combiner (process-tree combiner quux null-value (car tree))
                        (process-tree combiner quux null-value (cdr tree))))))

Доступ к левому и правому подмобилям мобиля m осуществляется при помощи специальных селекторов

(branch-structure (left-branch m))
(branch-structure (right-branch m))

что существенно сложнее, чем предполагаемое в process-tree—(car tree) и (cdr tree). Таким образом указанная процедура total-weight не вкладывается в абстракцию process-tree, но естественным образом приводит нас к ее расширению

(define (process-tree-structure left right leaf? combiner quux null-value tree)
  (cond ((null? tree) null-value)
        ((leaf? tree) (quux tree))
        (else (combiner (process-tree-structure left right leaf? combiner quux null-value (left tree))
                        (process-tree-structure left right leaf? combiner quux null-value (right tree))))))

Теперь процедуру total-weight можно выразить таким образом

(define (total-weight mobile)
  (process-tree-structure (lambda (a) (branch-structure (left-branch a)))
                          (lambda (a) (branch-structure (right-branch a)))
                          (lambda (a) (not (pair? a)))
                          +
                          (lambda (a) a)
                          0
                          mobile))

Продолжение в следующей заметке =)

–thror

Comment from thror
Date: February 13, 2008, 11:41 pm

Рассмотрим второе расширение абстракции process-tree, порожденное следующей идеей—комбинирующая функция принимает в качестве параметров только результаты обработки левого и правого поддеревьев.

Это подразумевает, что информация будет содержаться только в листах дерева, но не в его узлах (к примеру, в случае с мобилями, информация содержится не только в листах древовидной структуры—масса гирек, но и в ее узлах—длины ветвей), поскольку у комбинирующей функции нет доступа к информации в узле.

Для того, чтобы иметь возможность получать информацию из узлов дерева, следует изменить комбинирующую функцию таким образом, чтобы она принимала три аргумента—результаты обработки поддеревьев и сам этот узел в качестве третьего аргумента.

Таким образом получим следующее расширение абстракции process-tree

(define (xprocess-tree xcombiner quux null-value tree)
  (cond ((null? tree) null-value)
        ((not (pair? tree)) (quux tree))
        (else (xcombiner (xprocess-tree xcombiner quux null-value (car tree))
                         (xprocess-tree xcombiner quux null-value (cdr tree))
                         tree))))

Несмотря на столь правдоподобное рассуждение о необходимости такого расширения…

Неожиданным и очень важным является тот факт, что абстракции process-tree и xprocess-tree эквивалентны (в том смысле, что одну можно выразить через другую и наоборот). Формально это можно сделать таким образом

(define (xprocess-tree xcombiner quux null-value tree)
  ((process-tree (lambda (l r) (lambda (x) (xcombiner (l (car x)) (r (cdr x)) x)))
                 (lambda (a) (lambda (x) (quux x)))
		 (lambda (a) null-value)
		 tree) tree))

Фактически process-tree проходя по дереву создает функцию, в которую мы передаем исходное дерево для получения результата. (Выражение process-tree через xprocess-tree практически тривиально).

–thror

Comment from thror
Date: February 13, 2008, 11:50 pm

Совместив указанные расширения можно построить следующую абстракцию для обработки древовидных структур, с информацией содержащейся не только в листьях но и в узлах

(define (xprocess-tree-structure left right leaf? xcombiner quux null-value tree)
  (cond ((null? tree) null-value)
        ((leaf? tree) (quux tree))
        (else (xcombiner (xprocess-tree-structure left right leaf? xcombiner quux null-value (left tree))
                         (xprocess-tree-structure left right leaf? xcombiner quux null-value (right tree))
                         tree))))

Или эквивалентное выражение через process-tree-structure

(define (xprocess-tree-structure left right leaf? xcombiner quux null-value tree)
  ((process-tree-structure left
                           right
                           leaf?
                           (lambda (l r) (lambda (x) (xcombiner (l (left x)) (r (right x)) x)))
                           (lambda (a) (lambda (x) (quux x)))
                           (lambda (a) null-value)
                           tree) tree))

А дальше—зачем все это нужно =)

–thror

Comment from thror
Date: February 14, 2008, 12:02 am

Собственно, решение предложенное Сергеем, очень даже хорошее, бесспорно. Но каждый раз попадая в узел древовидной структуры, представляющей мобиль, мы вынуждены пройти все поддерево этого узла, чтобы определить его общую массу.

Было бы неплохо, посетив поддерево, накапливать информацию о его массе и сбалансированности. Вот что я имею ввиду

(define (make-residue state weight)
  (list state weight))

(define (residue-state residue)
  (car residue))

(define (residue-weight residue)
  (cadr residue))

(define (combine l r mobile)
  (make-residue (and (residue-state l)
                     (residue-state r)
                     (= (* (residue-weight l) (branch-length (left-branch mobile)))
                        (* (residue-weight r) (branch-length (right-branch mobile)))))
                (+ (residue-weight l) (residue-weight r))))

(define (reduce mobile)
  (cond ((null? mobile) (make-residue true 0))
        ((not (pair? mobile)) (make-residue true mobile))
        (else (let ((l (reduce (branch-structure (left-branch mobile))))
                    (r (reduce (branch-structure (right-branch mobile)))))
                (combine l r mobile)))))

(define (total-weight mobile)
  (residue-weight (reduce mobile)))

(define (balanced? mobile)
  (residue-state (reduce mobile)))

Это разумеется не короче исходного решения, но хотя бы просто обратите внимание на процедуру reduce—вот пример того, когда потребуется xprocess-tree-structure, но об этом позже.

–thror

Comment from thror
Date: February 14, 2008, 12:09 am

Собственно, все решение задачи содержится только в одном предыдущем комментарии =) Все остальное—это обсуждение идей, возникающих при синтезе и последующем анализе решения. Этот комментарий не исключение. Вот как можно выразить reduce через xprocess-tree-structure

(define (reduce mobile)
  (xprocess-tree-structure (lambda (a) (branch-structure (left-branch a)))
                           (lambda (a) (branch-structure (right-branch a)))
                           (lambda (a) (not (pair? a)))
                           combine
                           (lambda (a) (make-residue true a))
                           (make-residue true 0)
                           mobile))

Надеюсь вы хорошенько повеселились читая это =)

–thror

Comment from Sergey Khenkin
Date: February 14, 2008, 12:20 am

Полностью согласен с замечанием относительно того, что в моем варианте процедуры balanced? делается много повторяющихся вычислений (веса одних и тех же подмобилей пересчитываются по много раз). Постараюсь привести более эффективное решение.

Вообще идеи очень интересные. Я присоединяюсь к мысли о том, что зачастую само решение менее ценно, чем путь к нему, на котором возникают любопытные озарения.

Comment from JessicaFletcher
Date: March 25, 2009, 11:52 am

(define (balanced? mobile)

 (define (function mobile)
  (let ((l (left-branch mobile))
       (r (right-branch mobile)))
  (cond (pair? (branch-struct item)) (if (= (* (branch-lenght l) (function (brunch-struct l)) (* (branch-lenght r) (function (brunch-struct r)))))
                                        (+ (function (brunch-struct l) (function (brunch-struct r))))
                                        (False))
       (not (pair? (branch-struct item))) branch-struct item)))

 (if (= (function mobile)) True) True)
    False)

Comment from JessicaFletcher
Date: March 25, 2009, 11:54 am

(define (balanced? mobile)

 (define (function mobile)
  (let ((l (left-branch mobile))
       (r (right-branch mobile)))
  (cond (pair? (branch-struct item)) (if (= (* (branch-lenght l) (function (brunch-struct l)) (* (branch-lenght r) (function (brunch-struct r)))))
                                        (+ (function (brunch-struct l) (function (brunch-struct r))))
                                        (False))
       (not (pair? (branch-struct item))) branch-struct item)))

 (if (= (function mobile)) True) True)
    False)

Comment from hi_artem
Date: January 23, 2013, 8:35 pm

После высокоуровневой абстракции, представленной –thror, совсем коротенькое решение для начинающих, как первый шаг к пониманию.
В решении принято допущение, что ни длина стержня, ни вес груза не может быть отрицательным.

Ф-ция moment подсчитывает сумму моментов вращения действующих на левую и на правую ветвь мобиля.
“Суммирование” происходит в ф-ции comb, причем применен следующий трюк:
если моменты равны, то результат просто математическая сумма, а если моменты не равны, то -1.

В итоге получаем, что если мобиль сбалансирован, то результат ф-ции moment – это сумма всех моментов вращения, а если не сбалансирован то отрицательное число.

Так как в итоге нам нужно сделать предикат, то добавлена ф-ция balanced?

(define (moment m)  ;;;;;  m - значит mobile :-)
 (cond  ((null? m) 0 )
        ((not (pair? m)) m )
        (else  (comb (* (branch-length (left-branch m)) (moment (branch-structure (left-branch m))))
                     (* (branch-length (right-branch m)) (moment (branch-structure (right-branch m))))))))

(define (comb a b)
    (if (or (= a 0) (= b 0) (= a b)) (+ a b)
         -1))

(define (balanced? m) (if (< (moment m) 0) false true))

Comment from Irv
Date: January 31, 2016, 11:07 pm

решение, которое получилось у меня до прочтения комментариев thror

часть 2
я посчитал, что одна единица длины стержня весит столько же сколько одна единица груза. тогда

(define (total-weight m)
  (+ (branch-weight (left-branch m)) (branch-weight (right-branch m))))

(define (branch-weight b)
  (let ((l (branch-length b))
        (s (branch-structure b)))
    (+ l (if (pair? s) (total-weight s) s))))

другой интересный вариант – применить fringe из прошлого упражнения к мобилю, который есть дерево. тогда останется просуммировать элементы полученного списка.

(define (total-weight m)
  (sum (fringe m)))

(define (sum items)
  (if (null? items)
      0
      (+ (car items) (sum (cdr items)))))

часть 3
у меня получилась процедура проверяющая сбалансированность конкретного мобиля и рекурсивная процедура перебирающая все мобили в дереве.

(define (balanced? m)  
  (let ((lb (left-branch m))
        (rb (right-branch m)))
    (= 
     (* (branch-length lb) (branch-weight lb)) 
     (* (branch-length rb) (branch-weight rb)))))

(define (balanced-deep? m)
  (if (not (pair? m))
      #t
      (and 
       (balanced? m)
       (balanced-deep? (branch-structure (left-branch m)))
       (balanced-deep? (branch-structure (right-branch m))))))

Write a comment