# How to thread a list

I have data in format

data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}}


Tableform:

I want to thread it to :

tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}}


Tableform:

And I would like to do better then

pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}];
SetAttributes[pseudofunction, Listable];
Range[2, 4] // pseudofunction


Here is my benchmark data, where data3 is normal sample of real data.

data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1];
data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5];
data = RandomReal[{0, 1}, {10^6, 4}];


Here is my benchmark code

kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list
kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list
OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}]
paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1]
RM[list_] := FoldList[Transpose[{First@list, #2}] &, Null, Rest[list]] // Rest
rcollyer[list_] := With[{fst = First@#, rst = Rest@#}, Thread[{fst, #}] & /@ rst] &@list

Drop[Timing[paradox2[#];] & /@ {data, data2, data3}, None, -1]
Drop[Timing[OleksandrR[#];] & /@ {data, data2, data3}, None, -1]
Drop[Timing[kptnw[#];] & /@ {data, data2, data3}, None, -1]
Drop[Timing[kptnw2[#];] & /@ {data, data2, data3}, None, -1]
Drop[Timing[RM[#];] & /@ {data, data2, data3}, None, -1]
Drop[Timing[rcollyer[#];] & /@ {data, data2, data3}, None, -1]


Results

{{7.503}, {0.968}, {0.031}}
{{0.983}, {0.296}, {0.031}}
{{0.312}, {1.67}, {0.031}}
{{0.094}, {0.218}, {0.031}}
{{3.759}, {0.546}, {0.032}}
{{3.073}, {0.733}, {0.031}}

-
It's interesting that Table and Outer switch positions in the rankings depending on whether the data are symbolic or numeric. Most likely this shows that different emphases were applied in the optimization of these functions. – Oleksandr R. Apr 8 '12 at 13:24

If your lists are long, there are faster approaches using high-level functions and structural operations. Here are two alternatives.

First we try Outer and Flatten:

data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}};
Flatten[Outer[List, List@First[data], Rest[data], 1], {{2}, {1, 4}}]

{{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}}


And now Distribute and Transpose:

Transpose[Distribute[{List@First[data], Rest[data]}, List], {1, 3, 2}]

{{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}}


Evidently, they give the correct result. Now for a Timing comparison:

data = RandomReal[{0, 1}, {10^6, 2}];


The timings, in rank order, are:

1. kptnw's Table/Transpose method: 0.297 seconds
2. Outer/Flatten: 0.812 seconds
3. Distribute/Transpose: 0.891 seconds
4. rcollyer's Thread/Map approach: 2.907 seconds
5. R.M's Transpose/FoldList method: 3.844 seconds
6. paradox2's solution with Riffle and Partition: 7.407 seconds

The Outer/Flatten and Distribute/Transpose approaches are quite fast, but clearly Table is much better-optimized than Distribute, since while these two methods are conceptually similar, kptnw's solution using the former is by far the fastest and most memory-efficient. The other solutions, not using structural operations, are considerably slower, which is not unexpected.

-
I double checked results - yes, table is of (4 << size < 10^6) and your Outer/Flatten is so far the most efficient in speed/memory. – Margus Apr 8 '12 at 8:35
kptnw added another method, swapping out Table for ConstantArray which on my system cuts the time by approx. one-sixth of his Table/Transpose method. – rcollyer Apr 11 '12 at 15:22
@rcollyer it seems to be quite data-dependent. While the ConstantArray/Transpose method is probably the best overall, Margus's benchmarks show that for symbolic inputs Outer/Flatten isn't much slower, if at all. I tried to improve on ConstantArray/Transpose, but I couldn't; if not absolutely optimal, it's very close. – Oleksandr R. Apr 11 '12 at 17:02

Try this：

data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}};
Partition[Riffle[First[data], #], 2] & /@ Rest[data]

-
+1 Drop[data,1] can also be expressed as Rest[data] – DavidC Apr 7 '12 at 13:40
@David Carraher Yep,in the same way,data[[1]] can also be replaced by First[data],so we get another expression :Partition[Riffle[First[data], #], 2] & /@ Rest[data].I really like this form which looks more graceful than using Drop and Part,thanks for your advice. – withparadox2 Apr 8 '12 at 0:47
I agree that it's more easy to comprehend in the form with First and Rest. – DavidC Apr 8 '12 at 2:57

Another approach using Transpose:

Transpose[{Table[First@#,{Length@#-1}],Rest@#},{3,1,2}]&@data
(* Out[1]= {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} *)


On my pc, it is about 3 times faster than the Outer/Flatten approach.

edit:

It seems that the bottleneck is Table.By changing it into ConstantArray:

Transpose[{ConstantArray[First@#,Length@#-1],Rest@#},{3,1,2}]&@data


Now it is about 10 times faster than the Outer/Flatten approach.

-
@kptnw: Good job. – Margus Apr 8 '12 at 13:03

Here's another approach using FoldList

data = {{a1,a2}, {b1, b2}, {c1, c2}, {d1, d2}};
FoldList[Transpose[{First@data, #2}] &, Null, Rest[data]] // Rest
(* Out[1]= {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} *)

-

This works:

data = {{a1,a2}, {b1, b2}, {c1, c2}, {d1, d2}}
With[{fst = First@#, rst = Rest@#}, Thread[{fst, #}] & /@ rst]& @ data

{{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}}

-