从每个列表中最佳地选择一个元素

Question

我遇到了Mathematica/StackOverflow人可能会喜欢的一个老问题,这对于后代的StackOverflow来说似乎很有价值.

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

例如:

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

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

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

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

其中argMax如下所述:
posmax:与argmax类似,但给出元素x的位置,其中f [x]是最大的

你能想出更好的东西吗？传奇的卡尔沃尔为我做了这个,我将在一周内揭示他的解决方案.

Answer 1

我会把这个扔进戒指里。我不确定它总是给出最佳解决方案，但它似乎与给出的其他一些答案的逻辑相同，而且速度很快。

\n\n

f@{} := (Sow[m]; m = {i, 1})\nf@x_ := m = {x, m[[2]] + 1}\n\nfindruns[lst_] :=\n  Reap[m = {{}, 0}; f[m[[1]] \xe2\x8b\x82 i] ~Do~ {i, lst}; Sow@m][[2, 1, 2 ;;]]\n

\n\n

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

\n\n

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

\n\n\n\n

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

\n\n

f2[{}, m_, i_] := (Sow[m]; {i, 1})\nf2[x_, m_, _] := {x, m[[2]] + 1}\n\nfindruns2[lst_] :=\n  Reap[Sow@Fold[f2[#[[1]] \xe2\x8b\x82 #2, ##] &, {{}, 0}, lst]][[2, 1, 2 ;;]]\n

\n