1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/monads/examples.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,425 @@
     1.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1.5 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1.6 +;;
     1.7 +;; Monad application examples
     1.8 +;;
     1.9 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.10 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.11 +
    1.12 +(ns
    1.13 +  #^{:author "Konrad Hinsen"
    1.14 +     :skip-wiki true
    1.15 +     :doc "Examples for using monads"}
    1.16 +  clojure.contrib.monads.examples
    1.17 +  (:use [clojure.contrib.monads
    1.18 +	 :only (domonad with-monad m-lift m-seq m-reduce m-when
    1.19 +		sequence-m
    1.20 +		maybe-m
    1.21 +		state-m fetch-state set-state 
    1.22 +		writer-m write
    1.23 +		cont-m run-cont call-cc
    1.24 +		maybe-t)])
    1.25 +  (:require (clojure.contrib [accumulators :as accu])))
    1.26 +
    1.27 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.28 +;;
    1.29 +;;  Sequence manipulations with the sequence monad
    1.30 +;;
    1.31 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.32 +
    1.33 +; Note: in the Haskell world, this monad is called the list monad.
    1.34 +; The Clojure equivalent to Haskell's lists are (possibly lazy)
    1.35 +; sequences. This is why I call this monad "sequence". All sequences
    1.36 +; created by sequence monad operations are lazy.
    1.37 +
    1.38 +; Monad comprehensions in the sequence monad work exactly the same
    1.39 +; as Clojure's 'for' construct, except that :while clauses are not
    1.40 +; available.
    1.41 +(domonad sequence-m
    1.42 +   [x (range 5)
    1.43 +    y (range 3)]
    1.44 +    (+ x y))
    1.45 +
    1.46 +; Inside a with-monad block, domonad is used without the monad name.
    1.47 +(with-monad sequence-m
    1.48 +  (domonad
    1.49 +     [x (range 5)
    1.50 +      y (range 3)]
    1.51 +     (+ x y)))
    1.52 +
    1.53 +; Conditions are written with :when, as in Clojure's for form:
    1.54 +(domonad sequence-m
    1.55 +   [x  (range 5)
    1.56 +    y  (range (+ 1 x))
    1.57 +    :when (= (+ x y) 2)]
    1.58 +   (list x y))
    1.59 +
    1.60 +; :let is also supported like in for:
    1.61 +(domonad sequence-m
    1.62 +   [x  (range 5)
    1.63 +    y  (range (+ 1 x))
    1.64 +    :let [sum (+ x y)
    1.65 +	  diff (- x y)]
    1.66 +    :when  (= sum 2)]
    1.67 +   (list diff))
    1.68 +
    1.69 +; An example of a sequence function defined in terms of a lift operation.
    1.70 +(with-monad sequence-m
    1.71 +   (defn pairs [xs]
    1.72 +      ((m-lift 2 #(list %1 %2)) xs xs)))
    1.73 +
    1.74 +(pairs (range 5))
    1.75 +
    1.76 +; Another way to define pairs is through the m-seq operation. It takes
    1.77 +; a sequence of monadic values and returns a monadic value containing
    1.78 +; the sequence of the underlying values, obtained from chaining together
    1.79 +; from left to right the monadic values in the sequence.
    1.80 +(with-monad sequence-m
    1.81 +   (defn pairs [xs]
    1.82 +      (m-seq (list xs xs))))
    1.83 +
    1.84 +(pairs (range 5))
    1.85 +
    1.86 +; This definition suggests a generalization:
    1.87 +(with-monad sequence-m
    1.88 +   (defn ntuples [n xs]
    1.89 +      (m-seq (replicate n xs))))
    1.90 +
    1.91 +(ntuples 2 (range 5))
    1.92 +(ntuples 3 (range 5))
    1.93 +
    1.94 +; Lift operations can also be used inside a monad comprehension:
    1.95 +(domonad sequence-m
    1.96 +   [x  ((m-lift 1 (partial * 2)) (range 5))
    1.97 +    y  (range 2)]
    1.98 +    [x y])
    1.99 +
   1.100 +; The m-plus operation does concatenation in the sequence monad.
   1.101 +(domonad sequence-m
   1.102 +   [x  ((m-lift 2 +) (range 5) (range 3))
   1.103 +    y  (m-plus (range 2) '(10 11))]
   1.104 +   [x y])
   1.105 +
   1.106 +
   1.107 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.108 +;;
   1.109 +;; Handling failures with the maybe monad
   1.110 +;;
   1.111 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.112 +
   1.113 +; Maybe monad versions of basic arithmetic
   1.114 +(with-monad maybe-m
   1.115 +   (def m+ (m-lift 2 +))
   1.116 +   (def m- (m-lift 2 -))
   1.117 +   (def m* (m-lift 2 *)))
   1.118 +
   1.119 +; Division is special for two reasons: we can't call it m/ because that's
   1.120 +; not a legal Clojure symbol, and we want it to fail if a division by zero
   1.121 +; is attempted. It is best defined by a monad comprehension with a
   1.122 +; :when clause:
   1.123 +(defn safe-div [x y]
   1.124 +  (domonad maybe-m
   1.125 +     [a x
   1.126 +      b y
   1.127 +      :when (not (zero? b))]
   1.128 +     (/ a b)))
   1.129 +
   1.130 +; Now do some non-trivial computation with division
   1.131 +; It fails for (1) x = 0, (2) y = 0 or (3) y = -x.
   1.132 +(with-monad maybe-m
   1.133 +   (defn some-function [x y]
   1.134 +      (let [one (m-result 1)]
   1.135 + 	   (safe-div one (m+ (safe-div one (m-result x))
   1.136 +			     (safe-div one (m-result y)))))))
   1.137 +
   1.138 +; An example that doesn't fail:
   1.139 +(some-function 2 3)
   1.140 +; And two that do fail, at different places:
   1.141 +(some-function 2 0)
   1.142 +(some-function 2 -2)
   1.143 +
   1.144 +; In the maybe monad, m-plus selects the first monadic value that
   1.145 +; holds a valid value.
   1.146 +(with-monad maybe-m
   1.147 +   (m-plus (some-function 2 0) (some-function 2 -2) (some-function 2 3)))
   1.148 +
   1.149 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.150 +;;
   1.151 +;;  Random numbers with the state monad
   1.152 +;;
   1.153 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.154 +
   1.155 +; A state monad item represents a computation that changes a state and
   1.156 +; returns a value. Its structure is a function that takes a state argument
   1.157 +; and returns a two-item list containing the value and the updated state.
   1.158 +; It is important to realize that everything you put into a state monad
   1.159 +; expression is a state monad item (thus a function), and everything you
   1.160 +; get out as well. A state monad does not perform a calculation, it
   1.161 +; constructs a function that does the computation when called.
   1.162 +
   1.163 +; First, we define a simple random number generator with explicit state.
   1.164 +; rng is a function of its state (an integer) that returns the
   1.165 +; pseudo-random value derived from this state and the updated state 
   1.166 +; for the next iteration. This is exactly the structure of a state
   1.167 +;  monad item.
   1.168 +(defn rng [seed]
   1.169 +  (let [m      259200
   1.170 +	value  (/ (float seed) (float m))
   1.171 +	next   (rem (+ 54773 (* 7141 seed)) m)]
   1.172 +    [value next]))
   1.173 +
   1.174 +; We define a convenience function that creates an infinite lazy seq
   1.175 +; of values obtained from iteratively applying a state monad value.
   1.176 +(defn value-seq [f seed]
   1.177 +  (lazy-seq
   1.178 +    (let [[value next] (f seed)]
   1.179 +      (cons value (value-seq f next)))))
   1.180 +
   1.181 +; Next, we define basic statistics functions to check our random numbers
   1.182 +(defn sum [xs]  (apply + xs))
   1.183 +(defn mean [xs]  (/ (sum xs) (count xs)))
   1.184 +(defn variance [xs]
   1.185 +  (let [m (mean xs)
   1.186 +	sq #(* % %)]
   1.187 +    (mean (for [x xs] (sq (- x m))))))
   1.188 +
   1.189 +; rng implements a uniform distribution in the interval [0., 1.), so
   1.190 +; ideally, the mean would be 1/2 (0.5) and the variance 1/12 (0.8333).
   1.191 +(mean (take 1000 (value-seq rng 1)))
   1.192 +(variance (take 1000 (value-seq rng 1)))
   1.193 +
   1.194 +; We make use of the state monad to implement a simple (but often sufficient)
   1.195 +; approximation to a Gaussian distribution: the sum of 12 random numbers
   1.196 +; from rng's distribution, shifted by -6, has a distribution that is
   1.197 +; approximately Gaussian with 0 mean and variance 1, by virtue of the central
   1.198 +; limit theorem.
   1.199 +; In the first version, we call rng 12 times explicitly and calculate the
   1.200 +; shifted sum in a monad comprehension:
   1.201 +(def gaussian1
   1.202 +   (domonad state-m
   1.203 +      [x1  rng
   1.204 +       x2  rng
   1.205 +       x3  rng
   1.206 +       x4  rng
   1.207 +       x5  rng
   1.208 +       x6  rng
   1.209 +       x7  rng
   1.210 +       x8  rng
   1.211 +       x9  rng
   1.212 +       x10 rng
   1.213 +       x11 rng
   1.214 +       x12 rng]
   1.215 +      (- (+ x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12) 6.)))
   1.216 +
   1.217 +; Let's test it:
   1.218 +(mean (take 1000 (value-seq gaussian1 1)))
   1.219 +(variance (take 1000 (value-seq gaussian1 1)))
   1.220 +
   1.221 +; Of course, we'd rather have a loop construct for creating the 12
   1.222 +; random numbers. This would be easy if we could define a summation
   1.223 +; operation on random-number generators, which would then be used in
   1.224 +; combination with reduce. The lift operation gives us exactly that.
   1.225 +; More precisely, we need (m-lift 2 +), because we want both arguments
   1.226 +; of + to be lifted to the state monad:
   1.227 +(def gaussian2
   1.228 +   (domonad state-m
   1.229 +      [sum12 (reduce (m-lift 2 +) (replicate 12 rng))]
   1.230 +      (- sum12 6.)))
   1.231 +
   1.232 +; Such a reduction is often quite useful, so there's m-reduce predefined
   1.233 +; to simplify it:
   1.234 +(def gaussian2
   1.235 +   (domonad state-m
   1.236 +      [sum12 (m-reduce + (replicate 12 rng))]
   1.237 +      (- sum12 6.)))
   1.238 +
   1.239 +; The statistics should be strictly the same as above, as long as
   1.240 +; we use the same seed:
   1.241 +(mean (take 1000 (value-seq gaussian2 1)))
   1.242 +(variance (take 1000 (value-seq gaussian2 1)))
   1.243 +
   1.244 +; We can also do the subtraction of 6 in a lifted function, and get rid
   1.245 +; of the monad comprehension altogether:
   1.246 +(with-monad state-m
   1.247 +   (def gaussian3
   1.248 +        ((m-lift 1 #(- % 6.))
   1.249 +           (m-reduce + (replicate 12 rng)))))
   1.250 +
   1.251 +; Again, the statistics are the same:
   1.252 +(mean (take 1000 (value-seq gaussian3 1)))
   1.253 +(variance (take 1000 (value-seq gaussian3 1)))
   1.254 +
   1.255 +; For a random point in two dimensions, we'd like a random number generator
   1.256 +; that yields a list of two random numbers. The m-seq operation can easily
   1.257 +; provide it:
   1.258 +(with-monad state-m
   1.259 +   (def rng2 (m-seq (list rng rng))))
   1.260 +
   1.261 +; Let's test it:
   1.262 +(rng2 1)
   1.263 +
   1.264 +; fetch-state and get-state can be used to save the seed of the random
   1.265 +; number generator and go back to that saved seed later on:
   1.266 +(def identical-random-seqs
   1.267 +  (domonad state-m
   1.268 +    [seed (fetch-state)
   1.269 +     x1   rng
   1.270 +     x2   rng
   1.271 +     _    (set-state seed)
   1.272 +     y1   rng
   1.273 +     y2   rng]
   1.274 +    (list [x1 x2] [y1 y2])))
   1.275 +
   1.276 +(identical-random-seqs 1)
   1.277 +
   1.278 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.279 +;;
   1.280 +;;  Logging with the writer monad
   1.281 +;;
   1.282 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.283 +
   1.284 +; A basic logging example
   1.285 +(domonad (writer-m accu/empty-string)
   1.286 +  [x (m-result 1)
   1.287 +   _ (write "first step\n")
   1.288 +   y (m-result 2)
   1.289 +   _ (write "second step\n")]
   1.290 +  (+ x y))
   1.291 +
   1.292 +; For a more elaborate application, let's trace the recursive calls of
   1.293 +; a naive implementation of a Fibonacci function. The starting point is:
   1.294 +(defn fib [n]
   1.295 +  (if (< n 2)
   1.296 +    n
   1.297 +    (let [n1 (dec n)
   1.298 +	  n2 (dec n1)]
   1.299 +      (+ (fib n1) (fib n2)))))
   1.300 +
   1.301 +; First we rewrite it to make every computational step explicit
   1.302 +; in a let expression:
   1.303 +(defn fib [n]
   1.304 +  (if (< n 2)
   1.305 +    n
   1.306 +    (let [n1 (dec n)
   1.307 +	  n2 (dec n1)
   1.308 +	  f1 (fib n1)
   1.309 +	  f2 (fib n2)]
   1.310 +      (+ f1 f2))))
   1.311 +
   1.312 +; Next, we replace the let by a domonad in a writer monad that uses a
   1.313 +; vector accumulator. We can then place calls to write in between the
   1.314 +; steps, and obtain as a result both the return value of the function
   1.315 +; and the accumulated trace values.
   1.316 +(with-monad (writer-m accu/empty-vector)
   1.317 +
   1.318 +  (defn fib-trace [n]
   1.319 +    (if (< n 2)
   1.320 +      (m-result n)
   1.321 +      (domonad
   1.322 +        [n1 (m-result (dec n))
   1.323 +	 n2 (m-result (dec n1))
   1.324 +	 f1 (fib-trace n1)
   1.325 +	 _  (write [n1 f1])
   1.326 +	 f2 (fib-trace n2)
   1.327 +	 _  (write [n2 f2])
   1.328 +	 ]
   1.329 +	(+ f1 f2))))
   1.330 +
   1.331 +)
   1.332 +
   1.333 +(fib-trace 5)
   1.334 +
   1.335 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.336 +;;
   1.337 +;; Sequences with undefined value: the maybe-t monad transformer
   1.338 +;;
   1.339 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.340 +
   1.341 +; A monad transformer is a function that takes a monad argument and
   1.342 +; returns a monad as its result. The resulting monad adds some
   1.343 +; specific behaviour aspect to the input monad.
   1.344 +
   1.345 +; The simplest monad transformer is maybe-t. It adds the functionality
   1.346 +; of the maybe monad (handling failures or undefined values) to any other
   1.347 +; monad. We illustrate this by applying maybe-t to the sequence monad.
   1.348 +; The result is an enhanced sequence monad in which undefined values
   1.349 +; (represented by nil) are not subjected to any transformation, but
   1.350 +; lead immediately to a nil result in the output.
   1.351 +
   1.352 +; First we define the combined monad:
   1.353 +(def seq-maybe-m (maybe-t sequence-m))
   1.354 +
   1.355 +; As a first illustration, we create a range of integers and replace
   1.356 +; all even values by nil, using a simple when expression. We use this
   1.357 +; sequence in a monad comprehension that yields (inc x). The result
   1.358 +; is a sequence in which inc has been applied to all non-nil values,
   1.359 +; whereas the nil values appear unmodified in the output:
   1.360 +(domonad seq-maybe-m
   1.361 +  [x  (for [n (range 10)] (when (odd? n) n))]
   1.362 +  (inc x))
   1.363 +
   1.364 +; Next we repeat the definition of the function pairs (see above), but
   1.365 +; using the seq-maybe monad:
   1.366 +(with-monad seq-maybe-m
   1.367 +   (defn pairs-maybe [xs]
   1.368 +      (m-seq (list xs xs))))
   1.369 +
   1.370 +; Applying this to a sequence containing nils yields the pairs of all
   1.371 +; non-nil values interspersed with nils that result from any combination
   1.372 +; in which one or both of the values is nil:
   1.373 +(pairs-maybe (for [n (range 5)] (when (odd? n) n)))
   1.374 +
   1.375 +; It is important to realize that undefined values (nil) are not eliminated
   1.376 +; from the iterations. They are simply not passed on to any operations.
   1.377 +; The outcome of any function applied to arguments of which at least one
   1.378 +; is nil is supposed to be nil as well, and the function is never called.
   1.379 +
   1.380 +
   1.381 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.382 +;;
   1.383 +;; Continuation-passing style in the cont monad
   1.384 +;;
   1.385 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   1.386 +
   1.387 +; A simple computation performed in continuation-passing style.
   1.388 +; (m-result 1) returns a function that, when called with a single
   1.389 +; argument f, calls (f 1). The result of the domonad-computation is
   1.390 +; a function that behaves in the same way, passing 3 to its function
   1.391 +; argument. run-cont executes a continuation by calling it on identity.
   1.392 +(run-cont
   1.393 +  (domonad cont-m
   1.394 +    [x (m-result 1)
   1.395 +     y (m-result 2)]
   1.396 +    (+ x y)))
   1.397 +
   1.398 +; Let's capture a continuation using call-cc. We store it in a global
   1.399 +; variable so that we can do with it whatever we want. The computation
   1.400 +; is the same one as in the first example, but it has the side effect
   1.401 +; of storing the continuation at (m-result 2).
   1.402 +(def continuation nil)
   1.403 +
   1.404 +(run-cont
   1.405 +  (domonad cont-m
   1.406 +    [x (m-result 1)
   1.407 +     y (call-cc (fn [c] (def continuation c) (c 2)))]
   1.408 +    (+ x y)))
   1.409 +
   1.410 +; Now we can call the continuation with whatever argument we want. The
   1.411 +; supplied argument takes the place of 2 in the above computation:
   1.412 +(run-cont (continuation 5))
   1.413 +(run-cont (continuation 42))
   1.414 +(run-cont (continuation -1))
   1.415 +
   1.416 +; Next, a function that illustrates how a captured continuation can be
   1.417 +; used as an "emergency exit" out of a computation:
   1.418 +(defn sqrt-as-str [x]
   1.419 +  (call-cc
   1.420 +   (fn [k]
   1.421 +     (domonad cont-m
   1.422 +       [_ (m-when (< x 0) (k (str "negative argument " x)))]
   1.423 +       (str (. Math sqrt x))))))
   1.424 +
   1.425 +(run-cont (sqrt-as-str 2))
   1.426 +(run-cont (sqrt-as-str -2))
   1.427 +
   1.428 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;