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

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