воскресенье, 25 июля 2010 г.

Лисп, свои типы данных и операции над ними.

В воскресенье объехали с женой вокруг Брно (65 км), размяли ноги. Увидел на lisper.ru этот тред, решил размять и мозг.

Итак, нужно иметь свой тип для представления денег. Деньги представляются числом с фиксированным количеством разрядов после запятой. Например, 2 для копеек. Числа с плавающей точкой использовать нельзя, т.к. значения во время вычислений определённо уедут из-за округлений, плюс нельзя контроллировать кол-во разрядов после запятой.

Пусть наш тип данным будет cons'ом, в голове которого будет само значение, а в хвосте - экспонента с десятичным основанием. Голова - целочисленная, масштабированная на экспоненту. Например, 2.43 во внутреннем представлении будет (243 . 2) .


(deftype money (&optional exp)
  `(and (satisfies consp) (satisfies is-money)))

Чтобы объект был похож на деньги, он должен быть cons'ом и удовлетворять is-money:

(defun is-money (x)
  (and (integerp (car x))
       (integerp (cdr x))))

Можно ещё проверок накрутить, типа, положительной экспоненты, пределов значений экспоненты и т.п., но не будем. Проверяем:

(typep '(1012 . 2) 'money) => T

Работает. Напишем хелпер, приводящий наш формат к нормальному числу:

(defun get-real-value (x)
  (cl:/ (car x) (expt 10 (cdr x))))

и хелпер, делающий деньги:

(defun make-money (val exp)
  `(,(round (cl:* val (expt 10 exp))) . ,exp))


Проверяем:

(make-money 10.12 2) => (1012 . 2)


Работает, но '(1012 . 2) в коде программы выглядит не очень презентабельно. К счастью, у нас есть ридтейбл, модификацией которого можно добиться, чтобы лисп, например, читал конструкцию вида $10.12'2 и создавал нужный конс (1012 . 2).

(set-macro-character #\$
 (lambda (s disp)
   (declare (ignore disp))
   (let ((*readtable* (copy-readtable)))
     (set-macro-character #\'
              (lambda (foo bar)
                (declare (ignore bar))
                (read foo)))
     `(make-money ,(read s) ,(read s)))))

Здесь объявляется, что символ $ имеет специальное значение для лиспового парсера, а при попадании на него нужно вызвать означенную лямбду. В лямбде также переопределяется смысл апострофа, т.к. он присутствует в формате наших денег для отделения экспоненты от тела. Разумеется, внутри области видимости новой *readtable* квотирование через апостроф больше работать не будет, но нам и не надо.

(equal $10.12'2 '(1012 . 2)) => T

(typep $10.12'2 'money) => T

Всё ещё работает.

Разберёмся с какой-нибудь зловредной математической операцией, меняющей кол-во знаков после запятой. Пусть это будет умножение.

Т.к. функция умножения уже присутствует в системе, то её нужно затенить, дабы компилятор не ругался: (shadow :*). Функция получает список аргументов, над которым нужно произвести действие. В первом приближении я написал код вида (apply #'cl:* (mapcar деньги-в-число ...)) с последующим вызовом make-money с полученным числом и максимальной найденной экспонентой, но так делать неправильно, т.к. во время умножения будет копиться ошибка, перетекающая в старшие разряды и потенциально могущая попасть в значимый диапазон. Правильнее будет на каждой итерации приводить результат к деньгам, для чего воспользуемся техникой reduce:

(defun * (&rest args)
  (reduce
   (lambda (&rest args)
     (when args
       (apply #'make-money
          (case (length args)
        (1
         (destructuring-bind (v1 e1)
             (normalize-value (car args))
           (list v1 e1)))
        (2
         (destructuring-bind ((v1 . e1) (v2 . e2))
             (list (normalize-value (car args))
               (normalize-value (cadr args)))
           (list (cl:* v1 v2) (max e1 e2))))))))
   args))

где normalize-value:

(defun normalize-value (x)
  (if (typep x 'money)
      (cons (get-real-value x) (cdr x))
      (cons x 0)))

Проверяем:

(* $1.23'2 $2.01'2 2.0 1/2) =>  (247 . 2)

Опять работает.

Оставшиемя основные арифметические операции определяются аналогично (через macrolet). Внутреннее представление денег можно, по вкусу, изменить на структуру.

4 комментария:

  1. Красиво. Только я не понял один момент, что значит: "...будет копиться ошибка, перетекающая в старшие разряды...". Т.е. непонятна аргументация против того, чтобы просто перевести всё в real-числа, перемножить, и сделать соотв. make-money?? Объясни, плиз, "на пальцах" если не трудно.

    ОтветитьУдалить
  2. Разобрав код я обнаружил, что вложенный set-macro-character не нужен. А также неплохо бы задавать экспоненту по умолчанию:

    (set-macro-character #\$
    (lambda (s disp)
    (declare (ignore disp))
    `(make-money
    ,(read s)
    ,(if (char= #\' (peek-char nil s nil nil))
    (read s)
    2))))

    (print $10.12)
    (print $10.12'4)

    ОтветитьУдалить
  3. ... хотя я не прав. Код читающий новый тип не должен зависеть от текущей обработки знака #\' - т.е. вложенный set-macro-character - нужен.

    ОтветитьУдалить
  4. > Только я не понял один момент, что значит: "...будет копиться ошибка, перетекающая в старшие разряды...". Т.е. непонятна аргументация против того, чтобы просто перевести всё в real-числа, перемножить, и сделать соотв. make-money??

    В IEEE754 нет точного представления чисел.

    ОтветитьУдалить

Архив блога