4
$\begingroup$

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).

Sieve of Eratosthenes

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!

$\endgroup$
1
  • $\begingroup$ Yup but the demonstration only colours the primes. The second question you linked is to do with the computational aspect not the plotting. $\endgroup$ Jul 4, 2021 at 16:32

1 Answer 1

8
$\begingroup$
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}]]

enter image description here

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]

enter image description here

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]

enter image description here

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]

enter image description here

$\endgroup$
1
  • $\begingroup$ Brilliant! Thank you. $\endgroup$ Jul 5, 2021 at 11:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.