functional navigational programming blog post

bank1.clj

(defn pay-fee [world]
  (transfer world
            [:people ALL :money]
            [:bank :funds]
            1))

bank2.clj

(defn bank-give-dollar [world]
  (transfer world
            [:bank :funds]
            [:people ALL :money]
            1))

bank3.clj

(defn user [name]
  [:people
   ALL
   #(= (:name %) name)])

bank4.clj

(defn transfer-users [world from to amt]
  (transfer world
            [(user from) :money]
            [(user to) :money]
            amt))

bank5.clj

(defn user->bank [world from amt]
  (transfer world
            [(user from) :money]
            [:bank :funds]
            amt))

bank6.clj

(defn bank-loyal-bonus [world]
  (transfer world
            [:bank :funds]
            [:people (srange 0 3) ALL :money]
            5000))

bench1.clj

(def DATA {:a {:b {:c 1}}})
(def compiled-path (comp-paths :a :b :c))

(benchmark 1000000 #(get-in DATA [:a :b :c]))
;; => "Elapsed time: 77.018 msecs"

(benchmark 1000000 #(select [:a :b :c] DATA))
;; => "Elapsed time: 4143.343 msecs"

(benchmark 1000000 #(select compiled-path DATA))
;; => "Elapsed time: 63.183 msecs"

(benchmark 1000000 #(compiled-select compiled-path DATA))
;; => "Elapsed time: 51.964 msecs"

(benchmark 1000000 #(-> DATA :a :b :c vector))
;; => "Elapsed time: 34.235 msecs"

bench2.clj

(benchmark 1000000 #(update-in DATA [:a :b :c] inc))
;; => "Elapsed time: 1037.94 msecs"

(benchmark 1000000 #(transform [:a :b :c] inc DATA))
;; => "Elapsed time: 4305.429 msecs"

(benchmark 1000000 #(transform compiled-path inc DATA))
;; => "Elapsed time: 184.593 msecs"

(benchmark 1000000 #(compiled-transform compiled-path inc DATA))
;; => "Elapsed time: 169.841 msecs"

(defn manual-transform [data]
  (update data
          :a
          (fn [d1]
            (update d1
                    :b
                    (fn [d2]
                      (update d2 :c inc))))))
(benchmark 1000000 #(manual-transform DATA))
;; => "Elapsed time: 161.945 msecs"

compiled1.clj

(def compiled-path (comp-paths ALL :a even?))
(transform compiled-path
           inc
           [{:a 2 :b 3} {:a 1} {:a 4}])

compiled2.clj

(transform [(srange 4 11) (filterer even?)]
           reverse
           [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15])

compiled3.clj

(defn reverse-matching-in-range [aseq start end predicate]
  (transform [(srange start end) (filterer predicate)]
             reverse
             aseq))

compiled4.clj

(let [compiled-path (comp-paths srange (filterer pred))]
  (defn reverse-matching-in-range [aseq start end predicate]
    (compiled-transform (compiled-path start end predicate)
	                reverse
	                aseq)))

compiled5.clj

(def user
  (comp-paths :people
              ALL
              (paramsfn [name]
                        [elem]
                        (= name (:name elem)))
              ))

(def user-money (comp-paths user :money))

(def BANK-MONEY (comp-paths :bank :funds))

(defn user->bank [world name amt]
  (transfer world (user-money name) BANK-MONEY amt))

ex1.clj

(transform [ALL :a even?]
            inc
            [{:a 2 :b 3} {:a 1} {:a 4}])
;; => [{:a 3 :b 3} {:a 1} {:a 5}]

ex2.clj

(transform [(filterer odd?) LAST]
           inc
           [2 1 3 6 9 4 8])
;; => [2 1 3 6 10 4 8]

ex3.clj

(transform [(srange 4 11) (filterer even?)]
           reverse
           [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15])
;; => [0 1 2 3 10 5 8 7 6 9 4 11 12 13 14 15]

ex4.clj

(select [ALL ALL #(= 0 (mod % 3))]
        [[1 2 3 4] [] [5 3 2 18] [2 4 6] [12]])
;;=> [3 3 18 6 12]

kw.clj

(extend-type clojure.lang.Keyword
  StructurePath
  (select* [kw structure next-fn]
    (next-fn (get structure kw)))
  (transform* [kw structure next-fn]
    (assoc structure kw (next-fn (get structure kw)))
    ))

manual-user-bank.clj

(defn user->bank [world name amt]
  (let [;; First, find out how much money that user has
        ;; to determine whether or not this is a valid transfer
        curr-funds (->> world
                        :people
                        (filter (fn [user] (= (:name user) name)))
                        first
                        :money
                        )]
   (if (< curr-funds amt)
     (throw (IllegalArgumentException. "Not enough funds!"))
     ;; If valid, then need to subtract the transfer amount from the
     ;; user and add the amount to the bank
     (-> world
         (update 
           :people
           (fn [user-list]
             ;; Important to use mapv to maintain the type of the 
             ;; sequence containing the list of users. This code
             ;; modifies the user matching the name and keeps
             ;; every other user in the sequence the same.
             (mapv (fn [user]
                     ;; Notice how nested this code is that manipulates the users          
                     (if (= (:name user) name)
                       (update user :money #(+ % amt))
                       ;; If a user doesn't match the name during the scan,
                       ;; don't modify them
                       user
                       ))
                   user-list)))
         (update-in
           [:bank :funds]
           #(- % amt))
           ))))

prot.clj

(defprotocol StructurePath
  (select* [this structure next-fn])
  (transform* [this structure next-fn])
  )

transfer.clj

(defn transfer
  "Note that this function works on *any* world structure. This handles
   arbitrary many to many transfers of a fixed amount without overdrawing anyone"
  [world from-path to-path amt]
  (let [;; Get the sequence of funds for all entities making a transfer
        givers (select from-path world)

        ;; Get the sequence of funds for all entities receiving a transfer
        receivers (select to-path world)

        ;; Compute total amount each receiver will be credited
        total-receive (* amt (count givers))

        ;; Compute total amount each transferrer will be deducted
        total-give (* amt (count receivers))]

    ;; Make sure every transferrer has sufficient funds
    (if (every? #(>= % total-give) givers)
      (->> world
           ;; Deduct from transferrers
           (transform from-path #(- % total-give))
           ;; Credit the receivers
           (transform to-path #(+ % total-receive))
           )
      (throw (IllegalArgumentException. "Not enough funds!"))
      )))

world.clj

(def world
  {:people [{:money 129827 :name "Alice Brown"}
            {:money 100 :name "John Smith"}
            {:money 6821212339 :name "Donald Trump"}
            {:money 2870 :name "Charlie Johnson"}
            {:money 8273821 :name "Charlie Rose"}
            ]
   :bank {:funds 4782328748273}}
  )