From aae80c68ff00d4bd8b92360e56b74a240a7936f5 Mon Sep 17 00:00:00 2001 From: KGOH Date: Mon, 5 Dec 2022 18:42:11 +0200 Subject: [PATCH 01/16] Add nested vs expansion queue algo WIP Co-authored-by: @islambegkatibov <79331750+islambegk@users.noreply.github.com> --- src/ftr/extraction/ig/value_set_expand.clj | 143 ++++++++++++++---- .../extraction/ig/value_set_expand_test.clj | 32 ++++ 2 files changed, 145 insertions(+), 30 deletions(-) create mode 100644 test/ftr/extraction/ig/value_set_expand_test.clj diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index 1712609..dbcd7c1 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -1,5 +1,6 @@ (ns ftr.extraction.ig.value-set-expand (:require + [zen.utils] [clojure.string :as str])) @@ -115,16 +116,22 @@ (:system compose-el) (:version compose-el))) - {value-set-systems :systems, value-set-pred :check-fn} - (vs-compose-value-set-fn ztx value-set (:valueSet compose-el)) + #_{value-set-systems :systems, value-set-pred :check-fn} + #_(vs-compose-value-set-fn ztx value-set (:valueSet compose-el)) - check-fn (some->> [code-system-pred value-set-pred] - (remove nil?) - not-empty - (apply every-pred))] - (when check-fn - {:systems (conj value-set-systems (:system compose-el)) - :check-fn check-fn}))) + check-fn code-system-pred + #_(some->> [code-system-pred value-set-pred] + (remove nil?) + not-empty + (apply every-pred))] + (if-let [vs-urls (:valueSet compose-el)] + {:value-set-queue-entry {:vs-url (:url value-set) + :system (:system compose-el) + :check-fn (or check-fn (constantly true)) + :depends-on vs-urls}} + (when check-fn + {:systems [(:system compose-el)] #_(conj value-set-systems (:system compose-el)) + :check-fn check-fn})))) (defn update-fhir-vs-expansion-index [ztx vs concept-identity-keys] #_"TODO: support recursive expansion :contains" @@ -161,16 +168,20 @@ includes (some->> (get-in vs [:compose :include]) (keep (partial check-if-concept-is-in-this-compose-el-fn ztx vs)) not-empty) + include-depends (keep :value-set-queue-entry includes) include-fn (or (some->> includes - (map :check-fn) + (keep :check-fn) + not-empty (apply some-fn)) (constantly false)) excludes (some->> (get-in vs [:compose :exclude]) (keep (partial check-if-concept-is-in-this-compose-el-fn ztx vs)) not-empty) + exclude-depends (keep :value-set-queue-entry excludes) exclude-fn (or (some->> excludes - (map :check-fn) + (keep :check-fn) + not-empty (apply some-fn) complement) (constantly true)) @@ -187,30 +198,102 @@ (mapcat (comp not-empty :systems)) includes-and-excludes)] {:systems (not-empty systems) + :include-depends include-depends + :exclude-depends exclude-depends :check-concept-fn check-concept-fn})) -(defn denormalize-into-concepts [ztx valuesets concepts-map] +(defn push-entries-to-vs-queue [queue entries entry-type] (reduce - (fn reduce-valuesets [concepts-acc vs] - (let [{systems :systems - concept-in-vs? :check-concept-fn} - (compose ztx vs)] - (reduce - (fn reduce-codesystems [acc [system concepts]] - (reduce - (fn reduce-concepts [acc [concept-id concept]] - (if (concept-in-vs? concept) - (update-in acc [system concept-id :valueset] - (fnil conj #{}) - (:url vs)) - acc)) + (fn [acc {:keys [vs-url depends-on system check-fn]}] + (reduce #(update-in %1 + [vs-url system %2] + conj + (case entry-type + :include check-fn + :exclude (complement check-fn))) acc - concepts)) - concepts-acc - (select-keys concepts-acc systems)))) - concepts-map - valuesets)) + depends-on)) + queue + entries)) + + +(defn process-vs-nested-refs [acc vs-url] + (reduce-kv + (fn [acc dep-system-url depends-valuesets-idx] + (reduce-kv + (fn [acc depends-on-vs-url check-fns] + (let [acc (if (get-in acc [:refs-queue depends-on-vs-url dep-system-url]) + (process-vs-nested-refs acc depends-on-vs-url) + acc) + + vs-dep-sys-idx (get-in acc [:value-set-idx depends-on-vs-url dep-system-url]) + + acc (-> acc + (update-in [:value-set-idx vs-url dep-system-url] #(into vs-dep-sys-idx %)) + (update-in [:refs-queue vs-url dep-system-url] dissoc depends-on-vs-url) + (update-in [:refs-queue vs-url] #(zen.utils/dissoc-when empty? % dep-system-url)) + (update-in [:refs-queue] #(zen.utils/dissoc-when empty? % vs-url)))] + (reduce (fn [acc code] + (let [concept (get-in acc [:concepts-map dep-system-url code])] + (cond-> acc + (every? #(% concept) check-fns) + (update-in [:concepts-map dep-system-url code :valueset] + (fnil conj #{}) + vs-url)))) + acc + vs-dep-sys-idx))) + acc + depends-valuesets-idx)) + acc + (get-in acc [:refs-queue vs-url]))) + + +(defn process-nested-vss-refs [concepts-map value-set-idx (nested-vs-refs-queue)] + (loop [acc {:refs-queue nested-vs-refs-queue + :concepts-map concepts-map + :value-set-idx value-set-idx} + vs-url (ffirst nested-vs-refs-queue)] + (let [{:as res-acc, :keys [refs-queue]} (process-vs-nested-refs acc vs-url)] + (if (seq refs-queue) + (recur res-acc (ffirst refs-queue)) + (:concepts-map res-acc))))) + + +(defn denormalize-into-concepts [ztx valuesets concepts-map] + (let [{:keys [concepts-map + value-set-idx + nested-vs-refs-queue]} + (reduce + (fn reduce-valuesets [concepts-acc vs] + (let [{systems :systems + concept-in-vs? :check-concept-fn + :keys [include-depends exclude-depends]} + (compose ztx vs)] + (reduce + (fn reduce-codesystems [acc [system concepts]] + (reduce + (fn reduce-concepts [acc [concept-id concept]] + (if (concept-in-vs? concept) + (-> acc + (update-in [:concepts-map system concept-id :valueset] + (fnil conj #{}) + (:url vs)) + (update-in [:value-set-idx (:url vs) system] + (fnil conj #{}) + (:code concept))) + acc)) + acc + concepts)) + (-> concepts-acc + (update :nested-vs-refs-queue push-entries-to-vs-queue include-depends :exclude) + (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :include)) + (select-keys concepts-acc systems)))) + {:concepts-map concepts-map + :value-set-idx {} + :nested-vs-refs-queue {}} + valuesets)] + (process-nested-vss-refs concepts-map value-set-idx nested-vs-refs-queue))) (defn denormalize-value-sets-into-concepts [ztx] diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj new file mode 100644 index 0000000..ccffddb --- /dev/null +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -0,0 +1,32 @@ +(ns ftr.extraction.ig.value-set-expand-test + (:require [ftr.extraction.ig.value-set-expand :as sut] + [clojure.test :as t])) + + +(t/deftest nested-vs-refs-process-test + (t/is (= {"sys1" {"code1" {:code "code1" + :system "sys1" + :valueset #{"vs1" "vs2" "vs4"}} + "code2" {:code "code2" + :system "sys1" + :valueset #{"vs2" "vs4" "vs3"}} + "code3" {:code "code3" + :system "sys1" + :valueset #{"vs2"}}}} + (sut/process-nested-vss-refs + {"sys1" {"code1" {:code "code1" + :system "sys1" + :valueset #{"vs1"}} + "code2" {:code "code2" + :system "sys1" + :valueset #{"vs2"}} + "code3" {:code "code3" + :system "sys1" + :valueset #{"vs2"}}}} + {"vs1" {"sys1" #{"code1"}} + "vs2" {"sys1" #{"code2"}}} + {"vs3" {"sys1" {"vs2" [(fn [concept] (= "code2" (:code concept)))]}} + "vs2" {"sys1" {"vs1" [(constantly true)]}} + "vs4" {nil {"vs1" [(constantly true)] + "vs2" [(constantly true) + (complement (fn [concept] (= "code3" (:code concept))))]}}})))) From 7459fe6083658120c65240aef3a0cf6e66c8f340 Mon Sep 17 00:00:00 2001 From: KGOH Date: Tue, 6 Dec 2022 19:33:43 +0200 Subject: [PATCH 02/16] Fix ftr.extraction.ig.value-set-expand/process-nested-vss-refs args typo Co-authored-by: @islambegkatibov <79331750+islambegk@users.noreply.github.com> --- src/ftr/extraction/ig/value_set_expand.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index dbcd7c1..5c2dd2e 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -249,7 +249,7 @@ (get-in acc [:refs-queue vs-url]))) -(defn process-nested-vss-refs [concepts-map value-set-idx (nested-vs-refs-queue)] +(defn process-nested-vss-refs [concepts-map value-set-idx nested-vs-refs-queue] (loop [acc {:refs-queue nested-vs-refs-queue :concepts-map concepts-map :value-set-idx value-set-idx} From 8db6e7c4ae8f21b068239a2bbaf10f823b884394 Mon Sep 17 00:00:00 2001 From: KGOH Date: Tue, 6 Dec 2022 19:34:20 +0200 Subject: [PATCH 03/16] Add nested-vs-refs-process-test test case Co-authored-by: @islambegkatibov <79331750+islambegk@users.noreply.github.com> --- test/ftr/extraction/ig/value_set_expand_test.clj | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index ccffddb..a63d4d6 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -4,7 +4,10 @@ (t/deftest nested-vs-refs-process-test - (t/is (= {"sys1" {"code1" {:code "code1" + (t/is (= {"sys0" {"code0" {:code "code0" + :system "sys0" + :valueset #{"vs1" "vs4"}}} + "sys1" {"code1" {:code "code1" :system "sys1" :valueset #{"vs1" "vs2" "vs4"}} "code2" {:code "code2" @@ -14,7 +17,10 @@ :system "sys1" :valueset #{"vs2"}}}} (sut/process-nested-vss-refs - {"sys1" {"code1" {:code "code1" + {"sys0" {"code0" {:code "code0" + :system "sys0" + :valueset #{"vs1"}}} + "sys1" {"code1" {:code "code1" :system "sys1" :valueset #{"vs1"}} "code2" {:code "code2" From 6074be96ab688385d903c648d5b8fea0fb8d8175 Mon Sep 17 00:00:00 2001 From: KGOH Date: Tue, 6 Dec 2022 19:35:20 +0200 Subject: [PATCH 04/16] Refactor denormalize-into-concepts acc name Co-authored-by: @islambegkatibov <79331750+islambegk@users.noreply.github.com> --- src/ftr/extraction/ig/value_set_expand.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index 5c2dd2e..7d3b979 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -265,7 +265,7 @@ value-set-idx nested-vs-refs-queue]} (reduce - (fn reduce-valuesets [concepts-acc vs] + (fn reduce-valuesets [acc vs] (let [{systems :systems concept-in-vs? :check-concept-fn :keys [include-depends exclude-depends]} @@ -285,10 +285,10 @@ acc)) acc concepts)) - (-> concepts-acc + (-> acc (update :nested-vs-refs-queue push-entries-to-vs-queue include-depends :exclude) (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :include)) - (select-keys concepts-acc systems)))) + (select-keys acc systems)))) {:concepts-map concepts-map :value-set-idx {} :nested-vs-refs-queue {}} From 0ecca43719b56f94acbc43005e08c3fb27c5d788 Mon Sep 17 00:00:00 2001 From: KGOH Date: Tue, 6 Dec 2022 19:35:39 +0200 Subject: [PATCH 05/16] Fix denormalize-into-concepts reduce acc --- src/ftr/extraction/ig/value_set_expand.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index 7d3b979..b8f0c6a 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -288,7 +288,7 @@ (-> acc (update :nested-vs-refs-queue push-entries-to-vs-queue include-depends :exclude) (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :include)) - (select-keys acc systems)))) + (select-keys (:concepts-map acc) systems)))) {:concepts-map concepts-map :value-set-idx {} :nested-vs-refs-queue {}} From a53bfa5fc4710a34100d32d53fa05933227e0b6a Mon Sep 17 00:00:00 2001 From: KGOH Date: Tue, 6 Dec 2022 20:23:04 +0200 Subject: [PATCH 06/16] Fix nested valueset refs expand when no system filter Co-authored-by: @islambegkatibov <79331750+islambegk@users.noreply.github.com> --- src/ftr/extraction/ig/value_set_expand.clj | 52 +++++++++++++------ .../extraction/ig/value_set_expand_test.clj | 3 +- 2 files changed, 37 insertions(+), 18 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index b8f0c6a..532c2d6 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -218,31 +218,49 @@ entries)) +(defn dissoc-in&sanitize-maps [m path] #_"TODO: refactor" + (assert (not= 0 (count path)) "Can't dissoc-in from empty path") + + (not-empty (zen.utils/dissoc-when + empty? + (reduce (fn [m-acc path] + (update-in m-acc (butlast path) #(zen.utils/dissoc-when empty? % (last path)))) + (cond-> m + (< 1 (count path)) + (update-in (butlast path) dissoc (last path))) + (take-while #(< 1 (count %)) (iterate butlast path))) + (first path)))) + + (defn process-vs-nested-refs [acc vs-url] (reduce-kv (fn [acc dep-system-url depends-valuesets-idx] (reduce-kv (fn [acc depends-on-vs-url check-fns] - (let [acc (if (get-in acc [:refs-queue depends-on-vs-url dep-system-url]) + (let [has-transitive-deps? + (seq (get-in acc [:refs-queue depends-on-vs-url])) + + acc (if has-transitive-deps? (process-vs-nested-refs acc depends-on-vs-url) acc) - vs-dep-sys-idx (get-in acc [:value-set-idx depends-on-vs-url dep-system-url]) - - acc (-> acc - (update-in [:value-set-idx vs-url dep-system-url] #(into vs-dep-sys-idx %)) - (update-in [:refs-queue vs-url dep-system-url] dissoc depends-on-vs-url) - (update-in [:refs-queue vs-url] #(zen.utils/dissoc-when empty? % dep-system-url)) - (update-in [:refs-queue] #(zen.utils/dissoc-when empty? % vs-url)))] - (reduce (fn [acc code] - (let [concept (get-in acc [:concepts-map dep-system-url code])] - (cond-> acc - (every? #(% concept) check-fns) - (update-in [:concepts-map dep-system-url code :valueset] - (fnil conj #{}) - vs-url)))) - acc - vs-dep-sys-idx))) + acc (reduce + (fn [acc sys] + (let [vs-dep-sys-idx (get-in acc [:value-set-idx depends-on-vs-url sys])] + (reduce (fn [acc code] + (let [concept (get-in acc [:concepts-map sys code])] + (cond-> acc + (every? #(% concept) check-fns) + (update-in [:concepts-map sys code :valueset] + (fnil conj #{}) + vs-url)))) + (update-in acc [:value-set-idx vs-url sys] #(into vs-dep-sys-idx %)) + vs-dep-sys-idx))) + (dissoc-in&sanitize-maps acc [:refs-queue vs-url dep-system-url depends-on-vs-url]) + (if (some? dep-system-url) + [dep-system-url] + (keys (get-in acc [:value-set-idx depends-on-vs-url]))))] + acc)) acc depends-valuesets-idx)) acc diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index a63d4d6..8a02b72 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -29,7 +29,8 @@ "code3" {:code "code3" :system "sys1" :valueset #{"vs2"}}}} - {"vs1" {"sys1" #{"code1"}} + {"vs1" {"sys0" #{"code0"} + "sys1" #{"code1"}} "vs2" {"sys1" #{"code2"}}} {"vs3" {"sys1" {"vs2" [(fn [concept] (= "code2" (:code concept)))]}} "vs2" {"sys1" {"vs1" [(constantly true)]}} From 560d11191f22c487998e75446f00ed61193fcae6 Mon Sep 17 00:00:00 2001 From: KGOH Date: Wed, 7 Dec 2022 19:20:08 +0200 Subject: [PATCH 07/16] Fix value set expand process queue --- src/ftr/extraction/ig/core.clj | 2 +- src/ftr/extraction/ig/value_set_expand.clj | 114 +++++++++++------- .../extraction/ig/value_set_expand_test.clj | 33 ++++- 3 files changed, 98 insertions(+), 51 deletions(-) diff --git a/src/ftr/extraction/ig/core.clj b/src/ftr/extraction/ig/core.clj index ca0c79d..d4d7d88 100644 --- a/src/ftr/extraction/ig/core.clj +++ b/src/ftr/extraction/ig/core.clj @@ -231,7 +231,7 @@ concepts (transduce (comp (mapcat :fhir/concepts) (map (fn [concept] {:path [(:system concept) - (:id concept)] + (:code concept)] :value concept}))) (completing (fn [acc {:keys [path value]}] diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index 532c2d6..a42c7b3 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -1,6 +1,7 @@ (ns ftr.extraction.ig.value-set-expand (:require [zen.utils] + [clojure.set :as set] [clojure.string :as str])) @@ -125,9 +126,9 @@ not-empty (apply every-pred))] (if-let [vs-urls (:valueSet compose-el)] - {:value-set-queue-entry {:vs-url (:url value-set) - :system (:system compose-el) - :check-fn (or check-fn (constantly true)) + {:value-set-queue-entry {:vs-url (:url value-set) + :system (:system compose-el) + :check-fn check-fn :depends-on vs-urls}} (when check-fn {:systems [(:system compose-el)] #_(conj value-set-systems (:system compose-el)) @@ -206,14 +207,10 @@ (defn push-entries-to-vs-queue [queue entries entry-type] (reduce (fn [acc {:keys [vs-url depends-on system check-fn]}] - (reduce #(update-in %1 - [vs-url system %2] - conj - (case entry-type - :include check-fn - :exclude (complement check-fn))) - acc - depends-on)) + (update-in acc + [vs-url (or system ::any-system) entry-type depends-on] + conj + (or check-fn ::any-concept))) queue entries)) @@ -232,37 +229,66 @@ (first path)))) +(defn process-per-system [acc vs-url sys depends-on-vs-urls-intersection check-fns] + (let [vs-dep-sys-idx (->> depends-on-vs-urls-intersection + (map #(get-in acc [:value-set-idx % sys])) + (apply set/intersection))] + (reduce (fn [acc code] + (let [concept (get-in acc [:concepts-map sys code])] + (cond-> acc + (every? #(if (= % ::any-concept) + true + (% concept)) + check-fns) + (-> (update-in [:concepts-map sys code :valueset] + (fnil conj #{}) + vs-url) + (update-in [:value-set-idx vs-url sys] + (fnil conj #{}) + code))))) + acc + vs-dep-sys-idx))) + + +(defn process-per-selected-systems* [acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns] + (let [selected-systems (if (= ::any-system dep-system-url) + (mapcat #(keys (get-in acc [:value-set-idx %])) + depends-on-vs-urls-intersection) + [dep-system-url])] + (reduce (fn [acc sys] + (process-per-system acc vs-url sys depends-on-vs-urls-intersection check-fns)) + acc + selected-systems))) + + +(declare process-vs-nested-refs) + + +(defn process-per-selected-systems [acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns] + (let [have-transitive-deps? + (->> depends-on-vs-urls-intersection + (filter #(seq (get-in acc [:refs-queue %]))) + seq) + + acc (if have-transitive-deps? + (reduce process-vs-nested-refs + acc + depends-on-vs-urls-intersection) + acc)] + + (process-per-selected-systems* acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns))) + + (defn process-vs-nested-refs [acc vs-url] (reduce-kv - (fn [acc dep-system-url depends-valuesets-idx] - (reduce-kv - (fn [acc depends-on-vs-url check-fns] - (let [has-transitive-deps? - (seq (get-in acc [:refs-queue depends-on-vs-url])) - - acc (if has-transitive-deps? - (process-vs-nested-refs acc depends-on-vs-url) - acc) - - acc (reduce - (fn [acc sys] - (let [vs-dep-sys-idx (get-in acc [:value-set-idx depends-on-vs-url sys])] - (reduce (fn [acc code] - (let [concept (get-in acc [:concepts-map sys code])] - (cond-> acc - (every? #(% concept) check-fns) - (update-in [:concepts-map sys code :valueset] - (fnil conj #{}) - vs-url)))) - (update-in acc [:value-set-idx vs-url sys] #(into vs-dep-sys-idx %)) - vs-dep-sys-idx))) - (dissoc-in&sanitize-maps acc [:refs-queue vs-url dep-system-url depends-on-vs-url]) - (if (some? dep-system-url) - [dep-system-url] - (keys (get-in acc [:value-set-idx depends-on-vs-url]))))] - acc)) - acc - depends-valuesets-idx)) + (fn [acc dep-system-url {:keys [include exclude]}] + (reduce-kv (fn [acc depends-on-vs-urls-intersection check-fns] + (-> acc + (dissoc-in&sanitize-maps [:refs-queue vs-url dep-system-url :include depends-on-vs-urls-intersection]) + (dissoc-in&sanitize-maps [:refs-queue vs-url dep-system-url :exclude]) + (process-per-selected-systems vs-url dep-system-url depends-on-vs-urls-intersection check-fns))) + acc + include)) acc (get-in acc [:refs-queue vs-url]))) @@ -278,7 +304,7 @@ (:concepts-map res-acc))))) -(defn denormalize-into-concepts [ztx valuesets concepts-map] +(defn denormalize-into-concepts [ztx valuesets concepts-map'] (let [{:keys [concepts-map value-set-idx nested-vs-refs-queue]} @@ -304,10 +330,10 @@ acc concepts)) (-> acc - (update :nested-vs-refs-queue push-entries-to-vs-queue include-depends :exclude) - (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :include)) + (update :nested-vs-refs-queue push-entries-to-vs-queue include-depends :include) + (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :exclude)) (select-keys (:concepts-map acc) systems)))) - {:concepts-map concepts-map + {:concepts-map concepts-map' :value-set-idx {} :nested-vs-refs-queue {}} valuesets)] diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index 8a02b72..118f804 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -1,5 +1,6 @@ (ns ftr.extraction.ig.value-set-expand-test (:require [ftr.extraction.ig.value-set-expand :as sut] + [clojure.string :as str] [clojure.test :as t])) @@ -31,9 +32,29 @@ :valueset #{"vs2"}}}} {"vs1" {"sys0" #{"code0"} "sys1" #{"code1"}} - "vs2" {"sys1" #{"code2"}}} - {"vs3" {"sys1" {"vs2" [(fn [concept] (= "code2" (:code concept)))]}} - "vs2" {"sys1" {"vs1" [(constantly true)]}} - "vs4" {nil {"vs1" [(constantly true)] - "vs2" [(constantly true) - (complement (fn [concept] (= "code3" (:code concept))))]}}})))) + "vs2" {"sys1" #{"code2" "code3"}}} + (-> {} + (sut/push-entries-to-vs-queue + [{:vs-url "vs3" + :system "sys1" + :check-fn (fn [concept] (= "code2" (:code concept))) + :depends-on ["vs2"]} + {:vs-url "vs2" + :system "sys1" + :check-fn nil + :depends-on ["vs1"]} + {:vs-url "vs4" + :system nil + :check-fn nil + :depends-on ["vs1"]} + {:vs-url "vs4" + :system nil + :check-fn nil + :depends-on ["vs2"]}] + :include) + (sut/push-entries-to-vs-queue + [{:vs-url "vs4" + :system nil + :check-fn (fn [concept] (str/ends-with? (:code concept) "3")) + :depends-on ["vs2"]}] + :exclude)))))) From ff2ef142b83e11c66a4f7600a6c06caaea459df1 Mon Sep 17 00:00:00 2001 From: KGOH Date: Thu, 8 Dec 2022 12:46:51 +0200 Subject: [PATCH 08/16] Refactor vs expand reducing nested refs into concepts map --- src/ftr/extraction/ig/value_set_expand.clj | 168 +++++++++++------- .../extraction/ig/value_set_expand_test.clj | 2 +- 2 files changed, 107 insertions(+), 63 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index a42c7b3..5dd3107 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -229,84 +229,128 @@ (first path)))) -(defn process-per-system [acc vs-url sys depends-on-vs-urls-intersection check-fns] - (let [vs-dep-sys-idx (->> depends-on-vs-urls-intersection - (map #(get-in acc [:value-set-idx % sys])) - (apply set/intersection))] - (reduce (fn [acc code] - (let [concept (get-in acc [:concepts-map sys code])] - (cond-> acc - (every? #(if (= % ::any-concept) - true - (% concept)) - check-fns) - (-> (update-in [:concepts-map sys code :valueset] - (fnil conj #{}) - vs-url) - (update-in [:value-set-idx vs-url sys] - (fnil conj #{}) - code))))) - acc - vs-dep-sys-idx))) +(defn pop-entry-from-vs-queue [acc vs-url sys-url entry-type dep-vs-urls] + (dissoc-in&sanitize-maps acc [:refs-queue vs-url sys-url entry-type dep-vs-urls])) + + +(defn push-concept-into-vs-idx [vs-idx vs-url concept] + (update-in vs-idx + [vs-url (:system concept)] + (fnil conj #{}) + (:code concept))) -(defn process-per-selected-systems* [acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns] +(defn vs-selected-system-intersection->vs-idx [acc vs-url sys depends-on-vs-urls-intersection checks vs-idx concepts-map] + (if-let [codes (->> depends-on-vs-urls-intersection + (map (fn [dep-vs-url] + (set/union (get-in acc [:vs-idx-acc dep-vs-url sys]) + (get-in vs-idx [dep-vs-url sys])))) + (apply set/intersection) + not-empty)] + (if-let [check-fns (not-empty (remove #(= ::any-concept %) checks))] + (update acc :vs-idx-acc + (fn [vs-idx-acc] + (transduce (comp (map (fn [code] (get-in concepts-map [sys code]))) + (filter (fn [concept] (every? #(% concept) check-fns)))) + (completing (fn [acc concept] (push-concept-into-vs-idx acc vs-url concept))) + vs-idx-acc + codes))) + (update-in acc [:vs-idx-acc vs-url sys] #(into codes %))) + acc)) + + +(defn vs-selected-systems->vs-idx [acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns vs-idx concepts-map] (let [selected-systems (if (= ::any-system dep-system-url) - (mapcat #(keys (get-in acc [:value-set-idx %])) + (mapcat #(concat (keys (get-in acc [:vs-idx-acc %])) + (keys (get vs-idx %))) depends-on-vs-urls-intersection) [dep-system-url])] (reduce (fn [acc sys] - (process-per-system acc vs-url sys depends-on-vs-urls-intersection check-fns)) + (vs-selected-system-intersection->vs-idx acc vs-url sys depends-on-vs-urls-intersection check-fns vs-idx concepts-map)) acc selected-systems))) -(declare process-vs-nested-refs) +(declare refs-in-vs->vs-idx) -(defn process-per-selected-systems [acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns] +(defn ensure-deps-processed [acc depends-on-vs-urls-intersection vs-idx concepts-map] (let [have-transitive-deps? (->> depends-on-vs-urls-intersection (filter #(seq (get-in acc [:refs-queue %]))) - seq) - - acc (if have-transitive-deps? - (reduce process-vs-nested-refs - acc - depends-on-vs-urls-intersection) - acc)] - - (process-per-selected-systems* acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns))) - - -(defn process-vs-nested-refs [acc vs-url] - (reduce-kv - (fn [acc dep-system-url {:keys [include exclude]}] - (reduce-kv (fn [acc depends-on-vs-urls-intersection check-fns] - (-> acc - (dissoc-in&sanitize-maps [:refs-queue vs-url dep-system-url :include depends-on-vs-urls-intersection]) - (dissoc-in&sanitize-maps [:refs-queue vs-url dep-system-url :exclude]) - (process-per-selected-systems vs-url dep-system-url depends-on-vs-urls-intersection check-fns))) - acc - include)) - acc - (get-in acc [:refs-queue vs-url]))) - - -(defn process-nested-vss-refs [concepts-map value-set-idx nested-vs-refs-queue] - (loop [acc {:refs-queue nested-vs-refs-queue - :concepts-map concepts-map - :value-set-idx value-set-idx} - vs-url (ffirst nested-vs-refs-queue)] - (let [{:as res-acc, :keys [refs-queue]} (process-vs-nested-refs acc vs-url)] - (if (seq refs-queue) - (recur res-acc (ffirst refs-queue)) - (:concepts-map res-acc))))) + seq)] + + (if have-transitive-deps? + (reduce #(refs-in-vs->vs-idx %1 %2 vs-idx concepts-map) + acc + depends-on-vs-urls-intersection) + acc))) + + +(defn add-includes-into-vs-idx [acc vs-url system include concepts-map vs-idx] + (reduce-kv (fn [acc depends-on-vs-urls-intersection check-fns] + (-> acc + (pop-entry-from-vs-queue vs-url system :include depends-on-vs-urls-intersection) + (ensure-deps-processed depends-on-vs-urls-intersection vs-idx concepts-map) + (vs-selected-systems->vs-idx vs-url system depends-on-vs-urls-intersection check-fns vs-idx concepts-map))) + acc + include)) + + +(defn remove-excludes-from-vs-idx [acc vs-url system exclude concepts-map vs-idx] #_"TODO" + (reduce-kv (fn [acc exclude-url-intersection check-fn] + (-> acc + (pop-entry-from-vs-queue vs-url system :exclude exclude-url-intersection))) + acc + exclude)) + + +(defn refs-in-vs->vs-idx [acc vs-url vs-idx concepts-map] + (reduce-kv (fn [acc dep-system-url {:keys [include exclude]}] + (-> acc + (add-includes-into-vs-idx vs-url dep-system-url include concepts-map vs-idx) + (remove-excludes-from-vs-idx vs-url dep-system-url exclude concepts-map vs-idx))) + acc + (get-in acc [:refs-queue vs-url]))) + + +(defn all-vs-nested-refs->vs-idx [concepts-map vs-idx nested-vs-refs-queue] + (loop [acc {:refs-queue nested-vs-refs-queue + :vs-idx-acc {}}] + (let [res-acc (refs-in-vs->vs-idx acc (ffirst (:refs-queue acc)) vs-idx concepts-map)] + (if (seq (:refs-queue res-acc)) + (recur res-acc) + (:vs-idx-acc res-acc))))) + + +(defn push-vs-url-into-concepts-map [concepts-map system code vs-url] + (update-in concepts-map + [system code :valueset] + (fnil conj #{}) + vs-url)) + + +(defn reduce-vs-idx-into-concepts-map [concepts-map vs-idx] + (reduce-kv (fn [acc vs-url vs-cs-idx] + (reduce-kv (fn [acc sys codes] + (reduce (fn [acc code] + (push-vs-url-into-concepts-map acc sys code vs-url)) + acc + codes)) + acc + vs-cs-idx)) + concepts-map + vs-idx)) + + +(defn all-vs-nested-refs->concepts-map [concepts-map vs-idx nested-vs-refs-queue] + (let [new-vs-idx-entries (all-vs-nested-refs->vs-idx concepts-map vs-idx nested-vs-refs-queue)] + (reduce-vs-idx-into-concepts-map concepts-map new-vs-idx-entries))) (defn denormalize-into-concepts [ztx valuesets concepts-map'] (let [{:keys [concepts-map - value-set-idx + vs-idx nested-vs-refs-queue]} (reduce (fn reduce-valuesets [acc vs] @@ -323,7 +367,7 @@ (update-in [:concepts-map system concept-id :valueset] (fnil conj #{}) (:url vs)) - (update-in [:value-set-idx (:url vs) system] + (update-in [:vs-idx (:url vs) system] (fnil conj #{}) (:code concept))) acc)) @@ -334,10 +378,10 @@ (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :exclude)) (select-keys (:concepts-map acc) systems)))) {:concepts-map concepts-map' - :value-set-idx {} + :vs-idx {} :nested-vs-refs-queue {}} valuesets)] - (process-nested-vss-refs concepts-map value-set-idx nested-vs-refs-queue))) + (all-vs-nested-refs->concepts-map concepts-map vs-idx nested-vs-refs-queue))) (defn denormalize-value-sets-into-concepts [ztx] diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index 118f804..1e9ee24 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -17,7 +17,7 @@ "code3" {:code "code3" :system "sys1" :valueset #{"vs2"}}}} - (sut/process-nested-vss-refs + (sut/all-vs-nested-refs->concepts-map {"sys0" {"code0" {:code "code0" :system "sys0" :valueset #{"vs1"}}} From 2bd116f70b0a775ceb9c62ae56635aaed6055354 Mon Sep 17 00:00:00 2001 From: KGOH Date: Thu, 8 Dec 2022 17:10:29 +0200 Subject: [PATCH 09/16] Add expand vs ref queue exclude support WIP --- src/ftr/extraction/ig/value_set_expand.clj | 133 ++++++++++++++------- 1 file changed, 88 insertions(+), 45 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index 5dd3107..d6bd054 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -229,8 +229,8 @@ (first path)))) -(defn pop-entry-from-vs-queue [acc vs-url sys-url entry-type dep-vs-urls] - (dissoc-in&sanitize-maps acc [:refs-queue vs-url sys-url entry-type dep-vs-urls])) +(defn pop-entry-from-vs-queue [acc vs-url sys-url] + (dissoc-in&sanitize-maps acc [:refs-queue vs-url sys-url])) (defn push-concept-into-vs-idx [vs-idx vs-url concept] @@ -240,33 +240,49 @@ (:code concept))) -(defn vs-selected-system-intersection->vs-idx [acc vs-url sys depends-on-vs-urls-intersection checks vs-idx concepts-map] - (if-let [codes (->> depends-on-vs-urls-intersection +(defn get-acc-key [any-system? mode] + (case [any-system? mode] + [true :include] :any-sys-include-acc + [false :include] :include-acc + [true :exclude] :any-sys-exclude-acc + [false :exclude] :exclude-acc)) + + +(defn vs-selected-system-intersection->vs-idx [acc vs-url sys vs-urls checks vs-idx concepts-map & {:keys [any-system? mode]}] + (if-let [codes (->> vs-urls (map (fn [dep-vs-url] (set/union (get-in acc [:vs-idx-acc dep-vs-url sys]) (get-in vs-idx [dep-vs-url sys])))) (apply set/intersection) not-empty)] - (if-let [check-fns (not-empty (remove #(= ::any-concept %) checks))] - (update acc :vs-idx-acc - (fn [vs-idx-acc] - (transduce (comp (map (fn [code] (get-in concepts-map [sys code]))) - (filter (fn [concept] (every? #(% concept) check-fns)))) - (completing (fn [acc concept] (push-concept-into-vs-idx acc vs-url concept))) - vs-idx-acc - codes))) - (update-in acc [:vs-idx-acc vs-url sys] #(into codes %))) + (let [acc-key (get-acc-key any-system? mode)] + (if-let [check-fns (not-empty (remove #(= ::any-concept %) checks))] + (update acc acc-key + (fn [vs-idx-acc] + (transduce (comp (map (fn [code] (get-in concepts-map [sys code]))) + (filter (fn [concept] (every? #(% concept) check-fns)))) + (completing (fn [acc concept] (push-concept-into-vs-idx acc vs-url concept))) + vs-idx-acc + codes))) + (update-in acc [acc-key vs-url sys] (fnil into #{}) codes))) acc)) -(defn vs-selected-systems->vs-idx [acc vs-url dep-system-url depends-on-vs-urls-intersection check-fns vs-idx concepts-map] - (let [selected-systems (if (= ::any-system dep-system-url) - (mapcat #(concat (keys (get-in acc [:vs-idx-acc %])) - (keys (get vs-idx %))) - depends-on-vs-urls-intersection) +(defn select-all-dep-systems [vs-idx-acc vs-idx deps-vs-urls] + (mapcat #(concat (keys (get vs-idx-acc %)) + (keys (get vs-idx %))) + deps-vs-urls)) + + +(defn vs-selected-systems->mode-acc [acc vs-url dep-system-url vs-urls check-fns vs-idx concepts-map mode] + (let [any-system? (= ::any-system dep-system-url) + selected-systems (if any-system? + (select-all-dep-systems (:vs-idx-acc acc) vs-idx vs-urls) [dep-system-url])] (reduce (fn [acc sys] - (vs-selected-system-intersection->vs-idx acc vs-url sys depends-on-vs-urls-intersection check-fns vs-idx concepts-map)) + (vs-selected-system-intersection->vs-idx acc vs-url sys vs-urls check-fns vs-idx concepts-map + {:any-system? any-system? + :mode mode})) acc selected-systems))) @@ -274,42 +290,69 @@ (declare refs-in-vs->vs-idx) -(defn ensure-deps-processed [acc depends-on-vs-urls-intersection vs-idx concepts-map] - (let [have-transitive-deps? - (->> depends-on-vs-urls-intersection - (filter #(seq (get-in acc [:refs-queue %]))) - seq)] - - (if have-transitive-deps? - (reduce #(refs-in-vs->vs-idx %1 %2 vs-idx concepts-map) - acc - depends-on-vs-urls-intersection) - acc))) +(defn ensure-deps-processed [acc vs-urls vs-idx concepts-map] + (transduce (filter #(seq (get-in acc [:refs-queue %]))) + (completing #(refs-in-vs->vs-idx %1 %2 vs-idx concepts-map)) + acc + vs-urls)) -(defn add-includes-into-vs-idx [acc vs-url system include concepts-map vs-idx] - (reduce-kv (fn [acc depends-on-vs-urls-intersection check-fns] - (-> acc - (pop-entry-from-vs-queue vs-url system :include depends-on-vs-urls-intersection) - (ensure-deps-processed depends-on-vs-urls-intersection vs-idx concepts-map) - (vs-selected-systems->vs-idx vs-url system depends-on-vs-urls-intersection check-fns vs-idx concepts-map))) +(defn collect-mode-acc [acc vs-url system include concepts-map vs-idx mode] + (reduce-kv (fn [acc vs-urls check-fns] + (vs-selected-systems->mode-acc acc vs-url system vs-urls check-fns vs-idx concepts-map mode)) acc include)) -(defn remove-excludes-from-vs-idx [acc vs-url system exclude concepts-map vs-idx] #_"TODO" - (reduce-kv (fn [acc exclude-url-intersection check-fn] - (-> acc - (pop-entry-from-vs-queue vs-url system :exclude exclude-url-intersection))) - acc - exclude)) +(defn push-include-exclude->vs-idx [acc vs-url dep-system-url concepts-map vs-idx] + (let [any-system? (= ::any-system dep-system-url) + incl-acc-key (get-acc-key any-system? :include) + excl-acc-key (get-acc-key any-system? :exclude) + vs-sys-idx-acc (get-in acc [:vs-idx-acc vs-url]) + exclude-idx (get-in acc [excl-acc-key vs-url]) + exclude-filter (when (seq exclude-idx) + (fn [system code] + (not (get-in exclude-idx [system code])))) + + new-vs-sys-idx + (if any-system? + (if exclude-filter + (reduce-kv (fn [acc sys concepts] + (update acc sys (fn [idx-concepts] + (into (or idx-concepts #{}) + (filter #(exclude-filter sys %)) + concepts)))) + vs-sys-idx-acc + (get-in acc [incl-acc-key vs-url])) + (merge-with #(if (some? %1) + (into %1 %2) + %2) + vs-sys-idx-acc + (get-in acc [incl-acc-key vs-url]))) + (update vs-sys-idx-acc + dep-system-url + (if exclude-filter + (fn [idx-concepts new-concepts] + (into (or idx-concepts #{}) + (filter #(exclude-filter dep-system-url %)) + new-concepts)) + #(if (some? %1) + (into %1 %2) + %2)) + (get-in acc [incl-acc-key vs-url dep-system-url])))] + (assoc-in acc [:vs-idx-acc vs-url] new-vs-sys-idx))) (defn refs-in-vs->vs-idx [acc vs-url vs-idx concepts-map] (reduce-kv (fn [acc dep-system-url {:keys [include exclude]}] - (-> acc - (add-includes-into-vs-idx vs-url dep-system-url include concepts-map vs-idx) - (remove-excludes-from-vs-idx vs-url dep-system-url exclude concepts-map vs-idx))) + (let [deps (distinct (concat (keys include) (keys exclude))) + acc (-> acc + (pop-entry-from-vs-queue vs-url dep-system-url) + (ensure-deps-processed deps vs-idx concepts-map) + (collect-mode-acc vs-url dep-system-url include concepts-map vs-idx :include) + (collect-mode-acc vs-url dep-system-url exclude concepts-map vs-idx :exclude) + (push-include-exclude->vs-idx vs-url dep-system-url concepts-map vs-idx))] + acc)) acc (get-in acc [:refs-queue vs-url]))) From 85065b46f54139c2d216c660f68aa27c24f446bb Mon Sep 17 00:00:00 2001 From: KGOH Date: Wed, 14 Dec 2022 18:03:01 +0200 Subject: [PATCH 10/16] Refactor expansion to do fn compile and deps collect first --- src/ftr/extraction/ig/value_set_expand.clj | 405 ++++++++---------- .../extraction/ig/value_set_expand_test.clj | 54 +-- test/ftr/zen_package_test.clj | 32 +- 3 files changed, 200 insertions(+), 291 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index d6bd054..602ff12 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -89,148 +89,117 @@ (declare compose) -(defn vs-compose-value-set-fn [ztx value-set value-set-urls] - (when-let [composes - (some->> value-set-urls - (keep #(when-let [vs (get-in @ztx [:fhir/inter "ValueSet" %])] - (compose ztx vs))) - not-empty)] - (when-let [check-fn - (some->> composes - (keep :check-concept-fn) - not-empty - (apply every-pred))] - {:systems (mapcat :systems composes) - :check-fn check-fn}))) - - -(defn check-if-concept-is-in-this-compose-el-fn [ztx value-set compose-el] - (let [code-system-pred (or (vs-compose-concept-fn ztx value-set - (:system compose-el) - (:version compose-el) - (:concept compose-el)) - (vs-compose-filter-fn ztx value-set - (:system compose-el) - (:version compose-el) - (:filter compose-el)) - (vs-compose-system-fn ztx value-set - (:system compose-el) - (:version compose-el))) - - #_{value-set-systems :systems, value-set-pred :check-fn} - #_(vs-compose-value-set-fn ztx value-set (:valueSet compose-el)) - - check-fn code-system-pred - #_(some->> [code-system-pred value-set-pred] - (remove nil?) - not-empty - (apply every-pred))] - (if-let [vs-urls (:valueSet compose-el)] - {:value-set-queue-entry {:vs-url (:url value-set) - :system (:system compose-el) - :check-fn check-fn - :depends-on vs-urls}} - (when check-fn - {:systems [(:system compose-el)] #_(conj value-set-systems (:system compose-el)) - :check-fn check-fn})))) - - -(defn update-fhir-vs-expansion-index [ztx vs concept-identity-keys] #_"TODO: support recursive expansion :contains" - (let [expansion-contains (get-in vs [:expansion :contains]) - full-expansion? (and (= (count expansion-contains) (get-in vs [:expansion :total])) - (empty? (get-in vs [:expansion :parameter]))) - #_#_concepts (into #{} (map #(select-keys % concept-identity-keys)) expansion-contains) - - concepts-index (reduce (fn [acc concept] - (assoc! acc (:system concept) - (if-let [sys-idx (get acc (:system concept))] - (conj! sys-idx (:code concept)) - (transient #{(:code concept)})))) - (transient {}) - expansion-contains)] - (swap! ztx assoc-in [:fhir/vs-expansion-index (:url vs)] {#_#_:concepts concepts - :concepts-transient-index concepts-index - :full? full-expansion?}))) +(defn check-concept-in-compose-el-fn [ztx value-set compose-el] + (let [code-system-pred + (or (vs-compose-concept-fn ztx value-set + (:system compose-el) + (:version compose-el) + (:concept compose-el)) + (vs-compose-filter-fn ztx value-set + (:system compose-el) + (:version compose-el) + (:filter compose-el)) + (vs-compose-system-fn ztx value-set + (:system compose-el) + (:version compose-el)))] + (some-> {:check-fn code-system-pred + :system (:system compose-el) + :depends-on (:valueSet compose-el)} + zen.utils/strip-nils + not-empty + (assoc :vs-url (:url value-set))))) + + +(defn vs-expansion-index [ztx vs] #_"TODO: support recursive expansion :contains" + (when (and (get-in vs [:expansion :contains]) + (not (get-in @ztx [:fhir/vs-expansion-index (:url vs)]))) + (let [expansion-contains (get-in vs [:expansion :contains]) + full-expansion? (and (= (count expansion-contains) (get-in vs [:expansion :total])) + (empty? (get-in vs [:expansion :parameter]))) + concepts-index (persistent! + (reduce (fn [acc concept] + (assoc! acc (:system concept) + (if-let [sys-idx (get acc (:system concept))] + (conj sys-idx (:code concept)) + #{(:code concept)}))) + (transient {}) + expansion-contains))] + group-by + {:concepts-index concepts-index + :full? full-expansion?}))) (defn compose [ztx vs] - (let [concept-identity-keys [:code :system] - _ (when (and (get-in vs [:expansion :contains]) - (not (get-in @ztx [:fhir/vs-expansion-index (:url vs)]))) - (update-fhir-vs-expansion-index ztx vs concept-identity-keys)) - vs-url (:url vs) - full-expansion? (get-in @ztx [:fhir/vs-expansion-index vs-url :full?]) - vs-concepts-index (-> @ztx - (get :fhir/vs-expansion-index) - (get vs-url) - (get :concepts-transient-index)) - expansion-fn (fn expansion-fn [{concept :zen.fhir/resource}] - (-> vs-concepts-index (get (:system concept)) (get (:code concept)))) - includes (some->> (get-in vs [:compose :include]) - (keep (partial check-if-concept-is-in-this-compose-el-fn ztx vs)) - not-empty) - include-depends (keep :value-set-queue-entry includes) - include-fn (or (some->> includes - (keep :check-fn) - not-empty - (apply some-fn)) - (constantly false)) - - excludes (some->> (get-in vs [:compose :exclude]) - (keep (partial check-if-concept-is-in-this-compose-el-fn ztx vs)) - not-empty) - exclude-depends (keep :value-set-queue-entry excludes) - exclude-fn (or (some->> excludes - (keep :check-fn) - not-empty - (apply some-fn) - complement) - (constantly true)) - - include-and-exclude-fn (every-pred include-fn exclude-fn) - - check-concept-fn (if full-expansion? - expansion-fn - (some-fn expansion-fn include-and-exclude-fn)) - - includes-and-excludes (concat includes excludes) - - systems (into #{} - (mapcat (comp not-empty :systems)) - includes-and-excludes)] - {:systems (not-empty systems) - :include-depends include-depends - :exclude-depends exclude-depends - :check-concept-fn check-concept-fn})) - - -(defn push-entries-to-vs-queue [queue entries entry-type] - (reduce - (fn [acc {:keys [vs-url depends-on system check-fn]}] - (update-in acc - [vs-url (or system ::any-system) entry-type depends-on] - conj - (or check-fn ::any-concept))) - queue - entries)) - - -(defn dissoc-in&sanitize-maps [m path] #_"TODO: refactor" - (assert (not= 0 (count path)) "Can't dissoc-in from empty path") - - (not-empty (zen.utils/dissoc-when - empty? - (reduce (fn [m-acc path] - (update-in m-acc (butlast path) #(zen.utils/dissoc-when empty? % (last path)))) - (cond-> m - (< 1 (count path)) - (update-in (butlast path) dissoc (last path))) - (take-while #(< 1 (count %)) (iterate butlast path))) - (first path)))) - - -(defn pop-entry-from-vs-queue [acc vs-url sys-url] - (dissoc-in&sanitize-maps acc [:refs-queue vs-url sys-url])) + (let [{full-expansion? :full? + vs-concepts-index :concepts-index} + (vs-expansion-index ztx vs) + + includes (some->> (get-in vs [:compose :include]) + (keep (partial check-concept-in-compose-el-fn ztx vs)) + not-empty) + + excludes (some->> (get-in vs [:compose :exclude]) + (keep (partial check-concept-in-compose-el-fn ztx vs)) + not-empty) + + #_#_systems (into #{} + (mapcat (comp not-empty :system)) + (concat includes excludes))] + + {#_#_:systems (not-empty systems) + :vs-url (:url vs) + :full-expansion? full-expansion? + :expansion-index vs-concepts-index + :includes includes + :excludes excludes})) + + +(defn push-compose-el-to-vs-queue [vs-queue el-type {:keys [depends-on system check-fn]}] + (let [has-dependencies? (seq depends-on) + allow-any-concept? (nil? check-fn) + has-concept-check? (some? check-fn) + any-system? (nil? system) + depends-on (vec depends-on) + + _ (assert (or has-concept-check? has-dependencies?) + "check fn may be missing only when depending on another value set") + _ (assert (or (not any-system?) has-dependencies?) + "system may be missing only when depending on another value set") + + queue-path (concat [el-type] + (if any-system? + [:any-system] + [:systems system]) + (if allow-any-concept? + [depends-on :allow-any-concept] + [depends-on :pred-fns]))] + (cond-> vs-queue + allow-any-concept? + (assoc-in queue-path true) + + has-concept-check? + (update-in queue-path conj check-fn) + + has-dependencies? + (update :deps (fnil into #{}) depends-on)))) + + +(defn push-compose-els-to-vs-queue [vs-queue el-type els] + (reduce #(push-compose-el-to-vs-queue %1 el-type %2) + vs-queue + els)) + + +(defn push-entries-to-vs-queue [vs-queue {:keys [full-expansion? expansion-index includes excludes]}] + (-> vs-queue + (push-compose-els-to-vs-queue :include includes) + (push-compose-els-to-vs-queue :exclude excludes) + (zen.utils/assoc-some :full-expansion? full-expansion? + :expansion-index expansion-index))) + + +(defn pop-entry-from-vs-queue [acc vs-url] + (update acc :vs-queue dissoc vs-url)) (defn push-concept-into-vs-idx [vs-idx vs-url concept] @@ -248,39 +217,50 @@ [false :exclude] :exclude-acc)) -(defn vs-selected-system-intersection->vs-idx [acc vs-url sys vs-urls checks vs-idx concepts-map & {:keys [any-system? mode]}] - (if-let [codes (->> vs-urls - (map (fn [dep-vs-url] - (set/union (get-in acc [:vs-idx-acc dep-vs-url sys]) - (get-in vs-idx [dep-vs-url sys])))) +(defn vs-selected-system-intersection->vs-idx [acc concepts-map vs-url sys vs-urls checks & {:keys [any-system? mode]}] + (if-let [concepts + (cond + (seq vs-urls) + (some->> vs-urls + (keep (fn [dep-vs-url] + (get-in acc [:vs-idx-acc dep-vs-url sys]))) + seq (apply set/intersection) - not-empty)] + (map (fn [code] [code (get-in concepts-map [sys code])])) + (into {})) + + sys + (get concepts-map sys) + + :else + (throw (ex-info "ValueSet or system should be present" {:vs-url vs-url, :sys sys, :deps vs-urls})))] (let [acc-key (get-acc-key any-system? mode)] - (if-let [check-fns (not-empty (remove #(= ::any-concept %) checks))] + (if-let [check-fns (seq (:pred-fns checks))] (update acc acc-key (fn [vs-idx-acc] - (transduce (comp (map (fn [code] (get-in concepts-map [sys code]))) - (filter (fn [concept] (every? #(% concept) check-fns)))) - (completing (fn [acc concept] (push-concept-into-vs-idx acc vs-url concept))) + (transduce (filter (fn [[_concept-id concept]] (every? #(% concept) check-fns))) + (completing (fn [acc [_concept-id concept]] (push-concept-into-vs-idx acc vs-url concept))) vs-idx-acc - codes))) - (update-in acc [acc-key vs-url sys] (fnil into #{}) codes))) + concepts))) + (if (:allow-any-concept checks) + (update-in acc [acc-key vs-url sys] (fnil into #{}) (keys concepts)) + (throw (ex-info "must be either predicate fn or whole system allow" + {:vs-url vs-url, :sys sys, :deps vs-urls}))))) acc)) -(defn select-all-dep-systems [vs-idx-acc vs-idx deps-vs-urls] - (mapcat #(concat (keys (get vs-idx-acc %)) - (keys (get vs-idx %))) +(defn select-all-dep-systems [vs-idx-acc deps-vs-urls] + (mapcat #(keys (get vs-idx-acc %)) deps-vs-urls)) -(defn vs-selected-systems->mode-acc [acc vs-url dep-system-url vs-urls check-fns vs-idx concepts-map mode] +(defn vs-selected-systems->mode-acc [acc concepts-map vs-url dep-system-url vs-urls checks mode] (let [any-system? (= ::any-system dep-system-url) selected-systems (if any-system? - (select-all-dep-systems (:vs-idx-acc acc) vs-idx vs-urls) + (select-all-dep-systems (:vs-idx-acc acc) vs-urls) [dep-system-url])] (reduce (fn [acc sys] - (vs-selected-system-intersection->vs-idx acc vs-url sys vs-urls check-fns vs-idx concepts-map + (vs-selected-system-intersection->vs-idx acc concepts-map vs-url sys vs-urls checks {:any-system? any-system? :mode mode})) acc @@ -290,29 +270,29 @@ (declare refs-in-vs->vs-idx) -(defn ensure-deps-processed [acc vs-urls vs-idx concepts-map] - (transduce (filter #(seq (get-in acc [:refs-queue %]))) - (completing #(refs-in-vs->vs-idx %1 %2 vs-idx concepts-map)) +(defn ensure-deps-processed [acc concepts-map vs-urls] + (transduce (filter #(seq (get-in acc [:vs-queue %]))) + (completing #(refs-in-vs->vs-idx %1 concepts-map %2)) acc vs-urls)) -(defn collect-mode-acc [acc vs-url system include concepts-map vs-idx mode] - (reduce-kv (fn [acc vs-urls check-fns] - (vs-selected-systems->mode-acc acc vs-url system vs-urls check-fns vs-idx concepts-map mode)) +(defn collect-mode-acc [acc concepts-map vs-url system compose-els mode] + (reduce-kv (fn [acc vs-urls checks] + (vs-selected-systems->mode-acc acc concepts-map vs-url system vs-urls checks mode)) acc - include)) + compose-els)) -(defn push-include-exclude->vs-idx [acc vs-url dep-system-url concepts-map vs-idx] +(defn push-include-exclude->vs-idx [acc vs-url dep-system-url] (let [any-system? (= ::any-system dep-system-url) incl-acc-key (get-acc-key any-system? :include) - excl-acc-key (get-acc-key any-system? :exclude) + #_#_excl-acc-key (get-acc-key any-system? :exclude) vs-sys-idx-acc (get-in acc [:vs-idx-acc vs-url]) - exclude-idx (get-in acc [excl-acc-key vs-url]) - exclude-filter (when (seq exclude-idx) - (fn [system code] - (not (get-in exclude-idx [system code])))) + #_#_exclude-idx (get-in acc [excl-acc-key vs-url]) + exclude-filter nil #_(when (seq exclude-idx) + (fn [system code] + (not (get-in exclude-idx [system code])))) new-vs-sys-idx (if any-system? @@ -343,25 +323,32 @@ (assoc-in acc [:vs-idx-acc vs-url] new-vs-sys-idx))) -(defn refs-in-vs->vs-idx [acc vs-url vs-idx concepts-map] - (reduce-kv (fn [acc dep-system-url {:keys [include exclude]}] - (let [deps (distinct (concat (keys include) (keys exclude))) - acc (-> acc - (pop-entry-from-vs-queue vs-url dep-system-url) - (ensure-deps-processed deps vs-idx concepts-map) - (collect-mode-acc vs-url dep-system-url include concepts-map vs-idx :include) - (collect-mode-acc vs-url dep-system-url exclude concepts-map vs-idx :exclude) - (push-include-exclude->vs-idx vs-url dep-system-url concepts-map vs-idx))] - acc)) - acc - (get-in acc [:refs-queue vs-url]))) +(defn refs-in-vs->vs-idx [acc concepts-map vs-url] + (let [{:keys [deps include exclude full-expansion? expansion-index]} (get-in acc [:vs-queue vs-url]) + + acc (-> acc + (pop-entry-from-vs-queue vs-url) + (ensure-deps-processed concepts-map deps))] + (if full-expansion? + (update-in acc [:vs-idx-acc vs-url] #(merge-with into % expansion-index)) + (let [acc (reduce-kv (fn [acc dep-system-url include] + (-> acc + (collect-mode-acc concepts-map vs-url dep-system-url include :include) + (push-include-exclude->vs-idx vs-url dep-system-url))) + acc + (:systems include)) + + acc (-> acc + (collect-mode-acc concepts-map vs-url ::any-system (:any-system include) :include) + (push-include-exclude->vs-idx vs-url ::any-system))] + acc)))) -(defn all-vs-nested-refs->vs-idx [concepts-map vs-idx nested-vs-refs-queue] - (loop [acc {:refs-queue nested-vs-refs-queue +(defn all-vs-nested-refs->vs-idx [concepts-map nested-vs-refs-queue] + (loop [acc {:vs-queue nested-vs-refs-queue :vs-idx-acc {}}] - (let [res-acc (refs-in-vs->vs-idx acc (ffirst (:refs-queue acc)) vs-idx concepts-map)] - (if (seq (:refs-queue res-acc)) + (let [res-acc (refs-in-vs->vs-idx acc concepts-map (ffirst (:vs-queue acc)))] + (if (seq (:vs-queue res-acc)) (recur res-acc) (:vs-idx-acc res-acc))))) @@ -386,45 +373,19 @@ vs-idx)) -(defn all-vs-nested-refs->concepts-map [concepts-map vs-idx nested-vs-refs-queue] - (let [new-vs-idx-entries (all-vs-nested-refs->vs-idx concepts-map vs-idx nested-vs-refs-queue)] +(defn all-vs-nested-refs->concepts-map [concepts-map nested-vs-refs-queue] + (let [new-vs-idx-entries (all-vs-nested-refs->vs-idx concepts-map nested-vs-refs-queue)] (reduce-vs-idx-into-concepts-map concepts-map new-vs-idx-entries))) -(defn denormalize-into-concepts [ztx valuesets concepts-map'] - (let [{:keys [concepts-map - vs-idx - nested-vs-refs-queue]} - (reduce - (fn reduce-valuesets [acc vs] - (let [{systems :systems - concept-in-vs? :check-concept-fn - :keys [include-depends exclude-depends]} - (compose ztx vs)] - (reduce - (fn reduce-codesystems [acc [system concepts]] - (reduce - (fn reduce-concepts [acc [concept-id concept]] - (if (concept-in-vs? concept) - (-> acc - (update-in [:concepts-map system concept-id :valueset] - (fnil conj #{}) - (:url vs)) - (update-in [:vs-idx (:url vs) system] - (fnil conj #{}) - (:code concept))) - acc)) - acc - concepts)) - (-> acc - (update :nested-vs-refs-queue push-entries-to-vs-queue include-depends :include) - (update :nested-vs-refs-queue push-entries-to-vs-queue exclude-depends :exclude)) - (select-keys (:concepts-map acc) systems)))) - {:concepts-map concepts-map' - :vs-idx {} - :nested-vs-refs-queue {}} - valuesets)] - (all-vs-nested-refs->concepts-map concepts-map vs-idx nested-vs-refs-queue))) +(defn denormalize-into-concepts [ztx valuesets concepts-map] + (let [nested-vs-refs-queue (transduce + (map #(compose ztx %)) + (completing (fn [queue {:as vs-comp-res :keys [vs-url]}] + (update queue vs-url push-entries-to-vs-queue vs-comp-res))) + {} + valuesets)] + (all-vs-nested-refs->concepts-map concepts-map nested-vs-refs-queue))) (defn denormalize-value-sets-into-concepts [ztx] diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index 1e9ee24..8fe80bf 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -5,56 +5,4 @@ (t/deftest nested-vs-refs-process-test - (t/is (= {"sys0" {"code0" {:code "code0" - :system "sys0" - :valueset #{"vs1" "vs4"}}} - "sys1" {"code1" {:code "code1" - :system "sys1" - :valueset #{"vs1" "vs2" "vs4"}} - "code2" {:code "code2" - :system "sys1" - :valueset #{"vs2" "vs4" "vs3"}} - "code3" {:code "code3" - :system "sys1" - :valueset #{"vs2"}}}} - (sut/all-vs-nested-refs->concepts-map - {"sys0" {"code0" {:code "code0" - :system "sys0" - :valueset #{"vs1"}}} - "sys1" {"code1" {:code "code1" - :system "sys1" - :valueset #{"vs1"}} - "code2" {:code "code2" - :system "sys1" - :valueset #{"vs2"}} - "code3" {:code "code3" - :system "sys1" - :valueset #{"vs2"}}}} - {"vs1" {"sys0" #{"code0"} - "sys1" #{"code1"}} - "vs2" {"sys1" #{"code2" "code3"}}} - (-> {} - (sut/push-entries-to-vs-queue - [{:vs-url "vs3" - :system "sys1" - :check-fn (fn [concept] (= "code2" (:code concept))) - :depends-on ["vs2"]} - {:vs-url "vs2" - :system "sys1" - :check-fn nil - :depends-on ["vs1"]} - {:vs-url "vs4" - :system nil - :check-fn nil - :depends-on ["vs1"]} - {:vs-url "vs4" - :system nil - :check-fn nil - :depends-on ["vs2"]}] - :include) - (sut/push-entries-to-vs-queue - [{:vs-url "vs4" - :system nil - :check-fn (fn [concept] (str/ends-with? (:code concept) "3")) - :depends-on ["vs2"]}] - :exclude)))))) + ) diff --git a/test/ftr/zen_package_test.clj b/test/ftr/zen_package_test.clj index 886b58d..97a8167 100644 --- a/test/ftr/zen_package_test.clj +++ b/test/ftr/zen_package_test.clj @@ -456,22 +456,22 @@ (t/testing "built ftr shape is ok" (matcho/match - (test-utils/fs-tree->tree-map profile-lib-path) - {"ftr" - {"ig" - {"tags" {"v1.ndjson.gz" {}} - "vs" {"gender2-cs-entire-code-system" nil - "gender2-vs" {} - "gender3-cs-entire-code-system" nil - "gender3-vs" nil - "gender4-cs-entire-code-system" {} - "gender4-vs" nil - "gender5-cs-entire-code-system" {} - "gender5-vs" nil - "gender6-cs-entire-code-system" nil - "gender6-vs" {} - #_#_"gender7-cs-entire-code-system" nil - #_#_"gender7-vs" {}}}}}))) + (get (test-utils/fs-tree->tree-map profile-lib-path) + "ftr") + {"ig" + {"tags" {"v1.ndjson.gz" {}} + "vs" {"gender2-cs-entire-code-system" nil + "gender2-vs" {} + "gender3-cs-entire-code-system" nil + "gender3-vs" nil + "gender4-cs-entire-code-system" {} + "gender4-vs" nil + "gender5-cs-entire-code-system" {} + "gender5-vs" nil + "gender6-cs-entire-code-system" nil + "gender6-vs" {} + #_#_"gender7-cs-entire-code-system" nil + #_#_"gender7-vs" {}}}}))) (defn test-concept-vs-backrefs [root-path] From f7d26b872740692d1aad5ff39ac1bbaaab076e6d Mon Sep 17 00:00:00 2001 From: KGOH Date: Thu, 15 Dec 2022 18:05:52 +0200 Subject: [PATCH 11/16] Add expansion tests & add support of not full expansion Co-authored-by: @islambegkatibov <79331750+islambegk@users.noreply.github.com> --- src/ftr/extraction/ig/value_set_expand.clj | 131 +++++++------ .../extraction/ig/value_set_expand_test.clj | 181 +++++++++++++++++- test/ftr/zen_package_test.clj | 6 +- 3 files changed, 252 insertions(+), 66 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index 602ff12..d8f11b0 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -5,13 +5,7 @@ [clojure.string :as str])) -(defn vs-compose-system-fn [ztx value-set system version] - (when (some? system) - (fn vs-compose-system [concept] - (= system (:system concept))))) - - -(defn vs-compose-concept-fn [ztx value-set system version concepts] +(defn vs-compose-concept-fn [value-set system version concepts] (when (seq concepts) (let [concept-codes (into #{} (map :code) concepts)] (fn vs-compose-concept [concept] @@ -20,66 +14,66 @@ (defmulti filter-op - (fn [_ztx _value-set _system _version filter] + (fn [_value-set _system _version filter] (:op filter))) -(defmethod filter-op :default [_ztx _value-set _system _version _filter] +(defmethod filter-op :default [_value-set _system _version _filter] (constantly false)) -(defmethod filter-op "=" [_ztx _value-set _system _version filter] +(defmethod filter-op "=" [_value-set _system _version filter] (fn eq-op [concept] (= (get (:property concept) (:property filter)) (:value filter)))) -(defmethod filter-op "in" [_ztx _value-set _system _version filter] +(defmethod filter-op "in" [_value-set _system _version filter] (fn in-op [concept] (get (into #{} (map str/trim) (str/split (or (:value filter) "") #",")) (get (:property concept) (:property filter))))) -(defmethod filter-op "not-in" [_ztx _value-set _system _version filter] +(defmethod filter-op "not-in" [_value-set _system _version filter] (fn not-in-op [concept] (not (get (into #{} (map str/trim) (str/split (or (:value filter) "") #",")) (get (:property concept) (:property filter)))))) -(defmethod filter-op "exists" [_ztx _value-set _system _version filter] +(defmethod filter-op "exists" [_value-set _system _version filter] (if (= "false" (some-> (:value filter) str/lower-case str/trim)) (fn not-exists-op [concept] (nil? (get (:property concept) (:property filter)))) (fn exists-op [concept] (some? (get (:property concept) (:property filter)))))) -(defmethod filter-op "is-a" [_ztx _value-set _system _version filter] +(defmethod filter-op "is-a" [_value-set _system _version filter] (fn is-a-op [concept] (or (= (:code concept) (:value filter)) (contains? (:zen.fhir/parents concept) (:value filter))))) -(defmethod filter-op "descendent-of" [_ztx _value-set _system _version filter] +(defmethod filter-op "descendent-of" [_value-set _system _version filter] (fn descendatnd-of-op [concept] (contains? (set (:hierarchy concept)) (:value filter)))) -(defmethod filter-op "is-not-a" [_ztx _value-set _system _version filter] +(defmethod filter-op "is-not-a" [_value-set _system _version filter] (fn is-not-a-op [concept] ;; TODO: not sure this is correct impl by spec (and (not (contains? (set (:hierarchy concept)) (:value filter))) (not= (:code concept) (:value filter))))) -(defmethod filter-op "regex" [_ztx _value-set _system _version filter] +(defmethod filter-op "regex" [_value-set _system _version filter] (fn regex-op [concept] (when-let [prop (get (:property concept) (:property filter))] (re-matches (re-pattern (:value filter)) (str prop))))) -(defn vs-compose-filter-fn [ztx value-set system version filters] +(defn vs-compose-filter-fn [value-set system version filters] (when (seq filters) (let [filter-fn (->> filters - (map #(filter-op ztx value-set system version %)) + (map #(filter-op value-set system version %)) (apply every-pred))] (fn compose-filter [concept] (and (= system (:system concept)) @@ -89,19 +83,16 @@ (declare compose) -(defn check-concept-in-compose-el-fn [ztx value-set compose-el] +(defn check-concept-in-compose-el-fn [value-set compose-el] (let [code-system-pred - (or (vs-compose-concept-fn ztx value-set + (or (vs-compose-concept-fn value-set (:system compose-el) (:version compose-el) (:concept compose-el)) - (vs-compose-filter-fn ztx value-set + (vs-compose-filter-fn value-set (:system compose-el) (:version compose-el) - (:filter compose-el)) - (vs-compose-system-fn ztx value-set - (:system compose-el) - (:version compose-el)))] + (:filter compose-el)))] (some-> {:check-fn code-system-pred :system (:system compose-el) :depends-on (:valueSet compose-el)} @@ -110,9 +101,8 @@ (assoc :vs-url (:url value-set))))) -(defn vs-expansion-index [ztx vs] #_"TODO: support recursive expansion :contains" - (when (and (get-in vs [:expansion :contains]) - (not (get-in @ztx [:fhir/vs-expansion-index (:url vs)]))) +(defn vs-expansion-index [vs] #_"TODO: support recursive expansion :contains" + (when (get-in vs [:expansion :contains]) (let [expansion-contains (get-in vs [:expansion :contains]) full-expansion? (and (= (count expansion-contains) (get-in vs [:expansion :total])) (empty? (get-in vs [:expansion :parameter]))) @@ -124,22 +114,21 @@ #{(:code concept)}))) (transient {}) expansion-contains))] - group-by {:concepts-index concepts-index :full? full-expansion?}))) -(defn compose [ztx vs] +(defn compose [vs] (let [{full-expansion? :full? vs-concepts-index :concepts-index} - (vs-expansion-index ztx vs) + (vs-expansion-index vs) includes (some->> (get-in vs [:compose :include]) - (keep (partial check-concept-in-compose-el-fn ztx vs)) + (keep (partial check-concept-in-compose-el-fn vs)) not-empty) excludes (some->> (get-in vs [:compose :exclude]) - (keep (partial check-concept-in-compose-el-fn ztx vs)) + (keep (partial check-concept-in-compose-el-fn vs)) not-empty) #_#_systems (into #{} @@ -161,8 +150,9 @@ any-system? (nil? system) depends-on (vec depends-on) - _ (assert (or has-concept-check? has-dependencies?) - "check fn may be missing only when depending on another value set") + _ (when (not has-concept-check?) + (assert (or (some? system) has-dependencies?) + "check fn may be missing only when depending on another value set or there's a system")) _ (assert (or (not any-system?) has-dependencies?) "system may be missing only when depending on another value set") @@ -217,6 +207,12 @@ [false :exclude] :exclude-acc)) +(defn update-if-some-result [m k f & args] + (if-let [result (apply f (get m k) args)] + (assoc m k result) + m)) + + (defn vs-selected-system-intersection->vs-idx [acc concepts-map vs-url sys vs-urls checks & {:keys [any-system? mode]}] (if-let [concepts (cond @@ -238,8 +234,10 @@ (if-let [check-fns (seq (:pred-fns checks))] (update acc acc-key (fn [vs-idx-acc] - (transduce (filter (fn [[_concept-id concept]] (every? #(% concept) check-fns))) - (completing (fn [acc [_concept-id concept]] (push-concept-into-vs-idx acc vs-url concept))) + (transduce (filter (fn [[concept-code concept]] (and #_(not-any? #(% concept) exclude-check-fns) + (or (get-in acc [:vs-idx-acc vs-url concept-code]) + (some #(% concept) check-fns))))) + (completing (fn [acc [_concept-code concept]] (push-concept-into-vs-idx acc vs-url concept))) vs-idx-acc concepts))) (if (:allow-any-concept checks) @@ -309,18 +307,21 @@ %2) vs-sys-idx-acc (get-in acc [incl-acc-key vs-url]))) - (update vs-sys-idx-acc - dep-system-url - (if exclude-filter - (fn [idx-concepts new-concepts] - (into (or idx-concepts #{}) - (filter #(exclude-filter dep-system-url %)) - new-concepts)) - #(if (some? %1) - (into %1 %2) - %2)) - (get-in acc [incl-acc-key vs-url dep-system-url])))] - (assoc-in acc [:vs-idx-acc vs-url] new-vs-sys-idx))) + (update-if-some-result + vs-sys-idx-acc + dep-system-url + (if exclude-filter + (fn [idx-concepts new-concepts] + (into (or idx-concepts #{}) + (filter #(exclude-filter dep-system-url %)) + new-concepts)) + #(if (some? %1) + (into %1 %2) + %2)) + (get-in acc [incl-acc-key vs-url dep-system-url])))] + (cond-> acc + (some? new-vs-sys-idx) + (assoc-in [:vs-idx-acc vs-url] new-vs-sys-idx)))) (defn refs-in-vs->vs-idx [acc concepts-map vs-url] @@ -331,7 +332,11 @@ (ensure-deps-processed concepts-map deps))] (if full-expansion? (update-in acc [:vs-idx-acc vs-url] #(merge-with into % expansion-index)) - (let [acc (reduce-kv (fn [acc dep-system-url include] + (let [acc (cond-> acc + (seq expansion-index) + (update-in [:vs-idx-acc vs-url] #(merge-with into % expansion-index))) + + acc (reduce-kv (fn [acc dep-system-url include] (-> acc (collect-mode-acc concepts-map vs-url dep-system-url include :include) (push-include-exclude->vs-idx vs-url dep-system-url))) @@ -373,22 +378,22 @@ vs-idx)) -(defn all-vs-nested-refs->concepts-map [concepts-map nested-vs-refs-queue] - (let [new-vs-idx-entries (all-vs-nested-refs->vs-idx concepts-map nested-vs-refs-queue)] - (reduce-vs-idx-into-concepts-map concepts-map new-vs-idx-entries))) +(defn build-valuesets-compose-idx [valuesets] + (transduce + (map compose) + (completing (fn [queue {:as vs-comp-res :keys [vs-url]}] + (update queue vs-url push-entries-to-vs-queue vs-comp-res))) + {} + valuesets)) -(defn denormalize-into-concepts [ztx valuesets concepts-map] - (let [nested-vs-refs-queue (transduce - (map #(compose ztx %)) - (completing (fn [queue {:as vs-comp-res :keys [vs-url]}] - (update queue vs-url push-entries-to-vs-queue vs-comp-res))) - {} - valuesets)] - (all-vs-nested-refs->concepts-map concepts-map nested-vs-refs-queue))) +(defn denormalize-into-concepts [valuesets concepts-map] + (let [nested-vs-refs-queue (build-valuesets-compose-idx valuesets) + new-vs-idx-entries (all-vs-nested-refs->vs-idx concepts-map nested-vs-refs-queue)] + (reduce-vs-idx-into-concepts-map concepts-map new-vs-idx-entries))) (defn denormalize-value-sets-into-concepts [ztx] (swap! ztx update-in [:fhir/inter "Concept"] (partial denormalize-into-concepts - ztx (vals (get-in @ztx [:fhir/inter "ValueSet"]))))) + (vals (get-in @ztx [:fhir/inter "ValueSet"]))))) diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index 8fe80bf..f37a8a3 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -1,8 +1,187 @@ (ns ftr.extraction.ig.value-set-expand-test (:require [ftr.extraction.ig.value-set-expand :as sut] [clojure.string :as str] + [matcho.core :as match] [clojure.test :as t])) +#_"NOTE: Concept resource" +{:code "string" + :system "string"} + +#_"NOTE: ValueSet resource" +{:url "string" + :compose {:include [#_"NOTE: contains union of rules" + {#_"NOTE: rule defining a selection of concepts" + #_"NOTE: Must have :system OR :valueSet. Can have both" + #_"NOTE: Can't have both :concept and :filter. Can have neither" + :system "string" + :concept [{:code "string"} #_...]} + {:system "string" + :filter {:property "string" + :op "string" #_"NOTE: = | is-a | descendent-of | is-not-a | regex | in | not-in | generalizes | exists" + :value "string"}} + {:valueSet ["string" #_"NOTE: intersection of other value sets"]}] + :exclude [#_"NOTE: structure is the same as include" + #_"NOTE: excludes union of rules here from the union defined in include" + {}]}} + +#_"NOTE: CodeSystem index" +{"" + {"" + {#_"" + :valueset [""] + #_"NOTE: this attr is empty before the start of the algorithm, must be populated as the result"}}} + +#_"NOTE: ValueSet.compose process queue" +{"" + {:deps #{""} + + :include {:systems + {"" {[""] #_"NOTE: value set intersection, can be empty" + {#_"NOTE: can't have both" + :allow-any-concept true + :pred-fn [#_"function that accepts a Concept and returns a boolean"]}}} + + :any-system #_"NOTE: when no system specified, deduce from provided value sets" + {[""] #_"NOTE: value set intersection, CAN NOT be empty" + {#_"NOTE: can't have both" + :allow-any-concept true + :pred-fn [#_"function that accepts a Concept and returns a boolean"]}}} + :exclude {#_"same structure as :include"} + + :full-expansion? true ;; boolean + :expansion-index {"" + #{""}}}} + +#_"NOTE: ValueSet content index" +{"" + {"" + #{""}}} + +#_"NOTE: after this index is produced it is normalized into the CodeSystem index [system code :valueset]" + + (t/deftest nested-vs-refs-process-test - ) + + (def concepts-index-fixture + {"sys1" {"code11" {:system "sys1" + :code "code11"} + "code12" {:system "sys1" + :code "code12"}} + "sys2" {"code21" {:system "sys2" + :code "code21"} + "code22" {:system "sys2" + :code "code22"}}}) + + (def valuesets-fixtures + [{:url "simple-include" + :compose {:include [{:system "sys1"} + {:system "sys2"}]}} + {:url "include-with-concept-enumeration" + :compose {:include [{:system "sys1" + :concept [{:code "code11"}]} + {:system "sys2"}]}} + {:url "include-with-filter" + :compose {:include [{:system "sys1" + :filter [{:op "is-a" + :property "code" + :value "code11"}]} + {:system "sys2"}]}} + + {:url "empty-vs" + :compose {:include [{:system "sys1" + :filter [{:op "is-a" + :property "code" + :value "???"}]}]}} + + {:url "full-expansion" + :compose {:include [{:system "sys1" + :filter [{:op "is-a" + :property "missing" + :value "foo"}]}]} + :expansion {:total 1 + :offset 0 + #_#_:parameter {:offset 0 :count 1000} #_"TODO: check if there no meaningful parameters" + :contains [{:system "sys1" #_"TODO: add recursive :contains" + :code "code12"}]}} + + {:url "not-full-expansion" + :compose {:include [{:system "sys1" + :filter [{:op "is-a" + :property "code" + :value "code11"}]} + {:system "sys2" + :filter [{:op "is-a" + :property "missing" + :value "foo"}]}]} + :expansion {:contains [{:system "sys2" + :code "code21"}]}} + + {:url "depends-on-valueset" + :compose {:include [{:valueSet ["simple-include"]}]}} + + {:url "depends-on-valueset-intersection" + :compose {:include [{:valueSet ["simple-include" + "full-expansion"]}]}} + + {:url "intersection-with-empty-valueset" + :compose {:include [{:valueSet ["simple-include" + "empty-vs"]}]}} + + {:url "empty-intersection" + :compose {:include [{:valueSet ["full-expansion" + "depends-on-valueset-and-filters-by-sys-and-pred"]}]}} + + {:url "depends-on-valueset-intersection-and-filters-by-sys" + :compose {:include [{:system "sys1" + :valueSet ["simple-include" + "not-full-expansion"]}]}} + + {:url "depends-on-valueset-and-filters-by-sys" + :compose {:include [{:system "sys1" + :valueSet ["simple-include"]}]}} + + {:url "depends-on-valueset-and-filters-by-sys-and-pred" + :compose {:include [{:system "sys1" + :filter [{:op "is-a" + :property "code" + :value "code11"}] + :valueSet ["simple-include"]}]}}]) + + (def valuesets-index-assert + {"simple-include" {"sys1" #{"code11" "code12"} + "sys2" #{"code21" "code22"}} + + "include-with-concept-enumeration" {"sys1" #{"code11"} + "sys2" #{"code21" "code22"}} + + "include-with-filter" {"sys1" #{"code11"} + "sys2" #{"code21" "code22"}} + + "empty-vs" {} + + "full-expansion" {"sys1" #{"code12"}} + + "not-full-expansion" {"sys1" #{"code11"} + "sys2" #{"code21"}} + + "depends-on-valueset" {"sys1" #{"code11" "code12"} + "sys2" #{"code21" "code22"}} + + "depends-on-valueset-intersection" {"sys1" #{"code12"}} + + "depends-on-valueset-intersection-and-filters-by-sys" {"sys1" #{"code11"}} + + "intersection-with-empty-valueset" {} + + "empty-intersection" {} + + "depends-on-valueset-and-filters-by-sys" {"sys1" #{"code11" "code12"}} + + "depends-on-valueset-and-filters-by-sys-and-pred" {"sys1" #{"code11"}}}) + + (t/is (= valuesets-index-assert + (sut/all-vs-nested-refs->vs-idx + concepts-index-fixture + (sut/build-valuesets-compose-idx valuesets-fixtures))))) diff --git a/test/ftr/zen_package_test.clj b/test/ftr/zen_package_test.clj index 97a8167..51ea383 100644 --- a/test/ftr/zen_package_test.clj +++ b/test/ftr/zen_package_test.clj @@ -810,8 +810,10 @@ :id "custom-gender-vs-id" :url "custom-gender-vs-url" :status "active" - :compose {:include [{:valueSet ["gender-vs-url"]} - {:valueSet ["expanded-gender-vs-url"]}] + :compose {:include [{:valueSet ["gender-vs-url"] + :system "gender-cs-url"} + {:valueSet ["gender-vs-url" + "expanded-gender-vs-url"]}] :exclude [{:valueSet ["unknown-gender-vs-url"]}]}}] {'ftr-expansion-lib {:deps #{['zen-fhir (str (System/getProperty "user.dir") "/zen.fhir/")]} :resources {"ig/node_modules/gender-codesystem.json" gender-cs From df85804bfb28c3e45d824be33107882648fb1f56 Mon Sep 17 00:00:00 2001 From: KGOH Date: Fri, 16 Dec 2022 15:05:38 +0200 Subject: [PATCH 12/16] Add vs idx empty valuesets push --- src/ftr/extraction/ig/value_set_expand.clj | 62 +++++++++++----------- 1 file changed, 30 insertions(+), 32 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index d8f11b0..ab7ac82 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -192,11 +192,11 @@ (update acc :vs-queue dissoc vs-url)) -(defn push-concept-into-vs-idx [vs-idx vs-url concept] - (update-in vs-idx - [vs-url (:system concept)] - (fnil conj #{}) - (:code concept))) +(defn push-concept-into-vs-idx [vs-idx concept] + (update vs-idx + (:system concept) + (fnil conj #{}) + (:code concept))) (defn get-acc-key [any-system? mode] @@ -214,37 +214,37 @@ (defn vs-selected-system-intersection->vs-idx [acc concepts-map vs-url sys vs-urls checks & {:keys [any-system? mode]}] - (if-let [concepts - (cond - (seq vs-urls) - (some->> vs-urls - (keep (fn [dep-vs-url] - (get-in acc [:vs-idx-acc dep-vs-url sys]))) - seq - (apply set/intersection) - (map (fn [code] [code (get-in concepts-map [sys code])])) - (into {})) - - sys - (get concepts-map sys) - - :else - (throw (ex-info "ValueSet or system should be present" {:vs-url vs-url, :sys sys, :deps vs-urls})))] - (let [acc-key (get-acc-key any-system? mode)] + (let [acc-key (get-acc-key any-system? mode)] + (if-let [concepts + (cond + (seq vs-urls) + (some->> vs-urls + (map (fn [dep-vs-url] + (get-in acc [:vs-idx-acc dep-vs-url sys] #{}))) + (apply set/intersection) + seq + (map (fn [code] [code (get-in concepts-map [sys code])])) + (into {})) + + sys + (get concepts-map sys) + + :else + (throw (ex-info "ValueSet or system should be present" {:vs-url vs-url, :sys sys, :deps vs-urls})))] (if-let [check-fns (seq (:pred-fns checks))] - (update acc acc-key - (fn [vs-idx-acc] + (update-in acc [acc-key vs-url] + (fn [vs-idx-acc ] (transduce (filter (fn [[concept-code concept]] (and #_(not-any? #(% concept) exclude-check-fns) (or (get-in acc [:vs-idx-acc vs-url concept-code]) (some #(% concept) check-fns))))) - (completing (fn [acc [_concept-code concept]] (push-concept-into-vs-idx acc vs-url concept))) - vs-idx-acc + (completing (fn [acc [_concept-code concept]] (push-concept-into-vs-idx acc concept))) + (or vs-idx-acc {}) concepts))) (if (:allow-any-concept checks) (update-in acc [acc-key vs-url sys] (fnil into #{}) (keys concepts)) (throw (ex-info "must be either predicate fn or whole system allow" - {:vs-url vs-url, :sys sys, :deps vs-urls}))))) - acc)) + {:vs-url vs-url, :sys sys, :deps vs-urls})))) + (update-in acc [acc-key vs-url] #(or % {}))))) (defn select-all-dep-systems [vs-idx-acc deps-vs-urls] @@ -286,7 +286,7 @@ (let [any-system? (= ::any-system dep-system-url) incl-acc-key (get-acc-key any-system? :include) #_#_excl-acc-key (get-acc-key any-system? :exclude) - vs-sys-idx-acc (get-in acc [:vs-idx-acc vs-url]) + vs-sys-idx-acc (get-in acc [:vs-idx-acc vs-url] {}) #_#_exclude-idx (get-in acc [excl-acc-key vs-url]) exclude-filter nil #_(when (seq exclude-idx) (fn [system code] @@ -319,9 +319,7 @@ (into %1 %2) %2)) (get-in acc [incl-acc-key vs-url dep-system-url])))] - (cond-> acc - (some? new-vs-sys-idx) - (assoc-in [:vs-idx-acc vs-url] new-vs-sys-idx)))) + (assoc-in acc [:vs-idx-acc vs-url] new-vs-sys-idx))) (defn refs-in-vs->vs-idx [acc concepts-map vs-url] From 8e367478d8e4a7ec9952376ac1e4b380555ea58f Mon Sep 17 00:00:00 2001 From: KGOH Date: Fri, 16 Dec 2022 17:40:26 +0200 Subject: [PATCH 13/16] Add exclude support WIP --- src/ftr/extraction/ig/value_set_expand.clj | 86 +++++++--- .../extraction/ig/value_set_expand_test.clj | 158 +++++++++++++++++- 2 files changed, 215 insertions(+), 29 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index ab7ac82..b27ad6e 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -213,7 +213,8 @@ m)) -(defn vs-selected-system-intersection->vs-idx [acc concepts-map vs-url sys vs-urls checks & {:keys [any-system? mode]}] +(defn vs-selected-system-intersection->vs-idx [acc concepts-map expansion-index vs-url sys vs-urls checks + & {:keys [any-system? mode]}] (let [acc-key (get-acc-key any-system? mode)] (if-let [concepts (cond @@ -235,7 +236,9 @@ (update-in acc [acc-key vs-url] (fn [vs-idx-acc ] (transduce (filter (fn [[concept-code concept]] (and #_(not-any? #(% concept) exclude-check-fns) - (or (get-in acc [:vs-idx-acc vs-url concept-code]) + (or (when (= :include mode) + #_"TODO: test on this when" + (get-in expansion-index [(:system concept) concept-code])) (some #(% concept) check-fns))))) (completing (fn [acc [_concept-code concept]] (push-concept-into-vs-idx acc concept))) (or vs-idx-acc {}) @@ -252,13 +255,13 @@ deps-vs-urls)) -(defn vs-selected-systems->mode-acc [acc concepts-map vs-url dep-system-url vs-urls checks mode] +(defn vs-selected-systems->mode-acc [acc concepts-map expansion-index vs-url dep-system-url vs-urls checks mode] (let [any-system? (= ::any-system dep-system-url) selected-systems (if any-system? (select-all-dep-systems (:vs-idx-acc acc) vs-urls) [dep-system-url])] (reduce (fn [acc sys] - (vs-selected-system-intersection->vs-idx acc concepts-map vs-url sys vs-urls checks + (vs-selected-system-intersection->vs-idx acc concepts-map expansion-index vs-url sys vs-urls checks {:any-system? any-system? :mode mode})) acc @@ -275,31 +278,43 @@ vs-urls)) -(defn collect-mode-acc [acc concepts-map vs-url system compose-els mode] +(defn collect-mode-acc [acc concepts-map expansion-index vs-url system compose-els mode] (reduce-kv (fn [acc vs-urls checks] - (vs-selected-systems->mode-acc acc concepts-map vs-url system vs-urls checks mode)) + (vs-selected-systems->mode-acc acc concepts-map expansion-index vs-url system vs-urls checks mode)) acc compose-els)) (defn push-include-exclude->vs-idx [acc vs-url dep-system-url] - (let [any-system? (= ::any-system dep-system-url) - incl-acc-key (get-acc-key any-system? :include) - #_#_excl-acc-key (get-acc-key any-system? :exclude) - vs-sys-idx-acc (get-in acc [:vs-idx-acc vs-url] {}) - #_#_exclude-idx (get-in acc [excl-acc-key vs-url]) - exclude-filter nil #_(when (seq exclude-idx) - (fn [system code] - (not (get-in exclude-idx [system code])))) - - new-vs-sys-idx + (let [any-system? (= ::any-system dep-system-url) + incl-acc-key (get-acc-key any-system? :include) + vs-sys-idx-acc (get-in acc [:vs-idx-acc vs-url] {}) + sys-exclude-idx (get-in acc [:any-sys-exclude-acc vs-url]) + any-exclude-idx (get-in acc [:exclude-acc vs-url]) + exclude-contains-sys? (fn [system] + (or (get-in sys-exclude-idx [system]) + (get-in any-exclude-idx [system]))) + exclude-remove (when (or (seq sys-exclude-idx) (seq any-exclude-idx)) + (fn [system code] + (or (get-in sys-exclude-idx [system code]) + (get-in any-exclude-idx [system code])))) + + new-vs-sys-idx #_"TODO: refactor" (if any-system? - (if exclude-filter + (if exclude-remove (reduce-kv (fn [acc sys concepts] - (update acc sys (fn [idx-concepts] - (into (or idx-concepts #{}) - (filter #(exclude-filter sys %)) - concepts)))) + (if (exclude-contains-sys? sys) + (update-if-some-result acc sys + (fn [idx-concepts] + (not-empty + (into (or idx-concepts #{}) + (remove #(exclude-remove sys %)) + concepts)))) + (update acc sys + #(if (some? %1) + (into %1 %2) + %2) + concepts))) vs-sys-idx-acc (get-in acc [incl-acc-key vs-url])) (merge-with #(if (some? %1) @@ -310,11 +325,11 @@ (update-if-some-result vs-sys-idx-acc dep-system-url - (if exclude-filter + (if (and exclude-remove (exclude-contains-sys? dep-system-url)) (fn [idx-concepts new-concepts] - (into (or idx-concepts #{}) - (filter #(exclude-filter dep-system-url %)) - new-concepts)) + (not-empty (into (or idx-concepts #{}) + (remove #(exclude-remove dep-system-url %)) + new-concepts))) #(if (some? %1) (into %1 %2) %2)) @@ -334,15 +349,32 @@ (seq expansion-index) (update-in [:vs-idx-acc vs-url] #(merge-with into % expansion-index))) + acc (collect-mode-acc acc concepts-map expansion-index vs-url ::any-system (:any-system exclude) :exclude) + + need-to-process-all-excludes? (:any-system include) + + acc (if need-to-process-all-excludes? #_"NOTE: can process not all, but only ones that will be used in any-system include" + (reduce-kv (fn [acc dep-system-url exclude] + (-> acc + (collect-mode-acc concepts-map expansion-index vs-url dep-system-url exclude :exclude) + (push-include-exclude->vs-idx vs-url dep-system-url))) + acc + (:systems exclude)) + acc) + acc (reduce-kv (fn [acc dep-system-url include] (-> acc - (collect-mode-acc concepts-map vs-url dep-system-url include :include) + (cond-> (not need-to-process-all-excludes?) + (collect-mode-acc concepts-map expansion-index vs-url dep-system-url + (get-in exclude [:systems dep-system-url]) + :exclude)) + (collect-mode-acc concepts-map expansion-index vs-url dep-system-url include :include) (push-include-exclude->vs-idx vs-url dep-system-url))) acc (:systems include)) acc (-> acc - (collect-mode-acc concepts-map vs-url ::any-system (:any-system include) :include) + (collect-mode-acc concepts-map expansion-index vs-url ::any-system (:any-system include) :include) (push-include-exclude->vs-idx vs-url ::any-system))] acc)))) diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index f37a8a3..604cd12 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -78,6 +78,8 @@ [{:url "simple-include" :compose {:include [{:system "sys1"} {:system "sys2"}]}} + {:url "simpler-include" + :compose {:include [{:system "sys2"}]}} {:url "include-with-concept-enumeration" :compose {:include [{:system "sys1" :concept [{:code "code11"}]} @@ -147,12 +149,130 @@ :filter [{:op "is-a" :property "code" :value "code11"}] - :valueSet ["simple-include"]}]}}]) + :valueSet ["simple-include"]}]}} + + {:url "exclude-system" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys2"}]}} + {:url "exclude-code" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys2" + :concept [{:code "code22"}]}]}} + {:url "multiple-exclude" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys1" + :concept [{:code "code12"}]} + {:system "sys2" + :concept [{:code "code22"}]}]}} + {:url "multiple-exclude-with-vs" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys1" + :valueSet ["full-expansion"]} + {:system "sys2" + :concept [{:code "code22"}]}]}} + {:url "multiple-exclude-with-vs-no-system" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:valueSet ["full-expansion"]} + {:system "sys2" + :concept [{:code "code22"}]}]}} + {:url "exclude-filter" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys2" + :filter [{:op "is-a" + :property "code" + :value "code22"}]}]}} + {:url "exclude-valueset-with-system" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys1" + :valueSet ["simple-include"]}]}} + {:url "exclude-valueset-with-pred" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys1" + :concept [{:code "code12"}] + :valueSet ["simple-include"]}]}} + {:url "exclude-valueset-with-pred-not-in-vs" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys1" + :filter [{:op "is-a" + :property "code" + :value "???"}] + :valueSet ["simple-include"]}]}} + {:url "exclude-valueset-no-system" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:valueSet ["depends-on-valueset-intersection"]}]}} + {:url "exclude-all" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys1"} + {:system "sys2"}]}} + {:url "exclude-all-vs" + :compose {:include [{:valueSet ["simple-include"]}] + :exclude [{:valueSet ["simple-include"]}]}} + {:url "exclude-valueset-system-not-present-in-vs" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys2" + :valueSet ["depends-on-valueset-intersection"]}]}} + {:url "exclude-empty-valueset" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:valueSet ["empty-vs"]}]}} + {:url "exclude-valueset-intersection" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:valueSet ["simple-include" + "full-expansion"]}]}} + {:url "exclude-empty-valueset-intersection" + :compose {:include [{:system "sys1"}] + :exclude [{:system "sys1" + :valueSet ["depends-on-valueset-intersection" + "depends-on-valueset-intersection-and-filters-by-sys"]}]}} + {:url "exclude-empty-valueset-intersection" + :compose {:include [{:valueSet ["depends-on-valueset-intersection"]}] + :exclude [{:system "sys1" + :valueSet ["depends-on-valueset-intersection-and-filters-by-sys"]}]}} + {:url "exclude-empty-valueset-intersection-system" + :compose {:include [{:system "sys1" + :valueSet ["depends-on-valueset-intersection"]}] + :exclude [{:system "sys1" + :valueSet ["depends-on-valueset-intersection-and-filters-by-sys"]}]}} + {:url "exclude-valueset-not-intersection-no-system" + :compose {:include [{:valueSet ["depends-on-valueset-intersection"]}] + :exclude [{:valueSet ["depends-on-valueset-intersection-and-filters-by-sys"]}]}} + {:url "exclude-valueset-not-intersection-no-system-no-system-in-exclude" + :compose {:include [{:valueSet ["simple-include"]}] + :exclude [{:system "sys1" + :valueSet ["simpler-include"]} + {:system "sys1" + :filter [{:op "is-a" + :property "code" + :value "code12"}]}]}} + #_{:url "exclude-with-expansion" + :compose {:include [{:system "sys1"} + {:system "sys2"}] + :exclude [{:system "sys2" #_"FIXME: WHAT TO DO WHEN WE CAN'T EVAL EXCLUDE????" + :filter [{:op "is-a" + :property "missing" + :value "???"}]}]} + :expansion {:contains [{:system "sys2" + :code "code21"}]}}]) (def valuesets-index-assert {"simple-include" {"sys1" #{"code11" "code12"} "sys2" #{"code21" "code22"}} + "simpler-include" {"sys2" #{"code21" "code22"}} + "include-with-concept-enumeration" {"sys1" #{"code11"} "sys2" #{"code21" "code22"}} @@ -179,7 +299,41 @@ "depends-on-valueset-and-filters-by-sys" {"sys1" #{"code11" "code12"}} - "depends-on-valueset-and-filters-by-sys-and-pred" {"sys1" #{"code11"}}}) + "depends-on-valueset-and-filters-by-sys-and-pred" {"sys1" #{"code11"}} + + "exclude-system" {"sys1" #{"code11" "code12"}} + "exclude-code" {"sys1" #{"code11" "code12"} + "sys2" #{"code21"}} + "multiple-exclude" {"sys1" #{"code11"} + "sys2" #{"code21"}} + "multiple-exclude-with-vs" {"sys1" #{"code11"} + "sys2" #{"code21"}} + "multiple-exclude-with-vs-no-system" {"sys1" #{"code11"} + "sys2" #{"code21"}} + "exclude-filter" {"sys1" #{"code11" "code12"} + "sys2" #{"code21"}} + "exclude-valueset-with-system" {"sys2" #{"code21" "code22"}} + "exclude-valueset-with-pred" {"sys1" #{"code11"} + "sys2" #{"code21" "code22"}} + "exclude-valueset-with-pred-not-in-vs" {"sys1" #{"code11" "code12"} + "sys2" #{"code21" "code22"}} + "exclude-valueset-no-system" {"sys1" #{"code11"} + "sys2" #{"code21" "code22"}} + "exclude-all" {} + "exclude-all-vs" {} + "exclude-valueset-system-not-present-in-vs" {"sys1" #{"code11" "code12"} + "sys2" #{"code21" "code22"}} + "exclude-empty-valueset" {"sys1" #{"code11" "code12"} + "sys2" #{"code21" "code22"}} + "exclude-valueset-intersection" {"sys1" #{"code11"} + "sys2" #{"code21" "code22"}} + "exclude-empty-valueset-intersection" {"sys1" #{"code12"}} + "exclude-empty-valueset-intersection-system" {"sys1" #{"code12"}} + "exclude-valueset-not-intersection-no-system" {"sys1" #{"code12"}} + "exclude-valueset-not-intersection-no-system-no-system-in-exclude" {"sys1" #{"code11"} + "sys2" #{"code21" "code22"}} + #_#_"exclude-with-expansion" {"sys1" #{"code11" "code12"} + "sys2" #{"code21"}}}) (t/is (= valuesets-index-assert (sut/all-vs-nested-refs->vs-idx From 18dfcde494ba5b36fd6c3ca4e312926b81865a0f Mon Sep 17 00:00:00 2001 From: KGOH Date: Fri, 16 Dec 2022 17:58:51 +0200 Subject: [PATCH 14/16] Add exclude with expansion test --- src/ftr/extraction/ig/value_set_expand.clj | 8 +++++--- test/ftr/extraction/ig/value_set_expand_test.clj | 14 +++++++++++--- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/ftr/extraction/ig/value_set_expand.clj b/src/ftr/extraction/ig/value_set_expand.clj index b27ad6e..4a9d2bf 100644 --- a/src/ftr/extraction/ig/value_set_expand.clj +++ b/src/ftr/extraction/ig/value_set_expand.clj @@ -234,10 +234,12 @@ (throw (ex-info "ValueSet or system should be present" {:vs-url vs-url, :sys sys, :deps vs-urls})))] (if-let [check-fns (seq (:pred-fns checks))] (update-in acc [acc-key vs-url] - (fn [vs-idx-acc ] - (transduce (filter (fn [[concept-code concept]] (and #_(not-any? #(% concept) exclude-check-fns) + (fn [vs-idx-acc] + (transduce (filter (fn [[concept-code concept]] (and #_(not-any? #(% concept) exclude-check-fns) #_"TODO: instead of building exclude idx maybe check exclude on building include idx?" (or (when (= :include mode) - #_"TODO: test on this when" + #_"NOTE: this when can not tested, because if expansion is included without checking exclude." + #_"NOTE: Without the 'when exclude gets a codes from expansion and it forbids to include these values," + #_"NOTE: but these values are already included, thus this effect is not observable form outside" (get-in expansion-index [(:system concept) concept-code])) (some #(% concept) check-fns))))) (completing (fn [acc [_concept-code concept]] (push-concept-into-vs-idx acc concept))) diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index 604cd12..cd936eb 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -257,7 +257,16 @@ :filter [{:op "is-a" :property "code" :value "code12"}]}]}} - #_{:url "exclude-with-expansion" + {:url "exclude-with-expansion" + :compose {:include [{:valueSet ["simple-include"] + :filter [{:op "is-a" + :property "missing" + :value "???"}]}] + :exclude [{:system "sys2" + :concept [{:code "code22"}]}]} + :expansion {:contains [{:system "sys2" + :code "code21"}]}} + #_{:url "exclude-withexpansion" :compose {:include [{:system "sys1"} {:system "sys2"}] :exclude [{:system "sys2" #_"FIXME: WHAT TO DO WHEN WE CAN'T EVAL EXCLUDE????" @@ -332,8 +341,7 @@ "exclude-valueset-not-intersection-no-system" {"sys1" #{"code12"}} "exclude-valueset-not-intersection-no-system-no-system-in-exclude" {"sys1" #{"code11"} "sys2" #{"code21" "code22"}} - #_#_"exclude-with-expansion" {"sys1" #{"code11" "code12"} - "sys2" #{"code21"}}}) + "exclude-with-expansion" {"sys2" #{"code21"}}}) (t/is (= valuesets-index-assert (sut/all-vs-nested-refs->vs-idx From cd0d95afc64a7517c59cd60c84a75862c53b16c6 Mon Sep 17 00:00:00 2001 From: KGOH Date: Fri, 16 Dec 2022 18:17:01 +0200 Subject: [PATCH 15/16] Add include one exclude another vs test --- test/ftr/extraction/ig/value_set_expand_test.clj | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/test/ftr/extraction/ig/value_set_expand_test.clj b/test/ftr/extraction/ig/value_set_expand_test.clj index cd936eb..b5f1099 100644 --- a/test/ftr/extraction/ig/value_set_expand_test.clj +++ b/test/ftr/extraction/ig/value_set_expand_test.clj @@ -274,7 +274,10 @@ :property "missing" :value "???"}]}]} :expansion {:contains [{:system "sys2" - :code "code21"}]}}]) + :code "code21"}]}} + {:url "include-vs-exclude-other-vs" + :compose {:include [{:valueSet ["simpler-include" "simple-include"]}] + :exclude [{:valueSet ["not-full-expansion"]}]}}]) (def valuesets-index-assert {"simple-include" {"sys1" #{"code11" "code12"} @@ -341,7 +344,8 @@ "exclude-valueset-not-intersection-no-system" {"sys1" #{"code12"}} "exclude-valueset-not-intersection-no-system-no-system-in-exclude" {"sys1" #{"code11"} "sys2" #{"code21" "code22"}} - "exclude-with-expansion" {"sys2" #{"code21"}}}) + "exclude-with-expansion" {"sys2" #{"code21"}} + "include-vs-exclude-other-vs" {"sys2" #{"code22"}}}) (t/is (= valuesets-index-assert (sut/all-vs-nested-refs->vs-idx From 1e8413d1343543273234ba69e3cab31b7004e576 Mon Sep 17 00:00:00 2001 From: KGOH Date: Fri, 16 Dec 2022 18:17:15 +0200 Subject: [PATCH 16/16] Fix zen package test fixture --- test/ftr/zen_package_test.clj | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/ftr/zen_package_test.clj b/test/ftr/zen_package_test.clj index 51ea383..21aac91 100644 --- a/test/ftr/zen_package_test.clj +++ b/test/ftr/zen_package_test.clj @@ -812,8 +812,7 @@ :status "active" :compose {:include [{:valueSet ["gender-vs-url"] :system "gender-cs-url"} - {:valueSet ["gender-vs-url" - "expanded-gender-vs-url"]}] + {:valueSet ["expanded-gender-vs-url"]}] :exclude [{:valueSet ["unknown-gender-vs-url"]}]}}] {'ftr-expansion-lib {:deps #{['zen-fhir (str (System/getProperty "user.dir") "/zen.fhir/")]} :resources {"ig/node_modules/gender-codesystem.json" gender-cs