1
$\begingroup$

EDIT: Question Updated with solution approach, but solution much slower than original implementation. Any ideas to speed up implementation?

In the discussion on collision detection (see here) I asked the question on an implementation of the sweep and prune algorithm for collision detection. I recently stumbled over the non-trivial extension for intersection test when having periodic boundary conditions.

If we modify the example of the original post for periodic boundaries (at position 0 and 10),

SeedRandom[35];
objects = Sort /@ RandomReal[{-5, 15}, {10, 2}];
Graphics[{MapIndexed[{Rectangle[{#1[[1]], -First[#2]}, {#1[[2]], \
-First[#2] - 0.5}], Text[First[#2], {-5.1, -First[#2] - 0.25}]} &, 
   objects], Dashed, Line[{{0, -Length[objects]}, {0, 0}}], 
  Line[{{10, -Length[objects]}, {10, 0}}]}]
Sort[Sort /@ SweepAndPrune[objects]]

and apply the really nice original solution

SweepAndPrune[obj_] := 
 Module[{ord = Quotient[Ordering@Flatten@obj + 1, 2]}, 
  Quotient[#, 2] &@
   DeleteDuplicates[
    Transpose@{# - #2, +##} &[+##, Abs[# - #2]] &[
       Flatten[Unitize@# Range@Length@#], Flatten@#] &[
     ord[[# + 1 ;; #2 - 1]] & @@@ Partition[Ordering@ord, 2]]]]

by ybeltukov, we get the following result.

enter image description here

{{1, 3}, {1, 5}, {1, 6}, {1, 7}, {1, 8}, {1, 9}, {2, 6}, {3, 5}, {3, 7}, {3, 8}, {3, 9}, {4, 6}, {5, 7}, {5, 9}, {7, 8}, {7, 9}, {7, 10}}

which is obviously not covering the overlaps between different "periods" of the same interval. If you take the modulo of the interval boundaries, one sees that there is e.g. an intersection between interval #1 and #4 or #7 and #2, which is not showing up in the list. A rather complex solution for the periodic approach is outlined on the following Webpage, but is not really straightforward suitable for the implementation into Mathematica if one wants to use the computational power of the Ordering function. I wonder if there is an easier way to take advantage of the built-in Mathematica routines?

EDIT: The following approach uses Sparse Matrices (needed if number of objects is high, and potential speedup of subsequent calculations), but is VERY slow compared to the implementation by ybeltukov.

SweepAndPrune[obj_, domain_, 1] := 
  Module[{ord = Quotient[Ordering@Flatten@obj + 1, 2]}, 
   Quotient[#, 2] &@
    DeleteDuplicates[
     Transpose@{# - #2, +##} &[+##, Abs[# - #2]] &[
        Flatten[Unitize@# Range@Length@#], Flatten@#] &[
      ord[[# + 1 ;; #2 - 1]] & @@@ Partition[Ordering@ord, 2]]]];
SweepAndPrune[obj_, domain_, 2] := 
 Module[{domspan, objper, ord, pairs},
  domspan = First[Differences[domain]];
  objper = 
   List @@@ 
    IntervalUnion @@@ ({IntervalIntersection[Interval[domain], 
          Interval@#], 
         IntervalIntersection[Interval[domain] - domspan, 
           Interval@#] + domspan, 
         IntervalIntersection[Interval[domain] + domspan, 
           Interval@#] - domspan} & /@ obj);
  ord = Quotient[Ordering@Flatten@objper + 1, 2];
  pairs = 
   Quotient[#, 2] &@
    DeleteDuplicates[
     Transpose@{# - #2, +##} &[+##, Abs[# - #2]] &[
        Flatten[Unitize@# Range@Length@#], Flatten@#] &[
      ord[[# + 1 ;; #2 - 1]] & @@@ Partition[Ordering@ord, 2]]];
  DeleteDuplicates[
   pairs /. 
    Thread[Rule[Range[Length[Flatten@objper]/2], 
      Flatten@MapIndexed[ConstantArray[First[#2], #1] &, 
        Length /@ objper]]]]
  ]

FindCollisionCandidates[objboxes_, domain_, dim_: 3, alg_: 0] :=
  Switch[alg,
   0, Extract[Subsets[Range[Length[objboxes]], {2}], 
    Position[
     Transpose[
      Apply[IntervalIntersection, 
       Map[Interval, 
        Subsets[Transpose[
             Transpose[objboxes, {1, 3, 2}]][[#]], {2}] & /@ 
         Range[dim], {3}], {2}]], {Repeated[Interval[_List], {dim}]}]],
   1, Intersection @@ 
    Table[SweepAndPrune[objboxes[[;; , ;; , d]], domain[[d]], 
      alg], {d, dim}],
   2, Intersection @@ 
    Table[SweepAndPrune[objboxes[[;; , ;; , d]], domain[[d]], 
      alg], {d, dim}]
   ];

alg=0 and alg=1 are the non-periodic implementations from the earlier post, and alg=2 is the periodic implementation solving this question. However if one tests the speed of the periodic algorithm, we are back at the performance of alg=0 (unfortunately).

rval = 0.1;
domain = {-5, 5};
Nbox = 500;
dim = 3;
SeedRandom[35];
p = Prepend[
   RandomReal[domain - {-rval, +rval}, {Nbox, dim}], {0, 0, 0}];
r = ConstantArray[rval, Length[p]];
res1 = Sort[
    Sort /@ FindCollisionCandidates[{p - r, p + r}\[Transpose], 
      domain + {-rval, +rval}, 2, 0]]; // AbsoluteTiming
res2 = FindCollisionCandidates[{p - r, p + r}\[Transpose], 
    domain + {-rval, +rval}, 2, 1]; // AbsoluteTiming
res3 = FindCollisionCandidates[{p - r, p + r}\[Transpose], 
    domain + {-rval, +rval}, 2, 2]; // AbsoluteTiming
res1 == res2 == res3

(*{1.513200, Null}*)
(*{0.015600, Null}*)
(*{1.185600, Null}*)
$\endgroup$
  • $\begingroup$ (1) You might consider, for those that cross the boundary, splitting into two cells in a "canonicalized" interval. Then for a given intersection you have to consider separately whether either partial cell of the first intersects either of the second (when they have two subcells). $\endgroup$ – Daniel Lichtblau Mar 17 '15 at 22:30
  • $\begingroup$ (2) For what it's worth, I suspect a binning approach with "stabbing" queries at interval endpoints might be reasonable for the task at hand. To get an idea of what I mean (albeit in a very different application) see this old MSE response $\endgroup$ – Daniel Lichtblau Mar 17 '15 at 22:33
  • $\begingroup$ @Daniel, you may have a look at the update of the question. I have now a solution but without the nice optimization by ybeltukov I'm back at the beginning with respect to code speed. $\endgroup$ – Rainer Mar 24 '15 at 6:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.