Category: авто

satyr

Трамплины и продолжения

Любопытно, конечно, что наибольшую популярность завоёвывают именно плохие с инженерной точки зрения технологии. Я не могу объяснить этот феномен: казалось бы, согласно эволюционной теории "более лучшие" вещи должны постепенно заменять эквивалентные по функционалу "более худшие", но этого не происходит. И даже не всегда проблема в том, что что-то сложнее, а что-то легче: обычно, в плохо продуманных технологиях сложность как раз выше, просто она "отложенная".

Давайте, например, посмотрим на такие платформы: Common Lisp/Scheme, Haskell или OCaml. А потом на такие: Java или Javascript. В чём разница? Правильно, в одних есть хвостовая рекурсия, в других нет :)

Ладно, на самом деле, большинству программистов наджави эта рекурсия нафиг не сдалась. Полагаю, что многие и не подозревают даже что это такое, и подобное неведение никак не мешает им вполне комфортно существовать на свете. Но оная проблема встаёт достаточно остро для пользователей более вменяемых языков, которые используют джаву или js в качестве бэкенд-платформы. Например, Clojure для jvm или Elm для javascript. Эти языки предполагают функциональную парадигму программирования, и отсутствие TCO при этом причиняет серьёзные неудобства.

Честно говоря, натолкнувшись на переполнение стека в Elm, я был несколько ошарашен. Ничто не предвещает беды, вокруг тепло и уютно: с одной стороны, у тебя почти хаскель, с другой тебе было обещано отсутствие рантайм-исключений (если ты не выходишь за рамки чистого elm). И тут херак, привет из js:

RangeError: Maximum call stack size exceeded

Я поначалу даже растерялся — к такому меня жизнь явно не готовила. Пришлось потратить некоторое количество времени, чтобы разобраться, как в таких случаях следует поступать: ведь никаких специальных технических средств для написания явных циклов руками в ельме нет. Он умеет оптимизировать только самые простые хвостовые вызовы, но любая чуть более сложная рекурсия сразу становится "честной". Поэтому пишу этот материал постфактум в качестве инструкции — мало ли кому ещё поможет.

Итак, давайте рассмотрим следующий синтетический пример:


isEven : Int -> Bool
isEven x =
    case abs x of
        0 -> True
        v -> isOdd <| v - 1


isOdd : Int -> Bool
isOdd x =
    case abs x of
        0 -> False
        v -> isEven <| v - 1


isSumEven : Int -> Int -> Bool
isSumEven a b =
    isEven a == isEven b


Я тут попытался смоделировать проблему: у нас есть две взаимно-рекурсивные функции (определяющие, чётное или нечётное число на входе) и одна утилитарная, которая их как-то использует (предсказывает, будет ли сумма двух чисел чётная).

Можно сразу посмотреть в репле, как они (не) работают:


> isEven 2
True : Bool
> isOdd 13
True : Bool
> isSumEven 100 1
False : Bool
> isEven 100000
RangeError: Maximum call stack size exceeded


Как их заставить работать, если платформа не поддерживает TCO? Никак, надо переписывать.

Общепринятая практика использовать в таких случаях технику, которая называется trampolining. Она широко используется, например, в Clojure. Идея там достаточно простая. Мы рефакторим функции, использующие рекурсию таким образом, чтобы:

  1. во всех местах, где производится рекурсивный вызов, вместо этого возвращалось наружу продолжение (достаточно просто обычного замыкания: thunk)
  2. на самом "верхнем" уровне выполняется обычный тупой цикл (trampoline), который последовательно вызывает отрефакторенную функцию до тех пор, пока она возвращает продолжения

Тем самым все функции перестают быть рекурсивными, и использование стека становится чётко детерминировано: из всех условных веток возвращаются либо результаты, либо замыкания (которые потом будут вызваны из трамплина).

В Elm, оказывается, есть даже микро-пакетик с трамплинами: elm-lang/trampoline. С его помощью можно переписать вышеприведённые взаимно-рекурсивные функции следующим образом:


import Trampoline exposing (Trampoline, done, jump, evaluate)


isEvenTr : Int -> Trampoline Bool
isEvenTr x =
    case abs x of
        0 -> done True
        v -> jump <| \() -> isOddTr <| v - 1


isOddTr : Int -> Trampoline Bool
isOddTr x =
    case abs x of
        0 -> done False
        v -> jump <| \() -> isEvenTr <| v - 1



В данном случае, всё получается достаточно прямолинейно: когда готов результат, возвращаем его через done, а когда нужно выполнить рекурсивный вызов, оборачиваем его в thunk и возвращаем через jump. Соответственно, в пакете trampoline лежит ещё функция evaluate, которая как раз крутит цикл, вызывая по-очереди все возвращаемые продолжения. Проверяем:


> evaluate <| isEvenTr 2
True : Bool
> evaluate <| isOddTr 13
True : Bool
> evaluate <| isOddTr 100000
False : Bool


Да, в этом варианте всё работает!

Кстати, небольшое отступление. Очевидно, что многим (включая меня) может не понравиться, как выглядит вот этот кусок кода:


jump <| \() -> isOddTr <| v - 1


Лично я его автоматически написал сначала так:


jump <| always <| isOddTr <| v - 1


За что был наказан потерянным часом на отладку. Кто может предположить, в чём кроется засада? :) Для справки: always.

Ладно, возвращаемся к примерам. Как написать трамплин-версию isSumEven? В принципе, можно как-то так:


isSumEvenTr : Int -> Int -> Trampoline Bool
isSumEvenTr a b =
    done <| (evaluate <| isEvenTr a) == (evaluate <| isEvenTr b)


Конкретно для этого синтетического примера, наверно, такой вариант особо ничем не плох. Но всё же: можно ли обойтись только одним evaluate? Очевидно, что можно, если получится каким-то образом "попасть внутрь" типа Trampoline a, чтобы достать значение a или, хотя бы, как-то его преобразовать. Но вот незадача: этот тип не является функтором или монадой, никаких соответствующих комбинаторов для него нет, да и вообще это всё страшные слова, и такой мерзости у нас в эльме не водится! Следовательно, единственный вариант — это честно интерпретировать Trampoline a через evaluate. Или нет?

На самом деле, есть способ "состыковать" несколько Trampoline-ов, чтобы выполнить их в одном цикле-эвалюаторе: опять же, CPS. Но для этого нам опять нужно отрефакторить функции, на этот раз в continuation passing style:


isEvenTrK : Int -> (Bool -> Trampoline Bool) -> Trampoline Bool
isEvenTrK x k =
    case abs x of
        0 -> k True
        v -> jump <| \() -> isOddTrK (v - 1) k


isOddTrK : Int -> (Bool -> Trampoline Bool) -> Trampoline Bool
isOddTrK x k =
    case abs x of
        0 -> k False
        v -> jump <| \() -> isEvenTrK (v - 1) k


isSumEvenTrK : Int -> Int -> (Bool -> Trampoline Bool) -> Trampoline Bool
isSumEvenTrK a b k =
    isEvenTrK a <|
        \resultA ->
            jump <| \() -> isEvenTrK b <|
                \resultB ->
                    k <| resultA == resultB



Главное изменение: функции теперь не возвращают результаты напрямую (логически, они уже ничего не должны возвращать), вместо этого они принимают дополнительные параметр: "продолжение", которому этот результат передаётся. Теперь в isEvenTrK появилась возможность состыковать две "затрамплиненные" функции внутри продолжения, при этом сохранив тип возвращаемого значения Trampoline Bool, который уже скармливается единственному evaluate:


> evaluate <| isSumEvenTrK 100000 1 done
False : Bool
> evaluate <| isSumEvenTrK 100000 100000 done
True : Bool


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

Ну, в целом, как-то так. Далее полагается, чтобы я написал какие-то выводы или подытоги, но какие тут могут быть выводы? Сложно, запутанно. Но это и есть та самая "отложенная сложность", про которую я говорил в начале поста. Был бы в вашем джаваскрипте изначально родной TCO, я бы не писал этот текст, а вместо этого сделал бы что-нибудь полезное.
satyr

Никогда не делай сегодня то, что можно отложить на завтра.

В апреле кончилась осага на втыкс, а новую ща по новым правилам без техосмотра сделать нельзя. Короче, надо было съездить сделать ТО.

Ну, собстно, вот, съездил сегодня, сделал =)
satyr

Honda NC700x, HD FLSTFB и BMW F800r

И вот снова благодаря Фениксице я абсолютно бессмысленно, но бесплатно катаюсь на всяческой технике :) На этот раз, вот, мотики.

Дисклеймер: все картинки из google images.

Honda NC700x




Крайне крутая штуковина для города, я ваще в восторге :) Достаточно узкая, чтобы пролезать в тесное междурядье; достаточно лёгкая, чтобы без проблем ворочать руками, достаточно высокая, чтобы вскарабкаться на бордюр, и достаточно борзая, чтобы уйти от всех со светофора.

Бензин практически не жрёт (катались с Фениксом в Питер -- топлива на nc700 хватает в полтора раза дальше, чем vtx1800, при том, что у втыкса бак больше).

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

Есть внятный абс, рулится как велик, посадка относительно удобная (хотя мне чопперная и нравится больше), подвеска замечательная (мелких дефектов дороги тупо не замечаешь). И всё это добро за 360к рублей за новый :)

Минусов немного, но чуток есть: дохлая фара (реально, надо всё время с дальним ехать, чтобы хоть чуть-чуть светило), цепь (ненавижу её смазывать, а центральной подножки нет) и дохловатый мотор на низах (я уже и забыл, что мот может заглохнуть, если не успеть сбросить передачу при падении оборотов).

Собственно, я бы уверенно поставил бы этот моц на заслуженное второе место среди самых удобных ТС для города. А если на табуретки-полтосы, всё-таки, введут права и начнут их прессовать, то и на первое.

HD FLSTFB




Не ну чё писать про харлей, непонятно :) Первые минут пятнадцать я катался с очень гордым выражением лица, но потом вроде немного полегчало. Ну и как бы HD оказался единственным мотом из всех, на которых я приезжал к офису, на который коллеги специально спускались посмотреть :)

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

Ну а как мотоцикл он, конечно, так себе, ничего особенного. VTX1800, например, почти везде объективно сильно лучше :) Ремень шумит, звук не очень, двигатель адски жарит в пробках, динамика так себе, на высоких оборотах непрятно дребезжит. Каким-то макаром постоянно пробуксовывает заднее колесо, если откручивать (при том, что втыкс рвёт заметно веселее, но ничем при этом не буксует). Есть ABS, но она какая-то крайне тупая, в отличие от NC700x и F800R: то застрекочет на совершенно ровном месте при спокойном торможении, то никак не мешает блокировать колесо, причём надолго (случайно получилось на ТТК).

Итого, вторым мотоциклом харлей было бы иметь прикольно, но так, пожалуй, ну его.

BMW F800R




Так получилось, что представители bmw чёто ступили и сначала выдали Фениксу не тот аппарат :) В итоге мы с ней пару дней ездили на сером f800r, имея на руках все документы от совершенно другого, красного.

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

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

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

И еще раз о задачке про ip-диапазоны.

Собственно, описание задачи и варианты её решения можно почитать здесь у nponeccop. Один из вариантов там предложен на CL лавсанчиком. Собственно, он меня немножечко возмутил, поэтому пришлось писать этот пост :)

Суть токова: это вполне себе рабочий код, но так на common lisp писать не надо :) Потому что так надо писать на си. На сях этот же код будет вдвое короче (хотя бы за счет отсутствия скобок и более лаконичного синтаксиса) и вдвое быстрее.

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

Условия нам благоприятсвуют: диапазоны грузятся один раз, а дальше только лукап. Поэтому мы попробуем решить эту задачу классическим лисповым способом: «расставить скобки вокруг спецификации и заставить её запуститься». Вот прямо так, буквально. Итак, имеем файл ranges.list такого вида:

104.72.221.173,220.57.219.35
16.65.26.150,133.42.154.151
80.241.37.220,93.109.90.13
35.165.212.97,105.166.11.16
122.143.149.115,246.17.13.31
20.44.170.80,144.105.12.169
122.132.114.84,184.165.60.95
102.111.151.45,120.152.236.26
53.252.70.24,171.51.24.110
101.103.12.180,224.55.178.136

Отлично, давайте расставим вокруг скобки, чтобы получить ranges.list.lisp:

(in-package :ip-ranges)
(gen-test-proc
  "104.72.221.173,220.57.219.35"
  "16.65.26.150,133.42.154.151"
  "80.241.37.220,93.109.90.13"
  "35.165.212.97,105.166.11.16"
  "122.143.149.115,246.17.13.31"
  "20.44.170.80,144.105.12.169"
  "122.132.114.84,184.165.60.95"
  "102.111.151.45,120.152.236.26"
  "53.252.70.24,171.51.24.110"
  "101.103.12.180,224.55.178.136"
)

Только, конечно же, не руками, а вот так:

(defun preprocess-ranges-file (filename)
  (let ((lisp-file (format nil "~a.lisp" filename)))
    (with-open-file (f-in filename)
      (with-open-file (f-out lisp-file
                             :direction :output
                             :if-exists :supersede
                             :if-does-not-exist :create
                             :external-format :ascii)
        (format f-out "(in-package :ip-ranges)~%(gen-test-proc~%")
        (iter (for range in-stream f-in using #'read-line)
              (format f-out "  \"~a\"~%" range))
        (format f-out ")~%~%")))
    lisp-file))

Переходим ко второму этапу: надо заставить полученную скобочную спецификацию компилироваться. Давайте сначала быстренько распарсим строчку ip-адреса и диапазона, плюнем на перфоманс:

(defpackage #:ip-ranges
  (:use :cl :iterate :metatilities)
  (:shadowing-import-from :metatilities #:minimize #:finish)
  (:export #:check))

(in-package :ip-ranges)

(defun extract-values (string)
  (unless (zerop (length string))
    (multiple-value-bind (value rest-index)
        (parse-integer string :junk-allowed t)
      (if value
          (cons value (extract-values (subseq string rest-index)))
          (extract-values (subseq string 1))))))

Работать это должно так:

IP-RANGES> (extract-values "104.72.221.173,220.57.219.35")
(104 72 221 173 220 57 219 35)

Теперь надо немного пораскинуть мозгами. Вот у нас есть диапазон, заданный ip-адресами, каждый из которых представлен четырьмя октетами -- в нашем случае '(104 72 221 173) и '(220 57 219 35). Допустим, нам выдали адрес в таком же формате: ip = (list ip-0 ip-1 ip-2 ip-3); какой код должен быть в программе, которым можно проверить принадлежность этого адреса заданному диапазону? Собственно, тут даже не надо ничего делать руками (например, склеивать октеты в 32-х битный адрес и т.п.), просто тупо сгенерируем сравнение в лесенкой столбик :)

(defun ip-range (range-string)
  (let ((values (extract-values range-string))
        (vars '(ip-0 ip-1 ip-2 ip-3)))
    (assert (= (length values) 8))
    (labels ((stairs (cmp values vars)
               (if (null values)
                   t
                   `(or (,cmp ,(car vars) ,(car values))
                        (and (= ,(car vars) ,(car values))
                             ,(stairs cmp (cdr values) (cdr vars)))))))
      `(and ,(stairs '> (subseq values 0 4) vars)
            ,(stairs '< (subseq values 4 8) vars)))))

IP-RANGES> (ip-range "104.72.221.173,220.57.219.35")
(AND
 (OR (> IP-0 104)
     (AND (= IP-0 104)
          (OR (> IP-1 72)
              (AND (= IP-1 72)
                   (OR (> IP-2 221)
                       (AND (= IP-2 221)
                            (OR (> IP-3 173) (AND (= IP-3 173) T))))))))
 (OR (< IP-0 220)
     (AND (= IP-0 220)
          (OR (< IP-1 57)
              (AND (= IP-1 57)
                   (OR (< IP-2 219)
                       (AND (= IP-2 219)
                            (OR (< IP-3 35) (AND (= IP-3 35) T)))))))))

Ну а теперь у нас есть все для того, чтобы "скомпилировать спецификацию":

(defmacro gen-test-proc (&rest ranges)
  `(defun ip-check (ip-0 ip-1 ip-2 ip-3)
     (or ,@(mapcar #'ip-range ranges))))

(defun check (ip-string)
  (apply #'ip-check (extract-values ip-string)))

Вуаля:

IP-RANGES> (load (compile-file (preprocess-ranges-file #p"ranges.list")))
; compiling file "/home/swizard/devel/lisp/ip-ranges/ranges.list.lisp" (written 03 NOV 2011 11:16:02 PM):
; compiling (IN-PACKAGE :IP-RANGES)
; compiling (GEN-TEST-PROC "104.72.221.173,220.57.219.35" ...)

; /home/swizard/devel/lisp/ip-ranges/ranges.list.fasl written
; compilation finished in 0:00:00.045
T
IP-RANGES> (check "192.168.0.1")
T
IP-RANGES> (check "10.0.0.0")
NIL


Итак, еще раз, что мы сейчас сделали:
  • Расставили скобки вокруг списка ip-диапазонов.
  • Сгенерировали по описанию функцию ip-check, решающую задачу.
  • ...
  • Profit!

Красотища? Да, но пока что не особо.

  • Несмотря на константные проверки и восьмибитную сегментацию адреса, у нас получилась последовательная проверка.
  • Несмотря на автоматическую генерацию условия по диапазону, это условие генерируется какое-то кривоватое и сильно избыточное.
  • Несмотря на то, что какие-то диапазоны проверять нет смысла, так как они "поглощаются" более широкими, все равно проверяются все.
  • По условиям задачи диапазонов могут быть сотни: поэтому код надо сегментировать по функциям, чтобы не нагнуть компилятор при стратегии (optimize (speed 3))


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

parenscript fix?

Все-таки следует признать, что один жирный минус в CL существует: практически нет библиотек приемлемого качества. Не, с количеством проблем никаких, но большинство пакаджей тупо уровня контрольной работы школоты, или вообще в формате "proof of concept".

Такое ощущение, что авторы даже и не пытаются проверить работоспособность своего добра в реальных условиях.

Например, в cl-prevalence от меня уже ушло два патча и еще один надо не забыть засабмитить. Патчи блин уровня "без них вообще никак не работало".

Хорошо, теперь вот два часа тупил, что так все тормозит в weblocks на do-dialog. В итоге, дебаг паяльником вывел на parenscript::parenscript-print -- я в него втыкал расширенными от ужаса глазами минут десять, пытаясь сообразить, что имелось в виду. Чуть-чуть поправил, стало работать в девяносто тысяч раз быстрее:

(defmethod parenscript-print (form)
  (let ((*indent-level* 0)
        (*print-accumulator* ()))
    (if (and (listp form) (eql 'js-block (car form))) ; ignore top-level block
        (loop for (statement . remaining) on (third form) do
             (ps-print statement) (psw ";") (when remaining (psw #\Newline)))
        (ps-print form))
    
;;; wtf?!
;;     (reduce (lambda (acc next-token)
;;               (if (and (stringp next-token)
;;                        (stringp (car (last acc))))
;;                   (append (butlast acc) (list (concatenate 'string (car (last acc)) next-token)))
;;                   (append acc (list next-token))))
;;             (cons () (reverse *print-accumulator*)))))
    
    (list (with-output-to-string (out)
            (loop
               :for next-token :in (reverse *print-accumulator*)
               :do (write-string next-token out))))))


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

Не, ну что за индусятина в серьезном коде, а? :)
(append (butlast acc) (list (concatenate 'string (car (last acc)) next-token)))

-- это ж блядь посимвольно для строк, неудивительно, что 20-ти килобайтный виджет компилируется 9 секунд.

Оно, конечно, понятно, что parenscript, в основном, на compile-time расчитан. Но все равно это не отмазка для таких катастрофических тормозов.
satyr

Зодачкоъ

Очередная проблемка / вопросец, ок? =)

Задачка, скорее, олимпиадная по духу, но неожиданно понадобилась на практике. Итак, формальное видоизмененное условие: предположим, лежит на полу куча монеток. Можно взять любые N штук. Так вот, надо получить все возможные варианты взятия :) Типа

Лежало [1, 5, 10, 50], можно брать по N=3
Вариант 1: [1, 5, 10]
Вариант 2: [1, 5, 50]
Вариант 3: [1, 10, 50]
Вариант 4: [5, 10, 50]

Лежало [1, 5, 10, 50], можно брать по N=2
Вариант 1: [1, 5]
Вариант 2: [1, 10]
Вариант 3: [1, 50]
Вариант 4: [5, 10]
Вариант 5: [5, 50]
Вариант 6: [10, 50]

Признаюсь честно, я с ней тупил весьма долго :) В итоге родил вчера в метро что-то кривое c множественной рекурсией =) но хочу грамотного решения :)

Мое решение (scheme):Collapse )
  • Current Music
    Darkthrone / Panzerfaust
  • Tags
satyr

LISP ебашит невероятно

Я в восторге просто :)

Когда мне его читали на четвертом курсе, я как-то не задумывался о его практическом применении, почему-то считая, что это просто одна из специфических автоматизированных систем для исчисления предикатов.

Пока что я тут за целый час кое-как родил функцию для сортировки списка, (листинг чуть ниже), завтра попробую уже что-нибудь совсем практическое написать :)

#!/usr/local/bin/clisp

(	defun mymax (l) 
	(	if (null (cdr l)) 
			(car l)
			(	if (> (car l) (setq r (mymax (cdr l)))) 
					(car l) r
			)
	)
)

(	defun mydel (l e)
	(	if (null l)
			nil 
			(	if (equal (car l) e)
				(cdr l)
				(cons (car l) (mydel (cdr l) e))
			)
	)
)

(	defun mysort (l)
	(	if (null (cdr l)) 
			(cons (car l) nil)
			(
				cons (setq mx (mymax l)) (mysort (mydel l mx))
			)
	)
)

(print (mysort '(101 2 3 1 9 2 2 1 5 -1 2 3 8 5 2 4 1 0 90 91 1101 12 13 19 12 12 15 -11 12 13 18 15 12 14 11 10 190 191)))

  • Current Music
    Shape Of Despair