# Symmetric icons

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.

• Note: Re[#], Im[#]} & can be replaced with ReIm. – m_goldberg Dec 27 '19 at 1:13
• Thanks! Currently the "best" code I know for this is has been edited above. – Bart Snapp Dec 28 '19 at 13:59

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]];
SystemSetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> Total}];
matrix = SparseArray[indices -> 1., {res, res}];
SystemSetSystemOptions["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]

• This is really great, I love the colors, but I would like to set the color by the number of times a neighborhood is hit by a point in the iteration. – Bart Snapp Dec 28 '19 at 14:06

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

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.

• I think this is actually the answer I'm looking for. However, I am unable to set the function for the coloring that will yield anything as interesting as the grayscale picture above. I think this is the answer, but I am unable to use it to produce the desired graph. – Bart Snapp Dec 28 '19 at 14:07
• Crank up the number of bins. With 2^8 bins, I get wispy structure like your example, but to get it to look 'nice' may require a lot more data and a lot more bins (read: rendering time). – evanb Dec 29 '19 at 4:02