행 표준 편차보다 작은 경우 행 값을 0으로 변경하십시오.

Question

해당 행의 표준 편차보다 작은 경우 행의 모든 ​​값을 0으로 변경하고 싶습니다.

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 

선은 아래

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 

은 무엇인가 .... 일을 할 것으로 보인다,하지만 내 실제 사용 사례에 대단히 느린 내가 반환 sapply 무엇을 좀 확실 해요 더 빠르고 효율적인 방법?

업데이트 신속하고 효율적인 답변을 보내 주셔서 감사합니다.

다음

그들이 쌓아 방법 ...

(아룬 노트로) 아룬의 대답은 작은 비트에 의해 가장 빠른 것 같은데

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) 
} 

. 그러나 DWin 's는 8 글자의 타이핑이 적으며 이국적인 (나에게) sweep 기능을 사용하는 것으로 유명합니다.

Arun의 방법은 상당히 빠르며 (t = 2.0112, df = 191.985, p-value = 0.04571), Arun의 평균 속도는 DWin의 평균 속도보다 훨씬 빠릅니다. (this robust Bayesian estimation method를 사용하여 그룹 1 = DWIN, 그룹 2 = 룬, 룬의 타이밍은 t - 거리에 적합하지 않습니다하지만) :이 방법에 대해

Answer 1

나는이 솔루션을 적용하는 것이 느리지 만, 의심 data.frame 단계와 apply.data.frame, 나는 여전히 "승리"할 수 있습니다 속도가 매우 느릴 사실 또는 추가 할 필요가 없기 때문에 다른 참가자들이 내가 행렬 객체를 사용한다는 사실에 넘어갈 때까지는 "적어도"조차 유지하십시오.

> 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 

추가 노트 : 나는 그가 행 조작을 원하는 경우 트랜스 필요한 생각하지만 리카르도와 나는이 영업 이익보다 같은 다른 시작점을 가지고

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

주 나는 주위를 연주했다 그래서

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

:

,691 rowMeans 제가 적용 할 벡터화 대안 (X, 1, SD)를 올 수 있다면 SD 버전()를 참조하는 기능으로

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