Cover a rectangle with size constrained rectangular regions

Question

I have a big grid (indicated on the image in grey) that is divided in several blocks (each with a maximum width of 3 units). Now I would like to divide a region (indicated on the grid in red) by the corresponding blocks.

To give an example, I would like the 'block regions' (represented {X,Y,Width,Height}):

A: {2,3,2,1} B: {4,3,3,1} C: {7,3,1,1} D: {2,4,2,3} ... The only information that I have is the size of the blocks in the grid (in this case 3) and the dimensions of the region: {2,3,6,5} (= {X,Y, width, height})

Does anybody know how to do this in an efficient way? I thought about the use of mround to calculate the first boundaries of the blocks, but that lead to a dead end. Thanks in advance!

Answer 1

Not terribly efficient, but here's a start:

f1[b_] := SplitBy[Range@# + #2, Ceiling[#, b] &] &;

f2[p_List] := Join[p[[All, 1]], Length /@ p]

f3[block_, {x_, y_, w_, h_}] :=
 f2 /@ Tuples@MapThread[f1[block], {{w, h}, {x, y} - 1}]

f3[3, {2, 3, 6, 5}]

{{2, 3, 2, 1}, {2, 4, 2, 3}, {2, 7, 2, 1}, {4, 3, 3, 1}, {4, 4, 3, 3},
 {4, 7, 3, 1}, {7, 3, 1, 1}, {7, 4, 1, 3}, {7, 7, 1, 1}}

---

Here's a faster, if more opaque, f1 function:

f1[b_] := Partition[Range@# + #2, b, b, {Mod[#2, b] + 1, -b}, {}] &

Answer 2

EDIT: Mr. Wizard's comment just made me realize that my blocks start at (0,0). The conversion to (1,1) blocks is obvious, but it only makes the calculations less readable. I've changed the graphics to show where the blocks are.

Not very pretty, but simple:

blockWidth = 3;
{x1, y1, x2, y2} = rect = {2, 3, 2 + 6, 3 + 5};

clippedRects = Table[
   {
    {
     Clip[x1, {x, x + blockWidth}],
     Clip[y1, {y, y + blockWidth}]
     },
    {
     Clip[x2, {x, x + blockWidth}],
     Clip[y2, {y, y + blockWidth}]
     }
    },
   {x, Floor[x1, blockWidth], Ceiling[x2, blockWidth] - 1, blockWidth},
   {y, Floor[y1, blockWidth], Ceiling[y2, blockWidth] - 1, 
    blockWidth}];

Displaying the results:

gridLines = {#, {Gray, If[Mod[#, 3] == 0, Dashed, Dotted]}} & /@ 
   Range[0, 9];
Graphics[{Transparent, EdgeForm[Red], 
  Rectangle[{x1, y1} - .1, {x2, y2} + .1], EdgeForm[Black], 
  Rectangle @@@ Flatten[clippedRects, 1],}, Axes -> True, 
 AxesOrigin -> {0, 0}, Ticks -> {Range[0, 9, 3], Range[0, 9, 3]}, 
 GridLines -> {gridLines, gridLines}]

Answer 3

I thought it could be easier using IntegerPartitions[], but suddenly the code got convoluted.

part[r_] := 
   Module[{d},
     d = IntegerPartitions[#, All, Range@3, 1][[1]] & /@ r[[3 ;; 4]];
     Flatten/@Transpose@{Tuples[r[[#]]+Most@FoldList[Plus,0,d[[#]]] & /@ {1, 2}], Tuples@d}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

Edit

A plotting function, just for completeness:

rect[{x_, y_, w_, h_}] := Rectangle[{x, -y - h}, {x + w, -y}]
plotrects[{x_, y_, w_, h_}] := 
 Graphics[{FaceForm[White], EdgeForm[Black],  rect /@ part[{x, y, w, h}]}, Axes -> True, 
           PlotRange -> {{x - 3, x + w + 3}, {-y - h - 3, -y + 3}}]
plotrects[{2, 3, 6, 5}]