从每个列表中最佳选择一个元素 [英] Optimally picking one element from each list

问题描述

我遇到了一个古老的问题，您Mathematica/StackOverflow的人们可能会喜欢这个问题，对于后代来说，在StackOverflow上看起来很有价值.

I came across an old problem that you Mathematica/StackOverflow folks will probably like and that seems valuable to have on StackOverflow for posterity.

假设您有一个列表列表，并且想从每个列表中选择一个元素，然后将它们放入新列表中，以使与其下一个相邻元素相同的元素数量最大化. 换句话说，对于结果列表l，最小化Length @ Split [l]. 换句话说，我们希望列表中具有相同连续元素的中断最少.

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.

例如:

pick[{ {1,2,3}, {2,3}, {1}, {1,3,4}, {4,1} }]
 --> {    2,      2,    1,     1,      1   }

(或者{3,3,1,1,1}同样好.)

(Or {3,3,1,1,1} is equally good.)

这是一个荒谬的蛮力解决方案:

Here's a preposterously brute force solution:

pick[x_] := argMax[-Length@Split[#]&, Tuples[x]]

其中argMax如下所述:
posmax:类似于argmax，但给出了f [x]最大值的元素x的位置

where argMax is as described here:
posmax: like argmax but gives the position(s) of the element x for which f[x] is maximal

您能提出更好的建议吗? 传奇人物卡尔·沃尔(Carl Woll)为我做到了这一点，我将在一周内揭示他的解决方案.

Can you come up with something better? The legendary Carl Woll nailed this for me and I'll reveal his solution in a week.

推荐答案

我将其扔入环中.我不确定它总是能提供最佳解决方案，但是它似乎可以与其他给出的答案在相同的逻辑上工作，而且速度很快.

I'll toss this into the ring. I am not certain it always gives an optimal solution, but it appears to work on the same logic as some other answers given, and it is fast.

f@{} := (Sow[m]; m = {i, 1})
f@x_ := m = {x, m[[2]] + 1}

findruns[lst_] :=
  Reap[m = {{}, 0}; f[m[[1]] ⋂ i] ~Do~ {i, lst}; Sow@m][[2, 1, 2 ;;]]

findruns给出游程长度编码的输出，包括并行答案.如果需要严格指定的输出，请使用:

findruns gives run-length-encoded output, including parallel answers. If output as strictly specified is required, use:

Flatten[First[#]~ConstantArray~#2 & @@@ #] &

---

这里是使用Fold的变体.在某些形状上，速度更快，但在其他形状上，速度稍慢.

---

Here is a variation using Fold. It is faster on some set shapes, but a little slower on others.

f2[{}, m_, i_] := (Sow[m]; {i, 1})
f2[x_, m_, _] := {x, m[[2]] + 1}

findruns2[lst_] :=
  Reap[Sow@Fold[f2[#[[1]] ⋂ #2, ##] &, {{}, 0}, lst]][[2, 1, 2 ;;]]

这篇关于从每个列表中最佳选择一个元素的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！