Re: Threading objects of unequal length
- To: mathgroup at smc.vnet.net
- Subject: [mg8372] Re: [mg8112] Threading objects of unequal length
- From: Olivier Gerard <jacquesg at pratique.fr>
- Date: Tue, 26 Aug 1997 20:41:06 -0400
- Sender: owner-wri-mathgroup at wolfram.com
Hi fans of PaddedThread !
I promised new developments, here they are
This new version of Allan Hayes program
f6[b:hd_[a__List]]:=Module[{x,ml,mn,pd,tb,mth},
If[ (Union[Length/@b]//(mn=(ml=Last[#1])-First[#1])&)==0,
Thread[b],
(* else *) pd=Table[x,{mn}];
tb=Take[Join[#,pd],ml]&/@{a};
mth=MapThread[hd,tb];
DeleteCases[mth,x,{2}]
]
]
performs poorly at very little lists but is slightly
better at large lists and includes Thread as a special case,
a fact that could be needed in applications.
Here is a timing test using the same code than Carl Wolf:
test=h@@Table[Table[Random[],{20+Random[Integer,30]}],{100}];
padtest=h@@Table[Table[Random[],{50}],{100}];
{
Do[t4=f4[test],{100}];//Timing//First,
Do[t4bis=f4bis[test],{100}];//Timing//First,
Do[t5=f5[test],{100}];//Timing//First,
Do[t6=f6[test],{100}];//Timing//First,
{Do[Thread[padtest],{100}];//Timing//First}}
{13.9833 Second, 7.35 Second, 5.66667 Second, 5.51667 Second, {0.733333
Second}}
I also note that my own dear f4bis is a good challenger
for larger inputs, as shows this series:
(* test samples *)
testlarge=Table[h@@Table[Table[Random[],{20+Random[Integer,30]}],{i}],{i,100,100
0,100}];
padtestlarge=Table[h@@Table[Table[Random[],{50}],{i}],{i,100,1000,100}];
(* code *)
tm4bis = Map[(f4bis[#];//Timing//First)/Second&, testlarge]
(* result *)
{0.1, 0.216667, 0.35, 0.383333, 0.433333, 0.716667, 0.783333, 0.9, 1., 1.1}
(* code *)
tm5 = Map[(f5[#];//Timing//First)/Second&, testlarge]
(* result *)
{0.15, 0.316667, 0.483333, 0.683333, 0.866667, 1.25, 1.45, 1.63333,
1.81667, 2.03333}
(* code *)
tm6 = Map[(f6[#];//Timing//First)/Second&, testlarge]
(* result *)
{0.166667, 0.316667, 0.5, 0.666667, 0.866667, 1.25, 1.43333, 1.61667,
1.81667, 2.01667}
(* code *)
tt6 = Map[(f6[#];//Timing//First)/Second&, padtestlarge]
(* result *)
{0.0333333, 0.0666667, 0.116667, 0.166667, 0.216667, 0.35, 0.383333,
0.433333, 0.5, 0.533333}
(* code *)
tmth = Map[(Thread[#];//Timing//First)/Second&, padtestlarge]
(* result *)
{0., 0.0166667, 0.0333333, 0.05, 0.05, 0.133333, 0.15, 0.15, 0.183333,
0.183333}
This quick and dirty multipleplot shows the result more visually
Show[MapIndexed[
ListPlot[#1,
DisplayFunction->Identity,PlotJoined->True,PlotStyle->Hue[#2[[1]]/6]]&,
{tm4bis,tm5,tm6,tt6,tmth}],
DisplayFunction->$DisplayFunction]
But I stop there because optimization can really be addictive.
Olivier Gerard
Here are the programs used in this message:
> f1[b:hd_[__List]]:=Module[{mx=Max@@Length/@b,m,dummy,dummylist},
> dummylist=Table[dummy,{mx}];
> m=Take[Join[#,dummylist],mx]&/@b;
> m=Thread[m];
> dummy=Sequence[];
> m
> ]
>
> f2[hd_[a__List]]:=
> Apply[hd,Table[#[[i]]&/@Select[{a},Length[#]>=i&],{i,Max@@Length/@{a}}],1]
>
> f3[hd_[a__List]]:=
> Table[hd@@Part[{a},Flatten[Position[Length/@{a},b_/;b>=i]],i],{i,
> Max@@Length/@{a}}]
>
> Clear[NotAnElt];
> TestEltQ[NotAnElt]=False;
> TestEltQ[__]=True;
>
> f4[ hd_Symbol[jk__List] ]:=
> Module[{mlotl=Max[Map[Length,List[jk]]]},
> Map[ hd@@Select[#1,TestEltQ]&,
> Transpose[Map[Join[#1,Array[NotAnElt&,
> mlotl-Length[#1]]]&,List[jk]]] ]]
>
> Clear[NotAnElt];
> f4bis[ hd_Symbol[jk__List] ]:=
> With[{mlotl=Max[Map[Length,List[jk]]]},
> Map[ hd@@DeleteCases[#1,NotAnElt,1]&,
> Transpose[Map[Join[#1,Array[NotAnElt&,
> mlotl-Length[#1]]]&,List[jk]]] ]]
> f5[b:hd_[a__List]]:=Module[{x,ml,pd,tb,mth},
> ml=Max@@Length/@b;
> pd=Table[x,{ml}];
> tb=Take[Join[#,pd],ml]&/@{a};
> mth=MapThread[hd,tb];
> DeleteCases[mth,x,{2}]
> f6[b:hd_[a__List]]:=Module[{x,ml,mn,pd,tb,mth},
> If[ (Union[Length/@b]//(mn=(ml=Last[#1])-First[#1])&)==0,
> Thread[b],
> (* else *) pd=Table[x,{mn}];
> tb=Take[Join[#,pd],ml]&/@{a};
> mth=MapThread[hd,tb];
> DeleteCases[mth,x,{2}]
> ]
> ]