R/helperSMOrth.R

In bigPint: Big multivariate data plotted interactively

#' @importFrom utils combn
#' @importFrom dplyr starts_with 
helperSMOrth <- function(data, dataMetrics, outDir, pointSize,
    threshOrth, threshVar, threshVal){
    
    rownames(data) <- data$ID
    lwr <- upr <- ID <- NULL
    myPairs <- helperMakePairs(data)[["myPairs"]]
    colGroups <- helperMakePairs(data)[["colGroups"]]
    ifelse(!dir.exists(outDir), dir.create(outDir), FALSE)
    
    minLine = 0
    maxLine = max(data[,-1])
    inc = (maxLine-minLine)/100
    xv = seq(minLine, maxLine, inc)
    uyv = xv+sqrt(2)*threshOrth
    lyv = xv-sqrt(2)*threshOrth
    lineDF = data.frame(xv=xv, uyv=uyv, lyv=lyv)
    
    cols.combn <- combn(myPairs, 2, simplify = FALSE)
    data_list <- lapply(cols.combn, function(x) {data %>% select(ID,
        starts_with(x[1]), starts_with(x[2]))})
    names_list <- lapply(cols.combn, function(x) {paste0(x[1], "_", x[2])})
    
    my_fn <- function(data, mapping, ...){
        xChar = as.character(mapping$x)[2]
        yChar = as.character(mapping$y)[2]
        x = data[,c(xChar)]
        y = data[,c(yChar)]
        
        seqVec <- seq_along(x)
        absDiff = abs(x-y)
        indexPoints <- which(absDiff > sqrt(2)*threshOrth)
        
        plotPoints = data[indexPoints,]
        
        colGroups <- helperMakePairs(data)[["colGroups"]]
        group1 = unique(colGroups)[1]
        group2 = unique(colGroups)[2]
        
        if (!is.null(dataMetrics)){
            rowDEG1 <- which(dataMetrics[[paste0(group1,"_",group2)]]
            [threshVar] < threshVal)
            rowDEG2 <- which(dataMetrics[[paste0(group2,"_",group1)]]
            [threshVar] < threshVal)
            rowDEG <- c(rowDEG1, rowDEG2)
            degID1 <- dataMetrics[[paste0(group1,"_",group2)]][rowDEG,]$ID
            degID2 <- dataMetrics[[paste0(group2,"_",group1)]][rowDEG,]$ID
            degID <- c(degID1, degID2)
            degData <- data[which(rownames(data) %in% degID),]
            indexBoth = rownames(plotPoints) %in% rownames(degData)
            indexBlue = rownames(degData) %in% rownames(plotPoints)
            redPoints = plotPoints[indexBoth,]
            greyPoints = plotPoints[!indexBoth,]
            bluePoints = degData[!indexBlue,]
            
            p <- ggplot(lineDF, aes(x=xv, y=lyv)) + geom_line(aes(y = lyv),
                alpha=0.1) + geom_line(aes(y = uyv), alpha=0.1) +
                geom_ribbon(aes(ymin=lyv,ymax=uyv), fill="blue", alpha=0.3) + 
                geom_point(data = bluePoints, aes_string(x = xChar,
                y = yChar), size=pointSize, alpha=0.5, color = "blue") +
                geom_point(data = greyPoints, aes_string(x=xChar, y = yChar),
                size=pointSize, color = "darkgrey") +
                geom_point(data = redPoints, aes_string(x = xChar,
                y = yChar), size=pointSize, color = "red")   
        }
        else{
            p <- ggplot(lineDF, aes(x=xv, y=lyv)) + geom_line(aes(y = lyv),
            alpha=0.1) + geom_line(aes(y = uyv), alpha=0.1) +
            geom_ribbon(aes(ymin=lyv,ymax=uyv), fill="blue", alpha=0.3) +
            geom_point(data = plotPoints, aes_string(x = xChar,
            y = yChar), size=pointSize)
        }
        p
    }
    
    my_fn2 <- function(data){
        p <- ggpairs(data %>% select(- ID), lower = list(continuous = my_fn))
        return(p)
    }
    
    ret <- lapply(data_list, function(x) my_fn2(x))
    names(ret) <- names_list
    return(ret)
}