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

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

Определение операции проецирования project похоже на определение операции raise.

Мы также вводим обобщенную операцию:

(define (project x) (apply-generic 'project x))

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

;integer package
;rational package 
(define (rational->integer r) 
  (make-integer (round (/ (numer r) (denom r))))) 
(put 'project '(rational) rational->integer)
;real package 
(define (real->rational x) 
  (make-rational (numerator x) (denominator x))) 
(put 'project '(real) real->rational)
; complex package 
(define (complex->real z) 
  (make-real (real-part z))) 
(put 'project '(complex) complex->real)

Преобразование комплексного числа к действительному и рационального к целому особых трудностей не вызывает, а вот получить из действительного числа рациональное уже сложнее. Первоначально я хотел выбросить рациональные числа из башни и сделать упражение без них, но потом подглядел у Эли Бендерски, что в Scheme есть встроенные процедуры numerator и denominator, которые получают числитель и знаменатель по действительному числу. Это как раз то, что мне было нужно для получения рационального числа из действительного.

Операция drop записывается довольно просто. Мы смотрим, можно ли вообще спроецировать объект на тип ниже. Если нет, то спуск по башне окончен. Если да, то проверяем, эквивалентен ли исходный объект поднятой проекции. Если нет, то опять же спуск окончен. Если же эквивалентность выполняется, то мы повторяем тот же процесс спуска на ступеньку для проекции. Выглядит это так:

(define (drop x) 
  (let ((op (get 'project (type-tag x)))) 
    (if op 
        (let ((p (project x))) 
          (if (equ? x (raise p)) 
              (drop p) 
              x)) 
        x)))

Для того, чтобы внедрить упрощение результатов операций с помощью drop в apply-generic достаточно просто обернуть в drop результат вызова apply. Соответствующая строчка будет иметь вид:

(drop (apply proc (map contents args)))

Больше никаких изменений apply-generic не требует.

Comments

Comment from nobody
Date: July 16, 2008, 12:05 pm

Если бы round возвращал целое число, а не дробное, то можно было бы сделать преобразование действительного в рациональное так:

(define epsilon 0.0001)
(define coeff (round (/ 1 epsilon)))
(define (real->rational x)
(make-rational (round (* x coeff))
coeff))

Comment from thror
Date: May 27, 2009, 11:49 pm

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

Comment from thror
Date: June 10, 2009, 7:01 am

и тут оказывается, что ничего работать не будет. Объясню. Допустим, как у вас, функцию raise мы определили через apply-generic. Смотрите. Например raise от (scheme-integer . 5) сначала сделает (rational . (5 . 1)) а потом попытается опустить… Смотрите теперь на свою функцию drop внимательнее… В ней вызовется project который сделает снова (scheme-integer . 5) и внимание… Вызовется снова raise от (scheme-integer . 5) результат такой – вызов raise почти с любым аргументом Х приведет к рекурсивному вызову raise от того же Х…

Comment from thror
Date: June 10, 2009, 7:05 am

причина этого в том, что raise и project лишь инструменты для правильного функционирования apply-generic, и не должны быть реализованы через нее.

Comment from Максим
Date: December 24, 2014, 9:15 pm

Среда разработки DrRacket:

(put 'project '(rational) (lambda (x) (inexact->exact (round (/ (numer x) (denom x))))))
(put 'project '(real) (lambda (x) (make-rational (real-numer x) (real-denom x))))
(put 'project '(complex) (lambda (z) (make-real (real-part z))))

(define (project x)
(apply-generic 'project x))
(define (drop x)
(let ((exists? (get 'project (list (type-tag x)))))
(if exists?
(let ((push (project x)))
(if (equ? x (raise push))
(drop push)
x))
x)))

В комментариях к упражнению 2.84 смотрите мою реализацию apply-generic, drop туда вставляется непосредственно:

(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(if (> (length args) 1)
(let ((t1 (car type-tags))
(t2 (cadr type-tags))
(rest-args (cddr args)))
(if (and (null? rest-args) (eq? t1 t2))
(error "No procedure specified for these types" op)
(let ((highest-type (type-tag (find-highest args))))
(let ((raised-args (raise-all-to-highest args highest-type)))
(drop (partition-and-apply op raised-args))))))
(error "No procedure specified for this type" op))))))

Comment from Максим
Date: December 24, 2014, 9:20 pm

То есть финальный алгоритм таков:
Выбираем из списка аргументов тот что с наивысшим типом -> “поднимаем” все остальные к его типу -> последовательно применяем операцию к списку аргументов -> упрощаем результат, если это возможно.

Comment from Максим
Date: December 24, 2014, 9:21 pm

Также рекомендую для прояснения ситуации посмотреть лекцию 4B на канале youtube MIT OpenCourseWare.

Comment from Максим
Date: December 24, 2014, 9:25 pm

Ах да, real-numer и real-denom – те встроенные примитивы numerator и denominator о которых говорит Сергей. inexact->exact тоже примитив.

Comment from Максим
Date: December 24, 2014, 11:33 pm

Моя реализация выше неверна, и реализация автора также, так как drop не будет работать по спискам с 1 и 2 аргументами. Однако тут встаёт вопрос – а можем ли мы вообще вот так запросто взять и обернуть в drop что-либо?
В решении затаилась серьезная ошибка. Как мы будем использовать equ?, который выражен через apply-generic и который возвращает булевское значение #t или #f c drop? Ведь drop первым делом проверит аргумент x на его метку типа, что сразу же выдаст ошибку – неподходящий тип данных. Не зря thror писал что довольно проблематичная эта функция apply-generic, и тяжело её модифицировать, когда все ключевые операции нашей системы завязаны именно на ней.

Comment from Максим
Date: December 24, 2014, 11:37 pm

Самым простым решением в данном случае, вообще не модифицировать apply-generic с помощью drop, а вынести его в наши обобщенные процедуры add,mul,div,sub за пределы apply-generic’a.

Comment from Den
Date: June 24, 2016, 4:10 pm

Поддержу слова Максима, из-за предикатов equ? и =zero? мы не можем просто обернуть в drop строку с apply в apply-generic.

Comment from Denis Larionov
Date: February 1, 2017, 11:35 am

в каждый пакет добавил метод project, который либо понижает тип в дереве, либо нет (и тогда возвращает объект исходного типа)

integer

(define (project z) (make-integer z))
(put 'project '(integer) project)

rational

(define (project z)
    (cond ((= (numer z) 0) (make-integer 0))
          ((= (denom z) 1) (make-integer (numer z)))
          (else (make-rational (numer z) (denom z)))))
(put 'project '(rational) project)

real

(define (project z)
    (if (= (round z) z)
        (make-integer z)
        (make-real z)))
(put 'project '(real) project)

complex

(define (project z)
    (if (= (imag-part z) 0)
        (make-real (real-part z))
        (make-complex (real-part z) (imag-part z))))
(put 'project '(complex) project)

тогда можно определить drop через обобщенный метод raise, но нельзя его использовать внутри apply-generic из-за возникающей рекурсии
(define (project z) (apply-generic 'project z))

(define (drop z)
  (let ((p (project z)))
    (if (eq? (type-tag z) (type-tag p))
        z
        (drop p))))

Write a comment