# Fastest way to do repeated subsample/Intersection calls over large set of vectors

In this answer I found I needed to calculate a bunch of intersections of subsets of vectors, like

Clear[takeSubpspaceIntersections];
takeSubpspaceIntersections[i_, pos_, val_, perms_] :=
Block[{
subperms, picked = Range[Length[perms]],
fullInds,
},
subperms = perms[[picked]];
badPickI = Pick[Range[Length[perms]], perms[[;; , i - 1]], val];
fullInds = Range[Length[perms[[1]]]];
Do[
badPickJ = Pick[Range[Length[picked]], subperms[[;; , j]], val];
(*
subsample set of input vectors, take their intersectiom
*)

(*
remap intersected vectors to corresponding elements of badPickJ
and resample input vectors
*)
picked = picked[[ Complement[Range[Length[picked]], badPosJ] ]];
subperms = perms[[picked]]
],
{j, pos}
];
subperms
]


The problem is that this can be slow over large numbers of vectors

perms1000 =
BlockRandom[SeedRandom[4];
RandomInteger[3, {1000000, 15}]] // DeleteDuplicates;

(spint = takeSubpspaceIntersections[5, {2}, 1, perms1000];) //
RepeatedTiming // First

0.83


Some preliminary testing suggests that the slowest part is the number of times I'm doing things like perms[[badPickI, Delete[fullInds, i - 1]]]; which because of the way Mathematica handles tensors internally forces a copy.

Is there a way I can make this subsample/Intersection process faster, maybe by doing the Intersection piece-by-piece over the intersection of Delete[fullInds, i - 1] and Delete[fullInds, j] first, allowing me to iteratively refine the result over smaller chunks of memory? (kinda similar to the ideas here: Pair-wise equality over large sets of large vectors)