Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

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

• Follow-Ups:
  • Re: Re: optimally picking one element from each list
    • From: DrBob <drbob@bigfoot.com>