# Rectangles in matrix

Consider the matrix 'm1' :

m1 = RandomReal[{0, 1}, {100, 100}];

Let's draw a rectangle in this matrix

dim = 100; (*matrix dimension*)
t1 = Table[{i, j}, {i, dim}, {j, dim}]; (*matrix coordinates*)
alpha = -Pi/3;
k = Tan[alpha]; (* 0<alpha<Pi/2 *)
t2 = RandomSample[Flatten[t1, 1],50]; (*randomly selected coordinates*)
X = t2[[1, 2]](**)
Y = t2[[1, 1]]  (**)
b1 = Solve[k X + n == Y, n][[1, 1, 2]];
b2 = Solve[-1/k X + n == Y, n][[1, 1, 2]];
w1 = 5; (*Half the length of the side of the rectangle *)
w2 = 10; (*Half the length of the side of the rectangle *)
e1 = k x + b1 + w1 Sqrt[1 + k^2];
e2 = k x + b1 - w1 Sqrt[1 + k^2];
e3 = -(1/k) x + b2 + w2 Sqrt[1 + k^2];
e4 = -(1/k) x + b2 - w2 Sqrt[1 + k^2];
Rotate[Show[(*ArrayPlot[t1,PlotTheme->"Detailed"],*) ListPlot[{Catenate@t1}, PlotStyle -> {Gray, Red}, AspectRatio -> 1, PlotMarkers -> {\[FilledSmallCircle], Small}],Plot[{k x + b1, e1, e2, e3, e4, -(1/k) x + b2}, {x, 1, 100},PlotRange -> {{1, 100}, {1, 100}}, PlotStyle -> {{Dashed, Black}, Blue, Blue, Green, Green, {Dashed, Black}}], ListPlot[{{X, Y}}, PlotStyle -> {PointSize -> 0.03, Red}],ImageSize -> 600], -Pi/2]

The question is: how to extract elements of matrix 'm1' from area bounded by straight lines (rectangle) and save it as a matrix the "bounding rectangle" (orange), keep the red elements, and set the grey elements to zero (fig. by @Domen):

@Henrik Schumacher Thanks. But how to control the alpha angle of the rectangle?

Maybe something like this does what you want:

m = 100;
n = 100;
m1 = RandomReal[{0, 1}, {m, n}];

(*center of the rectangle*)
center = {RandomInteger[{1, m}], RandomInteger[{1, n}]};
(*direction of first side of the rectangle*)
e1 = RandomPoint[Circle[]];
(*direction of the second side of the rectangle*)
e2 = RotationTransform[Pi/2][e1];
(*half the length of the first side of the rectangle*)
halflength1 = RandomReal[{1, m/2}];
(*half the length of the second side of the rectangle*)
halflength2 = RandomReal[{1, n/2}];

pts = Tuples[{Range[m], Range[n]}];
(*The following vector has a 1 at positions that belong to the rectangle; other entries are 0.*)
picker = Times[
UnitStep[halflength1 - Abs[pts.e1 - center.e1]],
UnitStep[halflength2 - Abs[pts.e2 - center.e2]]
];
(*Pick the coordinates of the points belonging to the rectangle.*)
pattern = Pick[pts, picker, 1];
(*Find axis-aligned bounding box (the orange rectangle)*)
{xspan, yspan} = Span @@@ (MinMax /@ Transpose[pattern]);

(*Use SparseArray to construct the actual matrix.*)
result = SparseArray[pattern -> Extract[m1, pattern], {m, n}][[xspan, yspan]]
• Thanks. But how to control the alpha angle of the rectangle? Feb 14, 2022 at 16:13
• Just by setting e1 = {cos[\[Alpha]],Sin[\[Alpha]]}? Feb 14, 2022 at 18:18
• Thanks. And now an equally important question. How to optimize it to make it faster? For example, for n = 1000 and m = 1000 it is very slow. Feb 15, 2022 at 21:01
• That was not part of the original post. Feb 16, 2022 at 16:06

"13.0.1 for Microsoft Windows (64-bit) (January 28, 2022)"

Alternatively, we can find four intersection points of lines and use CoordinateBoundingBox to find bounding rectangle.

ClearAll["Global`*"]

SeedRandom@123;
m = 100;
m1 = RandomReal[{0, 1}, {m, m}];
t1 = Tuples[Range@m, {2}] ;  (*matrix coordinates*)
alpha = -Pi/3;
k = Tan[alpha];   (*0<alpha<Pi/2*)
t2 = RandomSample[t1, 50];    (*randomly selected coordinates*)
X = t2[[1, 2]];
Y = t2[[1, 1]] ;
b1 = Solve[k X + n == Y, n][[1, 1, 2]];
b2 = Solve[-1/k X + n == Y, n][[1, 1, 2]];
w1 = 5;(*Half the length of the side of the rectangle*)
w2 = 10;(*Half the length of the side of the rectangle*)
e1 = k x + b1 + w1 Sqrt[1 + k^2];
e2 = k x + b1 - w1 Sqrt[1 + k^2];
e3 = -(1/k) x + b2 + w2 Sqrt[1 + k^2];
e4 = -(1/k) x + b2 - w2 Sqrt[1 + k^2];

pts = Flatten /@ {SolveValues[ {y == e1, y == e3}, {x, y}],
SolveValues[ {y == e1, y == e4}, {x, y}],
SolveValues[ {y == e2, y == e3}, {x, y}],
SolveValues[ {y == e2, y == e4}, {x, y}]} // Simplify;

{{x1, y1}, {x2, y2}} = CoordinateBoundingBox[pts]

mask = UnitStep[t1[[All, 1]] - x1, x2 - t1[[All, 1]],
t1[[All, 2]] - y1, y2 - t1[[All, 2]]]~Partition~m;

{Show[ArrayPlot[Transpose@m1, Frame -> True, FrameTicks -> All,
DataReversed -> True, ImageSize -> 300],
Graphics[{FaceForm[None], EdgeForm[{Red, Thick}],
Rectangle[{x1, y1}, {x2, y2}]}]],
Show[ArrayPlot[boundingRectangle, Frame -> True, FrameTicks -> All,
DataReversed -> True, ImageSize -> 300],
Graphics[{FaceForm[None], EdgeForm[{Red, Thick}],
Rectangle[{x1, y1}, {x2, y2}]}, GridLines -> {{x1, x2}, {y1, y2}},
PlotRange -> {{1, 100}, {1, 100}}, ImageSize -> 300]]}

list2 = Join @@ DeleteCases[Pick[t1~Partition~m, mask, 1], {}];

orange = Graphics[{FaceForm[Orange], Opacity[0.5],
Rectangle[Sequence @@ CoordinateBoundingBox[pts]]}];

red = Graphics[{FaceForm[Red], Opacity[0.5],
Polygon[{pts[[1]], pts[[3]], pts[[4]], pts[[2]]}]}];

Show[ListPlot[t1, PlotStyle -> Gray, AspectRatio -> 1,
PlotMarkers -> {\[FilledSmallCircle], Small}, Frame -> True],
Plot[{k x + b1, e1, e2, e3, e4, -(1/k) x + b2}, {x, 1, m},
PlotRange -> {{1, m}, {1, m}},
PlotStyle -> {{Dashed, Black}, Blue, Blue, Green,
Green, {Dashed, Black}}, Frame -> True], orange, red,
ListPlot[list2, PlotStyle -> Orange],
ListPlot[{{{X, Y}}, pts}, PlotStyle -> Red]]