0
$\begingroup$

In the code, I indicated a fragment (picker =...) where the program is slow for large m=n=dim (for example)=2000. Does anyone have any idea what to replace it with to make it faster? The code looks for rectangles set at an alpha angle located on the matrix 'm1'. The 'result' represents this rectangle in the matrix padding the missing corners with zeros.

result = {};  (*The most important result of the calculations !!!!!!!!*)
Table[
 m = 100; (*2000*)
 n = 100; (*2000*)
 dim = 100; (*2000*)
 m1 = RandomReal[{0, 1}, {m, n}];
 alpha = Pi/4;
 
 (*direction of first side of the rectangle*)
 e1 = {Cos[alpha], Sin[alpha]};
 (*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 = 40;
 (*half the length of the second side of the rectangle*)
 halflength2 = 4;
 
 
 (*Constraints for the Center of the Rectangle*)
 ogr1 = (halflength1)*Cos[alpha] + (halflength2)* Sin[alpha];
 ogr2 = (halflength2)*Cos[alpha] + (halflength1)* Sin[alpha];
 ogr1 = Ceiling[ogr1*3/100 + ogr1];
 ogr2 = Ceiling[ogr2*3/100 + ogr2];
 center = {RandomInteger[{ogr1, m - ogr1}], 
   RandomInteger[{ogr2, n - ogr2}]}; (*Center of the rectangle*)
 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]]];
(*******    ***Calculation bottleneck.How to speed it up?***  ***********)
 
 
 
 (*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]);
 Print[i];
 (*Use SparseArray to construct the actual matrix.*)
 AppendTo[result, SparseArray[pattern -> Extract[m1, pattern], {m, n}][[xspan, yspan]] ];
(*The most important result of the calculations !!!!!!!!*)
 , {i, 1, 50}]
(*****  Only for visualization. Not used for large calculations:  ******)
r1 = Select[Flatten[result[[-1]]], # > 0 &];
r2 = Flatten[Table[Position[m1, r1[[i]]], {i, 1, Length[r1]}], 1];
t1 = Table[{i, j}, {i, dim}, {j, dim}]; (*matrix coordinates*)
Rotate[Show[
  ListPlot[{Catenate@t1}, PlotStyle -> {Gray, Red}, AspectRatio -> 1, 
   PlotMarkers -> {\[FilledSmallCircle], Small}, 
   Epilog -> {PointSize[Medium], Red, Point[r2]}]], -Pi/2]
$\endgroup$
2
  • $\begingroup$ Thank you for including code, but can you expand on what you are trying to achieve with your code, in words, so we don't have to tease that out of your implementation? $\endgroup$
    – MarcoB
    Feb 16, 2022 at 15:24
  • $\begingroup$ Thanks. See update. $\endgroup$
    – ralph
    Feb 16, 2022 at 15:36

1 Answer 1

1
$\begingroup$

I found what the bottleneck is. Well, it is enough to replace alpha=Pi/4 with, for example, Round[alpha=Pi/4, 0.0001] :) :)

$\endgroup$
2
  • $\begingroup$ If that is the case, then simply alpha = Pi/4. should help, too. $\endgroup$
    – Domen
    Feb 17, 2022 at 12:44
  • $\begingroup$ Of course :) :) $\endgroup$
    – ralph
    Feb 17, 2022 at 12:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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