Add near Search Param for Location Resource

Signed-off-by: Jonas Wagner <jwagner@knoppiks.de>

Author: knoppiks

.github/scripts/search-location-near.sh

@@ -0,0 +1,31 @@
+#!/bin/bash -e
+
+script_dir="$(dirname "$(readlink -f "$0")")"
+. "$script_dir/util.sh"
+
+base="http://localhost:8080/fhir"
+
+location() {
+cat <<END
+{
+  "resourceType": "Location",
+  "name": "Leipzig",
+  "position": {
+    "latitude": 51.3397,
+    "longitude": 12.3731
+  }
+}
+END
+}
+
+create() {
+  curl -s -f -H "Content-Type: application/fhir+json" -H 'Accept: application/fhir+json' -d @- -o /dev/null "$base/Location"
+}
+
+location | create
+
+search() {
+  curl -s -H "Content-Type: application/fhir+json" "$base/Location?near=$1&summary=count" | jq -r .total
+}
+
+test "Location 900km from Florence finds Leipzig" "$(search "43.77925|11.24626|900|km")" "1"

.github/workflows/build.yml

@@ -1318,6 +1318,9 @@ jobs:
     - name: Control Character Handling
       run: .github/scripts/control-character-handling.sh
 
+    - name: Control Character Handling
+      run: .github/scripts/search-location-near.sh
+
     - name: Prometheus Metrics
       run: .github/scripts/test-metrics.sh
       if: ${{ matrix.variant == 'standalone' }}

docs/api/interaction/search-type.md

@@ -40,6 +40,10 @@ Search for `Resource.meta.profile` is supported using the `_profile` search para
 
 When searching for date/time with a search parameter value without timezone like `2024` or `2024-02-16`, Blaze calculates the range of the search parameter values based on [UTC][2]. That means that a resource with a date/time value staring at `2024-01-01T00:00:00+01:00` will be not found by a search with `2024`. Please comment on [issue #1498](https://github.com/samply/blaze/issues/1498) if you like to have this situation improved.
 
+## Geopositional Search
+
+Blaze implements the [positional](https://hl7.org/fhir/R4B/location.html#positional) search parameter `near` for resources with a geospatial position (i.e., Location). The search parameter takes a latitude, longitude, distance and unit as search parameter values in the form `longitude|latitude[|distance[|unit]]`. Defaults for `distance` and `unit` are `1` and `km`. The [Haversine formula](https://en.wikipedia.org/wiki/Haversine_formula) is used to calculate the distance between the search parameter value and the resource's location, which simplifies calculation by assuming a spherical earth and has an error of less than approximately 0.5%.
+
 ## Sorting
 
 The special search parameter `_sort` supports the values `_id`, `_lastUpdated` and `-_lastUpdated`.

modules/db/src/blaze/db/impl/index/resource_as_of.clj

@@ -410,3 +410,22 @@
               (rf result handle)
               result)
             result)))))))
+
+(defn- encode-seek-key [tid]
+  (-> (bb/allocate codec/tid-size)
+      (bb/put-int! tid)
+      bb/flip!
+      (bs/from-byte-buffer!)))
+
+(defn estimated-scan-size
+  "Returns a relative estimation for the amount of work to do while scanning the
+  ResourceAsOf index with the prefix consisting of `tid`.
+
+  The metric is relative and unitless. It can be only used to compare the amount
+  of scan work between different prefixes.
+
+  Returns an anomaly if estimating the scan size isn't supported by `kv-store`."
+  [kv-store tid]
+  (let [seek-key (encode-seek-key tid)
+        key-range [seek-key (bs/concat seek-key (bs/from-hex "FF"))]]
+    (kv/estimate-scan-size kv-store :resource-as-of-index key-range)))

modules/db/src/blaze/db/impl/search_param.clj

@@ -13,6 +13,7 @@
    [blaze.db.impl.search-param.date]
    [blaze.db.impl.search-param.has]
    [blaze.db.impl.search-param.list]
+   [blaze.db.impl.search-param.near]
    [blaze.db.impl.search-param.number]
    [blaze.db.impl.search-param.quantity]
    [blaze.db.impl.search-param.string]

modules/db/src/blaze/db/impl/search_param/near.clj

@@ -0,0 +1,163 @@
+(ns blaze.db.impl.search-param.near
+  (:require
+   [blaze.anomaly :as ba :refer [when-ok]]
+   [blaze.coll.core :as coll]
+   [blaze.db.api :as d]
+   [blaze.db.impl.index.index-handle :as ih]
+   [blaze.db.impl.index.resource-as-of :as rao]
+   [blaze.db.impl.index.single-version-id :as svi]
+   [blaze.db.impl.protocols :as p]
+   [blaze.db.impl.search-param.near.geo :as spng]
+   [blaze.db.impl.search-param.special :as special]
+   [blaze.db.impl.search-param.util :as u]
+   [blaze.fhir.spec.type :as type]
+   [blaze.fhir.spec.type.system :as system]
+   [clojure.string :as str]
+   [cognitect.anomalies :as anom]))
+
+(set! *warn-on-reflection* true)
+
+(defn- near? [{:keys [longitude latitude]} {:keys [distance] :as compiled-value}]
+  (let [coordinates {:latitude (type/value latitude)
+                     :longitude (type/value longitude)}
+        actual-dist (spng/haversine-distance coordinates compiled-value)]
+    (<= actual-dist distance)))
+
+(defn- matches? [batch-db resource-handle compiled-values]
+  (let [{:keys [position]} @(d/pull batch-db resource-handle)]
+    (some #(near? position %) compiled-values)))
+
+(defn- missing-param-msg [arg code]
+  (format "Missing argument `%s` in search parameter `%s`." arg code))
+
+(defn- parsing-err-msg [arg code]
+  (format "Error parsing argument `%s` in search parameter `%s`." arg code))
+
+(defn- update-msg [msg]
+  (fn [anomaly]
+    (update anomaly ::anom/message #(str msg " " %))))
+
+(defn- parse-decimal-arg [coord name code]
+  (if (str/blank? coord)
+    (ba/incorrect (missing-param-msg name code))
+    (-> (system/parse-decimal coord)
+        (ba/exceptionally (update-msg (parsing-err-msg name code))))))
+
+(defn- unsupported-unit-msg [unit code]
+  (format "Unsupported unit `%s` in search parameter `%s`. Supported are 'km', 'm'." unit code))
+
+(defn- parse-distance [dist-str unit code]
+  (cond
+    (str/blank? dist-str)
+    1000M
+
+    (or (nil? unit) (= unit "km"))
+    (when-ok [dist (parse-decimal-arg dist-str "distance" code)]
+      (* dist 1000))
+
+    (= unit "m")
+    (parse-decimal-arg dist-str "distance" code)
+
+    :else
+    (ba/incorrect (unsupported-unit-msg unit code))))
+
+(def ^:private ^:const min-latitude -90.0)
+
+(def ^:private ^:const max-latitude 90.0)
+
+(defn invalid-latitude-msg [arg code]
+  (format
+   "Invalid argument `%s` for latitude in search parameter `%s`, must be between %s and %s."
+   arg code min-latitude max-latitude))
+
+(defn- parse-latitude [val code]
+  (when-ok [latitude (parse-decimal-arg val "latitude" code)]
+    (if (<= min-latitude latitude max-latitude)
+      latitude
+      (ba/incorrect (invalid-latitude-msg val code)))))
+
+(def ^:private ^:const min-longitude -180.0)
+
+(def ^:private ^:const max-longitude 180.0)
+
+(defn invalid-longitude-msg [val code]
+  (format
+   "Invalid argument `%s` for longitude in search parameter `%s`, must be between %s and %s."
+   val code min-longitude max-longitude))
+
+(defn- parse-longitude [val code]
+  (when-ok [longitude (parse-decimal-arg val "longitude" code)]
+    (if (<= min-longitude longitude max-longitude)
+      longitude
+      (ba/incorrect (invalid-longitude-msg val code)))))
+
+(defrecord SearchParamNear [index name type code]
+  p/SearchParam
+  (-validate-modifier [_ modifier]
+    (some->> modifier (u/unknown-modifier-anom code)))
+
+  (-compile-value [_ _ value]
+    (let [[lat long dist unit] (str/split value #"\|" 4)]
+      (when-ok [parsed-lat (parse-latitude lat code)
+                parsed-long (parse-longitude long code)
+                parsed-dist (parse-distance dist unit code)]
+        {:latitude parsed-lat
+         :longitude parsed-long
+         :distance parsed-dist})))
+
+  (-estimated-scan-size [_ batch-db tid _ _]
+    (rao/estimated-scan-size (:kv-store batch-db) tid))
+
+  (-supports-ordered-index-handles [_ _ _ _ _]
+    true)
+
+  (-ordered-index-handles [search-param batch-db tid modifier compiled-values]
+    (if (= 1 (count compiled-values))
+      (p/-index-handles search-param batch-db tid modifier (first compiled-values))
+      (let [index-handles #(p/-index-handles search-param batch-db tid modifier %)]
+        (u/union-index-handles (map index-handles compiled-values)))))
+
+  (-ordered-index-handles [search-param batch-db tid modifier compiled-values start-id]
+    (if (= 1 (count compiled-values))
+      (p/-index-handles search-param batch-db tid modifier (first compiled-values) start-id)
+      (let [index-handles #(p/-index-handles search-param batch-db tid modifier % start-id)]
+        (u/union-index-handles (map index-handles compiled-values)))))
+
+  (-index-handles [search-param batch-db tid modifier compiled-value]
+    (coll/eduction
+     (comp (p/-matcher search-param batch-db modifier [compiled-value])
+           (map ih/from-resource-handle))
+     (p/-type-list batch-db tid)))
+
+  (-index-handles [search-param batch-db tid modifier compiled-value start-id]
+    (coll/eduction
+     (comp (p/-matcher search-param batch-db modifier [compiled-value])
+           (map ih/from-resource-handle))
+     (p/-type-list batch-db tid start-id)))
+
+  (-supports-ordered-compartment-index-handles [_ _]
+    false)
+
+  (-ordered-compartment-index-handles [_ _ _ _ _]
+    (ba/unsupported))
+
+  (-ordered-compartment-index-handles [_ _ _ _ _ _]
+    (ba/unsupported))
+
+  (-matcher [_ batch-db _ compiled-values]
+    (filter #(matches? batch-db % compiled-values)))
+
+  (-single-version-id-matcher [search-param batch-db tid modifier compiled-values]
+    (comp (map ih/from-single-version-id)
+          (u/resource-handle-xf batch-db tid)
+          (p/-matcher search-param batch-db modifier compiled-values)
+          (map svi/from-resource-handle)))
+
+  (-second-pass-filter [_ _ _])
+
+  (-index-values [_ _ _]
+    []))
+
+(defmethod special/special-search-param "near"
+  [index _]
+  (->SearchParamNear index "near" "special" "near"))

modules/db/src/blaze/db/impl/search_param/near/geo.clj

@@ -0,0 +1,28 @@
+(ns blaze.db.impl.search-param.near.geo)
+
+(set! *warn-on-reflection* true)
+
+(def ^:private ^:const earth-radius
+  "Earths mean radius in meters, see https://en.wikipedia.org/wiki/Earth_radius."
+  6371008.7714)
+
+(defn- hav
+  "Haversed sine of `theta`."
+  [theta]
+  (let [half-angle (/ theta 2)]
+    (* (Math/sin half-angle) (Math/sin half-angle))))
+
+(defn haversine-distance
+  "Calculate the distance between two geographic coordinates (`location-1` and
+  `location-2`) using the Haversine formula, which simplifies by assuming a
+  spherical earth (error ≤ 0.5%). Returns distance in meters. See
+  https://en.wikipedia.org/wiki/Haversine_formula."
+  {:arglists '([location-1 location-2])}
+  [{lat-1 :latitude lon-1 :longitude} {lat-2 :latitude lon-2 :longitude}]
+  (let [delta-lat (Math/toRadians (- lat-2 lat-1))
+        delta-long (Math/toRadians (- lon-2 lon-1))
+        alpha (+ (hav delta-lat)
+                 (* (Math/cos (Math/toRadians lat-1))
+                    (Math/cos (Math/toRadians lat-2))
+                    (hav delta-long)))]
+    (* earth-radius (Math/asin (Math/sqrt alpha)) 2)))

modules/db/src/blaze/db/search_param_registry.clj

@@ -221,13 +221,18 @@
   {:type "special"
    :name "_has"})
 
+(def ^:private near-search-param
+  {:type "special"
+   :name "near"})
+
 (defn- add-special
   "Add special search params to `index`.
 
   See: https://www.hl7.org/fhir/search.html#special"
   [index]
   (-> (assoc-in index ["Resource" "_list"] (sc/search-param nil list-search-param))
-      (assoc-in ["Resource" "_has"] (sc/search-param index has-search-param))))
+      (assoc-in ["Resource" "_has"] (sc/search-param index has-search-param))
+      (assoc-in ["Location" "near"] (sc/search-param index near-search-param))))
 
 (defn- build-url-index* [index filter entries]
   (transduce