Commit 03947223 authored by dmattek's avatar dmattek

Added: scatter plot

parent a79bbb1a
source('modules/auxfunc.R')
source('modules/downPlot.R')
source('modules/downCellIDsCls.R')
\ No newline at end of file
source('modules/downCellIDsCls.R')
source('modules/tabScatter.R')
\ No newline at end of file
......@@ -220,6 +220,105 @@ myNorm = function(in.dt,
return(loc.dt)
}
# Plots a scatter plot with marginal histograms
# Points are connected by a line (grouping by cellID)
#
# Assumes an input of data.table with
# x, y - columns with x and y coordinates
# id - a unique point identifier (here corresponds to cellID)
# mid - a (0,1) column by which points are coloured (here corresponds to whether cells are within bounds)
myGgplotScat = function(dt.arg,
band.arg = NULL,
facet.arg = NULL,
facet.ncol.arg = 2,
xlab.arg = NULL,
ylab.arg = NULL,
plotlab.arg = NULL,
alpha.arg = 1,
group.col.arg = NULL) {
p.tmp = ggplot(dt.arg, aes(x = x, y = y))
if (is.null(group.col.arg)) {
p.tmp = p.tmp +
geom_point(alpha = alpha.arg, aes(group = id))
} else {
p.tmp = p.tmp +
geom_point(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
geom_path(aes(colour = as.factor(get(group.col.arg)), group = id), alpha = alpha.arg) +
scale_color_manual(name = group.col.arg, values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green'))
}
if (is.null(band.arg))
p.tmp = p.tmp +
stat_smooth(
method = function(formula, data, weights = weight)
rlm(formula, data, weights = weight, method = 'MM'),
fullrange = FALSE,
level = 0.95,
colour = 'blue'
)
else {
p.tmp = p.tmp +
geom_abline(slope = band.arg$a, intercept = band.arg$b) +
geom_abline(
slope = band.arg$a,
intercept = band.arg$b + abs(band.arg$b)*band.arg$width,
linetype = 'dashed'
) +
geom_abline(
slope = band.arg$a,
intercept = band.arg$b - abs(band.arg$b)*band.arg$width,
linetype = 'dashed'
)
}
if (!is.null(facet.arg)) {
p.tmp = p.tmp +
facet_wrap(as.formula(paste("~", facet.arg)),
ncol = facet.ncol.arg)
}
if (!is.null(xlab.arg))
p.tmp = p.tmp +
xlab(paste0(xlab.arg, "\n"))
if (!is.null(ylab.arg))
p.tmp = p.tmp +
ylab(paste0("\n", ylab.arg))
if (!is.null(plotlab.arg))
p.tmp = p.tmp +
ggtitle(paste0(plotlab.arg, "\n"))
p.tmp = p.tmp +
theme_bw(base_size = 18, base_family = "Helvetica") +
theme(
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
axis.line.x = element_line(color = "black", size = 0.25),
axis.line.y = element_line(color = "black", size = 0.25),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
strip.text.x = element_text(size = 14, face = "bold"),
strip.text.y = element_text(size = 14, face = "bold"),
strip.background = element_blank(),
legend.key = element_blank(),
legend.key.height = unit(1, "lines"),
legend.key.width = unit(2, "lines"),
legend.position = "none"
)
# Marginal distributions don;t work with plotly...
# if (is.null(facet.arg))
# ggExtra::ggMarginal(p.scat, type = "histogram", bins = 100)
# else
return(p.tmp)
}
myGgplotTheme = theme_bw(base_size = 18, base_family = "Helvetica") +
theme(
......
# RShiny module for performing hierarchical clustering
# Use:
# in ui.R
# tabPanel(
# 'Hierarchical',
# clustHierUI('TabClustHier'))
#
# in server.R
# callModule(clustHier, 'TabClustHier', dataMod)
# where dataMod is the output from a reactive function that returns dataset ready for clustering
require(plotly) # interactive plot
require(robust)
# UI
tabScatterPlotUI <- function(id, label = "Comparing t-points") {
ns <- NS(id)
tagList(
h4(
"Scatter plot between two time points"
),
br(),
fluidRow(
column(
6,
uiOutput(ns('varSelTptX')),
uiOutput(ns('varSelTptY'))
),
column(
6,
numericInput(
ns('inPlotHeight'),
'Display plot height',
value = 1000,
min = 100,
step = 100
),
numericInput(
ns('inPlotNcolFacet'),
'#columns',
value = 2,
min = 1,
step = 1
)
)
),
br(),
actionButton(ns('butGoScatter'), 'Plot!'),
checkboxInput(ns('plotInt'),
'Interactive Plot?',
value = FALSE),
uiOutput(ns("plotInt_ui")),
downPlotUI(ns('downPlotScatter'), "Download PDF")
)
}
# SERVER
tabScatterPlot <- function(input, output, session, in.data) {
# return all unique time points (real time)
# This will be used to display in UI for box-plot
# These timepoints are from the original dt and aren't affected by trimming of x-axis
getDataTpts <- reactive({
cat(file = stderr(), 'getDataTpts\n')
loc.dt = in.data()
if (is.null(loc.dt))
return(NULL)
else
return(unique(loc.dt$realtime))
})
output$varSelTptX = renderUI({
cat(file = stderr(), 'UI varSelTptX\n')
ns <- session$ns
loc.v = getDataTpts()
if (!is.null(loc.v)) {
selectInput(
ns('inSelTptX'),
'Select timepoint for X-axis:',
loc.v,
width = '100%',
selected = 0,
multiple = FALSE
)
}
})
output$varSelTptY = renderUI({
cat(file = stderr(), 'UI varSelTptY\n')
ns <- session$ns
loc.v = getDataTpts()
if (!is.null(loc.v)) {
selectInput(
ns('inSelTptY'),
'Select timepoint for Y-axis:',
loc.v,
width = '100%',
selected = 0,
multiple = FALSE
)
}
})
data4scatterPlot <- reactive({
cat(file = stderr(), 'data4scatterPlot\n')
loc.dt.in = in.data()
if(is.null(loc.dt.in))
return(NULL)
loc.dt = data.table(x = loc.dt.in[realtime == input$inSelTptX, y],
y = loc.dt.in[realtime == input$inSelTptY, y],
group = loc.dt.in[realtime == input$inSelTptX, group])
loc.dt.x = loc.dt.in[realtime == input$inSelTptX]
loc.dt.y = loc.dt.in[realtime == input$inSelTptY]
loc.dt = merge(loc.dt.x, loc.dt.y, by = 'id')
setnames(loc.dt, c('group.x', 'y.x', 'y.y'), c('group', 'x', 'y'))
return(loc.dt)
})
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
# This function is used to plot and to downoad a pdf
plotScatter <- function() {
cat(file=stderr(), "plotScatter\n")
# isolate because calculations & plotting take a while
# re-plotting done upon button press
loc.dt = isolate(data4scatterPlot())
#loc.fit = isolate(dataFit())
cat("plotScatter on to plot\n\n")
if (is.null(loc.dt)) {
cat(file=stderr(), 'plotScatter: dt is NULL\n')
return(NULL)
}
cat(file=stderr(), 'plotScatter:dt not NULL\n')
## FIX: r.squared is unavailable for lm
# loc.fit.rsq = ifelse(input$inRobustFit, loc.fit$r.squared, )
p.out = myGgplotScat(
dt.arg = loc.dt,
band.arg = NULL, #list(a = loc.fit$coeff.a, b = loc.fit$coeff.b, width = input$inBandWidth),
group.col.arg = NULL,
plotlab.arg = NULL,
# plotlab.arg = sprintf(
# "%s%.2f\n%s%.2f x %.2f",
# ifelse(input$inRobustFit, "lmRob, entire dataset R2=", "lm, entire dataset R2="),
# loc.fit$r.squared,
# 'bandwidth=',
# input$inBandWidth,
# loc.fit$coeff.b
# ),
facet.arg = 'group',
facet.ncol.arg = input$inPlotNcolFacet,
alpha.arg = 0.5
)
return(p.out)
}
# display plot
output$outPlotScatter <- renderPlot({
locBut = input$butGoScatter
if (locBut == 0) {
cat(file=stderr(), 'plotScatter: Go button not pressed\n')
return(NULL)
}
plotScatter()
})
output$outPlotScatterInt <- renderPlotly({
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
# https://github.com/ropensci/plotly/issues/494
if (names(dev.cur()) != "null device") dev.off()
pdf(NULL)
return( plotly_build(plotScatter()))
})
# download pdf
callModule(downPlot, "downPlotScatter", "scatter.pdf", plotScatter, TRUE)
# Hierarchical - choose to display regular heatmap.2 or d3heatmap (interactive)
output$plotInt_ui <- renderUI({
ns <- session$ns
if (input$plotInt)
tagList(plotlyOutput(ns("outPlotScatterInt"), height = paste0(input$inPlotHeight, "px")))
else
tagList(plotOutput(ns('outPlotScatter'), height = paste0(input$inPlotHeight, "px")))
})
}
\ No newline at end of file
......@@ -803,6 +803,9 @@ shinyServer(function(input, output, session) {
}
###### Scatter plot
callModule(tabScatterPlot, 'tabScatter', data4trajPlot)
##### Hierarchical clustering
output$uiPlotHierClSel = renderUI({
......@@ -972,12 +975,12 @@ shinyServer(function(input, output, session) {
# s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv'),
# getDataCl(userFitDendHier, input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim))
#
# output$downloadDataClean <- downloadHandler(
# filename = 'tCoursesSelected_clean.csv',
# content = function(file) {
# write.csv(data4trajPlot(), file, row.names = FALSE)
# }
# )
output$downloadDataClean <- downloadHandler(
filename = 'tCoursesSelected_clean.csv',
content = function(file) {
write.csv(data4trajPlot(), file, row.names = FALSE)
}
)
......
......@@ -142,12 +142,17 @@ shinyUI(fluidPage(
),
# scatter plot
tabPanel(
'Scatter',
tabScatterPlotUI('tabScatter')
),
tabPanel(
'Hierarchical',
br(),
fluidRow(
column(
6,
column(4,
selectInput(
"selectPlotHierLinkage",
label = ("Select linkage method:"),
......@@ -174,7 +179,7 @@ shinyUI(fluidPage(
selected = 1
)
),
column(6,
column(4,
sliderInput(
'inPlotHierNclust',
'#dendrogram branches to colour',
......@@ -191,8 +196,6 @@ shinyUI(fluidPage(
downloadButton('downCellCl', 'Download CSV with cell IDs and cluster no.')
)
),
br(),
#checkboxInput('inPlotHierSparInteractive', 'Interactive Plot?', value = FALSE),
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment