monads: better default for which-m-plus in maybe-t

3 files changed, 45 insertions, 36 deletions

diff --git a/src/clojure/contrib/monads.clj b/src/clojure/contrib/monads.clj
index 04dd3f5a..1995eed5 100644
--- a/src/clojure/contrib/monads.clj
+++ b/src/clojure/contrib/monads.clj
@@ -1,7 +1,7 @@
 ;; Monads in Clojure
 
 ;; by Konrad Hinsen
-;; last updated April 21, 2009
+;; last updated April 23, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -403,31 +403,35 @@
    the base values can be invalid (represented by nothing, which defaults
    to nil). The third argument chooses if m-zero and m-plus are inherited
    from the base monad (use :m-plus-from-base) or adopt maybe-like
-   behaviour (use :m-plus-from-maybe)."
-  ([m] (maybe-t m nil :m-plus-from-base))
+   behaviour (use :m-plus-from-maybe). The default is :m-plus-from-base
+   if the base monad m has a definition for m-plus, and :m-plus-from-maybe
+   otherwise."
+  ([m] (maybe-t m nil :m-plus-default))
+  ([m nothing] (maybe-t m nothing :m-plus-default))
   ([m nothing which-m-plus]
-   (let [combined-m-zero
-	 (cond
-	  (identical? which-m-plus :m-plus-from-base)
-	  (with-monad m m-zero)
-	  (identical? which-m-plus :m-plus-from-maybe)
-	  (with-monad m (m-result nothing))
-	  :else ::undefined)
-	 combined-m-plus
-	 (cond
-	  (identical? which-m-plus :m-plus-from-base)
-	  (with-monad m m-plus)
-	  (identical? which-m-plus :m-plus-from-maybe)
-	  (with-monad m
-	    (fn [& mvs]
-	      (m-result (loop [mv (first mvs)]
-			  (if (nil? mv)
-			    nothing
-			    (let [v (m-bind mv identity)]
-			      (if (identical? v nothing)
-				(recur (rest mvs))
-				v)))))))
-	  :else ::undefined)]
+   (let [which-m-plus    (cond (= which-m-plus :m-plus-default)
+			       (if (= ::undefined (with-monad m m-plus))
+				 :m-plus-from-maybe
+				 :m-plus-from-base)
+			       (or (= which-m-plus :m-plus-from-base) 
+				   (= which-m-plus :m-plus-from-maybe))
+			       which-m-plus
+			       :else (throw (java.lang.IllegalArgumentException.
+					     "undefined m-plus choice")))
+	 combined-m-zero   (if (= which-m-plus :m-plus-from-base)
+			     (with-monad m m-zero)
+			     (with-monad m (m-result nothing)))
+	 combined-m-plus   (if (= which-m-plus :m-plus-from-base)
+			     (with-monad m m-plus)
+			     (with-monad m
+			       (fn [& mvs]
+				 (m-result (loop [mv (first mvs)]
+					     (if (nil? mv)
+					       nothing
+					       (let [v (m-bind mv identity)]
+						 (if (identical? v nothing)
+						   (recur (rest mvs))
+						   v))))))))]
      (monad [m-result (with-monad m
 		        m-result)
 	     m-bind   (with-monad m
diff --git a/src/clojure/contrib/probabilities/examples_finite_distributions.clj b/src/clojure/contrib/probabilities/examples_finite_distributions.clj
index a7ae7618..ca301654 100644
--- a/src/clojure/contrib/probabilities/examples_finite_distributions.clj
+++ b/src/clojure/contrib/probabilities/examples_finite_distributions.clj
@@ -176,8 +176,9 @@
   (normalize-cond
     (domonad cond-dist-m
       [die    prior
-       number (get dice die)]
-      (when (= number observation) die))))
+       number (get dice die)
+       :when  (= number observation) ]
+      die)))
 
 ; Add one observation.
 (add-observation prior 1)
@@ -197,7 +198,8 @@
       (normalize-cond
         (domonad
           [die    prior
-           nums   (n-nums die)]
-	  (when (= nums observations) die))))))
+           nums   (n-nums die)
+	   :when  (= nums observations)]
+	  die)))))
 
 (add-observations prior [1 3 7])
diff --git a/src/clojure/contrib/probabilities/finite_distributions.clj b/src/clojure/contrib/probabilities/finite_distributions.clj
index 7dcc280f..3b76b318 100644
--- a/src/clojure/contrib/probabilities/finite_distributions.clj
+++ b/src/clojure/contrib/probabilities/finite_distributions.clj
@@ -114,13 +114,16 @@
 
 )
 
-(defn cond-prob
-  "Returns the conditional probability for the values in dist that satisfy
-   the predicate pred."
-  [pred dist]
-  (normalize-cond
-    (with-monad cond-dist-m
-      (m-bind dist (fn [v] (m-result (when (pred v) v)))))))
+(with-monad cond-dist-m
+  (defn cond-prob
+    "Returns the conditional probability for the values in dist that satisfy
+     the predicate pred."
+    [pred dist]
+    (normalize-cond
+      (domonad
+        [v dist
+	 :when (pred v)]
+	v))))
 
 ; Select (with equal probability) N items from a sequence