更改行值为零，若低于行标准偏差(Change row values to zero if less

我想换行的所有值为零，如果他们是小于该行的标准偏差。

set.seed(007)
X <- data.frame(matrix(sample(c(5:50), 100, replace=TRUE), ncol=10))

   X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1  37 10 43 45 11 17 39 13 13  44
2  10 24 32 16  7 50 41 47  9  39
3  23 49 46 35 16 30 22 10 11  46
4  41 46 19 28 47 39 27 40 49  13
5  29 23 49 10 50 17 42 43  7  31
6  31 26 11 36 35 43 45 29 33   9
7  21 12  5 21 29 12 31 30  7  30
8  32 24  8 43  9 17 35 44 41   8
9  20 44 39  8 40 17 27 45 14  37
10 50  8  5 48 27 15 15 12 30  15

下面的线条似乎做的工作，但我的实际使用情况非常慢，我有点不确定什么sapply正在恢复....

Y <- t(sapply(1:nrow(X), function(i) 
      sapply(1:ncol(X), function(j) 
        ifelse(X[i,][[j]] < sd(X[i,]), 0, X[i,][[j]]))))

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]   37    0   43   45    0   17   39    0    0    44
 [2,]    0   24   32    0    0   50   41   47    0    39
 [3,]   23   49   46   35   16   30   22    0    0    46
 [4,]   41   46   19   28   47   39   27   40   49    13
 [5,]   29   23   49    0   50   17   42   43    0    31
 [6,]   31   26    0   36   35   43   45   29   33     0
 [7,]   21   12    0   21   29   12   31   30    0    30
 [8,]   32   24    0   43    0   17   35   44   41     0
 [9,]   20   44   39    0   40   17   27   45   14    37
[10,]   50    0    0   48   27    0    0    0   30     0

什么是更快，更有效的方法？

UPDATE谢谢大家非常的快速，高效的答案！

下面是他们如何叠起...

set.seed(007)
size <- 1e5
X <- matrix(sample(c(5:50), size, replace=TRUE), ncol=size/2)

library(microbenchmark)    
results <- microbenchmark(
  X[ sweep(X, 1, apply(X,1,sd) ) < 0 ] <- 0,
  X[t(apply(X, 1, function(x) x - sd(x) < 0))] <- 0,
  sapply(X, function(x) ifelse(x < sd(x), 0, x)),
  times = 100L)
print(results)
Unit: milliseconds
                                              expr         min          lq     median         uq        max neval
          X[sweep(X, 1, apply(X, 1, sd)) < 0] <- 0    7.966167   10.869785   12.38399   15.00107   45.41557   100
 X[t(apply(X, 1, function(x) x - sd(x) < 0))] <- 0    7.344227    9.675577   11.22283   14.34280   53.70728   100
    sapply(X, function(x) ifelse(x < sd(x), 0, x)) 3028.336236 3221.325598 3302.16115 3466.66875 4539.88358   100
# plot
if (require("ggplot2")) {
  plt <- ggplot2::qplot(y=time, data=results, colour=expr)
  plt <- plt + ggplot2::scale_y_log10()
  print(plt)
}

看起来像阿伦的回答是最快的一点点（如阿伦指出）。然而，迪文的是八个字少打字，值得注意的是使用外来的（对我） sweep功能。

A小调娱乐更新，Arun的方法是显著更快（T = 2.0112，DF = 191.985，p值= 0.04571），或者，如果愿意，Arun的功能的平均速度是可信快于迪文的的平均速度（使用此稳健贝叶斯估计方法，第1组=迪文，第2组=阿伦，虽然Arun的定时是不适合的叔DIST）：

Answer 1:

我怀疑这是比较慢的应用解决方案，但因为没有必要添加data.frame步骤和事实apply.data.frame是出了名的慢，我仍然可以“双赢”或“保持甚至”至少要等到其他参赛者滚落到我用的矩阵对象的事实。

set.seed(007)
X <- matrix(sample(c(5:50), 100, replace=TRUE), ncol=10)
X[ sweep(X, 1, apply(X,1,sd) ) < 0 ] <- 0

需要注意的是理查多和我都得到了比OP相同的出发点不同，虽然我认为他需要的，如果他想要一个行操作移调：

> X
   X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1  50  0 34 36 41 31  0 18 45  20
2  23 15 18 17 22 38 28 32 45   0
3   0 40 50  0 39 40 40 43 16  46
4   0  0 46  0 25 33 36 33 39   0
5  16 25 50 22 46 38 30  0 22  38
6  41  0  0 43 19 22 35 31  0  31
7  20 30 33 27  0 12 26 25  0  29
8  49  0 27 41 42  0 27 25 40  21
9   0 50 49 43 46 22 20 33 21  42
10 26 19 21 26 49 17 24 47 24  13

补充说明：我被玩弄的rowMeans功能，看我能不能拿出一个量化的替代应用（X，1，SD）SD（）版本：

sqrt(rowSums((X[1:10, ]-rowMeans(X))^2)/9)

所以：

 sdbyrow <- function(mat) sqrt(rowSums((mat-rowMeans(mat))^2)/(ncol(mat)-1) )
 all.equal(apply(X,1,sd), sdbyrow(X) )
#[1] TRUE

Answer 2:

这个怎么样？

X[t(apply(X, 1, function(x) x - sd(x) < 0))] <- 0
#    X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
# 1  50  0 34 36 41 31  0 18 45  20
# 2  23 15 18 17 22 38 28 32 45   0
# 3   0 40 50  0 39 40 40 43 16  46
# 4   0  0 46  0 25 33 36 33 39   0
# 5  16 25 50 22 46 38 30  0 22  38
# 6  41  0  0 43 19 22 35 31  0  31
# 7  20 30 33 27  0 12 26 25  0  29
# 8  49  0 27 41 42  0 27 25 40  21
# 9   0 50 49 43 46 22 20 33 21  42
# 10 26 19 21 26 49 17 24 47 24  13

文章来源: Change row values to zero if less than row standard deviation