如何解决Clojure范围大小写宏
| 在R. Kent Dybvig的书“ The Scheme Programming Language，第4版”（第86页）中，作者为接受条件范围的case
define-syntax
:ii
:ie
:ei
:ee
cond
if
cond
(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)))))))
(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,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 first 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)))))))
解决方法
我也会投票给我一些冗长但丑陋的东西。
(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)
(cond
(in-range target [0.0 1.0]) :greatly-disagree)
(in-range target [1.0 2.0]) :disagree)
...)
(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))))
(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)
[0 < x <= y < 4 <= z]
x
(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)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
