Thread over list in different levels

I have these two lists, both with the same length in the first dimension:

l1={{a1,a2},{b1,b2},{c1,c2}};
l2={{{1,2,3},{4,5,6}},{{10,11,12},{13,14,15},{16,17,18}},{{19,20,21}}};


And I need mix both to get into this result:

{{a1,a2,1,2,3},{a1,a2,4,5,6},{b1,b2,10,11,12},{b1,b2,13,14,15},
{b1,b2,16,17,18},{c1,c2,19,20,21}}


I have done this code that do the job:

Flatten[MapThread[Function[{a,b},Join[a,#]&/@b][#1,#2]&,{l1,l2}],1]


But I think it could be simpler. Some clue?

• Short and fast is always the best. Commented Aug 29, 2013 at 11:31
• A lot of people don't bother to look at answers to old questions; I appreciate the fact that you do. Commented Aug 29, 2013 at 11:32

I don't know why no one thought to use ArrayFlatten:

wizard1[l1_, l2_] := ArrayFlatten @ MapThread[Append, {l1, l2}]

wizard2[l1_, l2_] := ArrayFlatten @ Join[l1, List /@ l2, 2]


Test:

wizard1[l1, l2]

wizard1[l1, l2] === wizard2[l1, l2]

 {{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12},
{b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}

True


According to ssch's test suite these functions are also the fastest:

testSpeed[50000, 15]


A similar alternative

MapThread[Flatten /@ Tuples[{{#1}, #2}] &, {l1, l2}]~Flatten~1


{{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}

• Nice! I liked the way you use Tuples to distribute the elements. Commented Oct 28, 2012 at 1:26
• I little bit faster with Flatten[MapThread[Tuples[{{#1},#2}]&,{l1,l2}],{{1,2},{3,4}}] Commented Aug 29, 2013 at 11:19

Something a bit compact:

Flatten[MapThread[Join[ConstantArray[#1, Length[#2]], #2, 2] &, {l1, l2}], 1]
(* {{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2, 13, 14, 15},
{b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}} *)


Using combinations of Thread and Join:

Join @@@ Join @@ (Thread[#, List, {2}] & /@ Thread@{l1, l2})


or (... why not?)

Join @@@ Join @@ (Thread[{##}, List, {2}] & @@@ Thread@{l1, l2})


UPDATE: ... few more:

Using ArrayPad:

Join@@(ArrayPad[#[[1]], {{0}, {2, 0}}, #[[2]]] & /@ Thread[{l2,Reverse/@ l1}])


and variations with MapThread:

Join @@ MapThread[ArrayPad[#1, {{0}, {2, 0}}, #2] &, {l2, Reverse /@ l1}]

Join @@ MapThread[Function[{a, b}, Join[a, #] & /@ b], {l1, l2}]

Join @@ MapThread[Function[e, Join[#1, e]] /@ #2 &, {l1, l2}]

• I was about to give it a try when I noticed that your answer's better than mine in every single way.
– VF1
Commented Nov 7, 2012 at 4:40
• @VF1, thank you... you might like the updated version with 9 @s :)
– kglr
Commented Nov 7, 2012 at 7:47
• +1 Excellent idea with the ArrayPad. Commented Nov 7, 2012 at 16:30
• @Sasha, thank you.
– kglr
Commented Nov 8, 2012 at 1:45

Your approach looks fine to me, but here's an alternative using Outer and Thread:

(Outer[Flatten[{##}] &, {#1}, #2, 1] & @@@ Thread[{l1, l2}]) ~Flatten~ 2
(* {{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2, 13, 14, 15},
{b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}} *)


You could also use Transpose[{l1,l2}] instead of thread (\[Transpose] looks compact in the front end).

You're joining columns at the 3rd level but have ragged lists:

DeleteCases[Flatten[Join[{#, #, #} &/@l1, l2, 3], 1], {_, _}]

(* {{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2,
13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}} *)


(Joining ragged lists gives you an non-ragged list with padding that has to be removed with DeleteCases otherwise this could be concise)

One more with Thread and Map:

Flatten[Thread[f[l1, l2]] /. f[a_, b_] :> (Join[a, #] & /@ b), 1]


And one with PadLeft:

Flatten[MapThread[PadLeft[#1, {Length@#1, 5}, #2] &, {l2, Reverse /@ l1}], 1]


I wonder whether we can abuse Partition's padding capabilities (or even Riffle's)...

I did some speed comparisons on the different solutions

murta[l1_, l2_] :=
Function[{a, b}, Join[a, #] & /@ b][#1, #2] &, {l1, l2}], 1];
rojo[l1_, l2_] :=
MapThread[Flatten /@ Tuples[{{#1}, #2}] &, {l1, l2}]~Flatten~1;
jm[l1_, l2_] :=
Join[ConstantArray[#1, Length[#2]], #2, 2] &, {l1, l2}], 1];
rmrf[l1_,
l2_] := (Outer[Flatten[{##}] &, {#1}, #2, 1] & @@@
mike[l1_, l2_] :=
DeleteCases[Flatten[Join[{#, #, #} & /@ l1, l2, 3], 1], {_, _}];
istván1[l1_, l2_] :=
Flatten[Thread[f[l1, l2]] /. f[a_, b_] :> (Join[a, #] & /@ b), 1];
istván2[l1_, l2_] :=
PadLeft[#1, {Length@#1, 5}, #2] &, {l2, Reverse /@ l1}], 1];
imagedr[l1_, l2_] :=
Join @@ {#[[1]], #[[2]]\[Transpose]}] & /@ ({l1,
l2}\[Transpose]), 1];
kguler1[l1_, l2_] :=
kguler2[l1_, l2_] :=
kguler3[l1_, l2_] :=
Join @@ (ArrayPad[#[[1]], {{0}, {2, 0}}, #[[2]]] & /@
kguler4[l1_, l2_] :=
ArrayPad[#1, {{0}, {2, 0}}, #2] &, {l2, Reverse /@ l1}];
kguler5[l1_, l2_] :=
Join @@ MapThread[Function[{a, b}, Join[a, #] & /@ b], {l1, l2}];
kguler6[l1_, l2_] :=
Join @@ MapThread[Function[e, Join[#1, e]] /@ #2 &, {l1, l2}];

mthds = {murta, rojo, jm, rmrf, mike, istván1, istván2, imagedr,
kguler1, kguler2, kguler3, kguler4, kguler5, kguler6};
testSpeed[n_, m_] := Module[{l1, l2},
l1 = RandomReal[{0, 1}, {n, 2}];
l2 = Table[RandomReal[{0, 1}, {RandomInteger[{1, m}], 3}], {n}];
Sort[Map[
{ToString[#], First[AbsoluteTiming[#[l1, l2]]]} &, mthds],
Last[#1] < Last[#2] &] // TableForm
]


First test, both lists length 5000, second one has at most 5 lists to append:

testSpeed[5000, 5]
kguler4 0.035028
mike    0.040346
istván2 0.042375
jm  0.044726
kguler3 0.044926
istván1 0.054379
kguler5 0.059240
kguler1 0.060311
kguler2 0.062870
murta   0.065296
kguler6 0.065683
imagedr 0.080554
rmrf    0.102988
rojo    0.116306


With up to 50 sublists:

testSpeed[5000, 50]
kguler4 0.051828
kguler3 0.059161
jm  0.100330
istván2 0.102177
imagedr 0.139533
mike    0.188815
istván1 0.268590
kguler5 0.270507
murta   0.285236
kguler6 0.343441
kguler2 0.365733
kguler1 0.367342
rojo    0.595591
rmrf    0.684573


So I'd go with kgulers solution:

Join @@ MapThread[
ArrayPad[#1, {{0}, {2, 0}}, #2] &, {l2, Reverse /@ l1}]


A variant using Thread and Transpose

Flatten[Thread[Join @@ {#[[1]], #[[2]]\[Transpose]}] & /@ ({l1, l2}\[Transpose]),1]


{{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}

Another combination with Thread, Join and Tuples:

Join @@@ (Tuples[{{#1}, #2}] & @@@ Thread[{l1, l2}])~Flatten~1


{{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12},
{b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}

Another variant with MapThread and PadLeft:

Join @@@ MapThread[


{{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12},
{b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}

l1 = {{a1, a2}, {b1, b2}, {c1, c2}};
l2 = {{{1, 2, 3}, {4, 5, 6}}, {{10, 11, 12}, {13, 14, 15}, {16, 17,
18}}, {{19, 20, 21}}};

Map[FlattenAt[#, -1] &]


MapThread[Thread@{Sequence @@ #1, #2} &, {l1, l2}]~Flatten~1


or (after v12)

MapThread[Thread@{Splice@#1, #2} &, {l1, l2}]~Flatten~1


{{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}

My attempt:

Catenate @ Map[Flatten, Thread /@ Join[l1, List /@ l2, 2], {2}]


{{a1, a2, 1, 2, 3}, {a1, a2, 4, 5, 6}, {b1, b2, 10, 11, 12}, {b1, b2, 13, 14, 15}, {b1, b2, 16, 17, 18}, {c1, c2, 19, 20, 21}}