R/appHelpers.R

In rhondabacher/methylscaper: Visualization of Methylation Data

buildOrderObjectShiny <- function(dataIn, method,
                        coordinatesObject, updateProgress)
{
    if (coordinatesObject$weight_start == 0 | coordinatesObject$weight_stop == 0) {
        orderObject <- initialOrder(dataIn, Method = method)
    } else orderObject <- initialOrder(dataIn, Method = method,
                    weightStart = coordinatesObject$weight_start,
                    weightEnd = coordinatesObject$weight_stop,
                    weightFeature = coordinatesObject$weight_color,
                    updateProgress = updateProgress)
return(orderObject)
}

refineOrderShiny <- function(orderObject, refine_method, coordinatesObject)
{
    refineFunction(orderObject, coordinatesObject$refine_start, 
                    coordinatesObject$refine_stop, Method=refine_method)
}

drawPlot <- function(orderObject, coordinatesObject, blankWidth = NULL, drawLines = TRUE, ...)
{
    plotSequence(orderObject, ...)
		
		if (is.null(blankWidth)) blankWidth <- ceiling(.12 * ncol(orderObject$toClust) / 2) 
			
    # draw the horizontal lines
    if (coordinatesObject$refine_start != 0 & coordinatesObject$refine_stop != 0) {
        n <- nrow(orderObject$toClust)# convert back to raw coordinates
        ymin <- (((n:1)[coordinatesObject$refine_start] / n * (n - 12)) + 12) / n 
        ymax <- (((n:1)[coordinatesObject$refine_stop] / n * (n - 12)) + 12) / n
        if (drawLines) {
            abline(b = 0, a = ymax, col = "blue", lwd = 2.5)
            abline(b = 0, a = ymin, col = "blue", lwd = 2.5)
        }
    }
    # draw the vertical lines
    if (coordinatesObject$weight_start != 0 & coordinatesObject$weight_stop != 0) {
		firstm <- (ncol(orderObject$toClust) + blankWidth)
        xmin <- coordinatesObject$weight_start / firstm
        xmax <- coordinatesObject$weight_stop / firstm
        if (coordinatesObject$weight_color == "yellow") {
			secondm <- (blankWidth+ncol(orderObject$toClust)/2) / firstm
            xmin <- xmin + secondm
            xmax <- xmax + secondm
        }
        if (drawLines) {
            abline(v = xmin, col = "green", lwd = 2.5)
            abline(v = xmax, col = "green", lwd = 2.5)
        }
    }
}

handleBrushCoordinates <- function(plot_brush, n, m, blankWidth=NULL){
	
	  if (is.null(blankWidth)) blankWidth <- ceiling(.12 * m) 
		
    weight_color <- "red"
    first_row_raw <- round(plot_brush$ymin * n) - 12
    last_row_raw <- round(plot_brush$ymax * n) - 12
    first_row <- round((first_row_raw / (n - 12)) * n)
    last_row <- round((last_row_raw / (n - 12)) * n)

    if (first_row <= 2) first_row <- 1
    if (last_row >= n - 1) last_row <- n

    if (first_row >= n - 1 | last_row <= 2) {
        first_row <- 0
        last_row <- 0
    }

    first_col <- round(plot_brush$xmin, 4)
    last_col <- round(plot_brush$xmax, 4)
	firstm <- (m) / (m*2 + blankWidth)
	secondm <- (blankWidth+m) / (m*2 + blankWidth)
    if (first_col <= firstm) { # red weighting 
        if (last_col >= firstm) last_col <- firstm # force the last column to be in red
        first_col <- first_col / firstm
        first_col <- round(first_col * m)
        last_col <- last_col / firstm
        last_col <- round(last_col * m)
    } else if (first_col >= secondm) { # yellow weighting
        weight_color <- "yellow"
        first_col <- first_col - secondm
        last_col <- last_col - secondm

        first_col <- first_col / firstm
        first_col <- round(first_col * m)
        last_col <- last_col / firstm
        last_col <- round(last_col * m)
    } else { # in the middle, just set them to 0
        first_col <- 0
        last_col <- 0
    }

    if (first_col <= 2) first_col <- 1
    if (last_col >= (m - 2)) last_col <- m

    return(list(first_row = ifelse(first_row == 0, 0, seq(n,1)[first_row]),
            last_row = ifelse(last_row == 0, 0, seq(n,1)[last_row]),
            first_col = first_col, last_col = last_col,
            weight_color = weight_color))
}