Chỉ bao gồm giá trị ngoại biên từ mỗi cột trong một dataframe

Question

Tôi có một dataframe như sau:

chr leftPos   TBGGT  12_try  324Gtt  AMN2 
    1  24352   34   43   19   43 
    1  53534   2   1   -1   -9 
    2  34   -15   7   -9   -18 
    3  3443   -100  -4   4   -9 
    3  3445   -100  -1   6   -1 
    3  3667   5   -5   9   5 
    3  7882   -8   -9   1   3 

tôi phải tạo ra một vòng lặp đó:

a) Tính giới hạn trên và dưới (UL và LL) cho mỗi cột từ cột thứ ba trở đi.
b) Chỉ bao gồm các hàng rơi bên ngoài của UL và LL (Zoutliers).
c) Sau đó đếm số hàng mà Zoutlier có cùng hướng (tức là dương hoặc âm) như trước hoặc hàng tiếp theo cho cùng một số. do đó

Kết quả sẽ là:

ZScore1 TBGGT  12_try  324Gtt  AMN2 
nrow  4   6   4   4 

Cho đến nay tôi có mã như sau:

library(data.table)#v1.9.5 
    f1 <- function(df, ZCol){ 

    #A) Determine the UL and LL and then generate the Zoutliers 
    UL = median(ZCol, na.rm = TRUE) + alpha*IQR(ZCol, na.rm = TRUE) 
    LL = median(ZCol, na.rm = TRUE) - alpha*IQR(ZCol, na.rm = TRUE) 
    Zoutliers <- which(ZCol > UL | ZCol < LL) 

    #B) Exclude Zoutliers per chr if same direction as previous or subsequent row 
    na.omit(as.data.table(df)[, {tmp = sign(eval(as.name(ZCol))) 
    .SD[tmp==shift(tmp) | tmp==shift(tmp, type='lead')]}, 
    by=chr])[, list(.N)]} 

    nm1 <- paste0(names(df) 
    setnames(do.call(cbind,lapply(nm1, function(x) f1(df, x))), nm1)[] 

Mã này được vá lại với nhau từ những nơi khác nhau. Vấn đề tôi có là kết hợp các bộ phận A) và B) của mã để có được đầu ra Tôi muốn

Answer 1

Bạn có thể thử chức năng này không? Tôi không chắc chắn những gì alpha là, vì vậy tôi không thể sao chép sản lượng dự kiến ​​và bao gồm nó như là biến trong chức năng.

# read your data per copy&paste 
d <- read.table("clipboard",header = T) 
# or as in Frank comment mentioned solution via fread 
d <- data.table::fread("chr leftPos   TBGGT  12_try  324Gtt  AMN2 
            1  24352   34   43   19   43 
            1  53534   2   1   -1   -9 
            2  34   -15   7   -9   -18 
            3  3443   -100  -4   4   -9 
            3  3445   -100  -1   6   -1 
            3  3667   5   -5   9   5 
            3  7882   -8   -9   1   3") 


# set up the function 
foo <- function(x, alpha, chr){ 
    # your code for task a) and b) 
    UL = median(x, na.rm = TRUE) + alpha*IQR(x, na.rm = TRUE) 
    LL = median(x, na.rm = TRUE) - alpha*IQR(x, na.rm = TRUE) 
    Zoutliers <- which(x > UL | x < LL) 
    # part (c 
    # factor which specifies the direction. 0 values are set as positives 
    pos_neg <- ifelse(x[Zoutliers] >= 0, "positive", "negative") 
    # count the occurrence per chromosome and direction. 
    aggregate(x[Zoutliers], list(chr[Zoutliers], pos_neg), length) 
} 

# apply over the columns and get a list of dataframes with number of outliers per chr and direction. 
apply(d[,3:ncol(d)], 2, foo, 0.95, d$chr)