12
$\begingroup$

Supose I have a rectangle which area is $x^2$. In some cases I may not know what is the size of each side, for $x=12,$ we have several possibilites:

{{144, 1}, {72, 2}, {48, 3}, {36, 4}, {24, 6}, {18, 8}, {16, 9}, {12, 
  12}, {9, 16}, {8, 18}, {6, 24}, {4, 36}, {3, 48}, {2, 72}, {1, 144}}

I want to plot each one of these rectangles, all them aligned by their center.

Until now, I did this:

n = 144;
a = Select[n/Range[1, n], IntegerQ];
b = Reverse[a];
c = Table[{a[[x]], b[[x]]}, {x, 1, Length[a]}]

Which finds all the sizes of the sizes which satisfy $a\cdot b=x^2$. But I can't figure out how to do the next part, can you help me?

Improve this question
$\endgroup$
5
  • $\begingroup$ To find all side pairs: {a, b} /. Solve[a b == 144 && a > 0 && b > 0, Integers] $\endgroup$
    – Vitaliy Kaurov
    Commented Sep 13, 2012 at 10:06
  • 2
    $\begingroup$ Everyone is so busy answering.. no one votes the question up? $\endgroup$
    – halirutan
    Commented Sep 13, 2012 at 10:40
  • $\begingroup$ Gustavo, I see that you have not Accepted an answer to this question. Did you forget or are they all unsatisfactory in some way? $\endgroup$
    – Mr.Wizard
    Commented Feb 12, 2013 at 18:32
  • $\begingroup$ @Mr.Wizard Oh sorry. I forgot. $\endgroup$
    – Red Banana
    Commented Feb 13, 2013 at 5:09
  • $\begingroup$ Well, thanks for the Accept. $\endgroup$
    – Mr.Wizard
    Commented Feb 13, 2013 at 23:43

5 Answers 5

Reset to default
11
$\begingroup$

This seems too simple to really be what you're asking but perhaps:

recs = {{144, 1}, {72, 2}, {48, 3}, {36, 4}, {24, 6}, {18, 8}, {16, 
    9}, {12, 12}, {9, 16}, {8, 18}, {6, 24}, {4, 36}, {3, 48}, {2, 
    72}, {1, 144}};

Rectangle[-#/2, #/2] & /@ recs // Graphics

Mathematica graphics

You should also look at Divisors.

Improve this answer
$\endgroup$
3
  • $\begingroup$ But what I want is really simple, also thanks for refreshing my memory on the Divisors. $\endgroup$
    – Red Banana
    Commented Sep 13, 2012 at 10:02
  • $\begingroup$ If you'd like you can make my answer a part of yours - I'll delete mine then. $\endgroup$
    – Vitaliy Kaurov
    Commented Sep 13, 2012 at 10:47
  • $\begingroup$ @Vitaliy sorry, I didn't notice your comment until now; please, keep your answer and your points. :-) $\endgroup$
    – Mr.Wizard
    Commented Sep 15, 2012 at 16:12
11
$\begingroup$

This is based on @Mr.Wizard answer , just trying to improve presentation:

First of all you can find all your sides as:

recs = {a, b} /. Solve[a b == 144 && a > 0 && b > 0, Integers];

Then lets clearly distinguish rectangles:

Manipulate[Graphics[{EdgeForm[{Opacity[.2], Thickness[.001], Black}], Blue, 
   Opacity[op], Rectangle[-#/2, #/2] & /@ recs[[1 ;; re]]}, PlotRange -> pl], 
   {{op, .2, "opacity"}, 0, 1, Appearance -> "Labeled"}, 
   {{pl, 16, "zoom"}, 1, 75, Appearance -> "Labeled"}, 
   {{re, Length[recs], "number"}, 1, Length[recs], 1, Appearance -> "Labeled"}]

enter image description here

Improve this answer
$\endgroup$
0
10
$\begingroup$

Try!

Graphics[{EdgeForm[Black], FaceForm[Hue[RandomReal[]]], 
Rectangle[{0, 0}, #]} & /@ c, Frame -> True, 
GridLines -> Automatic, GridLinesStyle -> Directive[Orange, Dashed]]

enter image description here

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ Oh, It's also a nice visualization. $\endgroup$
    – Red Banana
    Commented Sep 13, 2012 at 10:09
9
$\begingroup$

It seems I understood your requirement somewhat differently from others, so this is what I came up with:

GraphicsGrid[{Graphics@Rectangle[{0, 0}, #] & /@ c}]

enter image description here

Graphics[Rectangle[…]] plots each rectangle in list c, without any consideration for alignement. Then let GraphicsGrid do the alignment for you…

Edit: and I can has color too:

enter image description here

Improve this answer
$\endgroup$
5
$\begingroup$

Also based on @Mr.W's answer and taking up his suggestion (using Divisors):

ClearAll[rectangles];
rectangles = Function[{x}, {-#/2, #/2} & /@ ({x^2/#, #} & /@ Divisors[x^2])];
grphcs :=  Graphics[{Directive[Hue[RandomReal[]], EdgeForm[Opacity[.3]], 
   FaceForm[Opacity[.3]]], Rectangle[Sequence @@ #]} & /@ #, ImageSize->300] &

Row[grphcs@rectangles[#] & /@ {2,3,4,5}]

enter image description here

Row[grphcs@rectangles[#] & /@ {9, 10, 12}]

enter image description here

Improve this answer
$\endgroup$

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