4

Based on that website I wanted to recreate the same effect using Mathematica but with any picture given by the user. Thus I came up with the following code:

DynamicModule[{list, r, divcir, parts, execpt , posC = {}, tab, col, center, i, pm, rect, rectvalue, coloring},
 i = ExampleData[{"TestImage", "Elaine"}];
 (* user should crop it in a square before, but in case: *)
 i = ImageCrop[i, {Min@ImageDimensions@i, Min@ImageDimensions@i}];
 center = #/2 & /@ ImageDimensions@i;
 list = {center};
 (r[#] = First@center) & /@ list;
 (col[#] = Mean@Mean@ImageData@i) & /@ list;
 Dynamic@Graphics[{coloring@col[#], Button[Disk[#, r[#]],
       {(* ==size/position of each disks== *)
        posC = #; (* get the clicked disk *)
        list = execpt[parts@{list, divcir[r[#], posC]}, posC];(* divide by four the clicked disk *)
        (r[#] = r[posC]/2) & /@ divcir[r[posC], posC];(* halve the radius of the next four disks *)
        (* ==color of each disks== *)
        rect = Transpose /@ (pm[#, r@#] & /@ list);(* area corresponding to the disks *)
        rectvalue = Mean@ImageValue[i, (Span @@@ rect[[#]])] & /@ Range@Length@rect; (* color of the rect *)
        ClearAll@col;(* assigning values to the variable col *)
        Set @@@ ((col[#] -> #2) & @@@ Thread[{list, rectvalue}]);
        }]} & /@ list, ImageSize -> 350]

 , Initialization :>
  (divcir[r_, {x0_, y0_}] := {{-r/2 + x0, r/2 + y0}, {r/2 + x0, r/2 + y0}, {r/2 + x0, -r/2 + y0}, {-r/2 + x0, -r/2 + y0}};
   parts[lst_] := Partition[Flatten@lst, 2];
   execpt[lst_, elm_] := Cases[lst, Except@elm];
   pm[a_, b_] := {a - b, a + b};
   coloring[col_] := If[Length@col == 0, GrayLevel@col, RGBColor@col];
   )]

Subdividing circles

By clicking over and over one would get:

Elaine


My issues are:

  1. It gets slower and slower when the number of disks increases since I am calculating the color of each disks each time, hence my question regarding the optimization.
  2. It is somehow boring for the user to click on each disks, the idea would be to use Mouseover but I only came up with crashing Mathematica.

Any help on these two issues would be highly appreciated :)

Öskå
  • 8,587
  • 4
  • 30
  • 49

0 Answers0