intersection between two 2D arrays with labeled data is slow
AbsoluteTiming[
counts = Normal[SparseArray[SparseArray[#, {50}] &@ DeleteCases[
Normal[Counts[Flatten[(1 - Unitize[seg1 - #]) seg2]]], 0 -> _] & /@ Range[51]]];]
{0.30279, Null}
(pos = Table[Length@Intersection[Position[seg1, i], Position[seg2, j]], {i,
51}, {j, 50}];) // AbsoluteTiming
{122.747, Null}
counts == pos
True
Something like the following would be pretty fast:
intersections[r1_, r2_] := Module[{t},
t = DeleteCases[Tally@Flatten[Unitize[r1 r2] (100 r1 + r2)], {0, _}];
t[[All, 1]] = IntegerDigits[t[[All, 1]], 100];
Normal[SparseArray[Rule @@@ t]]
]
This assumes that the labels are all less than 100. For the OP example:
res=intersections[seg1, seg2]; //AbsoluteTiming
res[[;;5, ;;5]]
{0.006349, Null}
{{0, 0, 0, 0, 267}, {0, 0, 6888, 0, 0}, {0, 6511, 0, 0, 0}, {204, 0, 0, 7249, 70}, {0, 0, 0, 110, 3971}}
A simpler solution using PositionIndex
a1 = Flatten[seg1] // PositionIndex;
a2 = Flatten[seg2] // PositionIndex;
a3 = Table[Length@Intersection[a1[i], a2[j]], {i, 51}, {j, 50}]; // AbsoluteTiming
{0.930523, Null}
counts == pos == a3
True
Can't beat kglr's solution, though. It takes 0.41 s
.