Mercurial > lasercutter

     1 ;; Test routines for monads.clj

     2 

     3 ;; by Konrad Hinsen

     4 ;; last updated March 28, 2009

     5 

     6 ;; Copyright (c) Konrad Hinsen, 2008. All rights reserved.  The use

     7 ;; and distribution terms for this software are covered by the Eclipse

     8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     9 ;; which can be found in the file epl-v10.html at the root of this

    10 ;; distribution.  By using this software in any fashion, you are

    11 ;; agreeing to be bound by the terms of this license.  You must not

    12 ;; remove this notice, or any other, from this software.

    13 

    14 (ns clojure.contrib.test-monads

    15   (:use [clojure.test :only (deftest is are run-tests)]

    16 	[clojure.contrib.monads

    17 	 :only (with-monad domonad m-lift m-seq m-chain

    18 		sequence-m maybe-m state-m maybe-t sequence-t)]))

    19 

    20 (deftest sequence-monad

    21   (with-monad sequence-m

    22     (are [a b] (= a b)

    23       (domonad [x (range 3) y (range 2)] (+ x y))

    24         '(0 1 1 2 2 3)

    25       (domonad [x (range 5) y (range (+ 1 x)) :when  (= (+ x y) 2)] (list x y))

    26         '((1 1) (2 0))

    27       ((m-lift 2 #(list %1 %2)) (range 3) (range 2))

    28         '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1))

    29       (m-seq (replicate 3 (range 2)))

    30         '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))

    31       ((m-chain (replicate 3 range)) 5)

    32         '(0 0 0 1 0 0 1 0 1 2)

    33       (m-plus (range 3) (range 2))

    34         '(0 1 2 0 1))))

    35 

    36 (deftest maybe-monad

    37   (with-monad maybe-m

    38     (let [m+ (m-lift 2 +)

    39           mdiv (fn [x y] (domonad [a x  b y  :when (not (zero? b))] (/ a b)))]

    40       (are [a b] (= a b)

    41         (m+ (m-result 1) (m-result 3))

    42 	  (m-result 4)

    43         (mdiv (m-result 1) (m-result 3))

    44 	  (m-result (/ 1 3))

    45         (m+ 1 (mdiv (m-result 1) (m-result 0)))

    46 	  m-zero

    47 	(m-plus m-zero (m-result 1) m-zero (m-result 2))

    48 	  (m-result 1)))))

    49 

    50 (deftest seq-maybe-monad

    51   (with-monad (maybe-t sequence-m)

    52     (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))]

    53       (are [a b] (= a b)

    54         ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n)))

    55           '(nil 2 nil 4 nil 6 nil 8 nil 10)

    56         (pairs (for [n (range 5)] (when (odd? n) n)))

    57           '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil)))))

    58 

    59 (deftest state-maybe-monad

    60   (with-monad (maybe-t state-m)

    61     (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4]

    62 				 [nil nil 3 4] [1 2 nil nil])]

    63 	     (let [f (domonad

    64 		       [x (m-plus (m-result a) (m-result b))

    65 			y (m-plus (m-result c) (m-result d))]

    66 		       (+ x y))]

    67 	       (f :state)))

    68 	   (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state])))))

    69 

    70 (deftest state-seq-monad

    71   (with-monad (sequence-t state-m)

    72     (is (= (let [[a b c d] [1 2 10 20]

    73 		 f (domonad

    74 		     [x (m-plus (m-result a) (m-result b))

    75 		      y (m-plus (m-result c) (m-result d))]

    76 		     (+ x y))]

    77 	     (f :state)))

    78 	(list [(list 11 21 12 22) :state]))))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children