Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

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

Search the Archive

optimally picking one element from each list

  • To: mathgroup at smc.vnet.net
  • Subject: [mg48297] optimally picking one element from each list
  • From: Daniel Reeves <dreeves at umich.edu>
  • Date: Sat, 22 May 2004 03:04:28 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

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 preposterously brute force solution:

pick[x_] := argMax[-Length[Split[#]]&, Distribute[x, List]]

   where argMax can be defined like so:

   (* argMax[f,domain] returns the element of domain for which f of
      that element is maximal -- breaks ties in favor of first occurrence.
    *)
   SetAttributes[argMax, HoldFirst];
   argMax[f_, dom_List] := Fold[If[f[#1] >= f[#2], #1, #2] &, 
                                First[dom], Rest[dom]]

Below is an attempt at a search-based approach, which is also way too 
slow.  So the gauntlet has been thrown down.  Anyone want to give it a 
shot?


(* Used by bestFirstSearch. *)
treeSearch[states_List, goal_, successors_, combiner_] :=
    Which[states=={}, $Failed,
          goal[First[states]], First[states],
          True, treeSearch[
                  combiner[successors[First[states]], Rest[states]],
                  goal, successors, combiner]]

(* Takes a start state, a function that tests whether a state is a goal
   state, a function that generates a list of successors for a state, and 
   a function that gives the cost of a state.  Finds a goal state that 
   minimizes cost. 
*)
bestFirstSearch[start_, goal_, successors_, costFn_] := 
  treeSearch[{start}, goal, successors,
             Sort[Join[#1,#2], costFn[#1] < costFn[#2] &]&]

(* A goal state is one for which we've picked one element of every list 
   in l.
*)
goal[l_][state_] := Length[state]==Length[l]

(* If in state s we've picked one element from each list in l up to list 
   i, then the successors are all the possible ways to extend s to pick 
   elements thru list i+1. 
*)
successors[l_][state_] := Append[state,#]& /@ l[[Length[state]+1]]

(* Cost function g: higher cost for more neighbors different
   (Length[Split[state]]) and then breaks ties in favor of longer 
   states to keep from unnecessarily expanding the search tree.
*)
g[l_][state_] := Length[Split[state]]*(Length[l]+1)+Length[l]-Length[state]

(* Pick one element from each of the lists in l so as to minimize the
   cardinality of Split, ie, maximize the number of elements that are 
   the same as their neighbor. 
*)
pick[l_] := bestFirstSearch[{}, goal[l], successors[l], g[l]]


-- 
http://ai.eecs.umich.edu/people/dreeves  - -  google://"Daniel Reeves"

             If you must choose between two evils,
             pick the one you've never tried before.


  • Prev by Date: RE: SetPrecision - What does in find?
  • Next by Date: Re: Uniform design
  • Previous by thread: Re: Eigensystem: different solution in V5.0 and V4.1 ??
  • Next by thread: Re: optimally picking one element from each list