1

以下のコードでは、plyr または data.table を使用して med.val2 をエレガントに計算する方法について誰かが洞察を持っているかどうか疑問に思っていました。

library(plyr)

設定例データ

data <- data.frame(id1 = 1:20, id2 = rep(letters[1:4], 5), vals=rnorm(20))

最初にグループの中央値をループで計算します

data$med.val <- rep(0, 20)
for (ind in 1:20) data$med.val[ind] <- median(data$vals[data$id2==data$id2[ind]])

現在、プライアを使用しています

data <- ddply(data, .(id2), mutate, med.val.plyr=median(vals))

等しいはずです

all.equal(data$med.val, data$med.val.plyr)

重要な行を除く、同じ id2 を持つ行の中央値

# Median of values corresponding to 
# data$id1!=data$id1[ind] & data$id2==data$id2[ind]
data$med.val2 <- rep(0, 20)
for (ind in 1:20) data$med.val2[ind] <- median(data$vals[data$id1!=data$id1[ind] & data$id2==data$id2[ind]])

R では、通常、グループごとに値を効率的に計算するために plyr または data.table を使用します。私の実際のデータと関数はより複雑ですが、構造は同じです。焦点行を除いて、共通の識別子を持つ行のデータを使用して関数を計算する必要があります。そして、それを効率的かつエレガントに行う方法がわかりません。

4

2 に答える 2

2

データ テーブルを使用した 1 つの可能な解決策:

dt = data.table(data)
dt[,med.val3 := sapply(.SD$id1, function(x) median(.SD[id1!=x,vals])), by=id2]

編集時: このソリューションと @shadow によるソリューションは、比較的簡潔でエレガントです。また、この種のソリューションに期待できるほど効率的です。ただし、より効率的な実装をコーディングできない限り、leave-one-out 統計の計算は O(n^2) 操作 (またはそれ以上) になります。平均や中央値などの場合、これは非常に簡単です。たとえば、次のようになります。

looMedian<-function(x){
  rng<-range(x)
  bigMedian<-median(c(x,rng[2]+1))
  smallMedian<-median(c(x,rng[1]-1))
  med<-median(x)
  ret<-ifelse(x<med,bigMedian,smallMedian)  
  wm<-which(x==med)
  if(length(wm)==0)
    return(ret)
  ret[wm]<-median(x[-wm[1]])
  ret
}

これは単純なソリューションよりもはるかに効率的です。

looMedianSlow<-function(x){
  sapply(seq_along(x),function(z) median(x[-z]))
}


> xx<-rnorm(100)
> all.equal(looMedianSlow(xx),looMedian(xx))
[1] TRUE
> xx<-rnorm(101)
> all.equal(looMedianSlow(xx),looMedian(xx))
[1] TRUE
> microbenchmark(looMedianSlow(xx),looMedian(xx))
Unit: microseconds
              expr      min       lq    median        uq       max neval
 looMedianSlow(xx) 5174.193 5264.951 5308.5075 5398.6950 44771.062   100
     looMedian(xx)  241.462  248.513  260.0685  278.3615  3495.796   100

あなたのケースでこのようなことが可能かどうかは、計算しようとしている統計に依存します。

于 2013-10-29T13:37:44.433 に答える
1

補助機能を使用してから、 と同じ方法を使用しmedianます。

med2 <- function(x) sapply(seq_along(x), function(ind) median(x[-ind]))
data <- ddply(data, .(id2), mutate, med.val2.plyr=med2(vals))
all.equal(data$med.val2, data$med.val2.plyr)

またはdata.table同じことを行う方法：

dt <- data.table(data, key="id2")
med2 <- function(x) sapply(seq_along(x), function(ind) median(x[-ind]))
dt[, med.val2.dt:=med2(vals), by=id2]
all.equal(dt$med.val2, dt$med.val2.dt)
于 2013-10-29T13:28:44.643 に答える