380 - PurelyFunctional.tv Newsletter - https://purelyfunctional.tv/issues/purelyfunctional-tv-newsletter-380-what-can-you-iterate-through/

00 Medication contraindications.md

Medication contraindications

You probably know this, but here's some background so we're all on the same page. Some medicines shouldn't be taken in combination. When two medications shouldn't be taken together, it's called a contraindication.

(def patient-medications [{:name "Blythenal"
                           :rxNorm "blyth"}
                          {:name "Masbutol"
                           :rxNorm "masbut"}
                          {:name "Welbutril"
                           :rxNorm "welb"}])

(def contraindication-pairs [["nr913ng" "blyth"]
                             ["masbut"  "87f2h139049f"]
                             ["nr913ng" "j1j81f0"]
                             ["blyth" "welb"]
                             ["masbut"  "welb"]])

Your task is to take the list of medications a patient has and a list of contraindication pairs, and determine what pairs of medications (if any) they are prescribed that don't mix well.

;;  complete this function
(defn contraindications [meds pairs]

It should return nil if there are no contraindications and a collection of the contraindications (pairs) if there are any.

Bonus: Make it a linear algorithm (linear in the number of the patient medications and the number of the contraindication pairs).

Email submissions to eric@purelyfunctional.tv until June 8, 2020. You can discuss the submissions in the comments below.

Alan Thompson.clj

(ns tst.demo.core
  (:use tupelo.core tupelo.test)
  (:require [schema.core :as s]
            [clojure.set :as set]))

(def patient-medications [{:name   "Blythenal"
                           :rxNorm "blyth"}
                          {:name   "Masbutol"
                           :rxNorm "masbut"}
                          {:name   "Welbutril"
                           :rxNorm "welb"}])

(def contraindication-pairs [["nr913ng" "blyth"]
                             ["masbut" "87f2h139049f"]
                             ["nr913ng" "j1j81f0"]
                             ["blyth" "welb"]
                             ["masbut" "welb"]])

(s/defn patient-meds-set :- #{s/Str}
  [arg :- [{s/Keyword s/Str}]]
  (set (mapv #(grab :rxNorm %) arg)))

(s/defn contra-pair-sets :- #{#{s/Str}}
  [arg :- [[s/Str]]]
  (set (mapv (fn [pair-vec]
               (set pair-vec))
         arg)))

(defn contraindications [meds-in pairs-in]
  (let [patient-meds (patient-meds-set meds-in)
        contra-pairs (contra-pair-sets pairs-in)
        result       (filterv #(= 2 (count %))
                       (forv [contra-pair contra-pairs]
                         (set/intersection patient-meds contra-pair)))]
    result))

(dotest
  (is= (contra-pair-sets contraindication-pairs)
    #{#{"j1j81f0" "nr913ng"}
      #{"masbut" "welb"}
      #{"nr913ng" "blyth"}
      #{"welb" "blyth"}
      #{"masbut" "87f2h139049f"}})

  (is= (patient-meds-set patient-medications) #{"masbut" "welb" "blyth"})

  (is= (contraindications patient-medications contraindication-pairs)
    [#{"masbut" "welb"} #{"welb" "blyth"}]))

Dave Paroulek.clj

(defn contraindications
  [meds pairs]
  ;; one loop thru the list of meds to make an map to facilitate quick lookups
  (let [medmap (into {} (map (fn [{:keys [name rxNorm]}] [rxNorm name]) meds))]
    ;; one loop thru the list of pairs. quickly check if each pair is
    ;; in list of meds
    (loop [pair (first pairs) pairs (rest pairs) result #{}]
      (if pair
        (let [[p1 p2] pair]
          (if (get medmap p1)
            (if (get medmap p2)
              (recur (first pairs) (rest pairs) (conj result pair))
              (recur (first pairs) (rest pairs) result))
            (recur (first pairs) (rest pairs) result)))
        (if (empty? result) nil result)))))

Dimitar Uzunov.clj

(defn contraindications [meds pairs]
 (let [rx (set (let [m (map :rxNorm meds)]
                (for [x1 m x2 m :when (not= x1 x2)] [x1 x2])))
       cp (set pairs)
       contra (clojure.set/intersection cp rx)]
   (if (= #{} contra)
    nil
    (vec contra))))

Eric Normand.clj

(defn contraindications [meds pairs]
  (let [medset (set (map :rxNorm meds))]
    (not-empty (filter #(and (contains? medset (first  %))
                             (contains? medset (second %)))
                       pairs))))

Frantisek Kobzik.clj

(defn contraindications [meds pairs]
  (let [contraindication-pairs (map (juxt first identity) pairs)
        contraindication-map   (into {} contraindication-pairs)
        med-ids                (map :rxNorm meds)]
    (->> med-ids
         (map contraindication-map)
         (remove nil?)
         seq)))

JF Rompre.clj

(ns functional-tv-puzzles.-2020.contraindications-380
  "Solution which can use several strategies, mainly iterating either over 
  pairs of contra-indications in linear time, or over generated pairs 
  from a list of meds in quadratic time, when meds is much smaller than contras. 
  The decision is taken algorithmically, unless input parameters are overriden. "
  (:require [clojure.set :as set])
  (:require [clojure.core.reducers :as r]))

(defn dominated? 
  "Returns true if n is larger than m^2/2 by a given margin"
[m n margin]
  (< (-> (* m m) (/ 2) (+ margin)) n))

(defn all-1x1 [xs]
  (let [indexed (map-indexed #(vector (inc %) %2) 
                             xs)]
    (for [[xi x :as xix] indexed 
          [yi y :as yiy] indexed 
          :when (< xi yi)]
      #{x y})))

(defn concurrent [pred xs]
  (->> xs (r/fold 
           (r/monoid #(concat %1 %2) (fn [] nil))
           (fn [acc pair]
             (if (pred pair)
               (conj acc (set pair))
               acc)))))

(defn ->rx [meds]
  (->> meds (map :rxNorm)))

(defn ->sets [pairs]
  (->> pairs (map set) (into #{})))

(defn using-sets [meds pairs]
  (let [ps (->sets pairs)]
    (->> meds ->rx all-1x1 set (set/intersection ps))))

(defn over-meds [meds pairs]
  (let [ps (->sets pairs)]
    (->> (all-1x1 (->rx meds))
         (concurrent (fn [p] (ps p))))))

(defn over-contras [meds pairs]
  (let [ms (into #{} (->rx meds))]
    (->> pairs
         (concurrent (fn [[rx1 rx2]]
                          (and (ms rx1) (ms rx2)))))))

(defn contraindications 
  "Returns a coll of all duples of :rxNorm values in `meds`, 
   which are also found in `pairs`. Option 
  :override [:meds | :pairs | :sets]
  imposes a single strategy of iterating over pairs (linear 
  performance), meds or sets - the later two involving 
  preprocessing with quadratic cost. 

  Otherwise the decision for iterating over meds vs pairs 
  can be influenced by options :factor and :margin 
  (defaults 2 and 0 resp.). Increasing these will increase 
  favoring iterating over pairs. 
"
  [meds pairs & {:keys [factor margin override] 
                 :or {factor 2 margin 0}}]

  (let [msiz (count meds)
        psiz (count pairs)
        f (or (get {:meds over-meds 
                    :pairs over-contras
                    :sets using-sets} override) 
              (if (dominated? msiz psiz 
                              (-> (* factor msiz) (+ margin)))
                over-meds
                over-contras))]
    (f meds pairs)))

Mark Champine.clj

(defn contraindications [meds pairs]
  (seq (filter #(not-any? nil? (map (set (map :rxNorm meds)) %)) pairs)))

Michal Roček.clj

(defn contraindications [meds pairs]
  (let [meds-set (reduce #(conj %1 (:rxNorm %2)) #{} meds)]
    (not-empty (->> pairs
                    (filter (fn [[first second]]
                              (and (contains? meds-set first)
                                   (contains? meds-set second))))))))

Nathan Donolli.clj

(defn contraindications [meds pairs]
  (let [meds-set (set (map :rxNorm meds))
        contains-pair? (partial every? meds-set)]
    (->> pairs (filter contains-pair?) not-empty)))

Paul Roush.clj

;;;
;;; Note that while the problem description asked only for handling
;;; "contra-indicated pairs" of medications, it is not meaningfully harder
;;; to handle N medications that shouldn't be taken together.
;;; This code does that, and has one test to demonstrate a "triplet".

;;
;; Examine a collection of medications prescribed to a given patient
;; and a collection of medication-tuples that are "conta-indicated", i.e.
;; that the given collection of medications should not be taken together.
;;
;; Examine the medications the patient is taking and report any combinations
;; that are contra-indicated.
;;
(defn contraindications [meds bad-combos]
  (let [prescribed? (fn [med] (contains? (set (map :rxNorm meds)) med))
        problem?    (fn [bad-combo] (every? prescribed? bad-combo))]
    (filter problem? bad-combos)))

(def meds1 [{:name "Blythenal"
             :rxNorm "blyth"}
            {:name "Masbutol"
             :rxNorm "masbut"}
            {:name "Welbutril"
             :rxNorm "welb"}])

(def meds2 [{:rxNorm "foo"}
            {:rxNorm "bar"}
            {:rxNorm "baz"}])

(def contraindication-pairs [["nr913ng" "blyth"]
                             ["masbut"  "87f2h139049f"]
                             ["nr913ng" "j1j81f0"]
                             ["blyth" "welb"]
                             ["masbut"  "welb"]])

(def contraindication-tups [["masbut"  "87f2h139049f"]
                            ["nr913ng" "j1j81f0"]
                            ["blyth" "welb" "foo"]
                            ["blyth" "welb" "masbut"]])

(contraindications meds1 contraindication-pairs)
;  ==> (["blyth" "welb"] ["masbut" "welb"])

(contraindications meds2 contraindication-pairs)
;  ==> ()

(contraindications meds1 contraindication-tups)
;  ==> (["blyth" "welb" "masbut"])

Steffan Westcott.clj

(defn contraindications [meds pairs]
  (seq (filter #(every? (set (map :rxNorm meds)) %) pairs)))

@ericnormand, Thanks for your comment! Indeed, I was assuming that meds being small that would be acceptable - but indeed, quadratic times makes for fast growth even on relatively small meds.

What do you think of the following? This won't exactly cut the linearity down, but could be a good speedup on large contraindications lists:

(defn step [rxs pair]
  (when (every? rxs pair) 
    pair))

(defn contraindications [meds pairs]
  (let [rxs (set (map :rxNorm meds))]
    (clojure.core.reducers/fold  
     (clojure.core.reducers/monoid #(concat %1 %2) (constantly nil)) 
     (fn [acc p] (if-let [contra? (step rxs p)]
                   (conj acc contra?)
                   acc))
     pairs)))

In case it helps, here are some fixtures and tests for (most?) corner cases and additionally some using generated inputs - I am learning how to use test.check generators (please bear with my hacking). This is far away from properties based testing, but it can be used for benchmarking.

Below are tests using generated fixtures with up to a thousand meds, 10k contraindications and 500 conflicts, but you can create your own by changing the numbers.

Please let me know if I missed corner cases and I will add them...Thanks!

  (ns my-namespace-test 
   (:require [my-namespace :as sut]
            [clojure.spec.alpha :as s]
            [clojure.spec.gen.alpha :as gen]
            [clojure.test :refer [deftest testing is are]]))

(let [alias-str "sut"
      sym (symbol (str alias-str "/contraindications"))]
  (def ci (resolve sym)))

(def fixtures [[[{:name "Blythenal"   ;; input meds 
                   :rxNorm "blyth"}
                  {:name "Masbutol"
                   :rxNorm "masbut"}
                  {:name "Welbutril"
                   :rxNorm "welb"}],
)
                [["nr913ng" "blyth"]     ;; input contra-indications
                 ["masbut"  "87f2h139049f"]
                 ["nr913ng" "j1j81f0"]
                 ["blyth" "welb"]
                 ["masbut"  "welb"]],
                
                [["blyth", "welb"],   ;; expected output, can be any seqable (including sets in 
                 ["masbut" "welb"]]], ;; any order, and the same for inner pairs


              [[{:name "Maalox"
                 :rxNorm "yuck"}
                {:name "Cola"
                 :rxNorm "cola"}],
               [["drumpfspeak" "any"]
                ["clorox" "any"]]
               nil],

               [[{:name "Niceone"
                  :rxNorm "yum"}]
                []
                nil],

               [[]
               [["drumpfspeak" "any"]
                ["clorox" "any"]]
                nil]

               [[] [] nil]])

(s/def ::string+ (s/with-gen string? 
                   #(gen/such-that (complement empty?) 
                                  (gen/string-alphanumeric))))
(s/def ::name ::string+) 
(s/def ::rxNorm ::string+)
(s/def ::med (s/keys :req-un [::name ::rxNorm]))
(s/def ::contra (s/coll-of ::rxNorm :count 2 :distinct true))
;; (s/def ::contras (s/coll-of ::contra :into []))
(s/def ::meds (s/coll-of ::med))

(defn insert-med-pfx [med pfx]
  (update med :rxNorm #(str pfx %)))

(defn distinct-rand-int [n limit]
  (let [gen (fn [] (repeatedly n #(rand-int limit)))]
    (if (<= limit n)
      (range limit)
      (loop [acc (set (gen))] 
        (if (<= n (count acc))
          (take n acc)
          (recur (into acc (gen))))))))

(defn pairs+conflicts [pairs conflicts-siz pfx]
  (let [idxs (distinct-rand-int conflicts-siz (count pairs))] 
    (reduce (fn [[pairs conflicts] i]
              (let [p (mapv (partial str pfx) (pairs i))]
                [(assoc pairs i p),
                 (conj conflicts p)]))
            [(vec pairs) []]
            idxs)))

(defn make-large-fixture [meds-siz contras-siz conflicts-siz]
  (assert (and (<= conflicts-siz contras-siz)
               (<= (* 2 conflicts-siz) meds-siz)) 
          (str "violation of: 2 x conflicts-siz <= meds-siz "
               "AND conflicts-siz <= contras-siz"))
  (let [[pairs conflicts] (pairs+conflicts 
                           (gen/sample (s/gen ::contra) contras-siz)
                           conflicts-siz "conflict_")  
        ;; conflicts (repeatedly conflicts-siz #(rand-nth pairs))
        conflict-meds (mapcat (fn [pair] 
                                (->> pair
                                     (map (fn [rx]
                                            {:name (gen/generate (s/gen ::name))
                                             :rxNorm rx}))))
                              conflicts)
        meds (->> conflict-meds
                  (into (gen/sample 
                         (gen/fmap #(insert-med-pfx % "no-conflict_") 
                                   (s/gen ::med)) 
                         (- meds-siz (* 2 conflicts-siz))))
                  shuffle)]
    [meds, pairs, conflicts]))

#_(deftest make-large-fixture-test
  (are [m c x] (let [[meds contras xfl] (make-large-fixture m c x)
                     meds-rx (set (map :rxNorm meds))]
                 (and 
                  (= m (count meds))
                  (= c (count contras))
                  (= x (count xfl))
                  (every? meds-rx (set (flatten xfl)))
                  (every? (set contras) (set xfl))))
    10 10 2
    10 100 1
    10 10000 3
    100 10000 50
    1000 20000 450))

;; make-large-fixture debugging
#_(defn find-failed [gen-f]
  (->>
   (repeatedly #(let [[meds contras exp :as fixt] (gen-f)
                      out (apply ci (take 2 fixt))]
                  [out exp [meds contras]]))
   (drop-while (fn [[out exp _]]
                 (= (set exp) (set out))))
   first))

(defn passing? [[meds contras exp]]
  (is (= (set (map set exp)) (set (map set (ci meds contras))))))

(defn passing?-strict [[meds contras exp]]
  (is (let [out (ci meds contras)] 
        (and (= (set (map set exp)) (set (map set out)))
             (if (empty? out)
               (nil? out)
               true)))))

(deftest contraindications-test
  (testing "correctness and corner cases on small inputs"
    (doall (map passing?-strict fixtures)))
  (testing  ;; no corner cases
      "correctness and linear performance on large contraindications"
    (are [m c k] (passing? (make-large-fixture m c k))
      4 1 1
      4 10 1
      10 10000 2   ;; large contras
      10 10000 3
      100 10000 50 ;; + large conflicts
      1000 10000 500  ;; + large meds
      30 10000 8  ;; worth iterating over quadratically generated meds' pairs?
      30 10000 15 ;; same, maximum conflicts 
)))

Looks like my solution is quadratic, any recommendations for something to read on time complexity?

I noticed several similar solutions with every, I preferred to use the fact of pairs explicitly

(defn contraindications [meds pairs]
   (let [rx-norms (->> meds
                  (map :rxNorm)
                  (set))]
     (->> pairs
          (filter (fn [[a b]] (and (rx-norms a) (rx-norms b))))
          (seq))))

@KingCode I think your first solution is linear in that it fulfills the bonus requirement :

linear in the number of the patient medications and the number of the contraindication pairs.

A set is a constant time lookup, you only traverse the pairs list once, and the pairs will always have a fixed length of two. There are probably ways to solve it in fewer operations, but given that both the meds and pairs are vectors I have a hard time imagining a solution where you don't have to traverse each at minimum once.

@ndonolli, that's an interesting comment - traversing two structures is still linear time indeed. The use of quadratic times pair generation of meds' rxNorm values might also be worthwhile when the meds list is much shorter than the contra pairs, if the inner pairs were sets instead of vectors.

Suppose meds is a 10 rxNorm list, and pairs is 10,000 long. As you say, if set membership is a constant time lookup, then quadratic-time generation of 10x10 = 100 meds combo duples to be checked for membership in 10000 pairs set looks good. However, the 10,000 pairs needing to be converted to sets with something like (set (map set pairs)) prior, that is probably still slower than straight linear operation over the pairs.
EDIT. Actually, we wouldn't need to make every contra pair a set, just put the 10K pairs in a set: (set pairs) since the 100 med pairs have all orderings. I don't know how much does the conversion from vector to set cost, but it's at most linear then probably worth it:

(defn contraindications [meds pairs]  ;; size(meds) ^2 < size(pairs)
  (seq
   (let [meds (map :rxNorm meds)
         pairs (set pairs)]
     (for [rx1 meds
           rx2 meds
           :when (not= rx1 rx2)
           :when (pairs [rx1 rx2])]
        [rx1 rx2]))))

@KingCode I see what you’re saying. When solving the problem I hadn’t considered the case of a much longer pairs list and the algorithmic tradeoffs to make. Interestingly this probably is a more real world case so production level code would have to take this requirement into account.