I was playing around with `codeworld-api`

recently, and found myself with a pair of interesting problems:

- Place (move and scale) a grid (represented as a CodeWorld
`Picture`

) onto the canvas; and - When responding to mouse clicks on the grid, reverse the transformation that placed the grid, so that I can determine which grid cell was clicked.

Placing the picture is easy — `codeworld-api`

provides two
functions that do exactly what I want:

`translated :: Double -> Double -> Picture -> Picture`

`scaled :: Double -> Double -> Picture -> Picture`

Going the other way is more difficult. After noodling around on paper trying to compute the inverse transform, I remembered that these transformations could be represented as 3x3 matrices (Wikipedia has some examples), and that inverting a 3x3 matrix is easy (provided that the affine transformation it represents hasn’t collapsed the space).

This means I have to compute the transformation twice: once as
`codeworld-api`

calls, and once as matrices. Or do I?

Let’s invent a simple DSL instead. We’ll start by defining a type for our transformations:

```
data Transform
= Scale Double Double
| Translate Double Double
```

We’ll also define the fold for `Transform`

, as this will
make it much easier to implement one of our interpreters. These
functions are often really handy as a compact way to do
`case`

-analysis on a value:

```
-- Note: transform Scale Translate = id (over Transform)
-- , just as foldr (:) [] = id (over lists)
-- , and maybe Nothing Just = id (over Maybe a)
transform :: (Double -> Double -> a) -- ^ Handle 'Scale'
-> (Double -> Double -> a) -- ^ Handle 'Translate'
-> Transform
-> a
Scale x y) = f x y
transform f _ (Translate x y) = g x y transform _ g (
```

Now, we need to interpret some `Transform`

s into either a
matrix or a `codeworld-api`

function. In Haskell, DSLs are
often associated with free monads and effect systems, but all we want is
a linear sequence of commands, so a list will do fine.

Both interpretations are essentially `foldMap`

over different monoids:

- To construct a matrix, map each
`Transform`

into a matrix, then multiply them all together. - To construct a function
`Picture -> Picture`

, map each`Transform`

into such a function, then compose them all together.

Unfortunately, the `Monoid`

instances don’t give us what
we want:

We’ll be using the matrix types and functions from Ed Kmett’s

`linear`

package, which considers matrices as vectors of vectors. The`Monoid`

instance for vectors is elementwise append; andThe

`Monoid`

instance for functions is`instance Monoid b => Monoid (a -> b)`

, which combines results. That’s not what we want either — we want the instance associated with the`Endo a`

newtype.

We could stand up a `newtype`

for matrix multiplication,
but it’s a lot of syntactic noise for a single use. Having noted that
these are both `foldMap`

, let’s move along and implement them
manually.

Let’s start with
`toMatrix :: [Transform] -> M33 Double`

.
`M33 Double`

is the type of a 3x3 matrix of
`Double`

(a 3-vector of (3-vectors of
`Double`

)):

```
-- (!*!) is matrix multiplication
toMatrix :: [Transform] -> M33 Double
= foldr (!*!) identity $ map toMatrix' list
toMatrix list where
Translate x y) = V3
toMatrix' (V3 1 0 x)
(V3 0 1 y)
(V3 0 0 1)
(
Scale x y) = V3
toMatrix' (V3 x 0 0)
(V3 0 y 0)
(V3 0 0 1) (
```

My friend Tony taught me (and many others) that `foldr`

performs *constructor replacement*. If we write the
`(:)`

calls in prefix position, we can see that
`map`

is expressible in terms of `foldr`

:

```
map f (x1 : x2 : [])
= f x1 : f x2 : [] -- Effect of `map`
= (:) (f x1) ((:) (f x2) []) -- Rewrite in prefix position
= ((:) . f) x1 (((:) . f) x2 []) -- Observing that g (f x) = (g . f) x
= foldr ((:) . f) [] (x1 : x2 : []) -- Noting that we replaced (:) with (:) . f
-- and we replaced [] with []
```

In our `toMatrix`

case, we’re using `map`

to:

- replace
`(:)`

with`(:) . toMatrix'`

; and - replace
`[]`

with`[]`

We then immediately replace `(:)`

with `(!*!)`

and `[]`

with `identity`

. This suggests that we
can avoid folding twice, by:

- replacing
`(:)`

with`(!*!) . toMatrix'`

; and - replacing
`[]`

with`identity`

.

This works, and we can avoid explicitly naming and applying the
`list`

argument while we’re at it (a process called
*eta-reduction*):

```
toMatrix :: [Transform] -> M33 Double
= foldr ((!*!) . toMatrix') identity
toMatrix where
Translate x y) = V3
toMatrix' (V3 1 0 x)
(V3 0 1 y)
(V3 0 0 1)
(
Scale x y) = V3
toMatrix' (V3 x 0 0)
(V3 0 y 0)
(V3 0 0 1) (
```

The interpreter for `codeworld-api`

functions only needs a
couple of changes:

- We use
`transform`

to apply the arguments from`Transform`

’s construtors to the appropriate`codeworld-api`

functions (giving us functions`Picture -> Picture`

instead of matrices); and `(.)`

composes all the functions into one, like how we previously used`(!*!)`

to multiply all the matrices together.

```
toCodeWorld :: [Transform] -> Picture -> Picture
= foldr ((.) . transform CodeWorld.translated CodeWorld.scaled) id toCodeWorld
```

The rest is fairly mechanical. We can now write a canonical way to
compute the `[Transform]`

that places the grid on the
screen:

```
gridTransforms :: Grid -> [Transform]
=
gridTransforms g Scale (scaleFactor g) (scaleFactor g) -- Shrink to fit viewport
[ -- Centre it around the origin
, toCenter g ]
```

Rendering the grid is done by interpreting the
`[Transform]`

into a `Picture -> Picture`

and
applying it to the drawn grid:

```
renderGrid :: Grid -> Picture
= toCodeWorld (gridTransforms g) (drawGrid g) renderGrid g
```

Finally, we convert screen coordinates to grid coordinates by interpreting the transforms into a matrix, inverting it, multiplying the inverse matrix with the screen coordinate (as a vector) and rounding the results:

```
fromPoint :: Grid -> Point -> Maybe (Int, Int)
fromPoint g (x, y)| x' >= 0 && x' < w && y' >= 0 && y' < h = Just (x', y')
| otherwise = Nothing
where
= (fromIntegral $ width g, fromIntegral $ height g)
(w, h) = (round invX, round invY)
(x', y')
-- inv33 inverts a 3x3 matrix, and (!*) is matrix-vector multiplication
V3 invX invY _ = inv33 (toMatrix (gridTransforms g)) !* V3 x y 1
```

Even in this relatively simple example, a small DSL saved us a lot of repeated work. It’s a useful technique to keep in your back pocket.

In hindsight, we used `[Transform]`

as an approximation to
the free monoid over `Transform`

, which we then interpreted
into the two types we cared about. (Reminder: lists are
not free monoids, though they’re close enough for most purposes.) If
this sort of thinking interests you, Justin Le has some great blog posts
about free structures and the cool payoffs you can get when using
them:

Solving a 2018 Advent of Code puzzle using free groups, and accidentally optimising the solution

Pulling a regular expression library almost out of thin air, using the free alternative

I would like to thank the Canberra Functional Programming (CanFP) meetup group, who reviewed drafts of this post.