Re: optimally picking one element from each list

• To: mathgroup at smc.vnet.net
• Subject: [mg48362] Re: optimally picking one element from each list
• From: koopman at sfu.ca (Ray Koopman)
• Date: Tue, 25 May 2004 07:17:57 -0400 (EDT)
• References: <c8mugt\$a3l\$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```Daniel Reeves <dreeves at umich.edu> wrote in message
news:<c8mugt\$a3l\$1 at smc.vnet.net>...
> Suppose you have a list of lists and you want to pick one element from
> each and put them in a new list so that the number of elements that are
> identical to their next neighbor is maximized.
>   (in other words, for the resulting list l, minimize Length[Split[l]].)
>   (in yet other words, we want the list with the fewest interruptions of
> identical contiguous elements.)
>
> EG, pick[{ {1,2,3}, {2,3}, {1}, {1,3,4}, {4,1} }]
>      --> {    2,      2,    1,     1,      1   }
> [...]

Here's a very simple brute-force function.

In[1]:= picker[xlist_] := Fold[
If[Length[Split[#1]] <= Length[Split[#2]], #1, #2]&,
First[#], Rest[#]]& [
Flatten[Outer[List, Delete[xlist,0]], Length[xlist]-1]]

Try it on two different lists that others have used.
(Times are for version 3 on a 33 MHz NeXT. YMMV)

In[2]:= alist = {{1,3},{2,3},{1,3},{1,3,4},{4,1}};

In[3]:= picker[alist] // Timing
Out[3]= {0.0781 Second,{3,3,1,1,1}}

In[4]:= blist = {{6},{2},{2},{7,8},{3,4,1},{2,8,2},{5,2},{7},
{8,5,8},{2,1,7},{5},{5}};

In[5]:= picker[blist] // Timing
Out[5]= {1.03073 Second,{6,2,2,7,3,2,2,7,8,2,5,5}}

If elements are duplicated within a sublist then preprocessing the
input list can save time (and give different answers, because ties
can get broken differently).

In[6]:= picker[Union /@ alist] // Timing
Out[6]= {0.078146 Second,{3,3,1,1,1}}

In[7]:= picker[Union /@ blist] // Timing
Out[7]= {0.484291 Second,{6,2,2,7,1,2,2,7,5,1,5,5}}

More time can be saved by a "divide-&-conquer" approach: don't apply
picker to the whole list, but to super-sublists formed by grouping
adjacent sublists that have common elements.

In[8]:= splitter[xlist_] := Split[Union /@ xlist,
(Length[Union[#1,#2]] < Length[#1]+Length[#2])&]

In[9]:= Flatten@Map[If[Length[#] == 1, #[[1,1]], picker[#]]&,
splitter[alist]] // Timing
Out[9]= {0.093755 Second,{3,3,1,1,1}}

In[10]:= Flatten@Map[If[Length[#] == 1, #[[1,1]], picker[#]]&,
splitter[blist]] // Timing
Out[10]= {0.046873 Second,{6,2,2,7,1,2,2,7,5,1,5,5}}

Still more time can be saved by deleting elements that should never be
picked.

In[11]:= cutter[xlist_] := If[Length[xlist] == 2,
{Select[xlist[[1]],MemberQ[xlist[[2]],#]&],
Select[xlist[[2]],MemberQ[xlist[[1]],#]&]},
Join[
{Select[xlist[[1]],MemberQ[xlist[[2]],#]&]},
Table[Select[xlist[[i]],
MemberQ[Union[xlist[[i-1]],xlist[[i+1]]],#]&],
{i,2,Length[xlist]-1}],
{Select[xlist[[-1]],MemberQ[xlist[[-2]],#]&]}]]

In[12]:= Flatten@Map[If[Length[#] == 1, #[[1,1]], picker[cutter[#]]]&,
splitter[alist]] // Timing
Out[12]= {0.031256 Second,{3,3,1,1,1}}

In[13]:= Flatten@Map[If[Length[#] == 1, #[[1,1]], picker[cutter[#]]]&,
splitter[blist]] // Timing
Out[13]= {0.031225 Second,{6,2,2,7,1,2,2,7,5,1,5,5}}

```

• Prev by Date: Re: Compile
• Next by Date: Re: Uniform design
• Previous by thread: Re: Re: Re: optimally picking one element from each list
• Next by thread: Re: Re: optimally picking one element from each list