Question

给定坐标对

data = {{1, 0}, {2, 0}, {3, 1}, {4, 2}, {5, 1}, 
        {6, 2}, {7, 3}, {8, 4}, {9, 3}, {10, 2}}

我想提取山峰和山谷，因此：

{{4, 2}, {5, 1}, {8, 4}}

我目前的解决方案是这种笨拙：

Cases[
 Partition[data, 3, 1],
 {{ta_, a_}, {tb_, b_}, {tc_, c_}} /; Or[a < b > c, a > b < c] :> {tb, b}
]

您可以看到，使用Partition将数据集的大小增加三倍。我认为可以使用Cases和PatternSequence来提取此信息，但此尝试不起作用：

Cases[
 data,
 ({___, PatternSequence[{_, a_}, {t_, b_}, {_, c_}], ___} 
         /; Or[a < b > c, a > b < c]) :> {t, b}
]

产生{}。

我认为模式没有任何问题，因为它适用于ReplaceAll：

data /. ({___, PatternSequence[{_, a_}, {t_, b_}, {_, c_}], ___} 
             /; Or[a < b > c, a > b < c]) :> {t, b}

这给出了正确的第一个峰值{4, 2}。这是怎么回事？

Answer 1

失败尝试失败的原因之一是Cases默认情况下会查找表达式第1级的匹配项。由于你在0级寻找匹配，你需要做类似

的事情

Cases[
 data,
 {___, {_, a_}, {t_, b_}, {_, c_}, ___} /; Or[a < b > c, a > b < c] :> {t, b}, 
 {0}
]

但是，这仅返回{4,2}作为解决方案，因此它仍然不是您正在寻找的。要查找所有匹配而不进行分区，您可以执行类似

的操作

ReplaceList[data, ({___, {_, a_}, {t_, b_}, {_, c_}, ___} /; 
    Or[a < b > c, a > b < c]) :> {t, b}]

返回

{{4, 2}, {5, 1}, {8, 4}}

Answer 2

你的“笨拙”解决方案相当快，因为它严重限制了所看到的内容。

这是一个例子。

m = 10^4;
n = 10^6;

ll = Transpose[{Range[n], RandomInteger[m, n]}];

In[266]:= 
Timing[extrema = 
    Cases[Partition[ll, 3, 
      1], {{ta_, a_}, {tb_, b_}, {tc_, c_}} /; 
       Or[a < b > c, a > b < c] :> {tb, b}];][[1]]

Out[266]= 3.88

In[267]:= Length[extrema]

Out[267]= 666463

这似乎比使用替换规则更快。

更快的是创建差异产品的标志表。然后选择不在列表末端的与1的符号产品对应的条目。

In[268]:= Timing[ordinates = ll[[All, 2]];
  signs = 
   Table[Sign[(ordinates[[j + 1]] - 
        ordinates[[j]])*(ordinates[[j - 1]] - ordinates[[j]])], {j, 2,
      Length[ll] - 1}];
  extrema2 = Pick[ll[[2 ;; -2]], signs, 1];][[1]]

Out[268]= 0.23

In[269]:= extrema2 === extrema

Out[269]= True

在这些方法中不考虑连续相等纵坐标的处理。这样做需要更多的工作，因为必须考虑大于三个连续元素的邻域。（我的拼写检查员希望我在“邻居”的中间音节添加“你”。我的拼写检查员必须认为我们在加拿大。）

Daniel Lichtblau

Answer 3

这可能不是你要求的实现，而是沿着这些方向：

ClearAll[localMaxPositions];
localMaxPositions[lst : {___?NumericQ}] := 
  Part[#, All, 2] &@
     ReplaceList[
        MapIndexed[List, lst], 
        {___, {x_, _}, y : {t_, _} .., {z_, _}, ___} /; x < t && z < t :> y];

示例：

In[2]:= test = RandomInteger[{1,20},30]
Out[2]= {13,9,5,9,3,20,2,5,18,13,2,20,13,12,4,7,16,14,8,16,19,20,5,18,3,15,8,8,12,9}

In[3]:= localMaxPositions[test]
Out[3]= {{4},{6},{9},{12},{17},{22},{24},{26},{29}}

一旦你有职位，你可以提取元素：

In[4]:= Extract[test,%]
Out[4]= {9,20,18,20,16,20,18,15,12}

请注意，这也适用于一行中有多个相同最大元素的高原。要获得最小值，需要轻松更改代码。我实际上认为ReplaceList是比Cases更好的选择。

将其与您的数据一起使用：

In[7]:= Extract[data,localMaxPositions[data[[All,2]]]]
Out[7]= {{4,2},{8,4}}

和最小值相同。如果你想要结合起来，上述规则的变化也是微不足道的。

Answer 4

另一种选择：

Part[#,Flatten[Position[Differences[Sign[Differences[#[[All, 2]]]]], 2|-2] + 1]] &@data

(* ==> {{4, 2}, {5, 1}, {8, 4}} *)

Extract[#, Position[Differences[Sign[Differences[#]]], {_, 2} | {_, -2}] + 1] &@data

(* ==> {{4, 2}, {5, 1}, {8, 4}} *)

Answer 5

由于您对“笨拙”方法的一个主要担忧是使用分区进行的数据扩展，您可能需要了解Developer`函数PartitionMap，它不会对所有数据一下子。我使用Sequence[]删除了我不想要的元素。

Developer`PartitionMap[
  # /. {{{_, a_}, x : {_, b_}, {_, c_}} /; a < b > c || a > b < c :> x,
        _ :> Sequence[]} &,
  data, 3, 1
]

使用PatternSequence和Mathematica中的Case来查找峰值

5 个答案: