10
$\begingroup$

I am working on a math question about infinite series, and one of the question images is below.

iterations of subdividing a square

Each new white square has an area that is 1/4 of the previous square.

Always looking to learn elegant ways to create things using Mathematica, and in this case, probably recursion as well?

I know it's not complicated, but any help with the process would be appreciated.

Having a NICE diagram really helps with creating a better response. (questions about sums of areas of white, black, etc.)

$\endgroup$

3 Answers 3

12
$\begingroup$
coords = {{0, 0}, {0, 1}, {1, 1}, {1, 0}};
tf = Composition[TranslationTransform[{1/2, 0}], ScalingTransform[{1/2, 1/2}]]
n = 4;
rects = NestList[tf /@ # &, coords, n];
Graphics[{EdgeForm[Black], Rectangle[], White, Polygon[Most/@rects], Polygon@Last@rects}]

enter image description here

Row @ Table[With[{rects = NestList[tf /@ # &, coords, n]}, 
 Graphics[{ EdgeForm[Black], Rectangle[], White, 
  Polygon[Most /@ rects], Polygon @ Last @ rects}, ImageSize -> 200]], {n, 0, 5}]

enter image description here

$\endgroup$
2
  • $\begingroup$ I used this answer to create a "Manipulate", SUPER useful for creating some help the student needed with this question. Can't even compare with the original diagram, having this was perfect. $\endgroup$ Oct 25, 2018 at 19:06
  • $\begingroup$ @TomDeVries, really glad it was useful. Thank you for the accept. $\endgroup$
    – kglr
    Oct 25, 2018 at 19:07
9
$\begingroup$
n = 100;
T1 = Developer`ToPackedArray[{{-1., 0.}, {-0.5, 0.}, {-0.5, 0.5}}];
T2 = Developer`ToPackedArray[{{-0.5, 0.5}, {0., 0.5}, {0., 1.}}];
Graphics[{
  Polygon[Table[0.5^k T1, {k, 0, n}]],
  Polygon[Table[0.5^k T2, {k, 0, n}]]
  }]

enter image description here

$\endgroup$
1
  • $\begingroup$ That is so concise, unbelievable! $\endgroup$ Oct 25, 2018 at 19:05
2
$\begingroup$

Inspired by @HenrikSchumacher:

Graphics@NestList[Scale[#, 1/2, {0, 0}] &, 
  Polygon[{{{-2, 0}, {-1, 0}, {-1, 1}}, {{-1, 1}, {0, 1}, {0, 2}}}], 10]

enter image description here

This can be also shortened to:

Graphics@NestList[Scale[#, 1/2, {0, 0}] &, 
  Polygon[{{-2, 0}, {-1, 0}, {-1, 1}, {0, 1}, {0, 2}}], 10]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.