Message Boards Message Boards

Fixing a code which covers $[-k,k]\times[-k,k]$ for a given $k\in\mathbb{N}$, with small rectangles

Motivation: From this post we, initially, wanted to cover a rectangle using smaller, non-overlapping rectangles with the same area: the difference between the total area of the smaller rectangles and the area of the original rectangle should be zero or positive and close to zero as possible.

Code 1:

Using this answer:

rad = {{-1, -1}, {1, 1}}; (*Definition Of Rectangle*)
epsilon = 7/10; (*Area of "smaller rectangles"*)
a = Area[Rectangle @@ rad];
n = Ceiling[a/eps];
dn = Divisors[n];
dim = Transpose[{dn, Reverse[dn]}];
rdim = RandomChoice[dim];
b = n*eps;
nr = r*x /. 
Solve[b == Times @@ Subtract @@ (r*x), x, PositiveReals][[1]];
nr = # - (Plus @@ nr/2 - Plus @@ r/2) & /@ nr // RootReduce;
Partition[
Table[i, {i, nr[[1, 1]], nr[[2, 1]], Abs[nr[[1, 1]] - nr[[2, 1]]]/
rdim[[1]]}], 2, 1] // RootReduce;
Partition[
Table[i, {i, nr[[1, 2]], nr[[2, 2]], Abs[nr[[1, 2]] - nr[[2, 2]]]/
rdim[[2]]}], 2, 1] // RootReduce;
Transpose /@ Tuples[{%%, %}];
Graphics[{Rectangle @@ r, EdgeForm[Red], Green, Opacity[0.5], 
Rectangle @@@ %}]

we want to cover a square of the form $[-k,k]\times[-k,k]$ for a given $k\in\mathbb{N}$

Attempt:

I attempted to define the code in the answer in terms of variable k

Clear["Global`*"]
Unprotect[Tr]
epsilon = .3; (* Area of smaller rectangles covering the original rectangle *)
rad[k_] := 
 rad[k] = {{-k, -k}, {k, k}}; (* Coordinates for original rectangle *)
a[k_] := a[k] = Area[Rectangle @@ rad[k]];
n[k_] := n[k] = Ceiling[a[k]/epsilon];
dn[k_] := dn[k] = Divisors[n[k]];
dim[k_] := dim[k] = Transpose[{dn[k], Reverse[dn[k]]}];
rdim[k_] := rdim[k] = RandomChoice[dim[k]];
b[k_] := b[k] = n[k]*epsilon;
nr[k_] := 
  nr[k] = rad[k]*x /. 
    Solve[b[k] == Times @@ Subtract @@ (rad[k]*x), x, 
      PositiveReals][[1]];
nr[k_] := 
  nr[k] = # - (Plus @@ nr[k]/2 - Plus @@ rad/2) & /@ nr[k] // 
    RootReduce;
Partk1[k_] := 
  Partk1[k] = 
   Partition[
     Table[i, {i, nr[k][[1, 1]], nr[k][[2, 1]], 
       Abs[nr[k][[1, 1]] - nr[k][[2, 1]]]/rdim[k][[1]]}], 2, 1] // 
    RootReduce;
Partk2[k_] := 
  Partk2[k] = 
   Partition[
     Table[i, {i, nr[k][[1, 2]], nr[k][[2, 2]], 
       Abs[nr[[1, 2]] - nr[k][[2, 2]]]/rdim[k][[2]]}], 2, 1] // 
    RootReduce;
Tr[k_] := Tr[k] = Transpose /@ Tuples[{Partk1[k], Partk2[k]}];
U[k_] := U[k] = Rectangle @@@ Tr[k]
S[k_] := S[k] = RegionCentroid /@ U[k]
G[k_] := G[k] = 
  Show[Graphics[{EdgeForm[{Thick, Red}], FaceForm[], 
     Rectangle @@ rad[k], EdgeForm[{Thick, Green}], U[k]}], 
   Graphics[{Black, Point[S[k]]}]]

 G[3] (* Code we want to output*)

We want the output of G[3] to be a picture of a square $[-3,3]\times[-3,3]$ bordered in red and its coverings of smaller, green rectangles that have the same area. (We assume, because of the second line of the recurrence relation nr[k], Partk1[k], and Partk2[k]; I get the following errors.)

$RecursionLimit::reclim2: Recursion depth of 1024 exceeded during evaluation of RootReduce[(#1-(Apply[<<2>>] Power[<<2>>]-Times[<<2>>])&)/@nr[3]].

$RecursionLimit::reclim2: Recursion depth of 1024 exceeded during evaluation of RootReduce[(#1-(Apply[<<2>>] Power[<<2>>]-Times[<<2>>])&)/@nr[3]].

$RecursionLimit::reclim2: Recursion depth of 1024 exceeded during evaluation of RootReduce[(#1-(Apply[<<2>>] Power[<<2>>]-Times[<<2>>])&)/@nr[3]].

General::stop: Further output of $RecursionLimit::reclim2 will be suppressed during this calculation.

Table::iterb: Iterator {i,Hold[nr[3][[1,1]]],Hold[nr[3][[2,1]]],Hold[Abs[nr[3][[1,1]]-nr[<<1>>][[2,1]]]/rdim[3][[1]]]} does not have appropriate bounds.

Table::iterb: Iterator {i,Hold[nr[3][[1,1]]],Hold[nr[3][[2,1]]],Hold[Abs[nr[3][[1,1]]-nr[<<1>>][[2,1]]]/rdim[3][[1]]]} does not have appropriate bounds.

Table::iterb: Iterator {i,Hold[nr[3][[1,1]]],Hold[nr[3][[2,1]]],Hold[Abs[nr[3][[1,1]]-nr[<<1>>][[2,1]]]/rdim[3][[1]]]} does not have appropriate bounds.

General::stop: Further output of Table::iterb will be suppressed during this calculation.

Part::partd: Part specification nr[[1,2]] is longer than depth of object.

Transpose::nmtx: The first two levels of {i,{i,Hold[nr[3][[1,2]]],Hold[nr[3][[2,2]]],Hold[Abs[nr[[1,2]]-Part[<<3>>]]/rdim[3][[2]]]}} cannot be transposed.

Transpose::nmtx: The first two levels of {{i,Hold[nr[3][[1,1]]],Hold[nr[3][[2,1]]],Hold[Abs[nr[<<1>>][[1,1]]-Part[<<3>>]]/rdim[3][[1]]]},i} cannot be transposed.

Question: How do we add k from Code 1 to the Attempt and fix the second nr[k_], Partk1, Partk2 and Tr? How do we fix the attempt, in general?

POSTED BY: Bharath Krishnan
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract