Skip to content

Instantly share code, notes, and snippets.

@jsmorph
Created July 6, 2012 18:50
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save jsmorph/3062006 to your computer and use it in GitHub Desktop.
Save jsmorph/3062006 to your computer and use it in GitHub Desktop.
St. Louis Fed FRED relation for clojure.core.logic
(ns logicrels.fred
(:require [clojure.xml :as xml]
[clojure.core.logic :as logic]))
;; (config :fred-key (do "See http://api.stlouisfed.org/api_key.html" nil))
;; (clojure.pprint/pprint (sort-by :date (fred-test "DGS10" "2012-07-02")))
;; ({:target "1.61", :date "2012-05-31", :value "1.59"}
;; {:target "1.61", :date "2012-06-01", :value "1.47"}
;; {:target "1.61", :date "2012-06-04", :value "1.53"}
;; {:target "1.61", :date "2012-06-05", :value "1.57"}
;; {:target "1.61", :date "2012-06-11", :value "1.60"}
;; {:target "1.61", :date "2012-06-15", :value "1.60"}
;; {:target "1.61", :date "2012-06-18", :value "1.59"}
;; {:target "1.61", :date "2012-06-28", :value "1.60"})
(let [m (ref {:max-query-results 1024
:verbose true})]
(defn config
"Configuration. Call with no args to see the current
configuration. Get a configuration property's value by passing the
property to this function. Change the config using the two-argument
dispatch."
([] @m)
([k] (@m k))
([k v] (dosync (alter m assoc k v)))))
(defonce get-series
(memoize
(fn
([key series]
(when (not key)
(throw (new IllegalArgumentException
(str "Need a FRED API key at (config :fred-key). "
"See http://api.stlouisfed.org/api_key.html."))))
(map #(assoc (:attrs %) :series series)
(:content
(xml/parse
(str "http://api.stlouisfed.org/fred/series/observations?series_id="
series "&api_key=" key))))))))
(defn submap?
([big small]
(loop [pairs small]
(if (empty? pairs)
true
(let [[[k v] & more] (seq pairs)]
(if (= (big k) v)
(recur more)
false))))))
(defn query-series
([key series m]
(when (not series)
(throw (new IllegalArgumentException "Need to specify :series.")))
(filter #(submap? % m)
(get-series key series))))
(defn fred-rel [q]
(fn [a]
(let [walked (logic/walk* a q)
vars (set (map first walked))
bound (into {} (remove (comp logic/lvar? last) walked))]
(logic/to-stream
(map #(logic/unify a % q)
(map #(into {}
(filter (comp vars first)
%))
(query-series (config :fred-key)
(:series bound)
bound)))))))
(defn fred-test
"Silly example: Find the dates and values when the given series
value exceeds the value on the given date."
([series date]
(logic/run* [q]
(logic/fresh [x d y]
(fred-rel {:series series :date date :value x})
(fred-rel {:series series :date d :value y})
(logic/project [x y]
(logic/== true
(and (not (= "." x))
(not (= "." y))
(< (Double/parseDouble y)
(Double/parseDouble x)))))
(logic/== q {:target x :date d :value y}))))
([]
(fred-test "DGS10" "2012-06-02")))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment