Replacing members of a list with elements sampled without replacement from another list

I have a list of element pairs:

pairList = {{1,2}, {2, 3}, {3, 4}, {4, 5}};

I'd list to pick a subset of the elements in this list:

pairListSubset = {2, 5};

Now, wherever any pairListSubset element occurs, I'd like to replace it with an element sampled without replacement from list in replacementSets occurring at the same index position in pairListSubset. Extending the previous example:

replacementSets = {{"a", "b", "c"}, {"d", "e", "f"}};

With the example provided the result of this procedure may result in one of the following nine possibilities:

pairListFinal = ...

{{1,"a"}, {"b", 3}, {3, 4}, {4, "d"}}
{{1,"a"}, {"c", 3}, {3, 4}, {4, "d"}}
{{1,"b"}, {"c", 3}, {3, 4}, {4, "d"}}
{{1,"a"}, {"b", 3}, {3, 4}, {4, "e"}}
{{1,"a"}, {"c", 3}, {3, 4}, {4, "e"}}
{{1,"b"}, {"c", 3}, {3, 4}, {4, "e"}}
{{1,"a"}, {"b", 3}, {3, 4}, {4, "f"}}
{{1,"a"}, {"c", 3}, {3, 4}, {4, "f"}}
{{1,"b"}, {"c", 3}, {3, 4}, {4, "f"}}

How can I concisely carry out this list operation? To simplify things, it would be fine to pick the first element of each replacementSets list, then the second element, and so on. Its not important to sample randomly without replacement.

• I answered using Mathematica 10 functionality (GroupBy). If you are using an earlier version please let me know and I shall provide an alternative. Jan 4, 2015 at 10:58
• Just for anyone seeing this, I've commented on this posting below Mr. Wizard's answer. Unfortunately I have only Version 8, but I'm coming around to buying v10. Jan 4, 2015 at 11:07

Starting data:

pairList = {{1, 2}, {2, 3}, {3, 4}, {4, 5}};
pairListSubset = {2, 5};
replacementSets = {{"a", "b", "c"}, {"d", "e", "f"}};

PositionIndex-style function with levelspec (avoids mapping Position; reference):

posIdxLevel[x_, levelspec_, opts : OptionsPattern[Position]] :=
GroupBy[Extract[x, #] &] @
Position[pairList, _, levelspec, opts, Heads -> False]

Positions:

pos = posIdxLevel[pairList, {2}] /@ pairListSubset;

Substitutions:

subs = Join @@
MapThread[Thread[#2 -> RandomSample[#, Length@#2]] &, {replacementSets, pos}];

Result:

ReplacePart[pairList, subs]
{{1, "b"}, {"c", 3}, {3, 4}, {4, "e"}}

Welcome to Mathematica.StackExchange :-)

Version 5+ implementation of posIdxLevel

posIdxLevel2[x_, lev_, opts : OptionsPattern[Position]] :=
Reap[
Sow[#, Extract[x, #]] & ~Scan~
Position[pairList, _, lev, opts, Heads -> False],
_,
Rule
][[2]] // Dispatch

Use with ReplaceAll rather than Map in this step:

pos = pairListSubset /. posIdxLevel2[pairList, {2}]
• I noticed your comment on GroupBy while writing to ask about it! Is there a workaround for an older version of Mathematica? Version 8 or earlier? Jan 4, 2015 at 11:00
• Also, just as a comment, I find your alias to be fairly appropriate. :) Jan 4, 2015 at 11:02
• @user23512 backward-compatible version added. Jan 4, 2015 at 11:35
• Is it maybe the backward compatible version? I noticed that pairList lists and pairListSubset must have the same dimension? Also thank you so much for the backward compatible version! Jan 4, 2015 at 11:56
• @user23512 No, that's the result of my using MapThread[. . . , {replacementSets, pos}]. I thought these two were always the same length. How should it be handled if they are not? Jan 4, 2015 at 11:58

This should be comparable on tiny lists and 20-50+X faster than the current posted solution on large lists, depending on number of replacements needed (at least when I compared to pre-V10 solution - I no longer have 10 installed, so did not bmark that 10-specific solution, perhaps Mr.W could bmark the two):

pairReplace[list_, pairsub_, subs_] :=
Module[{f = Flatten@list, r, p, sr, c},
r = Range@Length@f;
p = Pick[ConstantArray[r, Length@pairsub], Subtract[f, #] & /@ pairsub, 0];
sr = Flatten[MapThread[RandomSample[#, Length@#2] &, {subs, p}]];
f[[Flatten[p]]] = sr;
Partition[f, 2]];

pairList = {{1, 2}, {2, 3}, {3, 4}, {4, 5}};
pairListSubset = {2, 5};
replacementSets = {{"a", "b", "c"}, {"d", "e", "f"}};

pairReplace[pairList, pairListSubset, replacementSets]

(* {{1, "b"}, {"c", 3}, {3, 4}, {4, "d"}} *)

For some use cases, the following simpler code can outperform the above:

pairReplace2[list_, sub_, reps_] :=
Module[{f = Flatten@list, pp, gb, l = Length@sub},
pp = Flatten@Join[sub, f];
gb = Subtract[(GatherBy[Range@Length@pp, pp[[#]] &])[[;; l, 2 ;;]], l];
MapThread[(f[[#1]] = RandomSample[#2, Length@#1]) &, {gb, reps}];
Partition[f, 2]]