wolfram-mathematica - 在Mathematica中查找相似但不相同的元素的运行

Question

我有一个数字 list 。我想从列表中提取落入某个范围内并具有一定最小长度的数字。例如，假设我要对此列表进行操作:

thisList = {-1.2, -1.8, 1.5, -0.6, -0.8, -0.1, 1.4, -0.3, -0.1, -0.7}

与 band=1和 runLength=3。我想拥有

{{-0.6, -0.8, -0.1}, {-0.3, -0.1, -0.7}}

作为结果。现在我正在使用

Cases[
 Partition[thisList,runLength,1],
 x_ /; Abs[Max[x] - Min[x]] < band
]

主要问题是，在运行重叠的地方，我会得到许多运行副本。例如，使用

thisList = {-1.2, -1.8, 1.5, -0.6, -0.8, -0.1, -0.5, -0.3, -0.1, -0.7}

给我

{{-0.6, -0.8, -0.1}, {-0.8, -0.1, -0.5}, {-0.1, -0.5, -0.3}, {-0.5, -0.3, -0.1}, {-0.3, -0.1, -0.7}}

我宁愿有的地方

{-0.6, -0.8, -0.1, -0.5, -0.3, -0.1, -0.7}

而不必对重叠结果进行一些简化。正确的方法是什么？如果不涉及使用 Partition展开数据，那就太好了。

Answer 1

编辑

显然，我的第一个解决方案至少有两个严重缺陷:速度慢且对于大于100个元素的列表来说是完全不切实际的，并且它包含一些我无法识别的错误-有时缺少某些频段。因此，我将提供两种(希望正确的)更有效的替代方法，并且下面为任何有兴趣的人提供有缺陷的一种。

基于链表的解决方案

这是基于链表的解决方案。它使我们仍然可以使用模式，但是避免了由于包含__或___的模式而导致的效率低下(当反复应用时):

ClearAll[toLinkedList];
toLinkedList[x_List] := Fold[{#2, #1} &, {}, Reverse@x]

ClearAll[accumF];
accumF[llFull_List, acc_List, {h_, t_List}, ctr_, max_, min_, band_, rLen_] :=
  With[{cmax = Max[max, h], cmin = Min[min, h]},
     accumF[llFull, {acc, h}, t, ctr + 1, cmax, cmin, band, rLen] /; 
        Abs[cmax - cmin] < band];
accumF[llFull_List, acc_List, ll : {h_, _List}, ctr_, _, _, band_, rLen_] /; ctr >= rLen :=
     accumF[ll, (Sow[acc]; {}), ll, 0, h, h, band, rLen];
accumF[llFull : {h_, t : {_, _List}}, _List, ll : {head_, _List}, _, _, _, band_, rLen_] :=
     accumF[t, {}, t, 0, First@t, First@t, band, rLen];
accumF[llFull_List, acc_List, {}, ctr_, _, _, _, rLen_] /; ctr >= rLen := Sow[acc];

ClearAll[getBandsLL];
getBandsLL[lst_List, runLength_Integer, band_?NumericQ] :=
  Block[{$IterationLimit = Infinity},
     With[{ll = toLinkedList@lst},
        Map[Flatten,
          If[# === {}, #, First@#] &@
            Reap[
              accumF[ll, {}, ll, 0, First@ll, First@ll, band,runLength]
            ][[2]]
        ]
     ]
  ];

以下是使用示例:

In[246]:= getBandsLL[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,1.4,-0.3,-0.1,-0.7},3,1]
Out[246]= {{-0.6,-0.8,-0.1},{-0.3,-0.1,-0.7}}

In[247]:= getBandsLL[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7},3,1]
Out[247]= {{-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7}}

函数 accumF的主要思想是遍历数字列表(在此之前转换为链接列表)，并在另一个链接列表中累积一个带，将其作为第二个参数传递给它。一旦波段条件失败，将使用 Sow(如果足够长)存储累积的波段，然后从链接列表的其余部分开始该过程。如果我们选择改为使用 ctr，则可能不需要 Depth[acc]参数。

上面的代码中存在一些非显而易见的内容。一个微妙的点是，尝试将 accumF的两个中间规则合并为一个规则(它们看起来非常相似)并在r.h.s上使用 CompoundExpression(类似 (If[ctr>=rLen, Sow[acc];accumF[...]))。会导致生成非尾递归的 accumF(有关此问题的详细讨论，请参见 this answer。这也是为什么我将 (Sow[acc]; {})行放在函数调用中-以避免在r.h.s上使用顶级 CompoundExpression的原因。)另一个微妙的地方是，我必须在找到最后一个成功匹配项之后立即维护包含剩余元素的链表的副本，因为在序列失败的情况下，我需要回滚到该列表减去它的第一个元素，然后开始超过。此链接列表存储在 accumF的第一个参数中。

请注意，传递大型链表并不会花费太多，因为复制的内容只是第一个元素(头)和指向其余元素的指针(尾部)。与 {___,x__,right___}之类的模式相比，这是使用链接列表可大大提高性能的主要原因-因为在后一种情况下，将复制完整序列 x或 right。使用链表，我们实际上只复制了几个引用，因此我们的算法的行为大致与我们期望的一样(在此处数据列表的长度上呈线性关系)。在 this answer中，我还提到了在某些情况下使用链表作为优化代码的技术之一(第3.4节)。

基于编译的解决方案

这是一个基于 Compile的简单但不太优雅的函数，该函数在列表中查找开始和结束频段位置的列表:

bandPositions = 
  Compile[{{lst, _Real, 1}, {runLength, _Integer}, {band, _Real}},
   Module[{i = 1, j, currentMin, currentMax, 
        startEndPos = Table[{0, 0}, {Length[lst]}], ctr = 0},
    For[i = 1, i <= Length[lst], i++,
      currentMin = currentMax = lst[[i]];
      For[j = i + 1, j <= Length[lst], j++,
        If[lst[[j]] < currentMin,
           currentMin = lst[[j]],
           (* else *)
           If[lst[[j]] > currentMax,
             currentMax = lst[[j]]
           ]
        ];
        If[Abs[currentMax - currentMin] >= band ,
          If[ j - i >= runLength,
             startEndPos[[++ctr]] = {i, j - 1}; i = j - 1
          ];
          Break[],
          (* else *)
          If[j == Length[lst] && j - i >= runLength - 1,
              startEndPos[[++ctr]] = {i, j}; i = Length[lst];
              Break[];
          ];
        ]
      ]; (* inner For *)
    ]; (* outer For *)
    Take[startEndPos, ctr]], CompilationTarget -> "C"];

这在最终功能中使用:

getBandsC[lst_List, runLength_Integer, band_?NumericQ] :=
   Map[Take[lst, #] &, bandPositions[lst, runLength, band]]

使用示例:

In[305]:= getBandsC[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,1.4,-0.3,-0.1,-0.7},3,1]
Out[305]= {{-0.6,-0.8,-0.1},{-0.3,-0.1,-0.7}}

In[306]:= getBandsC[{-1.2,-1.8,1.5,-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7},3,1]
Out[306]= {{-0.6,-0.8,-0.1,-0.5,-0.3,-0.1,-0.7}}

基准测试

In[381]:= 
largeTest  = RandomReal[{-5,5},50000];
(res1 =getBandsLL[largeTest,3,1]);//Timing
(res2 =getBandsC[largeTest,3,1]);//Timing
res1==res2

Out[382]= {1.109,Null}
Out[383]= {0.016,Null}
Out[384]= True

显然，如果要提高性能， Compile会很成功。我对较大列表的观察结果是，这两种解决方案都具有与数字列表的大小近似的线性复杂度(应该如此)，在我的机器上，其编译速度比基于链接列表的解决方案快150倍。

评论

实际上，这两种方法都编码相同的算法，尽管这可能并不明显。带有递归和模式的代码可以说更容易理解，但这是一个见解。

一个简单但缓慢且错误的版本

这是我为解决此问题而首先编写的原始代码。这是基于模式的直接使用和重复规则的应用。如上所述，该方法的一个缺点是其非常差的性能。实际上，这是另一种反对将 {___,x__,y___}之类的结构与重复的规则应用程序结合使用的情况，这种情况适用于长度超过几十个元素的任何事物。在提到的 recommendations for code optimization techniques中，这对应于4.1节。

无论如何，这是代码:

If[# === {}, #, First@#] &@
 Reap[thisList //. {
    left___, 
    Longest[x__] /;Length[{x}] >= runLength && Abs[Max[{x}] - Min[{x}]] < band,
    right___} :> (Sow[{x}]; {right})][[2]]

它对于两个原始的小型测试列表都可以正常工作。通常看起来也是正确的，但是对于较大的列表，它通常会遗漏一些频段，通过与其他两种方法进行比较可以看出。到目前为止，我还无法本地化该错误，因为该代码看起来非常透明。