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

@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.