# Joining two lists with Transpose and with an offset

I have two lists of the same length n.

For the case of n=5, these would be:

a = {a1, a2, a3, a4, a5};
b = {b1, b2, b3, b4, b5};


I want to Transpose these lists but with an offset of 1 creating a resulting list with one additional element. Such as:

wantResult = {{a1},{a2,b1},{a3,b2},...,{b5}}


I can sort of do this by prepending {} to a, and appending {} to b resulting in the following two lists:

az = Append[a,{}] = {a1,a2,a3,a4,a5,{}}
bz = Prepend[b,{}] = {{},b1,b2,b3,b4,b5}


Then Transpose[{az,bz}], but I get:

{ {a1,{}},{a2,b1},{a3,b2},...,{{},b5} }


where the empty braces/lists are the problem :(..

Any ideas would be very helpful.

• Map[Flatten]@Transpose[{az,bz}]?
– kglr
Feb 6 at 9:49
• Thank you! Many great answers below. I am working through them and dread having to pick a single one to mark as answered. This is a great collection of variations and is growing my mind already. Feb 6 at 15:16

{#[[{1}]], ##2, #[[{-1}]]} & @@ Transpose[{a, RotateRight @ b}]

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}


Also

Inner[ List, a, RotateRight @ b, {#[[{1}]], ##2, #[[{-1}]]} &]

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}


For fun:

☺ = {#[[{1}]], ##2, #[[{-1}]]} & @@ ({#, {##2, #} & @@ #2}\[Transpose]) &;

☺[a, b]

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}

• it was fun! .. thanks for the great answers :) Feb 6 at 15:13
• I accepted this answer as it profiles fastest. All the answers work, and make a great collection of alternatives to demonstrate the many ways to achieve this task. Feb 6 at 17:28

Using Partition and Riffle:

If both lists have the same length, then:

a = {a1, a2, a3, a4, a5};
b = {b1, b2, b3, b4, b5};

g[a_List, b_List] := {{First@a}}~Join~
Partition[Riffle[Rest@a, Most@b], UpTo[2]]~Join~{{Last@b}}

g[a, b]


Using TakeList:

h[a_List, b_List] :=
Module[{chunks = {1, Sequence @@ ConstantArray[2, Length@a - 1], 1}},
Riffle[a, b] // TakeList[#, chunks] & // Map[Reverse]
]

h[a, b]


Using Transpose:

Transpose[{Append[a, x], Prepend[b, x]}] /. x -> Nothing


Result(s):

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}

f[x_, y_] := Module[{r = Thread[{Most@x, Rest@y}]},
Join[{{x[[1]]}}, r, {{y[[-1]]}}]]


Testing

am = Array[a, 10];
bm = Array[b, 10];
f[am, bm]


yields: {{a[1]}, {a[1], b[2]}, {a[2], b[3]}, {a[3], b[4]}, {a[4], b[5]}, {a[5], b[6]}, {a[6], b[7]}, {a[7], b[8]}, {a[8], b[9]}, {a[9], b[10]}, {b[10]}}

Alternative ways to combine Partition and Riffle:

Partition[Riffle[a, b], 2, 2, {-1, 1}, {}, Reverse @* List]

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}

Partition[Riffle[Append[Last @ b] @ a, b, {3, -2, 2}], 2, 2, {-1, 1}, {}]

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}

a = {a1, a2, a3, a4, a5};
b = {b1, b2, b3, b4, b5};

MapAt[Nothing, {1, 2}] @ Append[{Last @ b}] @
Thread[{a, RotateRight @ b}]


{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}

Append[{Last @ b}] @ Prepend[{First @ a}] @
Thread[{a[[2 ;;]], b[[;; -2]]}]


{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}

Using Flatten to transpose a 'ragged' array (see here):

Flatten[{Rest@a,b},{{2}}]//Prepend[{First@a}]

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

a = {a1, a2, a3, a4, a5};
b = {b1, b2, b3, b4, b5};


Another way using Insert and Thread:

l1 = Thread[{a, b}];
l2 = Thread[{a[[2 ;;]], b[[;; -2]]}];

Insert[List /@ Diagonal@#[[{1, -1}]] &@l1, Splice@l2, 2]

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}


I did a quick profile of all the answers so far. They all work and thank you. I will mark the fastest one as the answer as that's a key goal of mine.

a = {a1, a2, a3, a4, a5};
b = {b1, b2, b3, b4, b5};

f[x_, y_] :=
Module[{r = Thread[{Most@x, Rest@y}]},
Join[{{x[[1]]}}, r, {{y[[-1]]}}]];
f[a, b];

g[a_List, b_List] := {{First@a}}~Join~
Partition[Riffle[Rest@a, Most@b], UpTo[2]]~Join~{{Last@b}};
g[a, b];

h[a_List, b_List] :=
Module[{chunks = {1, Sequence @@ ConstantArray[2, Length@a - 1],
1}}, Riffle[a, b] // TakeList[#, chunks] & // Map[Reverse]];
h[a, b];

(*Transpose[{Append[a,x],Prepend[b,x]}]/. x->Nothing*)
i[x_, y_] :=
Transpose[{Append[x, u], Prepend[y, u]}] /. u -> Nothing;
i[a, b];

(*{#[[{1}]],##2,#[[{-1}]]}&@@Transpose[{a,RotateRight@b}]*)
j[x_, y_] := {#[[{1}]], ##2, #[[{-1}]]} & @@
Transpose[{x, RotateRight@y}];
j[a, b];

(*Inner[List,a,RotateRight@b,{#[[{1}]],##2,#[[{-1}]]}&]*)
k[x_, y_] :=
Inner[List, x, RotateRight@y, {#[[{1}]], ##2, #[[{-1}]]} &];
k[a, b];

(*\[HappySmiley]={#[[{1}]],##2,#[[{-1}]]}&@@({#,{##2,#}&@@#2}\
\[Transpose])&;*)
\[HappySmiley] = {#[[{1}]], ##2, #[[{-1}]]} & @@ ({#, {##2, #} & @@ \
#2}\[Transpose]) &;
\[HappySmiley][a, b];

l[x_, y_] :=
MapAt[Nothing, {1, 2}]@Append[{Last@y}]@Thread[{x, RotateRight@y}];
l[a, b];

m[x_, y_] :=
Append[{Last@x}]@
Prepend[{First@y}]@Thread[{x[[2 ;;]], y[[;; -2]]}];
m[a, b];

(*Partition[Riffle[a,b],2,2,{-1,1},{},Reverse@*List]*)
n[x_, y_] := Partition[Riffle[x, y], 2, 2, {-1, 1}, {}, Reverse@*List];
n[a, b];

(*Partition[Riffle[Append[Last@b]@a,b,{3,-2,2}],2,2,{-1,1},{}]*)
o[x_, y_] :=
Partition[Riffle[Append[Last@y]@a, y, {3, -2, 2}], 2,
2, {-1, 1}, {}];
o[a, b];

Print["f[a,b]", RepeatedTiming[f[a, b], 1]]
Print["g[a,b]", RepeatedTiming[g[a, b], 1]]
Print["h[a,b]", RepeatedTiming[h[a, b], 1]]
Print["i[a,b]", RepeatedTiming[i[a, b], 1]]
Print["j[a,b]", RepeatedTiming[j[a, b], 1]]
Print["k[a,b]", RepeatedTiming[k[a, b], 1]]
Print["\[HappySmiley][a,b]", RepeatedTiming[\[HappySmiley][a, b], 1]]
Print["l[a,b]", RepeatedTiming[l[a, b], 1]]
Print["m[a,b]", RepeatedTiming[m[a, b], 1]]
Print["n[a,b]", RepeatedTiming[n[a, b], 1]]
Print["o[a,b]", RepeatedTiming[o[a, b], 1]]

f[a,b]{4.612*10^-6,{{a1},{a1,b2},{a2,b3},{a3,b4},{a4,b5},{b5}}}

g[a,b]{5.08331*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

h[a,b]{7.72621*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

i[a,b]{6.75102*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

j[a,b]{4.82434*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

k[a,b]{2.8945*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

\[HappySmiley][a,b]{4.89292*10^-6,{{a1},{a2,b3},{a3,b4},{a4,b5},{a5,b1},{b2}}}

l[a,b]{3.28372*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

m[a,b]{3.12413*10^-6,{{b1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{a5}}}

n[a,b]{4.9749*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}

o[a,b]{3.91459*10^-6,{{a1},{a2,b1},{a3,b2},{a4,b3},{a5,b4},{b5}}}
$$$$

a = {a1, a2, a3, a4, a5};

b = {b1, b2, b3, b4, b5};


Using Splice (new in 12.1)

{{First @ a}, Splice @ Transpose[{Rest @ a, Most @ b}], {Last @ b}}
`

{{a1}, {a2, b1}, {a3, b2}, {a4, b3}, {a5, b4}, {b5}}