exupero's blog
RSSApps

Specialty transducers

While the previous post highlighted transducers I've used time and again, here are transducers whose uses are more obscure, their original purposes lost to time. I present them here because I've often found these tiny bundles of stateful logic easier to write and use than their more purely functional equivalents, yet despite their mutative logic, they retain a clean functional interface that doesn't pollute surrounding code with their mutations.

take-until-repeat quits reducing as soon as it sees an item a second time:

(defn take-until-repeat [rf]
  (let [seen (volatile! #{})]
    (fn
      ([] (rf))
      ([result] (rf result))
      ([result item]
       (if (@seen item)
         (reduced result)
         (do (vswap! seen conj item)
           (rf result item)))))))
(sequence
  take-until-repeat
  [1 2 3 5 1 7 9 8 2 7])
(1 2 3 5)

halt-when-result quits as soon as the reduced value meets some criteria:

(defn halt-when-result [pred]
  (fn [rf]
    (fn
      ([] (rf))
      ([result] (rf result))
      ([result item]
       (let [ret (rf result item)]
         (if (pred ret)
           (reduced ret)
           ret))))))
(transduce
  (halt-when-result #(even? (reduce + %)))
  conj
  [1 2 4 1 7 9 8 2 7])
[1 2 4 1]

The example above uses transduce because sequence provides an rf that doesn't return anything other than nil. Probably that means one shouldn't try using the sum result of the previous transductions in a pipeline in the current transducing function, but this suited my purpose well enough, whatever it was.

interpolate I used in an old implementation of island generation. It inserts a value between each pair of values, handing the pair to the given function so the inserted value can be derived from them:

(defn interpolate [f]
  (let [prev (volatile! nil)]
    (fn [rf]
      (fn
        ([] (rf))
        ([result] (rf (rf result @prev)))
        ([result item]
         (let [p @prev]
           (vreset! prev item)
           (if p
             (-> result
                 (rf p)
                 (rf (f p item)))
             result)))))))
(sequence
  (interpolate #(float (/ (+ %1 %2) 2)))
  [1 2 4 8 16])
(1 1.5 2 3.0 4 6.0 8 12.0 16)

This is one of the relatively rare examples of a transducer that feeds multiple items into the reducing function.

interpolate can also be implemented in terms of the xforms library:

(require '[net.cgrand.xforms :as xf])
(defn interpolate-2 [f]
  (comp
    (xf/partition 2 1 (repeat nil))
    (mapcat (fn [[a b]]
              (if b
                [a (f a b)]
                [a])))))
(sequence
  (interpolate-2 #(float (/ (+ %1 %2) 2)))
  [1 2 4 8 16])
(1 1.5 2 3.0 4 6.0 8 12.0 16)

spillover is a bit curious. For each item it calls a given function k and saves truthy values, which it then passes to the mapping function alongside each item for which k returned a falsey value:

(defn spillover [k f]
  (fn [rf]
    (let [value (volatile! nil)]
      (fn
        ([] (rf))
        ([result] (rf result))
        ([result item]
         (if-let [v (k item)]
           (do (vreset! value v)
             (rf result item))
           (rf result (f item @value))))))))
(sequence
  (spillover :category #(assoc %1 :category %2))
  [{:x 1 :category :start}
   {:x 2}
   {:x 3}
   {:x 4 :category :end}
   {:x 5}])
({:x 1, :category :start}
 {:x 2, :category :start}
 {:x 3, :category :start}
 {:x 4, :category :end}
 {:x 5, :category :end})

I don't recall exactly what would cause the original data to be structured in such a way, but my best guess is data in log files needed to be carried over to subsequent lines.

Finally, zip-with is inspired by the vararg version of map, but the first argument to the mapping function is taken from the reducing context:

(defn zip-with [f & seqs]
  (let [cs (volatile! seqs)]
    (fn [rf]
      (fn
        ([] (rf))
        ([result] (rf result))
        ([result item]
         (let [ss (map seq @cs)]
           (if (every? identity ss)
             (do
               (vswap! cs #(map rest %))
               (rf result (apply f item (map first ss))))
             result)))))))
(sequence
  (zip-with *
    [1 1 2 3 5]
    [1 -1 1 -1 1])
  [1 2 4 8 16])
(1 -2 8 -24 80)

sequence has the built-in feature that when its first transducer is map, additional arguments are supplied as they are to map:

(sequence
  (map *)
  [1 2 4 8 16]
  [1 1 2 3 5]
  [1 -1 1 -1 1])
(1 -2 8 -24 80)

zip-with was probably written when I needed similar behavior further down the transducer pipeline.

In the next post we'll look at a specialty transducer for signal processing.