10
$\begingroup$

I have code to generate this image:

divisors of 24

But my code is awkward and clunky:

Graphics[
{
Hue[3/5], EdgeForm[Thin],
Table[Rectangle[{x, 0}, {x + 24, 1}], {x, 0, 0, 24}],
Table[Rectangle[{x, 1}, {x + 12, 2}], {x, 0, 12, 12}],
Table[Rectangle[{x, 2}, {x + 8, 3}], {x, 0, 16, 8}],
Table[Rectangle[{x, 3}, {x + 6, 4}], {x, 0, 18, 6}],
Table[Rectangle[{x, 4}, {x + 4, 5}], {x, 0, 20, 4}],
Table[Rectangle[{x, 5}, {x + 3, 6}], {x, 0, 21, 3}],
Table[Rectangle[{x, 6}, {x + 2, 7}], {x, 0, 22, 2}],
Table[Rectangle[{x, 7}, {x + 1, 8}], {x, 0, 23, 1}]
}

]

Using as many Table[]s as there are divisors is ridiculous. I'd like to just Map Rectangle onto the appropriate corners, like here, but I can't generate the appropriate lists. I'm also curious about a Table of Tables approach, but I can't generate that, either. Out of curiosity, why is the functional approach preferable to a Table of Tables? I appreciate the help.

$\endgroup$
15
$\begingroup$

You can obtain it with a proper combination of Table and Divisors

n = 24;
Graphics@{Hue[3/5], EdgeForm[Thin], Table[Rectangle[{x, -i}, {x + #[[i]], 1 - i}], 
  {i, Length@#}, {x, 1, n, #[[i]]}] &@Divisors@n}

descr

Image-processing approach can be even more compact

Image@Flatten[ArrayPad[ConstantArray[{0, .4, 1}, {n/#, 18, 20 # - 2}], {0, 1, 1, 0}] & /@ 
 Divisors@n, {{1, 3}, {2, 4}}]

enter image description here

$\endgroup$
8
$\begingroup$

Here's a Table of Table's approach for starters:

list = {1, 2, 3, 4, 6, 8, 12, 24};
Graphics[{Hue[3/5], EdgeForm[Thin], 
  Table[Rectangle[{24 (j - 1)/list[[k]], k}, {24 j/list[[k]], 
     k + 1}], {k, 8}, {j, list[[k]]}]}]

enter image description here

$\endgroup$
6
$\begingroup$

I used Grid for this.

n = 36;

PadRight and SpanFromLeft make empty spaces.

Grid[Flatten@Table[PadRight[{""},#,SpanFromLeft],{n/#}]& /@ Divisors@n,Frame-> All]

Blockquote

$\endgroup$
3
$\begingroup$
rng = Range[0, 24, #] & /@ Divisors[24];
Graphics[{{Hue[0.6], Rectangle[{0, 0}, {24, 8}]}, 
  Map[Line, 
   MapThread[
    Map[Function[x, {{x, #2}, {x, #2 + 1}}], #1] &, {Reverse[rng], 
     Range[0, 7, 1]}], {2}], 
  Table[Line[{{0, j}, {24, j}}], {j, 0, 8}]}]

enter image description here

$\endgroup$
2
$\begingroup$

Here's my take on it:

With[{n=24},
     Graphics[{Hue[3/5], EdgeForm[Thin],
               MapIndexed[Table[Rectangle[{x, First@#2-1}, {x+#1, First@#2}],
                                {x, 0, n-#1, #1}]&,
                          Reverse@Divisors@n]}]]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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