# Shuffling two lists into each other

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.

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}.

• Fold[ReplacePart, Range@n, {Thread[s -> a], Thread[Complement[Range@n, s] -> b]}] Commented Nov 19, 2023 at 12:10
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}

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} *)


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}

• Great! Although I am sure this is optimal, still let me wait until tomorrow for other versions until accepting. Commented Nov 19, 2023 at 8:41
• There are many ways of accomplishing list manipulation tasks in Mathematica. The 10-way challenge is on.
– Syed
Commented Nov 19, 2023 at 8:44
• What is this 10-way challenge? Never heard of it. Commented Nov 19, 2023 at 8:51
• I believe the trend was started by @Nasser, where participants try to come up with at least 10 ways of solving a stated problem.
– Syed
Commented Nov 19, 2023 at 8:55
• I see. Sounds horrifying... Commented Nov 19, 2023 at 8:56

### 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}


# 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
}
}
]

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}

### 9.

a$$= 0; b$$ = 0;

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

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

• This does not work with, say, a=Array[A,3], b=Array[B,4] Commented Nov 20, 2023 at 5:27
• @მამუკაჯიბლაძე, right; it doesn't work if input lists a and b are not lists of atoms. I will post an update if I figure out a way to make it work for arbitrary lists.
– kglr
Commented Nov 20, 2023 at 8:57
• Would be nice - this version is conceptually very transparent, I would say. Commented Nov 20, 2023 at 9:39

### 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}

• Why (?)?$\ \ \$ Commented Nov 20, 2023 at 9:38
• b/c I lost count:)
– kglr
Commented Nov 20, 2023 at 9:39
• Seems to be right. I've updated the timings. @vindobona is ahead by few milliseconds (these two solutions must be practically identical, imo) Commented Nov 20, 2023 at 9:47