Inspired by Eric Normand's challenge 404: https://gist.github.com/ericnormand/2318405631f158d6f2ceaaff3161c6c4

Composable Rules

(defn monoid* [init body]
  `(fn f# 
     ([] 
      (fn [& ~'xs] ~init))
     ([~'r] 
      (fn [& ~'xs] (~body (apply ~'r ~'xs))))
     ([~'r1 ~'r2] 
      (fn [& ~'xs] (~body(apply ~'r1 ~'xs) (apply ~'r2 ~'xs))))
     ([~'r1 ~'r2 & ~'rs]
      (fn [& ~'xs] 
        (~body(apply ~'r1 ~'xs)
         (~body (apply ~'r2 ~'xs)
          (apply (apply f# ~'rs) ~'xs)))))))

(defn ->1+2ary [ary-1 ary-2]
  `(fn ([~'x] (~ary-1 ~'x))
     ([~'x ~'y] (~ary-2 ~'x ~'y))))

(defmacro defmonoid 
  ([rule-name-sym init cdecl]
   `(def ~rule-name-sym  ~(monoid* init cdecl)))
  ([rule-name-sym init ary1-body ary2-body]
   `(def ~rule-name-sym ~(monoid* init (->1+2ary ary1-body 
                                                 ary2-body)))))
;; utilities for rule counting combinators
(defn ->bit [bool-or-bit] 
  (cond 
    (= 0 bool-or-bit) 0
    (number? bool-or-bit) bool-or-bit
    bool-or-bit 1
    :else 0))

(defn +bool
  ([] 0)
  ([x] (+ (->bit x)))
  ([x y]
   (+ (->bit x) (->bit y))))

;; COMBINATORS 
(defmonoid rule-and true and)

(defmonoid rule-or false or)

(def rule-not complement)

(defn rule-if [p q]
  (rule-or (rule-not p) q))

(defn rule-iff [p q]
  (rule-and (rule-if p q) (rule-if q p)))

(defn rule-xor [p q]
  (rule-and (rule-or p q) (rule-not (rule-and p q))))

(defmonoid rule-oneof (comp boolean identity) identity 
  #(= 1 (+ (->bit %) (->bit %2))))

;; A combinator yielding the number of satisfied rules.
;; Each argument rule is a boolean predicate, or results are undetermined.
(defmonoid rule-count* (+bool) +bool)

;; Same as rule-count*, but rule return types are auto-converted to booleans. 
(defn rule-count [& rules]
  (->> rules (map #(comp boolean %)) 
       (apply rule-count*)))

;; Yields a rule returning the result of applying 'pred to the number 
;; of satisfied rules; 'rules are wrapped/converted to boolean predicates
(defn rule-filter-count [pred rules]
  (let [cmbtr (apply rule-count rules)]
    (fn [& xs]
      (apply (comp pred cmbtr) xs))))

(defn rule-at-least [n & rules]
  (rule-filter-count #(<= n %) rules))

(defn rule-at-most [n & rules]
  (rule-filter-count #(<= % n) rules))

(defn rule-eactly [n & rules]
  (rule-filter-count #(= n %) rules))

;; tests
(-> (rule-and odd? #(< 2 %) #(< % 6))
    (map (range 2 7))) ;; => (false, true, false, true, false)

(-> (rule-or even? #(zero? (rem % 5)))
    (map [2 7 15 300])) ;;=> (true false true true)

(-> (rule-if #(zero? (rem % 4)) even?)
    (map [10 16 3])) ;;=> (true true true)

(-> (rule-iff #(zero? (rem % 2)) even?)
    (map (range 4))) ;;=> (true true true true)

(-> (rule-xor even? odd?)
    (map (range 4))) ;;=> (true true true true)

(-> (rule-xor #(zero? (rem % 5)) #(zero? (rem % 3)))
    (map '(1 2 3 5 10 15 25 30))) 
;;=> (false false true true true false true false) 

(-> (rule-oneof :berlin :rome :new-york)
    (map '({:berlin true} {:rome true} {:new-york :work :rome :home})))
;;=> (true true false)

(-> (rule-oneof :berlin :rome :new-york)
    (map '({} {:rome :ok} {:new-york :work :rome :home})))
;;=> (false true false)

(-> (rule-at-least 2 :berlin :rome :new-york)
    (map '({:berlin :sales} {:new-york :home :rome :overseas} {})))
;;=> (false true false
(-> (rule-at-most 2 :berlin :rome :new-york)
    (map '({:berlin :away :rome :summer} {:rome :summer :berlin 1 :new-york 2} {:new-york :sales})))
;;=> (true false true)

(def can-vote? (rule-and
                (rule-and #(<= 18 (:age %)) :citizen?) 
                (rule-at-least 1 :affiliated? :registered?)))

(->> '({:age 17 :citizen? :acquired} {:age 40 :citizen? :at-birth :registered? :yes}) 
     (map can-vote?)) ;;=> (false true)