How to make a graphic for Sieve of Eratosthenes with a legend

Question

Definition

The Sieve of Eratosthenes is a simple algorithm to find the primes before a given $n$.

Starting from $n=2$ you delete all multiples of 2, and keep incrementing till all that are left are prime numbers.

Example

The above linked Wikipedia page has a nice animation for the Sieving process, but I want to make a static graph, like such (but without the enumerated primes in the side).

Question

• How do I make a static graph as shown above to display the Sieve for any given $n$.
• Also how do I add a legend in the side (Red 2, Green 3, Purple Prime etc.)? Instead of enumerating the primes.

Thanks for any and all help!

Answer 1

ClearAll[primes]
primes[n_] := Prime[Range @ PrimePi[n]]

n = 120;

array = Partition[Range @ n, 10];

split = Split[primes[n], #^2 >= n &];

 {{2}, {3}, {5}, {7},
  {11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 
   59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113}}

Select a list of 5 (1 + PrimePi[Sqrt @ n]) colors:

colors = {Red, Green, Blue, Orange, Magenta};

Use colors and split to construct a legend:

legend = SwatchLegend[colors, MapAt[primes >= # &, First /@ split, {-1}]]

Construct a styling map associating colors with primes, and, for a composite number x, using transparent versions of the colors associated with its prime factors:

colormap = Flatten /@ 
   MapAt[{#, Thread[Range[First[#]^2, n, First[#]] -> Append[Last@#, .3]]}&,
       Thread[First@# -> Last@#] & /@ Thread[{split, colors}], 
    {;; 4, 1}];

1. Using ArrayPlot

Legended[
 ArrayPlot[array /. 1 -> "", 
     Mesh -> All, 
     MeshStyle -> Directive[Thick, White], 
     ColorRules -> Append[Flatten @ Reverse @ colormap, "" -> White], 
     ImageSize -> 1 -> {50, 40}, 
     Epilog -> MapIndexed[Text[Style[#, 16], Reverse[#2 - 1/2]] &, 
         Reverse[array /. 1 -> ""], {2}]], 
 legend]

2. Using Grid:

backgroundRules = Prepend[{1, 1} -> White] @
   Flatten[MapAt[Position[array, #][[1]] &, colormap, {All, All, 1}]];

Legended[
    Grid[array /. 1 -> "", 
      Dividers -> Directive[Thick, White], 
      ItemSize -> {3, 3}, 
      ItemStyle -> 16, 
      Alignment -> {Center, Center}, 
      Background -> {None, None, backgroundRules}],
    legend]

3. Animation:

To get something similar to the animation in wikipedia >> Sieve of Eratosthenes:

wikiLegend[k_] := Placed[
  Labeled[
     Multicolumn[
        Prepend[Flatten[colormap], 1 -> RGBColor[0, 0, 0, 0]][[;; k]] /. 
           {Rule[_, RGBColor[_, _, _, _]] -> Nothing, 
            Rule[a_, b_] :> Style[a, b, 16, Bold]}, 
        4, 
        Appearance -> "Horizontal", 
        Dividers -> {White, {1 -> GrayLevel[0, .2]}}, 
        ItemSize -> {3, 2}, 
        Alignment -> {Center, Center}], 
      Style["primes", 16], Top], 
 {After, Top}]

frames = Table[
  Legended[
    Grid[array /. 1 -> "", 
     Dividers -> White, 
     ItemSize -> {2, 2}, 
     BaseStyle -> FontSize -> 16, 
     Alignment -> {Center, Center}, 
     Background -> {GrayLevel[.8], GrayLevel[.8], backgroundRules[[;; i]]}], 
    wikiLegend[i]], 
   {i, 1, Length @ backgroundRules, 1}];

 Export["eratosth.gif", frames]