Проигрываем wav файл на clojure

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

Открываем поток:

(defn create-stream [file]

  (AudioSystem/getAudioInputStream file))

Создаем объект Info описывающий наш звуковой файл

(defn create-info [stream]

  (let [format (.getFormat stream)]

      (DataLine$Info. Clip

     format

     (* (.getFrameLength stream)

(.getFrameSize format)))))

По объекту Info создаем Clip для проигрывания

(defn create-clip [info]

  (AudioSystem/getLine info))

Вот так выглядит код проигрывающий файл:

(defn play [file]

  (let [stream (create-stream file)

clip (create-clip (create-info stream))]

    (.open clip stream)

    (.start clip)

    (Thread/sleep 99)

    (loop [active (.isActive clip)]

      (if active

(do

 (Thread/sleep 99)

 (recur (.isActive clip)))))

    (.stop clip)

    (.close clip)))

Тут присутствует магия с потоками, которая позволяет отслеживать окончание проигрывания клипа и закрывать ресурсы по окончанию.

clojure-mode + paredit-mode + show-paren-mode

Я использую emacs для программирования на Clojure. И оказалось, что paredit-mode чудо как хорош при работе со скобочками. Ты просто пишешь код, а редактор сам следит за тем, что скобочек было необходимое и достаточное количество. У меня 2 компьютера один под Mac OS, другой под Windows. Под мак есть хорошая сборка Emacs AquaMacs, в которой у меня сразу заработали clojure-mode + paredit-mode + show-paren-mode. Под виндой пришлось немного помучится. Paredit писал ошибку рекурсивной загрузки библиотеки "recursive load", что я вылечил
строчкой в .emacs:

(load (expand-file-name "~/.emacs.d/elpa/paredit-20/paredit.el"))

Это не очень хороший вариант, из моих скромных познаний elisp следует, что emacs при каждом запуске компилит этот плагин, но другого способа запустить paredit я не нашел.

А теперь я решил еще одну проблему. Чтобы каждый раз открывая clj файл, у меня запуска сладкая троечка, добавил два хука:


(add-hook 'clojure-mode-hook (lambda () (paredit-mode +1)))
(add-hook 'clojure-mode-hook (lambda () (show-paren-mode +1)))

Это заработала. Жизнь определенно налаживается. И возможно скоро моя игра для самых маленьких станет значительно интереснее.

Ring сессии и wrap-reload

Нет времени написать развернутый текст, а написать хочется. Поэтому кратенько.
wrap-session в Ring не дружит с wrap-reload.

Из-за этого когда вы используете compojure.handler/site совместно с wrap-reload, надо писать так:

(defonce my-atom (atom {}))

(site handler {:session {:store (memory-store my-atom)}})

Сессии не работают из-за того, что по умолчанию они хранятся в памяти, а wrap-reload их перезагружает при каждом GET запросе. 

ClojureQL: take для Oracle.

Оракл не поддерживает оператор OFFSET. Из-за этого в ClojureQL не работает оператор take. Но это можно обойти вот таким образом:

(defn oracle-take
  [tname limit]
  (-> (table (str "SELECT ROW_NUMBER() OVER (ORDER BY key ASC)"
          " AS rownumber, columns"
          " FROM " tname ")"))
      (select (where (<= :rownumber limit)))
      (project ["*"])))

Подробности на английском можно посмотреть здесь (искать по слову oracle-take).

Мой первый макрос на Clojure.

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

(def debug true)

(defmacro defhandler [handler-name args & body]
  (if debug
    (let [msg (str handler-name " " args)]
      `(defn ~handler-name [~@args]
     (println ~msg ~args)
     ~@body))
    `(defn ~handler-name [~@args]
       ~@body)))

;usage

(defhandler foo [x y] (+ x y))

Теперь будет логироваться название функции и её переменных. Без рефлекшена. Восхитительно!

Scheme: сортировка слиянием 2.

В первой части я привел алгоритм сортировки слиянием. Он плох тем, что рекурсивен. Казалось бы что такого. А дело в том, что из-за того что данные копируются из одного списка в другой нам приходится использовать 2n памяти, где n - это память, которая требуется для хранения массива. Поэтому на практике сортировать данные умещающие в память методом слияния неэффективно. Его имеет смысл использовать для данных, которые целиком в оперативку не влезают, например, упомянутые данные на магнитных лентах. Кстати, да будет тебе известно рынок магнитных лент неуклонно растет, хотя в обычной жизни мы с ними уже не встречаемся. Они находят свое место в системах резервного копирования, огромных по своим размерам.

Итак был приведен рекурсивный метод сортировки того, что не влезает в память.

(define (merge-sort pred ls)
  (cond
    [(null? ls) ls]
    [(null? (cdr ls)) ls]
    [else (let ([splits (split ls)])
            ;Вот тут довольно неприятный рекурсивный вызов.
            ;Он не позволит использовать в точности этот алгоритм для 
            ;магнитных лент.
            (merge pred
              (merge-sort pred (car splits))
              (merge-sort pred (cdr splits))))]))

Так как мы должны будем разбить начальный список на одно элементные множества, нам понадобится сделать вызов merge-sort огромное число раз. Короче в память не влезет. Из чего можно сделать вывод, что алгоритм приведенный в статье Scheme: сортировка слиянием не работоспособен. 

На первой странице гугла, нормальный алгоритм merge sort я не нашел и постарался сам его модифицировать, с целью убрать рекурсивный вызов. Вот что у меня получилось. 

#lang scheme
;Возвращает пару из первых n элементов списка и остатка.
(define (first-n l n)
  (define (helper head tail counter)
    (cond ((or (= counter 0)
               (null? tail))
           (cons head tail))
          ;Тут не очень хороший вызов append, я так эмулирую запись в конец.
          ;Я пошел на это так, как в дальнейшем собираюсь сортировать не списки
          ;а непосредственно файлы, в которых как раз таки легко записывать именно в 
          ;конец
          (else (helper (append head (list (car tail))) (cdr tail) (- counter 1)))))
  (helper '() l n))
;Делит список на два помещаю в каждый попеременно n элементов
(define (split l n)
  (define (iter l1 l2 p tail)
    (cond ((null? tail) (cons l1 l2))
          (else (let ((items (first-n tail n)))
                  (if p
                      ;Опять не очень быстрый append, по той же самой причине.
                      (iter (append l1 (car items)) l2 (not p) (cdr items))
                      (iter l1 (append l2 (car items)) (not p) (cdr items)))))))
  (iter '() '() #t l))

;Сливает n-элементные последовательности каждого из списков.
(define (merge pred l1 l2 n)
  ;Итеративно сливает n-элементов из каждого списка.
  ;Наверно можно переписать используя функцию first-n.
  (define (merge-n l l1 l2 c1 c2)
    (cond
      [(or (= c1 0) (null? l1)) 
           (let ((items (first-n l2 c2)))
             (list (append l (car items)) l1 (cdr items)))]
      [(or (= c2 0) (null? l2)) 
       (let ((items (first-n l1 c1)))
         (list (append l (car items)) (cdr items) l2))]
      [(pred (car l1) (car l2))
       (merge-n (append l (list (car l1))) (cdr l1) l2 (- c1 1) c2)]
    [else (merge-n (append l (list (car l2))) l1 (cdr l2) c1 (- c2 1))]))
  (define (iter l l1 l2)
    (cond ((null? l1) (append l l2))
          ((null? l2) (append l l1))
          (else (let ((lists (merge-n l l1 l2 n n)))
                  (iter (car lists) (cadr lists) (caddr lists))))))
  (iter '() l1 l2))
;Собственно mergesort, который последовательно делит и сливает списки длины 
;1, 2, 4, 8 ....
(define (mergesort pred l)
  (define (iter l n)
    (let ((splits (split l n)))
      (if (null? (cdr splits))
          (car splits)
          (iter (merge pred (car splits) (cdr splits) n) (* n 2)))))
   (iter l 1)) 

После того, как написал понял, что функция first-n плохая она пытается законсить теоретически не помещающиеся в память списки. Но зато хоть от рекурсии избавился. Теперь на очереди сортировка файла и сортировка ленты. Файл имеет ту особенность, что считывают из него сначала, а записывают в конец. У магнитной ленты особенность в том, что она сначала записывается в одну сторону, а потом считывается может в другую. По мне так аналогия с cons очевидна.

Scheme: сортировка слиянием.

Представляю твоему вниманию алгоритм сортировки слиянием на языке Scheme. Если мне не изменяет память этот алгоритм очень удобно применять при сортировке данных на магнитных лентах. Аналогично спискам в примере ниже, данные сначала делятся на две части и записываются на магнитные ленты, а потом с этих лент сливаются вместе и записываются на третью. Для тех кто не в курсе, Scheme это диалект Lisp, созданный для того, чтобы профессорам из MIT было легче мучить студентов.

";" служит для обозначения комментариев в коде.
#lang scheme Используется интерпретатором для определения языка.

#lang scheme
;Делим список
(define (split ls)
  ;letrec создает область значений, это нужно для рекурсивного вызова split-h
  ;Зачем? Ну хз, я бы define использовал.
  (letrec ([split-h (lambda (ls ls1 ls2)
                      (cond
                        ;Если первый список подошел концу
                        [(or (null? ls) (null? (cdr ls)))
                         ;Делаем пару из второго списка и первого. 
                         ;Переворачиваем, так как при добавлении первым идет последний добавленный.
                         (cons (reverse ls2) ls1)]
                         ;По-начальному списку спускаемся на 2 элемента вниз,
                         ;по-первому на 1. Когда дойдем до конца во втором списке будет 
                         ;первая половина начального списка.
                        [else (split-h (cddr ls)
                                (cdr ls1) (cons (car ls1) ls2))]))])
    (split-h ls ls '())))
;Сливаем списки, тут на мой взгяд все очевидно.
(define (merge pred ls1 ls2)
  (cond
    [(null? ls1) ls2]
    [(null? ls2) ls1]
    [(pred (car ls1) (car ls2))
     (cons (car ls1) (merge pred (cdr ls1) ls2))]
    [else (cons (car ls2) (merge pred ls1 (cdr ls2)))]))

(define (merge-sort pred ls)
  (cond
    [(null? ls) ls]
    [(null? (cdr ls)) ls]
    [else (let ([splits (split ls)])
            ;Вот тут довольно неприятный рекурсивный вызов.
            ;Он не позволит использовать в точности этот алгоритм для 
            ;магнитных лент.
            (merge pred
              (merge-sort pred (car splits))
              (merge-sort pred (cdr splits))))]))

Оригинальная статься по данному алгоритму содержит лицензию, которую я надеюсь не нарушаю. В работе алгоритма я убедился в замечательной среде PLT-Scheme .

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

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