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

5 February, 2008 (21:25) | Решения упражнений

Сначала простое. Рисовалка, обводящая рамку просто строит 4 отрезка, которые являются сторонами рамки, то есть соединяют точки (0, 0), (1, 0), (1, 1) и (0, 1):

(define outline-painter 
  (segments->painter (list (make-segment (make-vect 0 0) 
                                         (make-vect 1 0)) 
                           (make-segment (make-vect 1 0) 
                                         (make-vect 1 1)) 
                           (make-segment (make-vect 1 1) 
                                         (make-vect 0 1)) 
                           (make-segment (make-vect 0 1) 
                                         (make-vect 0 0)))))

Рисовалка, соединяющая противоположные концы рамки еще проще:

(define X-painter 
  (segments->painter (list (make-segment (make-vect 0 0) 
                                         (make-vect 1 1)) 
                           (make-segment (make-vect 1 0) 
                                         (make-vect 0 1)))))

Ромб – это контур с вершинами в точках (0.5, 0), (1, 0.5), (0.5, 1) и (0, 0.5):

(define diamond-painter 
  (segments->painter (list (make-segment (make-vect 0.5 0) 
                                         (make-vect 1 0.5)) 
                           (make-segment (make-vect 1 0.5) 
                                         (make-vect 0.5 1)) 
                           (make-segment (make-vect 0.5 1) 
                                         (make-vect 0 0.5)) 
                           (make-segment (make-vect 0 0.5) 
                                         (make-vect 0.5 0)))))

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

  1. polyline генерирует список отрезков, составляющих ломаную линию, по набору векторов, обозначающих вершины,
  2. contour генерирует список отрезков, составляющих замкнутый контур, по набору векторов, обозначающих вершины.

Определения этих процедур выглядят так:

(define (polyline vectors) 
    (if (null? (cdr vectors)) 
        null 
        (cons (make-segment (car vectors) (cadr vectors)) 
              (polyline (cdr vectors)))))
(define (contour vectors) 
  (polyline (append vectors 
                    (list (car vectors)))))

Идея процедуры contour в том, что контур – это ломаная линия, к которой начальная точка добавлена еще раз в конец.

Теперь мы можем укоротить с помощью этих новых процедур рисовалки outline-painter и diamond-painter:

(define outline-painter 
  (segments->painter (contour (list (make-vect 0 0) 
                                    (make-vect 1 0) 
                                    (make-vect 1 1) 
                                    (make-vect 0 1))))) 
(define diamond-painter 
  (segments->painter (contour (list (make-vect 0.5 0) 
                                    (make-vect 1 0.5) 
                                    (make-vect 0.5 1) 
                                    (make-vect 0 0.5)))))

Рисовалка wave может быть записана таким образом (обратите внимание, как я объединяю 5 ломаных линий, составляющих изображение в набор отрезков):

(define wave-painter 
  (segments->painter 
    (append (polyline (make-vect 0 0.15) 
                      (make-vect 0.15 0.4) 
                      (make-vect 0.3 0.35) 
                      (make-vect 0.4 0.35) 
                      (make-vect 0.35 0.15) 
                      (make-vect 0.4 0)) 
            (polyline (make-vect 0.6 0) 
                      (make-vect 0.65 0.15) 
                      (make-vect 0.6 0.35) 
                      (make-vect 0.75 0.35) 
                      (make-vect 1 0.65)) 
            (polyline (make-vect 1 0.85) 
                      (make-vect 0.6 0.55) 
                      (make-vect 0.75 1)) 
            (polyline (make-vect 0.6 1) 
                      (make-vect 0.5 0.7) 
                      (make-vect 0.4 1)) 
            (polyline (make-vect 0.25 1) 
                      (make-vect 0.35 0.5) 
                      (make-vect 0.3 0.4) 
                      (make-vect 0.15 0.6) 
                      (make-vect 0 0.35)))))

Координаты векторов взяты приближенно (но достаточно правдоподобно) по исходному рисунку.

Comments

Pingback from SICP по-русски » Blog Archive » Решение упражнения 2.52 из SICP
Date: February 7, 2008, 8:54 pm

[…] wave-painter я просто добавил еще одну ломаную (последнюю) для […]

Comment from gorilych
Date: July 27, 2008, 6:22 pm

polyline принимает только один аргумент, соотв-но


(polyline (make-vect ...) .. (make-vect ...))

надо заменить на


(polyline (list (make-vect ...) .. (make-vect ...)))

Write a comment