3

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.

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

2 Answers2

2

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}]
Community
  • 1
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • 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? – user23512 Jan 04 '15 at 11:00
  • Also, just as a comment, I find your alias to be fairly appropriate. :) – user23512 Jan 04 '15 at 11:02
  • @user23512 backward-compatible version added. – Mr.Wizard Jan 04 '15 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! – user23512 Jan 04 '15 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? – Mr.Wizard Jan 04 '15 at 11:58
  • I erred there; stupid mistake. I think everything is fine. pairListSubset and replacementSets need to be of the same length, but neither needs to be of length 2. – user23512 Jan 04 '15 at 12:00
  • @user23512 Okay; the code should work correctly in that case. If you have any problems let me know. – Mr.Wizard Jan 04 '15 at 12:02
  • Thank you very much for your time! – user23512 Jan 04 '15 at 12:03
0

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]]
ciao
  • 25,774
  • 2
  • 58
  • 139