9
$\begingroup$

I want to plot something like this, the first 100,000 digits of Pi: enter image description here

... in a rectangular or circular form.

$\endgroup$
  • 1
    $\begingroup$ Welcome to Mathematica.SE! You should watch the introductory Tour to get the basics of the site. $\endgroup$ – Vitaliy Kaurov Sep 5 '18 at 19:21
  • $\begingroup$ @VitaliyKaurov Thank You for the welcoming and your answer, I appreciate your efforts. $\endgroup$ – adam Sep 5 '18 at 19:25
  • $\begingroup$ For plotting PI, the circular form should be logical. But it would be interesting to find out if such a plot for other irrational numbers (e, sqrt(2)) pr just random numbers, would look different $\endgroup$ – Roland Sep 6 '18 at 11:02
10
$\begingroup$

Before asking for help you should always try your own solution and post the code that you have tried (see docs and EIWL), even if you cannot finish it, it's a good etiquette :-) (please do that in future). But you are new user and this problem have a nice minimal solution in Wolfram Language, so I post my take on it.

Your colors look like Hue (or HSB), I will use that and transfer to RGB:

colors = ColorConvert[Hue /@ Range[0, .9, .1], "RGB"]

enter image description here

Build rules for replacement of a digit by color:

rules = Dispatch[Thread[Range[0, 9] -> List @@@ colors]]

Build image. You are basically building a matrix partitioning Pi digits list into a matrix, and then replacing in that matrix digits by RGB values. And that is the array structure of an Image which is efficient in this case, I think, more than Graphics. You can partition at a different than 400 width to achieve different aspect ratio.

Image[Partition[First[RealDigits[Pi, 10, 100000]], 400] /. rules]

enter image description here

$\endgroup$
9
$\begingroup$

You mentioned plotting the digits of Pi in a "circular form". Perhaps a "sunflower" plot is of interest. Digits are plotted in a spiral from the centre outwards, and coloured by the chosen colour scheme. As the rational approximation to Pi gets better, that is, as exponent k increases, patterns in the plot disappear. A visual confirmation of the randomness of the digits.

This function plots a sunflower with each disk having the property accorded by the function f.

SunflowerPlot[n_, c_, d_, phi_, f_, cs_String] :=
   Graphics[
      Table[{
         ColorData[cs, f[k]],
         Disk[c Sqrt[k] {Cos[k phi Degree], Sin[k phi Degree]}, d]},
         {k, 1, n}]]

The plot may be manipulated with the following.

Manipulate[
   SunflowerPlot[n, c, d, phi,
                 ((RealDigits[Rationalize[Pi, 10.^-k], 10, 2500][[1]][[#]]*0.1)^e &),
                 cs],
   {{n, 1000, "Number of Florets"}, 10, 2500, 10, Appearance -> "Labeled"},
   {{c, 0.2, "Scaling Parameter"}, 0.1, 0.5, Appearance -> "Labeled"},
   {{d, 0.2, "Floret Radius"}, 0.1, 0.5, Appearance -> "Labeled"},
   {{k, 5., "Rationalize Exponent"}, 1., 15., Appearance -> "Labeled"},
   {{phi, 137.50776405, "Spiral Angle"}, 10, 360, Appearance -> "Labeled"},
   {{cs, "SolarColors", "Colour Scheme"}, ColorData["Gradients"]},
   {{e, 1.0, "Colour Exponent"}, 0.1, 3.0, Appearance -> "Labeled"}]

sunflowers

$\endgroup$
6
$\begingroup$

You can also use MatrixPlot:

legend = Graphics[{Hue[#/10], Disk[{#, 0}, .5], Black, 
      Text[Style[#, 16], {#, 0}]} & /@ Range[0, 9], ImageSize -> 300];
MatrixPlot[Partition[First[RealDigits[Pi, 10, 100000]], 400], 
 ColorFunction -> ( Hue[#/10] &), ColorFunctionScaling -> False, 
 Frame -> False, ImageSize -> 2 -> 3,  PlotLegends -> Placed[legend, Below]]

enter image description here

Alternatively, use an array of colors as the first argument of MatrixPlot:

MatrixPlot[Map[Hue[#/10] &, Partition[First[RealDigits[Pi, 10, 100000]], 400], {-1}],
 Frame -> False, ImageSize -> 2 -> 3, 
 PlotLegends -> Placed[legend, Below]]

same picture

$\endgroup$
4
$\begingroup$

Small 10 x 5 version showing the first 50 digits of Pi

colours = Transpose@Reverse@Partition[Characters[
      "3" <> StringDrop[ToString[N[Pi, 50]], 2]], 10];
insets = Table[Inset[Style[Text[colours[[i + 1, j + 1]]],
     Black, FontSize -> 20],
    {10 i, 10 j}, {0, 0}, {10, 10}], {i, 0, 10 - 1}, {j, 0, 5 - 1}];
Graphics[{Yellow, Rectangle[{0, 0}, {100, 50}], insets}]

Same again with colours

colours = Transpose@Reverse@Partition[Characters[
       "3" <> StringDrop[ToString[N[Pi, 50]], 2]] /. Thread[
       ToString /@ Range[0, 9] -> ColorData[3, "ColorList"]], 10];
insets = Table[Inset[Graphics[{colours[[i + 1, j + 1]],
      Rectangle[{0, 0}, {10, 10}]},
     PlotRange -> {{0, 10}, {0, 10}}, ImageSize -> 10],
    {10 i, 10 j}, {0, 0}, {10, 10}], {i, 0, 10 - 1}, {j, 0, 5 - 1}];
Graphics[{Yellow, Rectangle[{0, 0}, {100, 50}],
  insets}, PlotRange -> {{0, 100}, {0, 50}}]

Similar version showing the first 5000 characters of Pi

colours = Transpose@Reverse@Partition[Characters[
       "3" <> StringDrop[ToString[N[Pi, 5000]], 2]] /. Thread[
       ToString /@ Range[0, 9] -> ColorData[3, "ColorList"]], 100];
insets = Table[Inset[Graphics[{colours[[i + 1, j + 1]],
      Rectangle[{0, 0}, {10, 10}]},
     PlotRange -> {{0, 10}, {0, 10}}, ImageSize -> 10],
    {10 i, 10 j}, {0, 0}, {10, 10}], {i, 0, 100 - 1}, {j, 0, 50 - 1}];
Graphics[{Yellow, Rectangle[{0, 0}, {1000, 500}],
  insets}, PlotRange -> {{0, 1000}, {0, 500}}]

enter image description here

$\endgroup$

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.