Clojure диапазон-макрос

Question

В книге "Язык программирования схем, 4-е издание" , Р. Кент Дибвиг, на стр. 86, автор написал define-syntax (макрос схемы) для оператора case который принимает диапазоны для своих условий. Я думал, что попробую это в Clojure.

Вот результат.

Как я могу улучшить это? Я использую :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)))))))

ОБНОВЛЕНИЕ : Вот пересмотренная версия, включающая изменения, предложенные mikera и 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 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)))))))

Answer 1

Я бы также проголосовал за что-то более многословное, но менее уродливое для чтения.

 (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)

Это может быть жизнеспособной альтернативой.

Answer 2

Мой первоначальный взгляд на это:

(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)

Моя версия может нарушать дух оригинального примера, но "преимущества" включают в себя:

1. Вы не жестко запрограммированы на один target. Вы также не ограничены двумя тестами (нижний тест и верхний тест). Вы могли бы сделать [0 < x <= y < 4 <= z] и т. Д.
2. Синтаксис более похож на нотацию математического сравнения.
3. Операторы сравнения Clojure могут быть переданы в качестве самих параметров; нет необходимости использовать ключевые слова и переводить их в операторы сравнения. Таким образом, операторы сравнения не жестко запрограммированы в функции, и удаление этого уровня косвенности делает его немного лучше читаемым.
4. Равенство больше не является особым случаем.

Недостатки

1. x повторяется несколько раз. Стоит ли захватывать x и ставить его на первое место, стоит ли увеличивать сложность и уменьшать гибкость?
2. Как и в вашем оригинальном примере, здесь используется инфиксная нотация. Это может быть немного неприятно, в мире префиксных обозначений.

Опять же, в этот момент наш макрос делает не намного больше, чем просто заменяет квадратные скобки на парены и and собирает кучу всего вместе. Поэтому я задаюсь вопросом, нужен ли вам макрос вообще.

(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)

Answer 3

Некоторые идеи:

• Иметь значение по умолчанию для оператора (например, ": т.е.", вероятно, было бы наиболее естественным в типичных задачах)
• Для одной из границ по умолчанию используется предыдущая или следующая верхняя / нижняя граница, чтобы вам не приходилось повторять одни и те же ограничивающие значения.
• Рассмотрим if, а не cond, чтобы вы могли выполнять деление на интервалы (это будет выигрыш в производительности, если вы ожидаете очень большое количество случаев)

Альтернативой может быть заставить ваш макрос работать на уровне кейса следующим образом:

(cond
  (in-range target [0.0 1.0]) :greatly-disagree)
  (in-range target [1.0 2.0]) :disagree)
  ...)

Мне лично это нравится, потому что вы можете при необходимости смешивать тесты диапазона с другими предикатами.