Symmetric icons

Question

I'm trying to replicate "symmetric icons" from this book:

https://www.amazon.com/Symmetry-Chaos-Search-Pattern-Mathematics/dp/0898716721

Here is what I have so far:

n = 6;
α = 5;
β = 1.5;
γ = 1;
ω = 0;
λ = -2.7;
f[z_] := (λ + α z Conjugate[z] + β Re[z^n] + ω I)z + γ Conjugate[z]^(n - 1);
z0 = .1 +.1 I;
(*data=NestList[f,z0,100000];*)
ListPlot[
  {Re[#], Im[#]}& /@ NestList[f, z0, 100000],
  AspectRatio -> 1,
  Axes -> False,
  PlotStyle -> {Opacity[.45], White, Small},
  Background -> Black]

I have two questions:

1) I have a vague idea that instead of using ListPlot, I can use Image and then map the points to pixels, counting the number of times a pixel is hit, and then coloring each pixel somehow using ColorFunction. However, I'm not real sure.

2) To make the image above nicer, you should change 100000 to a million, or ten million, and make the Opacity lower. However, I worry that I'm being very inefficient. Is there an obvious way to make this much more efficient?

Edit

From the help below, the "best" code I have for this is:

f[z_] = (λ + α z Conjugate[z] + β Re[z^n] + ω I)z + γ Conjugate[z]^(n - 1);
z0 = .1 + .1 I;
iter = 10000000;
opac=.1;
Graphics[
  {Black, Opacity[opac], PointSize[Tiny], Point[ReIm @ NestList[f, z0, iter]]}]

producing

I would like to be able to "simply" add custom colors (based on the number of times a neighborhood is hit by a point in the iteration) to an Image like this:

res = 1000;
colorLim = 1;
dataBin = 
  Map[GrayLevel, 
    Sqrt[(1/colorLim) * 
      Transpose @ 
        BinCounts[
          {Re[#],Im[#]}&/ @ NestList[f, z0, 1000000], 
          {-1, 1, 1/res}, {-1, 1,1/res}]], 
    {2}];
Image[dataBin]

but this is eluding me right now.

Answer 1

dat = Quiet@ReIm@NestList[f, z0, 10000000];

Binning

Using the method from this answer for bin counts:

res = 1000; 
epsilon = 1*^-10;
indices = 1 + Floor[(1 - epsilon) res Rescale[dat]];
System`SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> Total}];
matrix = SparseArray[indices -> 1., {res, res}];
System`SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> First}]; 

Image

You can play with different scalings for bincounts:

Image[1 - Rescale[matrix^(1/4)], ImageSize -> Large]

Image[Map[Blend[{ Red, Orange, Yellow,  White}, #^4] &, 
  1 - Rescale[Normal[matrix]^(1/4)], {2}], ImageSize -> Large]

MatrixPlot

 MatrixPlot[Rescale[matrix^(1/4)], ImageSize -> Large, 
  MaxPlotPoints -> Infinity, Frame -> False, 
  ColorFunction -> "Rainbow", ColorFunctionScaling -> False]

Add the option ColorRules -> {0. -> Black} to get

ComplexListPlot

ComplexListPlot[NestList[f, z0, 50000], 
  AspectRatio -> 1, Axes -> False, Background -> Black, 
 ColorFunction -> (ColorData["Rainbow"][Abs[ f[# + #2 I]]] &), 
 ColorFunctionScaling -> False]

ListPlot + VertexColors

You can post-process ListPlot output to add VertexColors:

{min, max} = MinMax[Abs@NestList[f, z0, 500000]]; 

ListPlot[ReIm@NestList[f, z0, 500000], AspectRatio -> 1, 
  Axes -> False, BaseStyle -> PointSize[Tiny]] /. 
 Point[x_] :>  Point[x, VertexColors -> (Opacity[.5, #] & /@ 
      ColorData[{"Rainbow", {min, max}}] /@ (Abs@f[# + I #2] & @@@ x))]

Graphics + VertexColors

{min, max} = MinMax[Abs@NestList[f, z0, 500000]]; 

Graphics[{PointSize[Tiny], Opacity[.5], 
  Point[#, VertexColors -> ColorData[{"Rainbow", {min, max}}]/@ (Abs@f[# + I #2]&@@@#)]&[
   ReIm@NestList[f, z0, 500000]]}, 
 AspectRatio -> 1]

Answer 2

Here's a quick-and-dirty approach which might be helpful - but is pretty slow on reasonable image sizes (that is, could be improved):

With[{bc = 
    BinCounts[ReIm@data, 
     Sequence @@ ({#1, #2, (#2 - #1)/256} & @@@ 
        CoordinateBounds@ReIm@data)]}, 
  bc /. Map[
    Evaluate[# -> 
       ColorData["SunsetColors"]@
        N@CDF[HistogramDistribution@Flatten@bc, #] &], 
    Union@Flatten@bc]] // Image

BinCounts is performed for a square defined by bounds of the dataset and color is assigned to each unique value in the count on basis of CDF of the distribution of these values. In this case ColorData["SunsetColors"] is used as a palette, but something custom could be used as well.

Something similar can be also achieved by "gamma-correcting" the range of bin counts. This is dramatically faster for a reason or another:

With[{bc = 
    BinCounts[ReIm@data, 
     Sequence @@ ({#1, #2, (#2 - #1)/256} & @@@ 
        CoordinateBounds@ReIm@data)]}, 
  Map[
   ColorData["SunsetColors"],
   (bc/N@Max@Flatten@bc)^(1/5), {2}]] // Image

Answer 3

Suppose you had data = NestList[f, z0, 10000000].

Then you might want DensityHistogram[ReIm@data, 100, "PDF"] or something similar, playing around with the ColorFunction option.