3
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ I answered using Mathematica 10 functionality (GroupBy). If you are using an earlier version please let me know and I shall provide an alternative. $\endgroup$ – Mr.Wizard Jan 4 '15 at 10:58
  • $\begingroup$ 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. $\endgroup$ – user23512 Jan 4 '15 at 11:07
2
$\begingroup$

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}]
$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – user23512 Jan 4 '15 at 11:00
  • $\begingroup$ Also, just as a comment, I find your alias to be fairly appropriate. :) $\endgroup$ – user23512 Jan 4 '15 at 11:02
  • $\begingroup$ @user23512 backward-compatible version added. $\endgroup$ – Mr.Wizard Jan 4 '15 at 11:35
  • $\begingroup$ 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! $\endgroup$ – user23512 Jan 4 '15 at 11:56
  • $\begingroup$ @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? $\endgroup$ – Mr.Wizard Jan 4 '15 at 11:58
0
$\begingroup$

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]]
$\endgroup$

Your Answer

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

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