включают в себя только выбросы из каждого столбца в dataframe

Question

У меня есть dataframe следующим образом:

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 

я должен создать цикл, который:

а) Вычисляет верхние и нижние пределы (UL и LL) для каждого столбца из третьего столбца.
b) Включает только строки, которые падают за пределами UL и LL (Zoutliers).
c) Затем подсчитайте количество строк, в которых Zoutlier является одним и тем же направлением (то есть положительным или отрицательным), как предыдущие или последующий ряд для того же chr. Поэтому

Выход будет:

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

До сих пор у меня есть код следующим образом:

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)[] 

Код склеиваются из разных мест. Проблема, которую я имею, состоит в объединении частей A) и B) кода для получения нужного результата.

Answer 1

Можете ли вы попробовать эту функцию? Я не был уверен, что такое alpha, поэтому я не смог воспроизвести ожидаемый результат и включил его как переменную в функцию.

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