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.

]]>In the previous post I highlighted a few transducers I've implemented that were tailored to specific purposes, but my favorite is the one that taught me how to write transducers, one for exponential smoothing.

To demonstrate, we need a noisy signal. Here's a sum of 20 random sine waves:

```
(def signal
(let [rng (java.util.Random. 0)
signals (repeatedly 20 (fn []
{:amplitude (+ 1 (.nextInt rng 10))
:frequency (.nextDouble rng 100)}))]
(for [t (range 0 (* Math/PI 2) 0.01)]
[t (reduce +
(for [{:keys [amplitude frequency]} signals]
(* amplitude (Math/sin (* frequency t)))))])))
```

Exponential smoothing is a weighted average of the signal's current value and the previous weighted average. It's not quite a `map`

operation, because it depends on the previously emitted value, yet it can't be implemented via, say, `iterate`

because it also depends on values coming in from another sequence. Both of those facets suggest a transducer.

```
(defn exponential-smoothing [alpha]
(let [prev (volatile! nil)]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result [x y]]
(if-let [p @prev]
(let [s (+ (* alpha y) (* (- 1 alpha) p))]
(vreset! prev s)
(rf result [x s]))
(do
(vreset! prev y)
(rf result [x y]))))))))
```

Weighting is determined by the parameter `alpha`

. With a value of 0.5, `y`

and `p`

are averaged and exponential smoothing dulls the spikes in our signal but leaves the signal mostly intact:

```
(sequence
(exponential-smoothing 0.5)
signal)
```

We can smooth further by decreasing `alpha`

and reducing how much each incoming value is weighed:

```
(sequence
(exponential-smoothing 0.1)
signal)
```

The choice of `alpha`

depends on your use case and the characteristics of your data, but a little trial and error should help you home in on an appropriate value.

In the next post we'll look at an experimental transducer for transducing nested values.

]]>In the previous post I showed the transducer that taught me how to write transducers. Here I'll finish our discussion of transducers with an experimental transducer that operates on nested values.

Occasionally it can be useful to transduce over a field within a map or the Nth position of a vector, but it's awkward to extract the values, transduce over a new sequence, then merge the transduced sequence back into the items in the original sequence. To handle this more fluently, I've toyed with a transducer like this:

```
(defn lens
([k xf]
(lens k #(assoc %1 k %2) xf))
([getter setter xf]
(let [rf' (xf (completing (fn [result item] item)))]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result item]
(let [value (getter item)
new-value (rf' nil value)
new-item (setter item new-value)]
(rf result new-item))))))))
```

The twist in `lens`

is the alternate reducing function `rf'`

, which does nothing other than return the final item, the one that's passed through the transducer `xf`

. This allows us to get an item out of a collection, run it through a transducer pipeline, then put the result back into the original collection, which is then itself reduced.

Here's an example which increments the field `:x`

:

```
(def data
[{:x 1}
{:x 2}
{:x 3}
{:x 4}
{:x 5}
{:x 6}])
```

```
(sequence
(lens :x (map inc))
data)
```

```
({:x 2} {:x 3} {:x 4} {:x 5} {:x 6} {:x 7})
```

When the transduction doesn't return a value, `:x`

becomes `nil`

:

```
(sequence
(lens :x (filter even?))
data)
```

```
({:x nil} {:x 2} {:x nil} {:x 4} {:x nil} {:x 6})
```

The same results could have been found with a simple `map`

operation. Where `lens`

helps most is when you want to carry some state from one item to the next, such as when partitioning:

```
(sequence
(lens :x (partition-all 2))
data)
```

```
({:x nil} {:x [1 2]} {:x nil} {:x [3 4]} {:x nil} {:x [5 6]})
```

Because `rf'`

returns `nil`

when it doesn't get a final value, whenever `xf`

keeps a value in its internal state, `:x`

ends up without a value. Using a transducing form of `(partition n step pad coll)`

may be more meaningful:

`(require '[net.cgrand.xforms :as xf])`

```
(sequence
(lens :x (xf/partition 2 1))
data)
```

```
({:x nil} {:x [1 2]} {:x [2 3]} {:x [3 4]} {:x [4 5]} {:x [5 6]})
```

Or possibly some default value should be supplied:

```
(defn lens
([k xf default]
(lens k #(assoc %1 k %2) xf default))
([getter setter xf default]
(let [rf' (xf (completing (fn [result item] item)))]
(fn [rf]
(fn
([] (rf))
([result] (rf result))
([result item]
(let [value (getter item)
new-value (rf' default value)
new-item (setter item new-value)]
(rf result new-item))))))))
```

```
(sequence
(lens :x (filter even?) 0)
data)
```

```
({:x 0} {:x 2} {:x 0} {:x 4} {:x 0} {:x 6})
```

If you find a use for `lens`

, or improvements to it, please email me.

An old puzzle whose answer used to baffle me is one about a row of one hundred lockers that have students pass by opening or closing every Nth locker. The first student opens every locker, the second student opens or closes every second locker, the third student every third, and so on. After all 100 students pass by, which lockers remain open?

The answer is lockers 1, 4, 9, 16, 25, 36, 49, 64, 81, and 100â€”perfect squares. Why perfect squares should appear from nowhere I couldn't figure out. To see where they come from, I had to pivot the problem from thinking about students walking down the row of lockers to thinking about each locker and what students interacted with it.

- Locker #1 is only interacted with by the first student, so it's never closed after being opened.
- Locker #2 is only interacted with by the first and second students, so it ends up closed.
- Locker #3 is only interacted with by the first and third students, so it ends up closed.
- Locker #4 is interacted with by the first, second, and fourth students, an odd number, so it gets opened a second time and from then on remains open.
- Locker #5 is only interacted with by the first and fifth students, ending up closed.
- Locker #6 is interacted with by the first, second, third, and sixth students, an even number, so it ends up closed.
- Locker #7 is interacted with by the first and seventh students, ending up closed.
- And so on.

Notice that the state of the locker depends on how many factors the locker's number has. Most numbers have an even number of factors because factors come in pairs: e.g., 8 has factors 1 and 8, and 2 and 4. Perfect squares, on the other hand, also have factors that come in pairs as well, but one of the pairs is just the same number twice, creating an *odd* number of distinct factors: 16 has factor pairs 1Ã—16, 2Ã—8, and 4Ã—4. Students 1, 2, 4, 8, and 16 will toggle locker #16's door, but even though 4Ã—4 is a factor pair, the fourth student only toggles the door once, which creates the imbalance that leaves locker #16 to open at the end.

What's clever about this puzzle is that it stems from a simple observation about how many distinct factors different kinds of numbers have, but that observation has been pivoted and hidden inside a sequential puzzle that seems tedious and manual to work out. Someone did that deliberately, but probably a lot of life's puzzles hide similar observations accidentally, and a little pivot to how we're thinking about it can help us cut through the tedium to find something slightly magical.

]]>Calculating the position of a body in orbit of the sun only requires a handful of parameters, so in this post and the next I'll walk through the steps. This post will show how to orient an ellipse around the sun, while the next post will work out where on that ellipse the body is on an arbitrary date.

Wikipedia articles on objects in the solar system the sun often list their orbital parameters, and while terms like "longitude of the ascending node" and "argument of perihelion" sound highly technical, their use in orienting an orbit around the sun is straight-forward. If you want to understand the terminology better, I suggest Wikipedia's article on orbital elements. Here I'll focus mainly on implementation.

Here are the parameters we need for calculating orbital ellipses:

Body | Semi-major axis (m) | Inclination | Longitude of ascending node | Argument of perihelion | Eccentricity |
---|---|---|---|---|---|

Mercury | 5.791e+10 | 7.005Â° | 48.331Â° | 29.124Â° | 0.20563 |

Venus | 1.082e+11 | 3.39458Â° | 76.86Â° | 54.884Â° | 0.006772 |

Earth | 1.496e+11 | 5.0E-5Â° | -11.26064Â° | 114.20783Â° | 0.0167086 |

Mars | 2.279e+11 | 1.85Â° | 49.558Â° | 286.502Â° | 0.0934 |

Jupiter | 7.785e+11 | 1.303Â° | 100.464Â° | 273.867Â° | 0.0489 |

Saturn | 1.434e+12 | 2.485Â° | 113.665Â° | 339.392Â° | 0.0565 |

Uranus | 2.871e+12 | 0.773Â° | 74.006Â° | 96.998857Â° | 0.04717 |

Neptune | 4.500e+12 | 1.77Â° | 131.783Â° | 273.187Â° | 0.008678 |

Pluto | 5.906e+12 | 17.16Â° | 110.299Â° | 113.834Â° | 0.2488 |

The planets' orbits (aside from Mercury) have low eccentricity and all but circular orbits, so I've included Pluto in the diagrams below to make it easier to see that we're working with ellipses.

The distance of an ellipse from one of its foci is given by the equation

where *a* is the ellipse's semi-major axis and *e* is its eccentricity. In Clojure,

```
(defn distance [semi-major-axis eccentricity]
(fn [angle]
(/ (* semi-major-axis (- 1 (* eccentricity eccentricity)))
(+ 1 (* eccentricity (Math/cos (Math/toRadians angle)))))))
```

The above orbital ellipses can now be calculated in two dimensions:

```
(defn polar->cartesian [radius angle]
[(* radius (Math/cos (Math/toRadians angle)))
(* radius (Math/sin (Math/toRadians angle)))
0])
```

```
(defn ellipse [{:keys [semi-major-axis eccentricity]}]
(let [dist (distance semi-major-axis eccentricity)]
(map (fn [angle]
(polar->cartesian (dist angle) angle))
(range 0 360))))
```

This isn't an accurate diagram of the solar system. For starters, the planets' closest approaches to the sun are all on the same side. To rotate perihelia to the correct positions, we'll use matrix multiplication:

```
(defn dot-product [v1 v2]
(reduce + (map * v1 v2)))
```

```
(defn transform [matrix coord]
(map #(dot-product % coord) matrix))
```

Here's a matrix to rotate around the Z-axis:

```
(defn rotate-z [angle]
(let [theta (Math/toRadians angle)]
[[(Math/cos theta) (- (Math/sin theta)) 0]
[(Math/sin theta) (Math/cos theta) 0]
[0 0 1]]))
```

Building on `ellipse`

, we rotate each coordinate around the Z-axis:

```
(defn orbit
[{:keys [argument-of-perihelion]
:as body}]
(sequence
(map (partial transform (rotate-z argument-of-perihelion)))
(ellipse body)))
```

This still isn't quite right, since there's a second rotation around the Z-axis we still need to do. First, however, we need to add inclination, which requires rotation around the X-axis:

```
(defn rotate-x [angle]
(let [theta (Math/toRadians angle)]
[[1 0 0]
[0 (Math/cos theta) (- (Math/sin theta))]
[0 (Math/sin theta) (Math/cos theta)]]))
```

```
(defn orbit
[{:keys [argument-of-perihelion
inclination]
:as body}]
(sequence
(comp
(map (partial transform (rotate-z argument-of-perihelion)))
(map (partial transform (rotate-x inclination))))
(ellipse body)))
```

It's hard to see the change since we're looking top-down, but notice the gap where Pluto's orbit dips inside Neptune's: between the last map and this one, it's become noticeably larger, an effect of Pluto's orbit tipping to an inclination of 17Â° while Neptune's is less than 2Â°.

The last step to get the orbits in the right places is to rotate them around the Z-axis by the longitude of the ascending node:

```
(defn orbit
[{:keys [argument-of-perihelion
inclination
longitude-of-ascending-node]
:as body}]
(sequence
(comp
(map (partial transform (rotate-z argument-of-perihelion)))
(map (partial transform (rotate-x inclination)))
(map (partial transform (rotate-z longitude-of-ascending-node))))
(ellipse body)))
```

There we have it. Pluto's orbit looks the same as on Wolfram Alpha.

Locating the planets on these orbits requires some basic numerical approximation that we'll explore in the next post.

]]>In the previous post I showed how to map an elliptical orbit around the sun, but I didn't show where any planets were in their orbits. Due to the inconstant speed of objects in elliptical orbits, finding their exact positions requires some numerical approximation.

Orbital parameters for a body will usually give three parameters that we can use to determine its location on any date: orbital period, mean anomaly at epoch, and the epoch itself. We'll use the common epoch of J2000, since that's what Wikipedia gives in its sidebars on the planets.

```
(defn local-date [d]
(-> d
(.toInstant)
(.atZone (java.time.ZoneId/of "UTC"))
(.toLocalDate)))
```

`(def J2000 (local-date #inst "2000-01-01T12:00:00Z"))`

The positional parameters for J2000:

Body | Period (days) | Mean anomaly at epoch |
---|---|---|

Mercury | 87.97 | 174.796Â° |

Venus | 224.70 | 50.115Â° |

Earth | 365.26 | 358.617Â° |

Mars | 686.98 | 19.412Â° |

Jupiter | 4332.59 | 20.02Â° |

Saturn | 10759.22 | 317.02Â° |

Uranus | 30688.50 | 142.2386Â° |

Neptune | 60195.00 | 256.228Â° |

Pluto | 90560.00 | 14.53Â° |

The first step in calculating an orbiting body's position is to convert the mean anomaly at the epoch to the mean anomaly on some other date. The mean anomaly indicates how far around the orbit the body would be on a circular orbit, so to find the mean anomaly for another date, we calculate how many orbits the body could have completed since the epoch and add it to the mean anomaly at the epoch:

`(import '[java.time.temporal ChronoUnit])`

```
(defn mean-anomaly [{:keys [mean-anomaly-at-epoch period epoch]} time]
(let [days-difference (.between ChronoUnit/DAYS epoch time)]
(mod (Math/toDegrees
(+ (Math/toRadians mean-anomaly-at-epoch)
(/ (* 2 Math/PI days-difference)
period)))
360)))
```

Testing it out:

`(def today (local-date #inst "2022-11-17T00:00:00Z"))`

```
(map (juxt :name
#(mean-anomaly % today))
bodies)
```

```
(["Mercury" 170.4396976165517]
["Venus" 117.50535429303818]
["Earth" 314.3667491893302]
["Mars" 78.2294328219159]
["Jupiter" 354.3298700777133]
["Saturn" 236.6090408412506]
["Uranus" 240.2609862358864]
["Neptune" 306.2015858460005]
["Pluto" 47.74731448763251])
```

Before we can get the actual angle of a body around the sun, we need to convert mean anomaly to eccentric anomaly, which is the angle of the body on an ellipse instead of a circle, but with the sun at the center instead of one focus. While the eccentric anomaly can be used to calculate the mean anomaly with

it's not so easy to solve for *E*, so we'll have to find it numerically. We can use Newton's method, providing the mean anomaly as an initial guess:

```
(defn newtons-method [f f' x0 tolerance]
(loop [x x0]
(let [x' (- x (/ (f x) (f' x)))]
(if (< tolerance (Math/abs (- x x')))
(recur x')
x'))))
```

```
(defn eccentric-anomaly [mean-anomaly eccentricity]
(let [mean-anomaly (Math/toRadians mean-anomaly)]
(Math/toDegrees
(newtons-method
#(- % (* eccentricity (Math/sin %)) mean-anomaly)
#(- 1 (* eccentricity (Math/cos %)))
mean-anomaly
1e-7))))
```

The values are only slightly different, even for more eccentric Mercury and Pluto:

```
(map (juxt :name
(fn [{:keys [eccentricity] :as body}]
(-> body
(mean-anomaly today)
(eccentric-anomaly eccentricity))))
bodies)
```

```
(["Mercury" 172.06596434790993]
["Venus" 117.84842485398484]
["Earth" 313.67433319664093]
["Mars" 83.54695355396832]
["Jupiter" 354.0388977811991]
["Saturn" 233.9904005230953]
["Uranus" 237.96977181287355]
["Neptune" 305.79830595492984]
["Pluto" 60.10581321804513])
```

With the eccentric anomaly we can finally calculate the true anomaly, which is the actual angle of a body in an elliptical orbit with the sun at one focus. The calculation is

I've chosen this form not just for the symmetry of the expression but also because this fractional form allows us to use Java's `Math.atan2`

function to avoid quadrant calculations:

```
(defn true-anomaly [eccentric-anomaly eccentricity]
(let [eccentric-anomaly (Math/toRadians eccentric-anomaly)]
(Math/toDegrees
(* 2 (Math/atan2 (* (Math/sqrt (+ 1 eccentricity))
(Math/sin (/ eccentric-anomaly 2)))
(* (Math/sqrt (- 1 eccentricity))
(Math/cos (/ eccentric-anomaly 2))))))))
```

```
(map (juxt :name
(fn [{:keys [eccentricity] :as body}]
(-> body
(mean-anomaly today)
(eccentric-anomaly eccentricity)
(true-anomaly eccentricity))))
bodies)
```

```
(["Mercury" 173.55630152670443]
["Venus" 118.19095653246261]
["Earth" 312.97785906507903]
["Mars" 88.90040394221349]
["Jupiter" 353.74049105531617]
["Saturn" 231.4129514495962]
["Uranus" 235.7059134207224]
["Neptune" 305.3939939703652]
["Pluto" 73.44522413262469])
```

Let's finally draw bodies in their correct positions. Here are a couple functions similar to `ellipse`

and `orbit`

from the previous post:

```
(defn elliptical-position [{:keys [semi-major-axis eccentricity] :as body} time]
(let [true-anom (-> body
(mean-anomaly time)
(eccentric-anomaly eccentricity)
(true-anomaly eccentricity))
dist (distance semi-major-axis eccentricity)]
(polar->cartesian (dist true-anom) true-anom)))
```

```
(defn orbit-position
[{:keys [argument-of-perihelion
inclination
longitude-of-ascending-node]
:as body}
time]
(->> (elliptical-position body time)
(transform (rotate-z argument-of-perihelion))
(transform (rotate-x inclination))
(transform (rotate-z longitude-of-ascending-node))))
```

To check our work, compare the above view with WolframAlpha or a more sophisticated map for November 17, 2022.

]]>In an earlier post I wrote about creating hand-drawn QR code-like images during long meetings. Rather than drawing very large grids, we can use small grids to generate abstract logos or identicons: