Re: optimally picking one element from each list
- To: mathgroup at smc.vnet.net
- Subject: [mg48404] Re: optimally picking one element from each list
- From: "Rob Pratt" <Rob.Pratt at sas.com>
- Date: Fri, 28 May 2004 00:50:33 -0400 (EDT)
- References: <c8mugt$a3l$1@smc.vnet.net>
- Reply-to: "Rob Pratt" <Rob.Pratt at sas.com>
- 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 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. Here's a dynamic programming approach. Let g(x,s) be the minimum value of Length[Split[.]], given that x is the most recently chosen element and s is the remaining list of lists. Let f(s) be the minimum value of g(x,s) over all choices of x from the first list. We want to compute f for the original data. (* Boundary condition: list containing only one list *) g[x_Integer, {t_List}] := g[x, {t}] = If[MemberQ[t, x], 1, 2]; (* Main recursion *) g[x_Integer, s_List] := g[x, s] = Min[(1 - KroneckerDelta[x, #] + g[#, Rest[s]] & ) /@ First[s]]; (* Definition of f *) f[s_List] := f[s] = Min[(g[#, Rest[s]] & ) /@ First[s]]; To get an optimal list of elements instead of just the optimal value of Length[Split[.]], keep track of the argmin along the way. Rob Pratt