Shuffling two lists into each other

Question

Given a subset s of Range[n] and two lists a and b, with Length[a] = Length[s] and Length[b] = n - Length[s], I would like to construct a new list shuffle[s,a,b], with members of a placed at positions given by s and members of b in the remaining positions, in the same order as in a and b.

For example, with n = 7, s = {2,3,6}, a = {a1,a2,a3} and b = {b1,b2,b3,b4}, shuffle[s,a,b] must be {b1,a1,a2,b2,b3,a3,b4}.

What comes to my mind is

l = Range[n];
Do[l[[s[[k]]]] = a[[k]],{k,Length[s]}];
t = Complement[Range[n],s];
Do[l[[t[[k]]]] = b[[k]],{k,Length[t]}]

but most likely there is a much more efficient solution.

Answer 1

s = {2, 3, 6};
a = {a1, a2, a3};
b = {b1, b2, b3, b4};

n = Length[a] + Length[b];
list = Range@n;
list[[s]] = a;
list[[Complement[Range[n], s]]] = b;
list

{b1, a1, a2, b2, b3, a3, b4}.

Or

n = Length[a] + Length[b];
ReplacePart[Range@n, 
 Thread /@ {s -> a, Complement[Range@n, s] -> b} // Flatten]

{b1, a1, a2, b2, b3, a3, b4}.

Answer 2

a = {a1, a2, a3};
s = {2, 3, 6};
b = {b1, b2, b3, b4};

1.

We can use one of the many DataStructures introduced with V 12.1:

ds = CreateDataStructure["ExtensibleVector"];

Scan[ds["Append", #] &, b];

ds["Insert", ##] & @@@ Transpose[{a, s}];

Normal @ ds

{b1, a1, a2, b2, b3, a3, b4}

2.

Or the more conventional

b // RightComposition @@ MapThread[Insert, {a, s}]

{b1, a1, a2, b2, b3, a3, b4}

Answer 3

Using Ordering:

s = {2, 3, 6}; a = {a1, a2, a3}; b = {b1, b2, b3, b4};

#[[ Ordering@Join[s, Complement[Range@Length@#, s]] ]]&@Join[a, b]

(* {b1, a1, a2, b2, b3, a3, b4} *)

Answer 4

Using Fold:

n = 7;
s = {2, 3, 6};
a = {a1, a2, a3};
b = {b1, b2, b3, b4};

Fold[Insert[#1, First@#2, Last@#2] &, b, Transpose[{a, s}]]

{b1, a1, a2, b2, b3, a3, b4}

Answer 5

7.

ClearAll[sA]

sA = Module[{i$ = Complement[Range @ Length @ Join @ ##2, #]},
      SparseArray[{# -> #2, i$ -> #3}]] &;

Example:

s = {2, 3, 6}; a = {a1, a2, a3}; b = {b1, b2, b3, b4};

sA[s, a, b]

Normal @ sA[s, a, b]

 {b1, a1, a2, b2, b3, a3, b4}

8.

Normal[SparseArray[s -> a, {Length@Join[a, b]}]] /. 0 :> Last[b = RotateLeft@b]

 {b1, a1, a2, b2, b3, a3, b4}

Answer 6

Timings (cw)

|shuf0OP      |0.00746207|
|shufSyed     |0.561942  |
|shufeldo1    |0.707056  |
|shufeldo2    |0.632279  |
|shufcvgmt1   |0.00218898|
|shufcvgmt2   |0.0100496 |
|shufkglr7    |0.00446289|
|shufkglr8    |0.863815  |
|shufvindobona|0.00143314|
|shufkglr10   |0.00182783|

Just in case, let me reproduce the way I coded it, in case something is unsatisfactory please let me know (or edit the post accordingly, it is cw after all).

funtest[f_, n_, ss_] :=
 Module[{a, b}, 
  Mean[
   First[AbsoluteTiming[f[#, Array[a, Length[#]], Array[b, n - Length[#]]]]]&/@ss
  ]
 ]

n = 10000
ss = Table[Union@RandomSample[Range[n], RandomInteger[n]], {100}];

shuf0OP[s_, a_, b_] :=
 With[{n = Length[a] + Length[b]},
  With[{t = Complement[Range[n], s]},
   Module[{l = Range[n]},
    Do[l[[s[[k]]]] = a[[k]], {k, Length[s]}];
    Do[l[[t[[k]]]] = b[[k]], {k, Length[t]}];
    l
    ]
   ]
  ]

shufSyed[s_, a_, b_] := 
 Fold[Insert[#1, First@#2, Last@#2] &, b, Transpose[{a, s}]]

shufeldo1[s_, a_, b_] :=
 Module[{ds = CreateDataStructure["ExtensibleVector"]},
  Scan[ds["Append", #] &, b];
  ds["Insert", ##] & @@@ Transpose[{a, s}];
  Normal@ds
  ]

shufeldo2[s_, a_, b_] := 
 b // RightComposition @@ MapThread[Insert, {a, s}]

shufcvgmt1[s_, a_, b_] :=
 With[{n = Length[a] + Length[b]},
  Module[{list = Range@n},
   list[[s]] = a; list[[Complement[Range[n], s]]] = b;
   list
   ]
  ]

shufcvgmt2[s_, a_, b_] :=
 With[{n = Length[a] + Length[b]},
  ReplacePart[Range@n, 
   Thread /@ {s -> a, Complement[Range@n, s] -> b} // Flatten]
  ]

ClearAll[sA]
sA = Module[{i$ = Complement[Range@Length@Join@##2, #]}, 
    SparseArray[{# -> #2, i$ -> #3}]] &;
shufkglr7[s_, a_, b_] := Normal@sA[s, a, b]

shufkglr8[s_, a_, b_] :=
 Module[{bb = b},
  Normal[SparseArray[s -> a, {Length@Join[a, b]}]] /. 
   0 :> Last[bb = RotateLeft@bb]
  ]

shufvindobona[s_, a_, b_] :=
 #[[Ordering@Join[s, Complement[Range@Length@#, s]]]]&@Join[a, b]

ClearAll[pA]
pA = Module[{ab$ = Join @ ##2, p$}, 
  p$ = Join[#, Complement[Range @ Length @ ab$, #]]; 
  Permute[ab$, p$]
 ] &;
shufkglr10[s_, a_, b_] := pA[s, a, b]

TableForm@
 Table[{f, funtest[f, n, ss]},
  {f, {
       shuf0OP,
       shufSyed,
       shufeldo1,
       shufeldo2,
       shufcvgmt1,
       shufcvgmt2,
       shufkglr7,
       shufkglr8,
       shufvindobona,
       shufkglr10
      }
   }
  ]

Answer 7

a = {a1, a2, a3};
s = {2, 3, 6};
b = {b1, b2, b3, b4};

A variant of Syed's answer using Fold with Sequence

Fold[Insert[#1, Sequence @@ #2] &, b, Transpose[{a, s}]]

{b1, a1, a2, b2, b3, a3, b4}

Answer 8

9.

a$ = 0; b$ = 0;

Range @ Length @ Join[a, b] /.
   Alternatives @@ s :> a[[++a$]] /. _Integer :> b[[++b$]]

{b1, a1, a2, b2, b3, a3, b4}

Answer 9

10. (?)

pA = Module[{ab$ = Join @ ##2, p$}, 
    p$ = Join[#, Complement[Range @ Length @ ab$, #]]; 
    Permute[ab$, p$]] &;


pA[s, a, b]

{b1, a1, a2, b2, b3, a3, b4}