Joining two lists with Transpose and with an offset

Question

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.

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. — Karl Easterly, Feb 06 '24 at 15:16

Syed · Answer 1 · 2024-02-06T06:11:54.683

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

score 5 · Answer 2 · answered Feb 06 '24 at 05:43

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

kglr · Answer 3 · 2024-02-06T08:31:44.020

3

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

edited Feb 06 '24 at 08:31

answered Feb 06 '24 at 07:44

kglr

394,356
18
477
896

eldo · Answer 4 · 2024-02-06T07:58:26.840

3

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

edited Feb 06 '24 at 07:58

answered Feb 06 '24 at 07:48

eldo

67,911
5
60
168

score 3 · Answer 5 · answered Feb 06 '24 at 12:27

3

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

answered Feb 06 '24 at 12:27

user1066

17,923
3
31
49

E. Chan-López · Answer 6 · 2024-02-06T15:12:38.047

3

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

edited Feb 06 '24 at 15:12

answered Feb 06 '24 at 14:53

E. Chan-López

23,117
3
21
44

kglr · Accepted Answer · 2024-02-06T08:27:27.117

2

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

edited Feb 06 '24 at 08:27

answered Feb 06 '24 at 07:25

kglr

394,356
18
477
896

it was fun! .. thanks for the great answers :) – Karl Easterly Feb 06 '24 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. – Karl Easterly Feb 06 '24 at 17:28

score 1 · Answer 8 · answered Feb 06 '24 at 17:26

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];
(MapAt[Nothing,{1,2}]@Append[{Last@b}]@Thread[{a,RotateRight@b}])
l[x_, y_] := 
  MapAt[Nothing, {1, 2}]@Append[{Last@y}]@Thread[{x, RotateRight@y}];
l[a, b];
(Append[{Last@b}]@Prepend[{First@a}]@Thread[{a[[2;;]],b[[;;-2]]}])
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}}}
```

Joining two lists with Transpose and with an offset

8 Answers8