Clojure range-case macro
In the book "The Scheme Programming Language, 4th Edition", by R. Kent Dybvig, on page 86, the author has written a define-syntax (Scheme macro) for a case statement that accepts ranges for its conditions. I thought I would try this in Clojure.
Here is the result.
How can I improve this? I use :ii, :ie, :ei, and :ee for the range operators, indicating inclusive-inclusive, inclusive-exclusive, exclusive-inclusive,
and exclusive-exclusive, respectively. Is there a better choice?
I chose to expand to a cond rather than discrete if statements because I felt that I would gain the benefit from any future improvements to the cond macro.
(defmacro range-case [target & cases]
"Compare the target against a set of ranges or constant values and return
the first one that matches. If none match, and there exists a case with the
value :else, return that target. Each range consists of a vector containing
3 terms: a lower bound, an operator, and an upper bound. The operator must
be one of :ii, :ie, :ei, or :ee, which indicate that the range comparison
should be inclusive-inclusive, inclusive-exclusive, exclusive-inclusive,
or exclusive-exclusive, respectively.
Example:
(range-case target
[0.0 :ie 1.0] :greatly-disagree
[1.0 :ie 2.0] :disagree
[2.0 :ie 3.0] :neutral
[3.0 :ie 4.0] :agree
[4.0 :ii 5.0] :strongly-agree
42 :the-answer
:else :do-not-care)
expands to
(cond
(and (<= 0.0 target) (< target 1.0)) :greatly-disagree
(and (<= 1.0 target) (< target 2.0)) :disagree
(and (<= 2.0 target) (< target 3.0)) :neutral
(and (<= 3.0 target) (< target 4.0)) :agree
(<= 4.0 target 5.0) :strongly-agree
(= target 42) :the-answer
:else :do-not-care)
Test cases:
(use '[clojure.test :only (deftest is run-tests)])
(deftest unit-tests
(letfn [(test-range-case [target]
(range-case target
[0.0 :ie 1.0] :greatly-disagree
[1.0 :ie 2.0] :disagree
[2.0 :ie 3.0] :neutral
[3.0 :ie 4.0] :agree
[4.0 :ii 5.0] :strongly-agree
42 :the-answer
:else :do-not-care))]
(is (= (test-range-case 0.0) :greatly-disagree))
(is (test-range-case 0.5) :greatly-disagree)
(is (test-range-case 1.0) :disagree)
(is (test-range-case 1.5) :disagree)
(is (test-range-case 2.0) :neutral)
(is (test-range-case 2.5) :neutral)
(is (test-range-case 3.0) :agree)
(is (test-range-case 3.5) :agree)
(is (test-range-case 4.0) :strongly-agree)
(is (test-range-case 4.5) :strongly-agree)
(is (test-range-case 5.0) :strongly-agree)
(is (test-range-case 42) :the-answer)
(is (test-range-case -1) :do-not-care)))
(run-tests)"
`(cond
~@(loop [cases cases ret []]
(cond
(empty? cases)
ret
(odd? (count cases))
(throw (IllegalArgumentException.
(str "no matching clause: " (first cases))))
(= :else (first cases))
(recur (drop 2 cases) (conj ret :else (second cases)))
(vector? (first cases))
(let [[lower-bound operator upper-bound] (first cases)
clause (second cases)
[condition clause]
(case operator
:ii `((<= ~lower-bound ~target ~upper-bound) ~clause)
:ie `((and (<= ~lower-bound ~target)
(< ~target ~upper-bound)) ~clause)
:ei `((and (< ~lower-bound ~target)
(<= ~target ~upper-bound)) ~clause)
:ee `((< ~lower-bound ~target ~upper-bound) ~clause)
(throw (IllegalArgumentException.
(str "unknown operator: " operator))))]
(recur (drop 2 cases) (conj ret condition clause)))
:else
(let [[condition clause]
`[(= ~target ~(first cases)) ~(second cases)]]
(recur (drop 2 cases) (conj ret condition clause)))))))
UPDATE: Here is the revised version incorporating changes suggested by mikera and kotarak:
(defmacro range-case [target & cases]
"Compare the target against a set of ranges or constant values and return
the first one that matches. If none match, and there exists a case with the
value :else, return that target. Each range consists of a vector containing
one of the following patterns:
[upper-bound] if this is the first pattern, match any
target <= upper-bound
otherwise, match any target <= previous
upper-bound and <= upper-bound
[< upper-bound] if this is the firs开发者_开发百科t pattern, match any
target < upper-bound
otherwise, match any target <= previous
upper-bound and < upper-bound
[lower-bound upper-bound] match any target where lower-bound <= target
and target <= upper-bound
[< lower-bound upper-bound] match any target where lower-bound < target
and target <= upper-bound
[lower-bound < upper-bound] match any target where lower-bound <= target
and target < upper-bound
[< lower-bound < upper-bound] match any target where lower-bound < target
and target < upper-bound
Example:
(range-case target
[0 < 1] :strongly-disagree
[< 2] :disagree
[< 3] :neutral
[< 4] :agree
[5] :strongly-agree
42 :the-answer
:else :do-not-care)
expands to
(cond
(and (<= 0 target) (< target 1)) :strongly-disagree
(and (<= 1 target) (< target 2)) :disagree
(and (<= 2 target) (< target 3)) :neutral
(and (<= 3 target) (< target 4)) :agree
(<= 4 target 5) :strongly-agree
(= target 42) :the-answer
:else :do-not-care)
Test cases:
(use '[clojure.test :only (deftest is run-tests)])
(deftest unit-tests
(letfn [(test-range-case [target]
(range-case target
[0 < 1] :strongly-disagree
[< 2] :disagree
[< 3] :neutral
[< 4] :agree
[5] :strongly-agree
42 :the-answer
:else :do-not-care))]
(is (= (test-range-case 0) :strongly-disagree))
(is (= (test-range-case 0.5) :strongly-disagree))
(is (= (test-range-case 1) :disagree))
(is (= (test-range-case 1.5) :disagree))
(is (= (test-range-case 2) :neutral))
(is (= (test-range-case 2.5) :neutral))
(is (= (test-range-case 3) :agree))
(is (= (test-range-case 3.5) :agree))
(is (= (test-range-case 4) :strongly-agree))
(is (= (test-range-case 4.5) :strongly-agree))
(is (= (test-range-case 5) :strongly-agree))
(is (= (test-range-case 42) :the-answer))
(is (= (test-range-case -1) :do-not-care))))
(run-tests)"
(if (odd? (count cases))
(throw (IllegalArgumentException. (str "no matching clause: "
(first cases))))
`(cond
~@(loop [cases cases ret [] previous-upper-bound nil]
(cond
(empty? cases)
ret
(= :else (first cases))
(recur (drop 2 cases) (conj ret :else (second cases)) nil)
(vector? (first cases))
(let [condition (first cases)
clause (second cases)
[case-expr prev-upper-bound]
(let [length (count condition)]
(cond
(= length 1)
(let [upper-bound (first condition)]
[(if previous-upper-bound
`(and (<= ~previous-upper-bound ~target)
(<= ~target ~upper-bound))
`(<= ~target ~upper-bound))
upper-bound])
(= length 2)
(if (= '< (first condition))
(let [[_ upper-bound] condition]
[(if previous-upper-bound
`(and (<= ~previous-upper-bound ~target)
(< ~target ~upper-bound))
`(< ~target ~upper-bound))
upper-bound])
(let [[lower-bound upper-bound] condition]
[`(and (<= ~lower-bound ~target)
(<= ~target ~upper-bound))
upper-bound]))
(= length 3)
(cond
(= '< (first condition))
(let [[_ lower-bound upper-bound] condition]
[`(and (< ~lower-bound ~target)
(<= ~target ~upper-bound))
upper-bound])
(= '< (second condition))
(let [[lower-bound _ upper-bound] condition]
[`(and (<= ~lower-bound ~target)
(< ~target ~upper-bound))
upper-bound])
:else
(throw (IllegalArgumentException. (str "unknown pattern: "
condition))))
(and (= length 4)
(= '< (first condition))
(= '< (nth condition 3)))
(let [[_ lower-bound _ upper-bound] condition]
[`(and (< ~lower-bound ~target) (< ~target ~upper-bound))
upper-bound])
:else
(throw (IllegalArgumentException. (str "unknown pattern: "
condition)))))]
(recur (drop 2 cases)
(conj ret case-expr clause)
prev-upper-bound))
:else
(let [[condition clause]
`[(= ~target ~(first cases)) ~(second cases)]]
(recur (drop 2 cases) (conj ret condition clause) nil)))))))
I would also vote for something slightly more verbose but less ugly to read.
(range-case target
[(<= 0.0) (< 1.0)] :greatly-disagree
[(<= 1.0) (< 2.0)] :disagree
[(<= 2.0) (< 3.0)] :neutral
[(<= 3.0) (< 4.0)] :agree
(<= 4.0 5.0) :strongly-agree
42 :the-answer
:else :do-not-care)
This could be a viable alternative.
Some ideas:
- Have a default value for the operator (e.g. ":ie" would probably be most natural in typical problems)
- Have one of the bounds default to the previous or following upper/lower bound so that you don't need to repeat the same bounding values.
- Consider ifs rather than cond so that you can do interval bisection (would be a performance win if you expect very large numbers of cases)
An alternative might be to make your macro work at the case level like follows:
(cond
(in-range target [0.0 1.0]) :greatly-disagree)
(in-range target [1.0 2.0]) :disagree)
...)
I personally like this because you can mix your range tests with other predicates if needed.
My initial take on it:
(defn make-case [test val]
(if (vector? test)
`((and ~@(for [[lower comp upper] (partition 3 2 test)]
(list comp lower upper)))
~val)
(list :else val)))
(defmacro range-case [& cases]
(let [cases (partition 2 cases)]
`(cond ~@(mapcat (partial apply make-case) cases))))
This requires a slight change to syntax, like this:
(range-case
[0.0 <= x < 1.0] :greatly-disagree
[1.0 <= x < 2.0] :disagree
[2.0 <= x < 3.0] :neutral
[3.0 <= x < 4.0] :agree
[4.0 <= x <= 5.0] :strongly-agree
[42 = x] :the-answer
:else :do-not-care)
My version may be violating the spirit of the original example, but "advantages" include:
- You aren't hard-coded to a single
target. You also aren't limited to two tests (lower test and upper test). You could do[0 < x <= y < 4 <= z]etc. - Syntax more closely resembles mathematical comparison notation.
- Clojure's comparison operators can be passed as parameters themselves; no need to use keywords and translate those into comparison operators. This way, the comparison operators aren't hard-coded into the function, and removing this layer of indirection makes it read a bit better.
- Equality is no longer a special case.
Disadvantages?
xis repeated a bunch of times. Is grabbingxand putting it at the top worth the increase in complexity and decrease in flexibility?- Like your original example, this uses infix notation. It may be a bit jarring, in a world of prefix notation.
Then again, at this point our macro isn't doing much more than changing square brackets into parens and anding a bunch of stuff together. So I question whether you really need a macro at all.
(defn ?? [& xs]
(every? (fn [[lower comp upper]]
(comp lower upper))
(partition 3 2 xs)))
(cond
(?? 0.0 <= x < 1.0) :greatly-disagree
(?? 1.0 <= x < 2.0) :disagree
(?? 2.0 <= x < 3.0) :neutral
(?? 3.0 <= x < 4.0) :agree
(?? 4.0 <= x <= 5.0) :strongly-agree
(= 42 x) :the-answer
:else :do-not-care)
加载中,请稍侯......
精彩评论