Fixing a code which covers $[-k,k]\times[-k,k]$ for a given $k\in\mathbb{N}$, with smaller rectangles of equal area?

Question

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.

Using this answer:

rad = {{-1, -1}, {1, 1}};
epsilon = 7/10;
a = Area[Rectangle @@ rad];
n = Ceiling[a/epsilon];
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}$

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

Clear["Global`*"]
Unprotect[Tr]
rad[k_] := 
 rad[k] = {{-k, -k}, {k, k}}; (* Define a sequence of rectangles with k *)
epsilon = 7/10;
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 with coverings of smaller, green rectangles that have the same area. (We assume, because of the second nr[k] (i.e., the recurrence relation), 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 fix the second nr[k_], Partk1, Partk2 and Tr so we could fix the code?

Answer 1

Your code is really not worth any fixing. Your style of writing code (programing) is really bad.

But anyway the question was how to fix it - so I leave it in its original form, only fixing the least amount to make it work. But in fact the code should be entirely rebuild.

Clear["Global`*"]
rad[k_] := 
 rad[k] = {{-k, -k}, {k, 
    k}};(*Define a sequence of rectangles with k*)epsilon = 7/10;
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;
nnr[k_] := 
  nnr[k] = rad[k]*x /. 
    Solve[b[k] == Times @@ Subtract @@ (rad[k]*x), x, 
      PositiveReals][[1]];
nr[k_] := 
  nr[k] = # - (Plus @@ nnr[k]/2 - Plus @@ rad[k]/2) & /@ nnr[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[k][[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]