Stars of the Mind’s Sky with Diagrams

A few weeks ago, Paul Salomon posted a really beautiful work of mathematical art on his blog, Lost In Recursion:

Stars of the Mind’s Sky, by Paul Salomon

He included a precise mathematical description of the image, and I naturally wondered how difficult it would be to replicate using the diagrams framework which I wrote about previously.

The answer: not hard! All told it is only about 30 lines of code, give or take. So I decided to exhibit it here, both as a way of explaining the cool math behind Paul’s image, and as a way of showing off the power of diagrams to do this sort of visualization and mathematical art.

This post is literate Haskell—you should be able to copy and paste the contents of this post into a file with an .lhs extension, and run and play around with it yourself. First, some requisite imports and such:

> {-# LANGUAGE NoMonomorphismRestriction #-}
> module SOTMS where
> import           Control.Arrow                  ((***))
> import           Data.Colour.SRGB
> import           Data.Colour.RGBSpace
> import           Data.Colour.RGBSpace.HSV
> import           Diagrams.Backend.Cairo.CmdLine
> import           Diagrams.Prelude

Star polygons

The image is primarily composed of a bunch of star polygons, the figures you get when you take p points evenly spaced around a circle and connect every qth point. For example, here’s what we get when we pick p = 12 and q = 5:

I’ve numbered the vertices to make it easier to see how vertex k is always connected to vertex k+5 (modulo 12) by a line segment. Vertex 0 is connected to 5, which is connected to 10, which is connected to 15 = 3, and so on.

In this example, we get one continuous polygonal path which cycles through all the vertices. But sometimes we get several disjoint paths. For example, below is what we get with p = 12 and q = 3. I’ve used distinct colors to make it easy to see the three separate squares:

If you connect every third point out of twelve, you come back to where you started after hitting only four points, so three separate square paths are needed to connect all the points. Given values for p and q, can you say in general how many distinct paths result? Here are a few more examples to fuel your investigations:

In fact, the number of separate paths needed to draw a given star polygon is how Paul chooses the color: red for star polygons that are one continuous path, yellow for two paths, blue for a lot (that is, 24), and shading gradually from yellow to green to blue for numbers in between. (Now that you know this, you might want to go back and study the image again, looking for patterns!)

There’s one thing left: what about q = 0? This is a sort of “degenerate” star polygon where we don’t connect any of the points. Paul chose to draw those using just dots for the vertices, like this:

In Paul’s image you can see these going in a straight line from the center to the top, though it’s a little hard to see what’s going on since they all overlap with each other.

Drawing star polygons

So, let’s see some code already! First, a simple function to generate the kind of regular polygons we want:

> -- Make a regular polygon with n sides and radius r, oriented with
> -- one vertex pointing in the positive y direction.
> regP n r = polygon with { polyType   = PolyRegular n r
>                         , polyOrient = NoOrient
>                         }
>          # rotateBy (1/4)

Now, we define a function mkStar which takes p and q as inputs and draws a (p,q)-star polygon, coloring it according to Paul’s color scheme:

> -- If q = 0, draw a bunch of dots at the vertices of a regular polygon
> mkStar n 0    = decoratePath (regP n 1) (repeat (circle 0.1 # lw 0))
>               # fc (colorByNumber n)
> -- Otherwise draw a star polygon
> mkStar n skip = let p        = star (StarSkip skip) (regP n 1)
>                     numPaths = length . pathTrails $ p
>                 in
>                     p # stroke # lw 0.08 # lc (colorByNumber numPaths)

Incidentally, the coloring scheme was the only part that wasn’t specified in Paul’s post, so I hacked something together using trial and error and the “eyedropper” tool in GIMP. I also have to go to a bit of trouble to blend from yellow to blue in HSV space, so it looks like this:

and not in RGB space, which looks like this:

You need not pay too much attention to this code, but I’m including it here for completeness. (I plan to soon include some extra tools in diagrams for helping manipulate colors, which would make this a lot easier to accomplish.)

> paulRed    = sRGB24 0xDA 0x22 0x22
> paulBlue   = sRGB24 0x4C 0x89 0xC0
> paulYellow = sRGB24 0xD1 0xB3 0x41
> colorByNumber 1 = paulRed
> colorByNumber c = hsvBlend (min 1 ((fromIntegral c - 2)/10))
>                     paulBlue paulYellow
> hsvBlend t c1 c2 = uncurryRGB sRGB . hsv3 $ lerp h2 h1 t
>   where
>     [h1, h2] = map (hsvView . toSRGB) [c1,c2]
>     fst3 (x,_,_) = x
>     hsv3 (h,s,v) = hsv h s v

The final colors don’t look exactly like Paul’s original image but they’re close enough.


Now that we can generate individual star polygons we have to put them together into “orbits”. All the star polygons in a particular “orbit” (that is, at a particular distance from the center) have the same value of p (that is, the same number of vertices). The star with q=0 is at the top, and then the stars for other values of q progress in order around the orbit. (Quick quiz: does the value of q increase going clockwise, or counterclockwise?)

Making the stars around a particular orbit is easy: we create all the stars (map (mkStar n) [0..] will make one star for each value of q), and then place them at the vertices of a radius-(n-1) regular n-gon using decoratePath.

> stars n = decoratePath
>             (regP n (fromIntegral n - 1))
>             (map (mkStar n) [0..])

For example, here are the outputs for stars 6 and stars 7:

Finally, each orbit is shown with a faint circle, so we make an orbit function which returns the stars and associated circle together:

> orbit n = ( stars n
>           , circle (fromIntegral n - 1)
>             # lc (blend 0.95 white black)
>             # lw 0.08
>           )

Putting it all together

Finally, we generate the orbits from 2 to 24 and draw them all! Note that we have to draw all the orbit circles first and then the stars, because we don’t want any of the orbit circles getting drawn on top of the stars. This is what the funny business with unzip, uncurry atop, etc. is doing.

> starsOfTheMindsSky = uncurry atop
>                    . (mconcat***mconcat)
>                    . unzip
>                    . reverse
>                    . map orbit
>                    $ [2..24]
> main = defaultMain (starsOfTheMindsSky # centerXY # pad 1.1)

And here’s Paul’s original version for comparison. Pretty close!

I love all the different patterns you can see in this work of art—close inspection and thinking really pays off as you discover more and more interesting structure. For example, this could really make a wonderful activity for a class—you could buy a print from Paul, put it up, and see what the students find!

Incidentally, I have also really been enjoying Paul’s “imbalance problems”, here, here, and here—go check them out!

About these ads
This entry was posted in geometry, group theory, pictures, programming and tagged , , , , , . Bookmark the permalink.

9 Responses to Stars of the Mind’s Sky with Diagrams

  1. Chris Hanusa says:

    Wow! Nice! Great! Exclamation point!

  2. Paul Salomon says:

    Hi! Thanks so much for sharing my stuff. FANtASTIC work by you to recreate it. It took me several months to get it all figured out, but I was learning Mathematica as I went. I tweaked the color function somewhat so that I could see some of the gentler shifting rays get further into the blue.

    I’d love to see that pyramid done with the coloring based on number of stars. That got me thinking of a Pascal’s triangle of stars. I’ll have to think more on this!! Thanks for everything!

    • Brent says:

      Ah, yes, I wondered if you had tweaked the color function like that.

      Re: a pyramid done with the coloring based on number of stars, ask and ye shall receive!

      I could easily make higher-resolution or vector versions as well.

      • Paul Salomon says:

        OH WOW! That’s FANTASTIC!!!! I’m so happy with that. The pattern of reds is extremely interesting. Thank you!

        • Brent says:

          It’s pretty cool, isn’t it!? =) I think the diagonal red stripes correspond to prime values of q. Incidentally, I would love to collaborate with you on more of this sort of thing. No idea what that would look like but collaborating is always fun, especially when playing around with math and art!

          • Paul Salomon says:

            No. That wasn’t pretty cool. It ROCKS! I would love to keep collaborating. Lets talk out a way to do a Pascal’s triangle.

            What if the rows are p and the q is the Pascal’s triangle numbers? Then every prime row is just point stars.

Comments are closed.