includere solo valori anomali da ciascuna colonna in una dataframe

Question

ho un dataframe come segue:

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 

devo creare un ciclo che:

a) Calcola il limite superiore e inferiore (UL e LL) per ogni colonna dalla terza colonna in poi.
b) Include solo le righe che cadono all'esterno di di UL e LL (Zoutliers).
c) Quindi contare il numero di righe in cui Zoutlier è nella stessa direzione (vale a dire positivo o negativo) come il precedente o la riga successiva per lo stesso chr.

L'uscita sarebbe quindi:

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

Finora ho codice come segue:

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

Il codice è patchato insieme da vari luoghi. Il problema che ho è di combinare le parti A) e B) del codice per ottenere l'output che voglio

Answer 1

Puoi provare questa funzione? Non ero sicuro di cosa sia alpha, quindi non sono riuscito a riprodurre l'output previsto e l'ho incluso come variabile nella funzione.

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