427 lines
16 KiB
Plaintext
427 lines
16 KiB
Plaintext
|
(ns lemondronor.circlebot
|
||
|
|
(:require
|
||
|
|
["commander" :as commander]
|
||
|
|
["fs" :as fs]
|
||
|
|
[cljs.pprint :as pprint]
|
||
|
|
[cljs.reader :as reader]
|
||
|
|
[clojure.set :as set]
|
||
|
|
[clojure.string :as string]
|
||
|
|
[fipp.edn :as fippedn]
|
||
|
|
[kitchen-async.promise :as p]
|
||
|
|
[lemondronor.circlebot.adsbx :as adsbx]
|
||
|
|
[lemondronor.circlebot.generation :as generation]
|
||
|
|
[lemondronor.circlebot.geo :as geo]
|
||
|
|
[lemondronor.circlebot.logging :as logging]
|
||
|
|
[lemondronor.circlebot.pelias :as pelias]
|
||
|
|
[lemondronor.circlebot.twitter :as twitter]
|
||
|
|
[lemondronor.circlebot.util :as util]))
|
||
|
|
|
||
|
|
(logging/deflog "circlebot" logger)
|
||
|
|
|
||
|
|
|
||
|
|
(defn parse-adsbexchange-ac-element [e]
|
||
|
|
(let [nilstr #(if (= % "") nil %)
|
||
|
|
numstr #(if (= % "") nil (js/parseFloat %))]
|
||
|
|
{:postime (numstr (e "postime"))
|
||
|
|
:lat (numstr (e "lat"))
|
||
|
|
:lon (numstr (e "lon"))
|
||
|
|
:icao (e "icao")
|
||
|
|
:registration (e "reg")
|
||
|
|
:alt (numstr (e "alt"))
|
||
|
|
:mlat? (= (e "mlat") "1")
|
||
|
|
:speed (numstr (e "spd"))
|
||
|
|
:squawk (nilstr (e "sqk"))
|
||
|
|
:military? (= (e "mil") "1")
|
||
|
|
:callsign (nilstr (e "call"))
|
||
|
|
:type (nilstr (e "type"))}))
|
||
|
|
|
||
|
|
|
||
|
|
(defn parse-adsbexchange-live-data [json-str]
|
||
|
|
{:aircraft
|
||
|
|
(map parse-adsbexchange-ac-element
|
||
|
|
(get
|
||
|
|
(js->clj (.parse js/JSON json-str))
|
||
|
|
"ac"))})
|
||
|
|
|
||
|
|
|
||
|
|
(defn get-adsbexchange-live-data [{:keys [url lat lon radius-nm api-key]}]
|
||
|
|
(let [url (->> [url
|
||
|
|
"lat" lat
|
||
|
|
"lon" lon
|
||
|
|
"dist" radius-nm]
|
||
|
|
(map str)
|
||
|
|
(string/join "/"))]
|
||
|
|
(p/let [http-result (util/http-get url {:headers {:api-auth api-key}})]
|
||
|
|
(let [result (parse-adsbexchange-live-data http-result)]
|
||
|
|
(log-verbose "Got %s aircraft from API" (count (:aircraft result)))
|
||
|
|
result))))
|
||
|
|
|
||
|
|
|
||
|
|
;; We keep position reports going back this far.
|
||
|
|
|
||
|
|
(def max-history-age-ms (* 25 60 1000))
|
||
|
|
|
||
|
|
|
||
|
|
;; Given a vector of position history, removes old entries.
|
||
|
|
|
||
|
|
(defn prune-history [history now]
|
||
|
|
(let [h (filterv #(< (- now (:time %)) max-history-age-ms) history)]
|
||
|
|
h))
|
||
|
|
|
||
|
|
|
||
|
|
(defn update-history-db-record [db ac]
|
||
|
|
(let [icao (:icao ac)
|
||
|
|
new-history-entry {:lat (:lat ac)
|
||
|
|
:lon (:lon ac)
|
||
|
|
:time (:postime ac)}]
|
||
|
|
(if (contains? db icao)
|
||
|
|
(let [old-record (db icao)
|
||
|
|
history (:history (db icao))
|
||
|
|
updated-record (-> old-record
|
||
|
|
(merge ac)
|
||
|
|
(assoc :history (conj history new-history-entry)))]
|
||
|
|
(assoc db icao updated-record))
|
||
|
|
(assoc db icao (assoc ac :history [new-history-entry])))))
|
||
|
|
|
||
|
|
|
||
|
|
(defn update-history-db-add-new-data [db new-data now]
|
||
|
|
(let [initial-count (count db)
|
||
|
|
initial-icaos (set (keys db))
|
||
|
|
updated-db (reduce update-history-db-record db new-data)
|
||
|
|
new-count (count updated-db)
|
||
|
|
new-icaos (set/difference (set (keys updated-db)) initial-icaos)]
|
||
|
|
(log-verbose "Added %s new aircraft records (%s). %s total."
|
||
|
|
(- new-count initial-count)
|
||
|
|
(string/join "," new-icaos)
|
||
|
|
new-count)
|
||
|
|
updated-db))
|
||
|
|
|
||
|
|
|
||
|
|
(defn prune-histories [db now]
|
||
|
|
(reduce-kv (fn [m k v]
|
||
|
|
(assoc m k (update v :history prune-history now)))
|
||
|
|
{}
|
||
|
|
db))
|
||
|
|
|
||
|
|
|
||
|
|
;; Removes entries for any aircraft that we haven't seen in a while.
|
||
|
|
|
||
|
|
(defn prune-records [db now]
|
||
|
|
(let [initial-count (count db)
|
||
|
|
initial-icaos (set (keys db))
|
||
|
|
pruned-db (reduce-kv (fn [m k v]
|
||
|
|
(if (or (> (count (:history v)) 0)
|
||
|
|
(if-let [ended-circling-time (:ended-circling-time v)]
|
||
|
|
(< (- now ended-circling-time) (* 20 60 1000))))
|
||
|
|
(assoc m k v)
|
||
|
|
m))
|
||
|
|
{}
|
||
|
|
db)
|
||
|
|
new-count (count pruned-db)
|
||
|
|
pruned-icaos (set/difference initial-icaos (set (keys pruned-db)))]
|
||
|
|
(log-verbose "Pruned %s stale aircraft records (%s). %s remain"
|
||
|
|
(- initial-count new-count)
|
||
|
|
(string/join "," pruned-icaos)
|
||
|
|
new-count)
|
||
|
|
pruned-db))
|
||
|
|
|
||
|
|
|
||
|
|
(defn debug-print [& args]
|
||
|
|
(apply println (drop 1 args))
|
||
|
|
(println (first args))
|
||
|
|
(first args))
|
||
|
|
|
||
|
|
|
||
|
|
(defn update-history-db [db new-data now]
|
||
|
|
(-> db
|
||
|
|
(update-history-db-add-new-data new-data now)
|
||
|
|
(prune-histories now)
|
||
|
|
(prune-records now)))
|
||
|
|
|
||
|
|
|
||
|
|
(defn write-history-db [db path]
|
||
|
|
(fs/writeFileSync path (with-out-str (fippedn/pprint db)))
|
||
|
|
db)
|
||
|
|
|
||
|
|
|
||
|
|
;; Reads the history database from a path. Returns a promise that
|
||
|
|
;; resolves to the database value.
|
||
|
|
|
||
|
|
(defn read-history-db [path]
|
||
|
|
(p/let [edn-str (util/read-file path {:encoding "utf-8"})
|
||
|
|
db (reader/read-string edn-str)]
|
||
|
|
(log-verbose "Loaded %s aircraft from database %s" (count db) path)
|
||
|
|
db))
|
||
|
|
|
||
|
|
|
||
|
|
(defn current-time []
|
||
|
|
(/ (.getTime (js/Date.)) 1))
|
||
|
|
|
||
|
|
|
||
|
|
;; This is how many degrees of turning we need to see over
|
||
|
|
;; max-history-age-ms ms to consider it a potential circling aircraft.
|
||
|
|
|
||
|
|
(def curviness-threshold-degrees 1440)
|
||
|
|
|
||
|
|
|
||
|
|
(defn ac-desc [ac]
|
||
|
|
(str (:icao ac) " " (:lat ac) " " (:lon ac)
|
||
|
|
" #" (:registration ac) " " (:alt ac) " " (:curviness ac) " "
|
||
|
|
(:normalized-curviness ac)))
|
||
|
|
|
||
|
|
|
||
|
|
(defn screenshot [icao lat lon]
|
||
|
|
(p/let [image-path
|
||
|
|
(adsbx/screenshot-aircraft icao lat lon
|
||
|
|
{:timeout 30000
|
||
|
|
;;:headless? false
|
||
|
|
;; :viewport {:width 1600 :height 800}
|
||
|
|
;; :clip {:width 1600 :height 800 :x 0 :y 0}
|
||
|
|
:vrs-settings (fs/readFileSync "vrs-settings.json" "utf-8")})]
|
||
|
|
(log-warn "%s: Got screenshot" icao)
|
||
|
|
image-path))
|
||
|
|
|
||
|
|
|
||
|
|
(defn circling? [ac]
|
||
|
|
(and (> (geo/flight-curviness (:history ac)) curviness-threshold-degrees)
|
||
|
|
(> (:alt ac) 300)))
|
||
|
|
|
||
|
|
|
||
|
|
;; Returns a vector of two elements,
|
||
|
|
;; [updated-database potentially-circling-aircraft]
|
||
|
|
|
||
|
|
(defn detect-circles [db now]
|
||
|
|
(log-verbose "Detecting circles")
|
||
|
|
(loop [old-db (seq db)
|
||
|
|
new-db {}
|
||
|
|
potential-circles '()]
|
||
|
|
(if (seq old-db)
|
||
|
|
(let [[icao ac] (first old-db)
|
||
|
|
curviness (geo/flight-curviness (:history ac))
|
||
|
|
ac (assoc ac
|
||
|
|
:curviness curviness
|
||
|
|
:normalized-curviness (geo/flight-normalized-curviness (:history ac)))
|
||
|
|
currently-circling? (circling? ac)
|
||
|
|
previously-circling? (:started-circling-time ac)]
|
||
|
|
(cond
|
||
|
|
(and currently-circling?
|
||
|
|
(not previously-circling?)
|
||
|
|
(or (nil? (:ended-circling-time ac))
|
||
|
|
(> (- now (:ended-circling-time ac)) (* 20 60 1000))))
|
||
|
|
(let [new-ac (assoc ac :started-circling-time now)]
|
||
|
|
(recur (rest old-db)
|
||
|
|
(assoc new-db icao new-ac)
|
||
|
|
(conj potential-circles new-ac)))
|
||
|
|
(and previously-circling?
|
||
|
|
(not currently-circling?))
|
||
|
|
(let [started-circling-time (:started-circling-time ac)
|
||
|
|
new-ac (assoc ac
|
||
|
|
:started-circling-time nil
|
||
|
|
:ended-circling-time now)]
|
||
|
|
(log-info "%s: Circle terminated after %s secs: %s"
|
||
|
|
icao
|
||
|
|
(/ (- now started-circling-time) 1000)
|
||
|
|
(ac-desc ac))
|
||
|
|
(recur (rest old-db)
|
||
|
|
(assoc new-db icao new-ac)
|
||
|
|
potential-circles))
|
||
|
|
:else
|
||
|
|
(recur (rest old-db)
|
||
|
|
(assoc new-db icao ac)
|
||
|
|
potential-circles)))
|
||
|
|
[new-db potential-circles])))
|
||
|
|
|
||
|
|
|
||
|
|
(defn parse-number [s]
|
||
|
|
(let [v (js/parseFloat s)]
|
||
|
|
(if (js/isNaN v)
|
||
|
|
(throw (str "Not a number: " s))
|
||
|
|
v)))
|
||
|
|
|
||
|
|
|
||
|
|
(defn debug-prn [x msg]
|
||
|
|
(println msg (with-out-str (fippedn/pprint x)))
|
||
|
|
x)
|
||
|
|
|
||
|
|
|
||
|
|
(defn closest-airport [lat lon]
|
||
|
|
(p/let [results (pelias/nearby lat lon
|
||
|
|
{:categories "transport:air:aerodrome"
|
||
|
|
:boundary.circle.radius 7})]
|
||
|
|
(-> results
|
||
|
|
(get :features)
|
||
|
|
(->> (sort-by #(get-in % [:properties :distance])))
|
||
|
|
first)))
|
||
|
|
|
||
|
|
|
||
|
|
(defn log-table [table keys]
|
||
|
|
(let [s (with-out-str (pprint/print-table keys table))
|
||
|
|
lines (string/split-lines s)]
|
||
|
|
(doseq [l lines]
|
||
|
|
(log-info "%s" l)))
|
||
|
|
)
|
||
|
|
|
||
|
|
(def description-templates
|
||
|
|
(map generation/parse-template
|
||
|
|
[(str "[{registration}|{militaryregistration}, a military aircraft,|"
|
||
|
|
"Aircraft with unknown registration, ICAO {icao}|"
|
||
|
|
"Military aircraft with unknown registration, ICAO {militaryicao}] "
|
||
|
|
"?:[(callsign {callsign}) ]"
|
||
|
|
"is circling over [{neighbourhood}, {locality}|{neighbourhood}, {county}|{locality}] "
|
||
|
|
"?:[at {alt} feet, ]"
|
||
|
|
"?:[speed {speed} MPH, ]"
|
||
|
|
"?:[squawking {squawk}, ]"
|
||
|
|
"?:[{nearbydistance} miles from {nearbylandmark} ]"
|
||
|
|
"?:[#{registration}|#{militaryregistration}]")]))
|
||
|
|
|
||
|
|
(defn expand-template [data]
|
||
|
|
(let [results (take 3 (generation/expand
|
||
|
|
description-templates
|
||
|
|
data
|
||
|
|
{:weights {:militaryregistration 4
|
||
|
|
:registration 3
|
||
|
|
:militaryicao 2
|
||
|
|
:icao 1
|
||
|
|
:neighbourhood 3
|
||
|
|
:locality 3}}))]
|
||
|
|
(log-table results [:score :text])
|
||
|
|
(first results)))
|
||
|
|
|
||
|
|
|
||
|
|
(defn generate-description [ac reverse wiki-nearby nearby]
|
||
|
|
(let [rev-props (:properties reverse)
|
||
|
|
nearby (:properties (first nearby))
|
||
|
|
wiki-nearby (:properties (first wiki-nearby))
|
||
|
|
info (cond-> (-> ac (dissoc :history) (merge rev-props))
|
||
|
|
(:military? ac)
|
||
|
|
(-> (assoc :militaryregistration (:registration ac)
|
||
|
|
:militaryicao (:icao ac)))
|
||
|
|
wiki-nearby
|
||
|
|
(assoc :nearbylandmark (:name wiki-nearby)
|
||
|
|
:nearbydistance (:distance wiki-nearby))
|
||
|
|
(and nearby (not wiki-nearby))
|
||
|
|
(assoc :nearbylandmark (:name nearby)
|
||
|
|
:nearbydistance (:distance nearby))
|
||
|
|
(:speed ac)
|
||
|
|
(assoc :speed (.toFixed (* (:speed ac) 1.15078) 0))
|
||
|
|
(= (:registration ac) (:callsign ac))
|
||
|
|
(dissoc :callsign)
|
||
|
|
;; TODO: If layer is "county", find the nearest city.
|
||
|
|
)
|
||
|
|
expansion (expand-template info)]
|
||
|
|
(log-info "Description data: %s" info)
|
||
|
|
(log-info "Description [score: %s] %s" (:score expansion) (:text expansion))
|
||
|
|
(:text expansion)))
|
||
|
|
|
||
|
|
|
||
|
|
(defn feature-has-wikipedia-page? [f]
|
||
|
|
(get-in f [:addendum :osm :wikipedia]))
|
||
|
|
|
||
|
|
|
||
|
|
;; If the centroid of the aircraft's positions is less than this close
|
||
|
|
;; to an airport, then it's probably just doinf flight training.
|
||
|
|
;;(def minimum-airport-distance-miles 2.5)
|
||
|
|
(def minimum-airport-distance-miles 0)
|
||
|
|
|
||
|
|
(defn process-potential-circle [ac config now]
|
||
|
|
(p/let [icao (:icao ac)
|
||
|
|
centroid (geo/centroid (filter #(< (- now (:time %)) (* 3 60 1000)) (:history ac)))
|
||
|
|
lat (:lat centroid)
|
||
|
|
lon (:lon centroid)
|
||
|
|
airport (closest-airport lat lon)
|
||
|
|
airport-properties (:properties airport)]
|
||
|
|
(log-info "%s: Recent centroid is %s %s" icao lat lon)
|
||
|
|
(if airport
|
||
|
|
(log-info "%s: Closest airport is %s, distance: %s"
|
||
|
|
(:icao ac) (:label airport-properties) (:distance airport-properties))
|
||
|
|
(log-info "%s: No airports nearby" (:icao ac)))
|
||
|
|
(if (and airport-properties (<= (:distance airport-properties) minimum-airport-distance-miles))
|
||
|
|
(log-info "%s: Filtering out because it's %s miles (minimum is %s) from %s"
|
||
|
|
(:icao ac)
|
||
|
|
(:distance airport-properties)
|
||
|
|
minimum-airport-distance-miles
|
||
|
|
(:label airport-properties)
|
||
|
|
())
|
||
|
|
(do
|
||
|
|
(p/let [coarse (pelias/reverse lat lon {:layers "coarse"})]
|
||
|
|
(let [coarse (first (:features coarse))]
|
||
|
|
(log-info "%s: Reverse geocode: %s" icao (:properties coarse))
|
||
|
|
;; Note that if we're over the ocean we get null :(
|
||
|
|
(if (or (nil? coarse)
|
||
|
|
;; TODO: Filter using the layer hierarchy; we want
|
||
|
|
;; anything smaller than "region" (state).
|
||
|
|
(= (get-in coarse [:properties :name]) "California"))
|
||
|
|
(log-info "%s: Filtering out because it is outside Los Angeles County" (:icao ac))
|
||
|
|
(p/then (p/all [(screenshot (:icao ac) lat lon)
|
||
|
|
(p/let [nearby (pelias/nearby lat lon {:boundary.circle.radius 100
|
||
|
|
:layers "venue"
|
||
|
|
:size 50})
|
||
|
|
nearby (:features nearby)
|
||
|
|
wiki-nearby (filter feature-has-wikipedia-page? nearby)]
|
||
|
|
(log-info "%s: Nearby geo search: %s potential landmarks, %s with wikipedia pages"
|
||
|
|
icao (count nearby) (count wiki-nearby))
|
||
|
|
(doseq [f wiki-nearby]
|
||
|
|
(log-info "%s: %s %s"
|
||
|
|
icao
|
||
|
|
(get-in f [:properties :label] f)
|
||
|
|
(get-in f [:properties :addendum] f)))
|
||
|
|
(let [description (generate-description ac coarse wiki-nearby nearby)]
|
||
|
|
(log-warn "Description: %s" description)
|
||
|
|
description))])
|
||
|
|
(fn [[image-path description]]
|
||
|
|
(if (and image-path description)
|
||
|
|
(if (:twitter config)
|
||
|
|
(twitter/tweet (twitter/twit (:twitter config))
|
||
|
|
description
|
||
|
|
[image-path])
|
||
|
|
(log-warn "Skipping tweeting: No twitter config provided"))
|
||
|
|
(log-warn "Skipping tweet %s %s" image-path description)))))))))))
|
||
|
|
|
||
|
|
|
||
|
|
(defn process-potential-circles [acs config now]
|
||
|
|
(p/loop [acs acs]
|
||
|
|
(when (seq acs)
|
||
|
|
(p/do
|
||
|
|
(process-potential-circle (first acs) config now)
|
||
|
|
(p/recur (rest acs))))))
|
||
|
|
|
||
|
|
|
||
|
|
(def history-db-path "advisory-circular.db")
|
||
|
|
(def secrets-path "secrets.yaml")
|
||
|
|
|
||
|
|
|
||
|
|
(defn main [& args]
|
||
|
|
(-> commander
|
||
|
|
(.requiredOption "--lat <lat>" "Latitude of the circle of region of interest" parse-number)
|
||
|
|
(.requiredOption "--lon <lat>" "Longitude of the circle of the region of interest" parse-number)
|
||
|
|
(.requiredOption "--url <url>" "API url")
|
||
|
|
(.option "--queue <queue url>" "Queue URL (graphile)")
|
||
|
|
(.option "--radius <radius>" "Radius of the circle of interest, in nautical miles" 20 parse-number)
|
||
|
|
(.parse (.-argv js/process)))
|
||
|
|
(let [start-time (current-time)]
|
||
|
|
(p/then (p/all [(read-history-db history-db-path)
|
||
|
|
(util/read-config secrets-path)])
|
||
|
|
(fn [[db config]]
|
||
|
|
(p/let [data (get-adsbexchange-live-data
|
||
|
|
{:url (.-url commander)
|
||
|
|
:api-key (get-in config [:adsbx :api-key])
|
||
|
|
:lat (.-lat commander)
|
||
|
|
:lon (.-lon commander)
|
||
|
|
:radius-nm (.-radius commander)})
|
||
|
|
now (current-time)
|
||
|
|
[new-db potential-circles] (-> db
|
||
|
|
(update-history-db (:aircraft data) now)
|
||
|
|
(detect-circles now))]
|
||
|
|
(p/do
|
||
|
|
(when potential-circles
|
||
|
|
(doseq [ac potential-circles]
|
||
|
|
(log-warn "%s: New circle detected: %s" (:icao ac) (ac-desc ac)))
|
||
|
|
(process-potential-circles potential-circles config now))
|
||
|
|
(write-history-db new-db history-db-path)
|
||
|
|
(let [end-time (current-time)]
|
||
|
|
(log-info
|
||
|
|
"Completed processing in %s seconds: tracking %s aircraft; %s potential circles"
|
||
|
|
(/ (- end-time start-time) 1000)
|
||
|
|
(count new-db)
|
||
|
|
(count potential-circles)))))))))
|