# public francoisdevlin /Full-Disclojure

### Subversion checkout URL

You can clone with HTTPS or Subversion.

Fetching contributors…

Cannot retrieve contributors at this time

file 121 lines (106 sloc) 3.503 kb
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 `(ns episode-012  (:use lib.sfd.pred-utils));;-------------------;; From episode 11;;-------------------(defn newton  "Creates a newton iterator. If start is not provided, zero is assumed."  ([f f-prime] (newton f f-prime 0))  ([f f-prime start]     (iterate (fn[x] (- x (/ (f x) (f-prime x)))) start)))(defn -sqr [a b] (let [d (- a b)] (* d d))) (defn -norm [a b] (Math/sqrt (-sqr a b)))(defn simple-converge  "Finds the first element of coll where the norm of two consecutiveelements is less than epsilon."  ([epsilon coll] (simple-converge epsilon -norm coll))  ([epsilon norm coll]     (ffirst       (drop-while        (fn [[a b] & more] (< epsilon (norm a b)))       (partition 2 1 coll)))))(defn richardson  "Creates a closure that computes the derivative using a Richardsoninterpolation"  [f delta]  (fn[x](/ (reduce + (map * [1 -8 8 -1] (map #(f (+ x (* delta %))) [-2 -1 1 2]))) (* 12 delta))));;-------------------------;; A convenience fn to solve equations;;-------------------------(defn solve-equation  "This solves a constraint fn with respect to free-var (a keyword). Typically constraints end with a * suffix."  [constraint free-var a-map]  (let [target-fn (fn [x] (constraint (assoc a-map free-var x))) target-prime (richardson target-fn 0.01)]    (simple-converge 0.01 (newton target-fn target-prime))));;-------------------------;; Helper fns to determine which variable is free;;-------------------------(defn find-all-free-keys  "This is a utility fn to determine which keys are free in a map. It is used to determine which variable to solve for."  [source-keys a-map]  (let [frozen-keys (map first (filter (every-pred? second (comp (set source-keys) first)) a-map)) remaining-keys (remove (set frozen-keys) source-keys)]    remaining-keys))(defn find-free-key  "This is a utility fn to determine which keys are free in a map. It is used to determine which variable to solve for."  [source-keys a-map]  (let [remaining-keys (find-all-free-keys source-keys a-map)]    (if (= (count remaining-keys) 1)      (first remaining-keys))));;---------------------------;; Our equation solving macro;;---------------------------(defmacro defequation  "Creates an equation. This macro defines three functions. * name*, which is the actual equation. It should be equal to zero. * name-val, a closure to determine the actual value of the free fn. * name, which returns a map. The result of sym-val is assoc'd with the free vairable."  ([name binding left right]     (let [name* (symbol (str name "*")) name-val (symbol (str name "-val")) keywords (vec (map keyword binding)) binding-map (zipmap binding keywords) free-key (gensym "free-key_")]       `(do (defn ~name* [~binding-map] (- ~left ~right)) (defn ~name-val [~'constraints-map] (let [~free-key (find-free-key ~keywords ~'constraints-map)] (if ~free-key (solve-equation ~name* ~free-key ~'constraints-map)))) (defn ~name [~'constraints-map] (let [~free-key (find-free-key ~keywords ~'constraints-map)] (if ~free-key (assoc ~'constraints-map ~free-key (~name-val ~'constraints-map))))) ))));;---------------------;; Temperature fns;;---------------------(defn c->f [c]  (-> c       (* 1.8)      (+ 32)       ))(defn f->c [f]  (-> f      (- 32)      (/ 1.8)      ))(defequation f<->c  [f c]  f  (-> c (* 1.8) (+ 32))  )`
Something went wrong with that request. Please try again.