2.5.1 · Обобщенные арифметические операции

Числовая башня с повышением и понижением типа

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

Вопрос для размышления

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

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

add сначала повышает ранг младшего операнда до тех пор, пока оба значения не получат одинаковый тег. Затем same-type-add выполняет арифметику только для конкретного представления. Целые числа integer повышаются до рациональных чисел со знаменателем 1, а рациональные числа повышаются до комплексных чисел с нулевой мнимой частью. Арифметические методы не определяют, какие преобразования разрешены.

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

Код SICP3,793 из 1,048,576 байт UTF-8

(begin
  (define (absolute value)
    (if (< value 0) (- value) value))
  (define (greatest-common-divisor a b)
    (if (= b 0)
        a
        (greatest-common-divisor b (remainder a b))))
  (define (make-integer value)
    (list 'integer value))
  (define (make-rational numerator denominator)
    (let* ((signed-numerator
             (if (< denominator 0) (- numerator) numerator))
           (positive-denominator (absolute denominator))
           (divisor
             (greatest-common-divisor
               (absolute signed-numerator)
               positive-denominator)))
      (list 'rational
            (/ signed-numerator divisor)
            (/ positive-denominator divisor))))
  (define (make-complex real-part imaginary-part)
    (list 'complex real-part imaginary-part))
  (define (type-tag value) (car value))
  (define (rank value)
    (cond ((eq? (type-tag value) 'integer) 0)
          ((eq? (type-tag value) 'rational) 1)
          ((eq? (type-tag value) 'complex) 2)
          (else -1)))
  (define (raise value)
    (cond ((eq? (type-tag value) 'integer)
           (make-rational (cadr value) 1))
          ((eq? (type-tag value) 'rational)
           (make-complex value (make-rational 0 1)))
          (else #f)))
  (define (raise-to value target-rank)
    (if (= (rank value) target-rank)
        value
        (raise-to (raise value) target-rank)))
  (define (add-rational left right)
    (make-rational
      (+ (* (cadr left) (caddr right))
         (* (cadr right) (caddr left)))
      (* (caddr left) (caddr right))))
  (define (same-type-add left right)
    (cond ((eq? (type-tag left) 'integer)
           (make-integer (+ (cadr left) (cadr right))))
          ((eq? (type-tag left) 'rational)
           (add-rational left right))
          ((eq? (type-tag left) 'complex)
           (make-complex
             (add-rational (cadr left) (cadr right))
             (add-rational (caddr left) (caddr right))))
          (else 'unsupported-type)))
  (define (generic-equal? left right)
    (and (eq? (type-tag left) (type-tag right))
         (cond ((eq? (type-tag left) 'integer)
                (= (cadr left) (cadr right)))
               ((eq? (type-tag left) 'rational)
                (and (= (cadr left) (cadr right))
                     (= (caddr left) (caddr right))))
               ((eq? (type-tag left) 'complex)
                (and (generic-equal? (cadr left) (cadr right))
                     (generic-equal? (caddr left) (caddr right))))
               (else #f))))
  (define (project value)
    (cond ((and (eq? (type-tag value) 'rational)
                (= (caddr value) 1))
           (make-integer (cadr value)))
          ((and (eq? (type-tag value) 'complex)
                (generic-equal?
                  (caddr value)
                  (make-rational 0 1)))
           (cadr value))
          (else #f)))
  (define (drop value)
    (let ((lower (project value)))
      (if lower
          (let ((raised (raise lower)))
            (if (and raised (generic-equal? raised value))
                (drop lower)
                value))
          value)))
  (define (add left right)
    (let* ((target-rank
             (if (> (rank left) (rank right))
                 (rank left)
                 (rank right)))
           (raised-left (raise-to left target-rank))
           (raised-right (raise-to right target-rank)))
      (drop (same-type-add raised-left raised-right))))
  (list
    (add (make-integer 2)
         (make-rational 3 2))
    (add (make-rational 1 2)
         (make-rational 1 2))
    (add (make-complex
           (make-rational 2 1)
           (make-rational 0 1))
         (make-integer 3))
    (add (make-complex
           (make-rational 1 1)
           (make-rational 1 1))
         (make-rational 2 1))))

(begin
  (define (absolute value)
    (if (< value 0) (- value) value))
  (define (greatest-common-divisor a b)
    (if (= b 0)
        a
        (greatest-common-divisor b (remainder a b))))
  (define (make-integer value)
    (list 'integer value))
  (define (make-rational numerator denominator)
    (let* ((signed-numerator
             (if (< denominator 0) (- numerator) numerator))
           (positive-denominator (absolute denominator))
           (divisor
             (greatest-common-divisor
               (absolute signed-numerator)
               positive-denominator)))
      (list 'rational
            (/ signed-numerator divisor)
            (/ positive-denominator divisor))))
  (define (make-complex real-part imaginary-part)
    (list 'complex real-part imaginary-part))
  (define (type-tag value) (car value))
  (define (rank value)
    (cond ((eq? (type-tag value) 'integer) 0)
          ((eq? (type-tag value) 'rational) 1)
          ((eq? (type-tag value) 'complex) 2)
          (else -1)))
  (define (raise value)
    (cond ((eq? (type-tag value) 'integer)
           (make-rational (cadr value) 1))
          ((eq? (type-tag value) 'rational)
           (make-complex value (make-rational 0 1)))
          (else #f)))
  (define (raise-to value target-rank)
    (if (= (rank value) target-rank)
        value
        (raise-to (raise value) target-rank)))
  (define (add-rational left right)
    (make-rational
      (+ (* (cadr left) (caddr right))
         (* (cadr right) (caddr left)))
      (* (caddr left) (caddr right))))
  (define (same-type-add left right)
    (cond ((eq? (type-tag left) 'integer)
           (make-integer (+ (cadr left) (cadr right))))
          ((eq? (type-tag left) 'rational)
           (add-rational left right))
          ((eq? (type-tag left) 'complex)
           (make-complex
             (add-rational (cadr left) (cadr right))
             (add-rational (caddr left) (caddr right))))
          (else 'unsupported-type)))
  (define (generic-equal? left right)
    (and (eq? (type-tag left) (type-tag right))
         (cond ((eq? (type-tag left) 'integer)
                (= (cadr left) (cadr right)))
               ((eq? (type-tag left) 'rational)
                (and (= (cadr left) (cadr right))
                     (= (caddr left) (caddr right))))
               ((eq? (type-tag left) 'complex)
                (and (generic-equal? (cadr left) (cadr right))
                     (generic-equal? (caddr left) (caddr right))))
               (else #f))))
  (define (project value)
    (cond ((and (eq? (type-tag value) 'rational)
                (= (caddr value) 1))
           (make-integer (cadr value)))
          ((and (eq? (type-tag value) 'complex)
                (generic-equal?
                  (caddr value)
                  (make-rational 0 1)))
           (cadr value))
          (else #f)))
  (define (drop value)
    (let ((lower (project value)))
      (if lower
          (let ((raised (raise lower)))
            (if (and raised (generic-equal? raised value))
                (drop lower)
                value))
          value)))
  (define (add left right)
    (let* ((target-rank
             (if (> (rank left) (rank right))
                 (rank left)
                 (rank right)))
           (raised-left (raise-to left target-rank))
           (raised-right (raise-to right target-rank)))
      (drop (same-type-add raised-left raised-right))))
  (list
    (add (make-integer 2)
         (make-rational 3 2))
    (add (make-rational 1 2)
         (make-rational 1 2))
    (add (make-complex
           (make-rational 2 1)
           (make-rational 0 1))
         (make-integer 3))
    (add (make-complex
           (make-rational 1 1)
           (make-rational 1 1))
         (make-rational 2 1))))

Примеры

Результат—

Вывод: —
Значение: —
Диагностика: —

Трасса выполнения0 / 0 событий

Ожидаемый результат

Программа возвращает ((rational 7 2) (integer 1) (integer 5) (complex (rational 3 1) (rational 1 1))).

На что обратить внимание в трассе

Для каждого вызова add зафиксируйте оба начальных ранга и каждое повышение raise. Затем перейдите к ровно одному методу для одинаковых типов. Проследите за project, raise и generic-equal? в процессе понижения drop: комплексный результат с нулевой мнимой частью доходит до integer 5, тогда как итоговый результат с ненулевой мнимой частью остается complex.

Попробуйте сами

Измените программу и сравните результат.

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

Показать подсказку

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

Завершить этот урок

В этой главе пройдено 0 из 20 уроков0%