viebel/audyx-toolbet

0.0.10


Audyx toolbet

dependencies

org.clojure/clojure
1.6.0
org.clojure/clojurescript
0.0-2202
org.clojure/test.check
0.6.1
com.velisco/herbert
0.6.6
midje
1.6.3
org.clojure/core.async
0.1.278.0-76b25b-alpha
org.clojure/clojurescript
0.0-2371



(this space intentionally left almost blank)
 
(ns audyx-toolbet.audio
        (:import [java.Math]))
(defn log[x]
        (Math/log x))
(defn pow[a b]
        (Math/pow a b))
(defn sqrt [x]
  (pow x 0.5))
(def log10-const
        (log 10))
(defn log10 [x]
  (/ (log x) log10-const))
(defn db-to-gain[db]
    (pow 10 (/ db 20)))
(defn gain-to-db[gain]
  (* 20 (log10 gain)))
(defn to-sec [x] (/ x 1000))
(defn to-msec [x] (* x 1000))
(defn volume-splitted [volume num-of-speakers]
  (- volume (* 20 (log10 (sqrt num-of-speakers)))))
(defn fft-frequencies[sampling-rate fftSize]
  (range 0 (/ sampling-rate 2) (/ sampling-rate fftSize)))
(defn freq-min [sampling-rate fftSize]
  (/ sampling-rate fftSize))
(defn dbspl->dbfs [volume max-dbspl]
  (- volume max-dbspl))
(def dbhl-delta-map {
  250 11
  500 4
  750 2
  1000 2 
  1500 1 
  2000 -1 
  3000 -6
  4000 -6 
  6000 2 
  8000 11})
(defn dbhl->dbspl [dbhl hz]
  (if-let [delta (dbhl-delta-map hz)]
    (+ delta dbhl)
    (throw
      (      Exception.                   (str "invalid frequency value: " hz)))))

This file autogenerated from src/cljx/audyx_toolbet/audio.cljx

 
(ns audyx-toolbet.collections
  (:require  [clojure.string :as string]))
(defn =without-keys? [obj-a obj-b keys-list]
  (apply = (map #(apply dissoc % keys-list) [obj-a obj-b])))

Converts a 2d vec to a hash-map. E.g.

[[:a 1] [:b 2]] -> {:a 1 :b 2}

(defn vec->map
  [vec]
  (into {} vec))
(defn map-2d-vec [f m]
  (map (fn[[k id]] [k (f id)]) m))

Usage:

  (map-object f m)

Returns a map with the same keys as m and with the values transformed by f.

For instance:

         (map-object #(* 100 %) {:a 1 :b 2 :c 3}); => {:a 100 :b 200 :c 300})
(defn map-object
  [f m]
  (vec->map (map-2d-vec f m)))
(defn map-object-with-key [f m]
  (into {} (map (fn [[a b]] [a (f a b)]) m)))
(defn map-2d-vec-kv [fk fv m]
  (map (fn[[k id]] [(fk k) (fv id)]) m))
(defn map-object-kv [fk fv m]
  (vec->map (map-2d-vec-kv fk fv m)))

Turns a hash map inside out. See: here

(defn map-reverse-hierarchy
[m]
  (or (apply merge-with conj
         (for [[k1 v1] m [k2 v2] v1] {k2 {k1 v2}}))
      {}))
(defn mean [x] 
  (if (empty? x) 0
    (/ (apply + x)
       (count x))))
(defn- range-with-end 
  ([end] [end (range end)])
  ([start end] [end (range start end)])
  ([start end steps] [end (range start end steps)]))
(defn range-till-end[& args]
  (let [[end lis] (apply range-with-end args)]
    (concat lis [end])))
(defn append-cyclic[lst a]
  (if (seq lst)
    (concat (rest lst) [a])
    lst))
(defn assoc-cyclic 
  ([coll k v]
   (if (contains? coll k)
     (assoc coll k v)
     (into {} (append-cyclic coll [k v]))))
  ([coll k v n]
   (if (< (count coll) n)
     (assoc coll k v)
     (assoc-cyclic coll k v))))
(defn max-and-min [x]
  (if (empty? x)
    [0 0]
    ((juxt #(apply max %) #(apply min %)) x)))
(defn compactize-map [m]
  (into {} (remove (comp nil? second) m)))
(defn abs[x]
  (max x (- x)))
(defn nearest-of-ss [ss x]
  (let [greater (first (subseq ss >= x))
        smaller (first (rsubseq ss <= x))]
    (apply min-key #(abs (- % x)) (remove nil? [greater smaller]))))
(defn nearest-of-seq[a b]
  (if (empty? a)
    b
    (map (partial nearest-of-ss (apply sorted-set a)) b)))
(defn map-to-object[f lst]
  (zipmap lst (map f lst)))

Usage:

  (map-with-index coll idx-key val-key)

Maps a sequence to a sequence of maps with index and value For instance:

  (map-with-index [10 20 30] :idx :val) =>  '({:idx 0, :val 10} {:idx 1, :val 20} {:idx 2, :val 30}))
(defn map-with-index 
  [s idx-key val-key]
  (map-indexed (fn [i v] {idx-key i val-key v}) s))
(defn map-to-object-with-index [f s]
    (into {} (map-indexed #(vector %1 (f %2)) s)))

Dissociates an entry from a nested associative structure returning a new nested structure. keys is a sequence of keys. Any empty maps that result will not be present in the new structure.

(defn dissoc-in
  [m [k & ks :as keys]]
  (if ks
    (if-let [nextmap (get m k)]
      (let [newmap (dissoc-in nextmap ks)]
        (if (seq newmap)
          (assoc m k newmap)
          (dissoc m k)))
      m)
    (dissoc m k)))
(defn index-of[seq item]
  (map first 
           (filter #(= (second %) item)
                   (map-indexed vector seq))))

Splits a collection to items where the separator is a repetition of at least n elements that satisfy pred inspired by: this question

(defn split-by-predicate 
[coll pred n] 
  (let [part  (partition-by  pred coll)
        ppart (partition-by (fn [x] (and
                                      (>= (count x) n) 
                                      (every? pred x))) part)]
        (map #(apply concat %) ppart)))

Receives a collection of lengths and returns a list of start and end positions

(defn positions 
[coll-of-lengths maximal-value]
  (let [end-pos (reductions + coll-of-lengths)
        start-pos (concat [0] end-pos)]
    (map #(list (min maximal-value %1) (min maximal-value %2)) start-pos end-pos)))
(defn subsequence [coll start end]
  (->> (drop start coll)
       (take (- end start))))
(defn split-by-predicate-opt [coll pred n d]
  (let [lengths (map #(* d %) (map count (split-by-predicate (take-nth d coll) pred (/ n d))))
        pos (positions lengths (count coll))]
    pos))
(defn index-of [s element]
  (or (ffirst (filter #(= (second %) element) (map-indexed #(vector %1 %2) s)))
      -1))
(defn display-sequence [long-seq short-seq value abs-step]
  (let [old-step (- (second short-seq) (first short-seq))
        step (* (- (second long-seq) (first long-seq)) abs-step)
        position-in-old-sequence (/ (- value (first short-seq)) old-step)]
    (cond
      (<= 0 position-in-old-sequence 4) (range (- value (* step position-in-old-sequence)) (+ value (* step (- 5 position-in-old-sequence))) step)
      (= position-in-old-sequence 5) (range (- value (* step (- position-in-old-sequence 1))) (+ value step) step)
      (empty? short-seq) (range (- value step) (+ value (* 4 step)) step)
      :else (range value (+ value (* 5 step)) step))))
(defn highest-below [m v]
  (second (last (sort-by first (group-by second (filter (fn [[x y]] (<= y v)) m))))))
(defn lowest-above [m v]
  (second (first (sort-by first (group-by second (filter (fn [[x y]] (>= y v)) m))))))
(defn find-keys-with-values-in [m s]
  (filter (comp s m) (keys m)))
(defn replace-keys [coll key-map]
  (zipmap (map #(get key-map % %) (keys coll)) (vals coll)))
(defn find-keys-with-value [m v]
  (find-keys-with-values-in m #{v}))
(defn linear [x a b aa bb]
  (+ aa (/ (* (- bb aa) (- x a)) (- b a))))
(defn interpolate-linear [m v]
  (or (first (find-keys-with-value m v))
      (let [[below val-below] (last (sort (highest-below m v)))
            [above val-above] (first (sort (lowest-above m v)))]
      (when (and val-below val-above)
        (linear v val-below val-above below above)))))
(defn strings-to-keywords [strings]
  (map keyword (string/split strings #"\s+")))

Thanks Jay Fields

(defn select-keys-in-order
  [m keyseq]
  (map m keyseq))
(defn select-vals [map keyseq]
  (vals (select-keys map keyseq)))

Taken from here

(defmacro doseq-indexed
  [index-sym [item-sym coll] & body]                                                   
  `(doseq [[~item-sym ~index-sym]                                                                                                                             
           (map vector ~coll (range))]                                                                                                                        
       ~@body))  
(defn flatten-keys* [a ks m]
  (if (map? m)
    (if (seq m)
      (reduce into (map (fn [[k v]] (flatten-keys* a (conj ks k) v)) (seq m)))
      {})
    (assoc a ks m)))

Thanks to Jay Fields

(defn flatten-keys 
  [m] (flatten-keys* {} [] m))
(defn unflatten-keys [m]
  (reduce-kv (fn [a b c] (assoc-in a b c)) {} m))

Creates a map with n leaves which are nested values of m.

  (= n (count (flatten-keys (take-from-map n m)))))))
(defn take-from-map 
  [n m]
  (->> m
       flatten-keys
       (take n)
       (into {}) 
       unflatten-keys))
(defn recursive-vals [m]
  (when m (vals (flatten-keys m))))
(defn sort-keys-by [a-func a-map]
  (map first (sort-by a-func a-map)))
(defn deep-merge* [& maps]
  (let [f (fn [old new]
            (if (and (map? old) (map? new))
              (merge-with deep-merge* old new)
              new))]
    (if (every? map? maps)
      (apply merge-with f maps)
      (last maps))))
(defn deep-merge [& maps]
  (let [maps (filter identity maps)]
    (assert (every? map? maps))
    (apply merge-with deep-merge* maps)))
(defn unflatten-keys [m]
    (reduce-kv (fn [a b c] (assoc-in a b c)) {} m))

check if index idx is in range of vector v. More efficiant than (get v idx)

(defn out-of-bound?
  [v idx]
   (or (<= (count v) idx) (> 0 idx)))

This file autogenerated from src/cljx/audyx_toolbet/collections.cljx

 
(ns audyx-toolbet.functions
  (:require [clojure.string :as string]
            [clojure.core.async :refer [<! timeout alts! go go-loop]]))

Definitions: * An asynchronous function is a function that returns a core.async channel

Usage:

   (memoize-async f)

Same as clojure.core.memoize for asynchronous functions (e.g. functions that return a chan). Returns a channel with the memoized result of the function call.

For instance:

(defn async-square [x]
  (go
    (* x x)))

(<!! ((memoize-async async-square) 4)) => 16
(defn memoize-async
  [f]
  (let [mem (atom {})]
    (fn [& args]
      (go
        (if-let [e (find @mem args)]
          (val e)
          (let [ret (<! (apply f args))]
            (swap! mem assoc args ret)
            ret))))))

Usage:

  (go-map f coll)

Returns a channel that will receive the result of f applied to each item of coll once all the data is available. The calculations are done in parallel.

For instance:

(defn async-square [x]
  (go
    (* x x)))

(<!! (go-map async-square [1 2 3])) => [1 4 9])
(defn go-map
  [f coll]
  (let [chans (map f coll)
        chan->coll (zipmap chans coll)]
    (go-loop [res {} channels chans]
             (if (empty? channels)
               (map res coll)
               (let [[x c] (alts! channels)]
                 (recur (assoc res (chan->coll c) x)
                        (remove #{c} channels)))))))
(defn vec->map [vec]
  (into {} vec))
(defn go-map-2d-vec [f m]
    (go-map (fn[[k id]] (go [k (<! (f id))])) m))

Usage:

(go-map-object f m)

Returns channel that will receive a map with the same keys as m and with the values transformed by f. Where f is an asynchronous function.

For instance:

(defn async-square [x]
  (go
    (* x x)))

(<!!
 (go-map-object async-square {:a 1 :b 2}))
; => {:a 1 :b 4})
(defn go-map-object 
 [f m]
  (go
    (vec->map (<! (go-map-2d-vec f m)))))
(defn go-map-to-object[f lst]
  (go
    (zipmap lst (<! (go-map f lst)))))
(defn wait-for-msg [c msg]
  (go
    (loop []
      (when-not (= msg (<! c))
        (recur)))))
(defn wait-for-condition [f interval-in-msec]
  (go-loop []
    (when-not (f)
      (<! (timeout interval-in-msec))
      (recur))))
(defn get-extension-file [filename]
  (last (string/split filename #"\.")))
(defn string-in? [search string]
  (not (nil? (re-find (re-pattern search) string))))

Receives a sequence of channels and returns a channel which will receive a sequence with the result of all the channels. Data is read from the channels in parallel. The result is a sequence where each element in the sequence is the result of the corresponding channel in the sequence.

(defn parallel 
  [chans]
  (let [channel-indexes (zipmap chans (range (count chans)))]
    (go-loop [res (vec (range (count chans))) channels chans]
             (if (empty? channels)
               res
               (let [[data c] (alts! channels)]
                 (recur (assoc res (channel-indexes c) data) (remove #{c} channels)))))))

This file autogenerated from src/cljx/audyx_toolbet/functions.cljx

 
(ns audyx-toolbet.numbers)

Returns a sequence of all the divisors of x ordered from the smallest to the greatest not including x and not including 1.

(defn factors 
  [x]
  (loop [xf [] i 2]
    (if (> (* i i) x)
      (vec (sort (distinct xf)))
      (if (zero? (rem x i))
        (recur (conj xf i (/ x i)) (inc i))
        (recur xf (inc i))))))
(defn greatest-factor [x]
  (or (last (factors x)) 1))

Returns a sequence of the subsequent divisors of x including the greatest divisor of x ordered from the smallest to the greatest not including x but including 1. All the numbers in the sequence are divisors of the subsequent numbers in the sequence

(defn subsequent-factors 
  [x]
  (loop [n x
         res []]
    (let [next-res (cons n res)]
      (if (<= n 1)
        next-res
        (recur (greatest-factor n) next-res)))))

This file autogenerated from src/cljx/audyx_toolbet/numbers.cljx