2011-06-15 14 views
9

下の図の赤い丸で示した領域のように、2Dプロットのディップを自動的に検出する必要があります。私は「メイン」ディップだけに興味があります。つまり、ディップはx軸に最小の長さにわたる必要があります。ディップの数は不明であり、すなわち、異なるプロットは異なる数のディップを含むことになる。何か案は?2Dプロットのディップの検出

Dips in a 2D plot

更新:

要求されるようにつるにより示唆されるように、ここではサンプルデータは、一緒にメディアンフィルタリングを使用して、それを滑らかにするための試みで、です。

データ内に残っている小さなブリップを無視するような、それぞれの点で微分を近似するための堅牢な方法が必要なようです。標準的なアプローチはありますか?あなたはいくつかの方法でグラフを滑らかにする必要があり

y <- c(0.9943,0.9917,0.9879,0.9831,0.9553,0.9316,0.9208,0.9119,0.8857,0.7951,0.7605,0.8074,0.7342,0.6374,0.6035,0.5331,0.4781,0.4825,0.4825,0.4879,0.5374,0.4600,0.3668,0.3456,0.4282,0.3578,0.3630,0.3399,0.3578,0.4116,0.3762,0.3668,0.4420,0.4749,0.4556,0.4458,0.5084,0.5043,0.5043,0.5331,0.4781,0.5623,0.6604,0.5900,0.5084,0.5802,0.5802,0.6174,0.6124,0.6374,0.6827,0.6906,0.7034,0.7418,0.7817,0.8311,0.8001,0.7912,0.7912,0.7540,0.7951,0.7817,0.7644,0.7912,0.8311,0.8311,0.7912,0.7688,0.7418,0.7232,0.7147,0.6906,0.6715,0.6681,0.6374,0.6516,0.6650,0.6604,0.6124,0.6334,0.6374,0.5514,0.5514,0.5412,0.5514,0.5374,0.5473,0.4825,0.5084,0.5126,0.5229,0.5126,0.5043,0.4379,0.4781,0.4600,0.4781,0.3806,0.4078,0.3096,0.3263,0.3399,0.3184,0.2820,0.2167,0.2122,0.2080,0.2558,0.2255,0.1921,0.1766,0.1732,0.1205,0.1732,0.0723,0.0701,0.0405,0.0643,0.0771,0.1018,0.0587,0.0884,0.0884,0.1240,0.1088,0.0554,0.0607,0.0441,0.0387,0.0490,0.0478,0.0231,0.0414,0.0297,0.0701,0.0502,0.0567,0.0405,0.0363,0.0464,0.0701,0.0832,0.0991,0.1322,0.1998,0.3146,0.3146,0.3184,0.3578,0.3311,0.3184,0.4203,0.3578,0.3578,0.3578,0.4282,0.5084,0.5802,0.5667,0.5473,0.5514,0.5331,0.4749,0.4037,0.4116,0.4203,0.3184,0.4037,0.4037,0.4282,0.4513,0.4749,0.4116,0.4825,0.4918,0.4879,0.4918,0.4825,0.4245,0.4333,0.4651,0.4879,0.5412,0.5802,0.5126,0.4458,0.5374,0.4600,0.4600,0.4600,0.4600,0.3992,0.4879,0.4282,0.4333,0.3668,0.3005,0.3096,0.3847,0.3939,0.3630,0.3359,0.2292,0.2292,0.2748,0.3399,0.2963,0.2963,0.2385,0.2531,0.1805,0.2531,0.2786,0.3456,0.3399,0.3491,0.4037,0.3885,0.3806,0.2748,0.2700,0.2657,0.2963,0.2865,0.2167,0.2080,0.1844,0.2041,0.1602,0.1416,0.2041,0.1958,0.1018,0.0744,0.0677,0.0909,0.0789,0.0723,0.0660,0.1322,0.1532,0.1060,0.1018,0.1060,0.1150,0.0789,0.1266,0.0965,0.1732,0.1766,0.1766,0.1805,0.2820,0.3096,0.2602,0.2080,0.2333,0.2385,0.2385,0.2432,0.1602,0.2122,0.2385,0.2333,0.2558,0.2432,0.2292,0.2209,0.2483,0.2531,0.2432,0.2432,0.2432,0.2432,0.3053,0.3630,0.3578,0.3630,0.3668,0.3263,0.3992,0.4037,0.4556,0.4703,0.5173,0.6219,0.6412,0.7275,0.6984,0.6756,0.7079,0.7192,0.7342,0.7458,0.7501,0.7540,0.7605,0.7605,0.7342,0.7912,0.7951,0.8036,0.8074,0.8074,0.8118,0.7951,0.8118,0.8242,0.8488,0.8650,0.8488,0.8311,0.8424,0.7912,0.7951,0.8001,0.8001,0.7458,0.7192,0.6984,0.6412,0.6516,0.5900,0.5802,0.5802,0.5762,0.5623,0.5374,0.4556,0.4556,0.4333,0.3762,0.3456,0.4037,0.3311,0.3263,0.3311,0.3717,0.3762,0.3717,0.3668,0.3491,0.4203,0.4037,0.4149,0.4037,0.3992,0.4078,0.4651,0.4967,0.5229,0.5802,0.5802,0.5846,0.6293,0.6412,0.6374,0.6604,0.7317,0.7034,0.7573,0.7573,0.7573,0.7772,0.7605,0.8036,0.7951,0.7817,0.7869,0.7724,0.7869,0.7869,0.7951,0.7644,0.7912,0.7275,0.7342,0.7275,0.6984,0.7342,0.7605,0.7418,0.7418,0.7275,0.7573,0.7724,0.8118,0.8521,0.8823,0.8984,0.9119,0.9316,0.9512) 

yy <- runmed(y, 41) 
plot(y, type="l", ylim=c(0,1), ylab="", xlab="", lwd=0.5) 
points(yy, col="blue", type="l", lwd=2) 

Median filtering

+0

私はあなたがデータを少し滑らかにし、これを使用することができると思います:http://stackoverflow.com/questions/6324354/プロット・イン・プロット・イン・ザ・フレーズ・イン・ザ・フィール・オブ・ザ・フィックス・イン・ザ・r/ –

+2

サンプル・データは素晴らしかったでしょう... –

+1

@Jorisプロットを生成するために使用したデータを追加しました。それを指摘してくれてありがとう。 – Leo

答えて

6

EDITED:機能は、必要に応じて、最も低い部分だけを含む領域を削除します。

実際、平均値を使用する方がメジアンを使用する方が簡単です。これにより、実際の値が平均よりも連続的に低い領域を見つけることができます。中央値は、簡単に適用できるほど滑らかではありません。これを行うには

一例としての機能は、次のようになります。

  • nが稼働して平均値を計算するのに使用されているどのくらいの値を決定
    FindLowRegion <- function(x,n=length(x)/4,tol=length(x)/20,p=0.5){ 
        nx <- length(x) 
        n <- 2*(n %/% 2) + 1 
        # smooth out based on means 
        sx <- rowMeans(embed(c(rep(NA,n/2),x,rep(NA,n/2)),n),na.rm=T) 
        # find which series are far from the mean 
        rlesx <- rle((sx-x)>0) 
        # construct start and end of regions 
        int <- embed(cumsum(c(1,rlesx$lengths)),2) 
        # which regions fulfill requirements 
        id <- rlesx$value & rlesx$length > tol 
        # Cut regions to be in general smaller than median 
        regions <- 
        apply(int[id,],1,function(i){ 
         i <- min(i):max(i) 
         tmp <- x[i] 
         id <- which(tmp < quantile(tmp,p)) 
         id <- min(id):max(id) 
         i[id]    
        }) 
        # return 
        unlist(regions) 
    } 
    

  • tolはどのように多くの連続した値を決定すべきです低い地域について話すためのランニング平均よりも低く、
  • は、リージョンを最下部にストリッピングするために(クォンタイルとして)使用されるカットオフを決定します。 p = 1の場合、完全な下側領域が示される。

表示されているようにデータを処理する機能は調整されていますが、数値は他のデータを扱うために少し調整する必要があります。

この関数は、低い領域を見つけることを可能にする一連のインデックスを返します。あなたのyベクトルとイラスト:

Lows <- FindLowRegion(y) 

newx <- seq_along(y) 
newy <- ifelse(newx %in% Lows,y,NA) 
plot(y, col="blue", type="l", lwd=2) 
lines(newx,newy,col="red",lwd="3") 

与える:

enter image description here

+0

統計的な妥当性? – hadley

+1

@Hadley:黄土()とお友達と同じくらい。 –

+1

あなたのステートメント 'newy < - ifelse(x%in%Lows、y、NA)'では 'x'はどこから来ますか?それは 'newx'ではありませんか? –

3

Median filtrationは、その目的には非常に便利です(http://en.wikipedia.org/wiki/Median_filter参照)。平滑化した後は、通常と同じように最小値を検索するだけです(つまり、1次導関数が負から正に切り替わる点を検索する)。

+0

提案していただきありがとうございます。私はメディアンフィルタリングで質問を更新しました。まだいくつかのノイズがあるので、1つの問題が残っています.1次微分のロバスト近似。 – Leo

+0

@レオ:Rについては事実上何も分かっていませんが、アルゴリズム的に言えば、私が試してみたいのはスライディングウインドウです:ウインドウ内のすべての点は、左端と右端を除いて、一番右にあると、ディップが見つかり、ウインドウがその幅で一度にシフトされます。そうでなければ、ウインドウは一歩だけシフトします。 – vines

+1

私の答えに示すように、平均平滑化はもっと便利です。 –

0

私の最初の考えは、フィルタリングよりもずっと重大なことでした。長期間の安定した期間に続いて大きな雫を探してみませんか?

span.b <- 20 
threshold.b <- 0.2 
dy.b <- c(rep(NA, span.b), diff(y, lag = span.b)) 
span.f <- 10 
threshold.f <- 0.05 
dy.f <- c(diff(y, lag = span.f), rep(NA, span.f)) 
down <- which(dy.b < -1 * threshold.b & abs(dy.f) < threshold.f) 
abline(v = down) 

プロットは、それは完璧ではないことを示しているが、それは(私はそれがデータ上のあなたのテイクに依存推測)異常値を破棄しません。

1

を(も平滑化する必要はありません)単純な答えはtseriesからmaxdrawdown()機能を適応させることによって提供することができます。 ドローダウンは、通常、最新の最大値からの後退として定義されます。ここで我々は反対が欲しい。このような関数は、スライディングウインドウ内でデータ上で、またはセグメント化されたデータ上で使用することができる。など

maxdrawdown <- function(x) { 
    if(NCOL(x) > 1) 
     stop("x is not a vector or univariate time series") 
    if(any(is.na(x))) 
     stop("NAs in x") 
    cmaxx <- cummax(x)-x 
    mdd <- max(cmaxx) 
    to <- which(mdd == cmaxx) 
    from <- double(NROW(to)) 
    for (i in 1:NROW(to)) 
     from[i] <- max(which(cmaxx[1:to[i]] == 0)) 
    return(list(maxdrawdown = mdd, from = from, to = to)) 
} 

代わりcummax()を使用するので、1がcummin()に切り替えなければならないでしょう

+0

私は簡単な答えが好きです。 – Jubbles