How to create this doge fractal zoom?

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:

enter image description here

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

fadeFrame[sides_: 20, bottom_: 40] :=
  ImageEffect[
    ImageEffect[#, {"FadedFrame", sides, {Left, Right}}],
    {"FadedFrame", bottom, {Bottom}}
    ] &;

dogeImg2 =
  ImagePad[
      Import["https://i.stack.imgur.com/BM8Bu.png"],
      {{0, 0}, {0, 100}},
      GrayLevel[1, 0]
      ] // ImageResize[#, Scaled[.5]] & //
    
    ImageTake[#, {.75, {.1, .85}}*Reverse@ImageDimensions[#] // 
       Apply[Sequence]] & // fadeFrame[];

dogeIFS2 =
  With[{scales = {1/5, 1/3}},
   With[{
     transfs = DiagonalMatrix[{1, 1}]/# & /@ scales,
     shifts = {{0.26, .98}, {0.65, .95}}/scales
     },
    MapThread[
     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
         },
        MapThread[
         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 *)
rightWhiteSpacePadding = 7;

dogesProcessed =
  Table[
   With[
    {
     dims1 = ImageDimensions[doge],
      dims2 = ImageDimensions[dogeImg2]
     },
    With[{scaling = dims1[[2]]/dims2[[2]]},
     (*fadeFrame[0, 0]@*)
     ImageTake[
      doge,
      {
        0,
        dims2[[2]]
        } + (scaling - 1)*topWhiteSpacePadding,
      {
        dims1[[1]] - dims2[[1]],
        dims1[[1]]
        } - (scaling - 1)*rightWhiteSpacePadding
      ]
     ]
    ],
   {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:

enter image description here

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

dogeImg = 
  ImageEffect[
   Import["https://i.stack.imgur.com/igIrh.png"], {"FadedFrame", 40}];

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]

enter image description here

Code

Here's the approach I mentioned in my comment:

imageIFS[imgs_List, funs_List] :=
  Flatten@Table[
    ImageTransformation[img, fn,
     DataRange -> Automatic,
      Padding -> Transparent
     ],
    {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"}];

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

makeIFSImage[img, sierpinksiGasketFS]

enter image description here

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.


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];

doge = Inpaint[im, mask]

enter image description here

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

enter image description here

The coordinates I picked:

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

enter image description here

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], 
  Padding -> "Fixed",
  DataRange -> Full
];

scaledoge[t_?NumericQ] := ImagePerspectiveTransformation[
  translated, 
  ScalingTransform[{t, t}, First[pts]], 
  Padding -> "Fixed", 
  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]], 
    Padding -> "Fixed", 
    DataRange -> Full
   ], 
   {t, Range[0, 1, 1/24]^1.5}
];

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

enter image description here

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


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

im = Import[
   "https://upload.wikimedia.org/wikipedia/commons/6/6b/Giovanni_Bellini%2C_portrait_of_Doge_Leonardo_Loredan.jpg"];

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];

enter image description here

(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[
   "https://upload.wikimedia.org/wikipedia/commons/6/6b/Giovanni_Bellini%2C_portrait_of_Doge_Leonardo_Loredan.jpg"];

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

mask = Dilation[DeleteSmallComponents[ColorNegate[bluecoverage]], 
   DiskMatrix[100]];

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

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

background = 
  Inpaint[imsmall, masksmall, 
   Method -> {"TextureSynthesis", 
     "Masking" -> ColorNegate[masksmall]}];

{background, SetAlphaChannel[im, bg]}

enter image description here

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];

enter image description here