# How to create this doge fractal zoom?

I would like to learn how to recreate this fractal in Mathematica and make others in the same style:

https://m.imgur.com/r/FractalGifs/lYEK8Cd

• The downvote is not from me but thinking about it, this might be easier with a unmanipulated image of the dog as a reference... – Henrik Schumacher Feb 22 '19 at 19:17
• Combine a set of AffineTransforms and use those with ImageTransformation to adjust the original image padding around the edges with 0 (Black) then add them together – b3m2a1 Feb 22 '19 at 19:17
• There is a related post here on the Wolfram Mathematica Blog. – Ted Ersek Feb 25 '19 at 0:19

# Making the GIF

I'm bored so let me GIF this up for you. I whipped out my trusty lasoo tool to make a no-background doge for you. The final result looks like this:

Here's how we use a variant of that IFS to make the frames of that GIF.

fadeFrame[sides_: 20, bottom_: 40] :=
ImageEffect[
] &;

dogeImg2 =
Import["https://i.stack.imgur.com/BM8Bu.png"],
{{0, 0}, {0, 100}},
GrayLevel[1, 0]
] // ImageResize[#, Scaled[.5]] & //

ImageTake[#, {.75, {.1, .85}}*Reverse@ImageDimensions[#] //

dogeIFS2 =
With[{scales = {1/5, 1/3}},
With[{
transfs = DiagonalMatrix[{1, 1}]/# & /@ scales,
shifts = {{0.26, .98}, {0.65, .95}}/scales
},
AffineTransform[{#, -#2}] &,
{transfs, shifts}
]
]
];

dogesRaw =
Table[
ImageCompose[#, makeIFSImage[#, dogeIFS2, 4]] &@
ImageResize[dogeImg2, Scaled[scaling]],
{scaling, 1, 3, .1}
];

dogeIFS2 =
With[{scales = {1/5, 1/3}},
With[{
transfs = DiagonalMatrix[{1, 1}]/# & /@ scales,
shifts = {{0.26, .98}, {0.65, .95}}/scales
},
AffineTransform[{#, -#2}] &,
{transfs, shifts}
]
]
];

doges =
Table[
ImageTake[
makeIFSImage[
ImageResize[dogeImg2, Scaled[scaling]],
dogeIFS2,
4
],
Sequence @@
Times[
{1, -1},
Reverse@ImageDimensions[
dogeImg2
]
]
],
{scaling, 1, 3, .1}
];


Your computer will churn for a while while it makes all those images, but you get a pretty good result. Then we'll stabilize the images and take only the region of interest for a nice GIF:

topWhiteSpacePadding = 14; (*these are fudge factors to make the GIF stableish *)

dogesProcessed =
Table[
With[
{
dims1 = ImageDimensions[doge],
dims2 = ImageDimensions[dogeImg2]
},
With[{scaling = dims1[[2]]/dims2[[2]]},
ImageTake[
doge,
{
0,
dims2[[2]]
{
dims1[[1]] - dims2[[1]],
dims1[[1]]
]
]
],
{doge, dogesRaw}
];


Finally we export with some other GIF-specific tweaks:

Export["~/Desktop/dogeGif.gif",
dogesProcessed[[2 ;;]],
"AnimationRepetitions" -> Infinity,
"DisplayDurations" ->
Join[
ConstantArray[.06, 10],
ConstantArray[.02, 10]
]
]


And in the end you have that GIF up there.

# Original

Here's a fun example. We'll use this basic doge:

Then we fade the frame, define our IFS, and doge away:

dogeImg =
ImageEffect[

dogeIFS =
With[{scale = 1/3},
With[{D = 1/scale*DiagonalMatrix[{1, 1}]}, {
AffineTransform[{D, -{0.26, 0.80}/scale}],
AffineTransform[{D, -{0.6, 0.7}/scale}]
}]
];

makeIFSImage[dogeImg, dogeIFS]


### Code

Here's the approach I mentioned in my comment:

imageIFS[imgs_List, funs_List] :=
Flatten@Table[
ImageTransformation[img, fn,
DataRange -> Automatic,
],
{img, imgs},
{fn, funs}
];
imageIFS[img_?ImageQ, funs_List] :=
imageIFS[{img}, funs];
makeIFSImage[img_?ImageQ, funs_List, iterations_: 4] :=

Fold[ImageCompose,
Flatten@
NestList[
imageIFS[#, funs] &,
img,
iterations
]
]


When applied to the Sierpinski triangle with a sample test image it looks like this:

img = ExampleData[{"TestImage", "Mandrill"}];

With[{D = 2*DiagonalMatrix[{1, 1}]}, {
AffineTransform[{D}],
AffineTransform[{D, -{1, 0}}],
AffineTransform[{D, -{0, 1}}]
}];



You can easily tweak sierpinksiGasketFS to get it to position the images differently and scale them differently.

Another version could be done just using Graphics and Inset and using a basic IFS to generate to points for the inset but I'll leave that for someone else.

• Oh wait, but it doesn't zoom 🙁 – user5601 Feb 23 '19 at 18:14
• @user5601 if you want it to be a GIF like that try modifying the input image to zoom on that for like 10 different scaling factors and make a GIF with "AnimationRepetitions"->Infinity – b3m2a1 Feb 23 '19 at 23:06

I didn't bother generating the nested fractal still since I don't have the original image. But here's how to semi-eyeball an animation with the still provided by OP. Because of this, my GIF will lose noticeable quality as it zooms.

First let's remove the watermark:

doge = RemoveAlphaChannel[Import["https://i.stack.imgur.com/PGfAi.jpg"]];

mask = Dilation[DeleteSmallComponents[# - DeleteSmallComponents[#] &[Binarize[im, .1]]], 2];



Next I used the interactive coordinates tool to find the coordinates of 2 noses.

The coordinates I picked:

pts = {{227, 360}, {133, 244}};
HighlightImage[doge, pts]


It's clear we need to translate the top point to the bottom point, but how much should we scale by? We can minimize the error through FindMinimum.

translated = ImagePerspectiveTransformation[
doge,
TranslationTransform[Subtract @@ pts],
DataRange -> Full
];

scaledoge[t_?NumericQ] := ImagePerspectiveTransformation[
translated,
ScalingTransform[{t, t}, First[pts]],
DataRange -> Full
]

t /. Last[Quiet@FindMinimum[ImageDistance[doge, scaledoge[t]], {t, 4.25}]]

4.14845


I'll round this to 4.15 and find the frames. Note that I scale the rate by a power of 1.5 to make the gif smoother.

frames = Most @ Table[
ImagePerspectiveTransformation[
doge,
ScalingTransform[(3.15 t + 1) {1, 1}, {t, 1 - t}.pts]@*TranslationTransform[{t, 1 - t}.pts - Last[pts]],
DataRange -> Full
],
{t, Range[0, 1, 1/24]^1.5}
];

Export["doge_fractal.gif", frames, AnimationRepetitions -> ∞, "DisplayDurations" -> 1/24];


Lastly, here's a comparison between the original image and the translated and scaled one:

A real doge: His Serenity Leonardo Loredan, the 75th Doge of Venice, with due credit to Bellini and Chip Hurst:

im = Import[

doge0 = ImageTake[im, {140, 4226 - 500}];

ctr = {1893, 3345};
doge = ImageCompose[doge0,
ImageResize[doge0, ImageDimensions@doge0/10], ctr];

doge = ImageCompose[doge0,
ImageResize[doge, ImageDimensions@doge0/10], ctr];

tfun = Last@FindGeometricTransform[
{{0, 0}, ImageDimensions@doge},
{ctr - ImageDimensions@doge0/20,
ctr + ImageDimensions@doge0/20}
];

frames = Most@Table[
ImageResize[
ImagePerspectiveTransformation[
doge, {IdentityMatrix[2] (1 - t) + t #[[All, ;; 2]],
t Flatten@#[[All, 3]]/First@ImageDimensions@doge} &@
Most@TransformationMatrix[tfun]],
ImageDimensions@doge/8.],
{t, Range[0, 1, 1/24]^1.5}];

Export["/tmp/doge_fractal.gif", frames,
AnimationRepetitions -> ∞, "DisplayDurations" -> 1/24];


(Having placed the inset images, the transformation was easier to find. One could derive it by hand as well.)

We can use Inpaint to make the background of the GIF constant.

im = Import[

bluecoverage = DominantColors[im, Automatic, "CoverageImage"][[1]];

DiskMatrix[100]];

bg = Blur[
DeleteSmallComponents[
ColorNegate[DeleteSmallComponents[bluecoverage, 500]]], 10];

imsmall = ImageResize[ImageTake[im, {140, 4226 - 500}], Scaled[1/8]];

background =
Method -> {"TextureSynthesis",

{background, SetAlphaChannel[im, bg]}


doge0 = ImageTake[SetAlphaChannel[im, bg], {140, 4226 - 500}];

ctr = {1893, 3345};
doge = ImageCompose[doge0,
ImageResize[doge0, ImageDimensions@doge0/10], ctr];

doge = ImageCompose[doge0,
ImageResize[doge, ImageDimensions@doge0/10], ctr];

tfun = Last@
FindGeometricTransform[{{0, 0},
ImageDimensions@doge}, {ctr - ImageDimensions@doge0/20,
ctr + ImageDimensions@doge0/20}];

frames = Most@
Table[RemoveAlphaChannel[
ImageCompose[background,
ImageResize[
ImagePerspectiveTransformation[
doge, {IdentityMatrix[2] (1 - t) + t #[[All, ;; 2]],
t Flatten@#[[All, 3]]/First@ImageDimensions@doge} &@
Most@TransformationMatrix[tfun]],
ImageDimensions[background]]]], {t, Range[0, 1, 1/24]^1.5}];

Export["/tmp/doge_fractal.gif", frames,
AnimationRepetitions -> ∞, "DisplayDurations" -> 1/24];