在Mathematica中查找类似但不相同的元素

Question

我有一个数字列表.我想从列表中提取出一些属于某些波段并具有一些最小长度的数字.例如,假设我想在此列表上操作:

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

编辑

Apparenty,我的第一个解决方案至少有两个严重的缺陷:对于大于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单个规则(它们看起来非常相似)并在rhs上使用CompoundExpression(类似的东西(If[ctr>=rLen, Sow[acc];accumF[...]))将导致非尾递归accumF(请参阅此答案以获取更详细的信息)讨论这个问题.这也是我(Sow[acc]; {})在函数调用中创建行的原因- 避免CompoundExpressionrhs上的顶层).另一个细微之处在于,我必须在找到最后一次成功匹配后立即维护包含剩余元素的链表的副本,因为在序列不成功的情况下,我需要回滚到该列表减去其第一个元素,然后开始过度.此链表存储在第一个参数中accumF.

请注意,传递大型链表不会花费太多,因为复制的只是第一个元素(头部)和指向其余部分(尾部)的指针.这是使用链表大大提高性能的主要原因,与模式的情况相比{___,x__,right___}- 因为在后一种情况下,完整序列x或被right复制.对于链表,我们实际上只复制了一些引用,因此我们的算法的行为与我们期望的大致相似(这里的数据列表的长度是线性的).在 这个答案中,我还提到在这种情况下使用链表作为优化代码的技术之一(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___}重复规则应用程序一样的结构,对于任何超过几十个元素的东西.在上面提到的代码优化技术建议中,这对应于4.1节.

无论如何,这里是代码:

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

它适用于两个原始的小测试列表.它看起来通常也是正确的,但是对于较大的列表,它经常会错过一些频段,这可以通过与其他两种方法进行比较来看出.由于代码看起来非常透明,因此我无法将错误本地化.