Skip to content

Commit

Permalink
Merge branch 'master' of github.com:sbabicki/heatmapper
Browse files Browse the repository at this point in the history
  • Loading branch information
sciguy committed Apr 25, 2016
2 parents 2dc00ba + 5708e9b commit 4eedd07
Show file tree
Hide file tree
Showing 8 changed files with 228 additions and 68 deletions.
106 changes: 64 additions & 42 deletions expression/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,8 @@ EACH_ROW_SIZE_LIMIT <- 13; # the minimum pixel size of each row in heatmap.2 ima
MIN_FONT_SIZE <- 1.0;
MAX_FONT_SIZE <- 1.45;


MIN_FILE_ROWS <- 100; # Control if auto-adjust plot size by this threshold row number of input file. If less, use the default
# plot size setting; if more, use auto-adjust plot size ("Preview Full Height")

shinyServer(function(input, output, session){

Expand Down Expand Up @@ -223,11 +224,26 @@ shinyServer(function(input, output, session){
# brighten the colors by shifting them closer to the low and high
# colors.
brightness_adj = as.integer(input$plotBrightness)


# Set number of colors to use in the color ramp palette, depending
# on whether we are rendering a heatmap.2 or d3heatmap plot.
if (input$tabSelections == 'Interactive') {
# Rendering d3heatmap, so ignore user's chosen no. of shades.
if (brightness_adj > 0) {
num_colors = q*2 + 1
} else {
#num_colors = 3
num_colors = q*2 + 1 # was 3 before, but use this since otherwise the color is off
}
} else {
# Rendering heatmap.2
num_colors = input$binNumber
}

if(input$colourScheme == 'red/green'){
lowCol = "#FF0000"
midCol = "#000000"
highCol = "#23B000"
highCol = "#33FF00"
}else if (input$colourScheme == 'blue/yellow'){
lowCol = "#0016DB"
midCol = "#FFFFFF"
Expand All @@ -248,9 +264,9 @@ shinyServer(function(input, output, session){

if(input$colourScheme == 'rainbow' || input$colourScheme == 'topo'){
if(input$colourScheme == 'rainbow'){
cl = rainbow(input$binNumber)
cl = rainbow(num_colors)
}else{
cl = topo.colors(input$binNumber)
cl = topo.colors(num_colors)
}

adjusted_colours = c()
Expand All @@ -271,17 +287,17 @@ shinyServer(function(input, output, session){
lowCol = lowCol
midCol = midCol
highCol = highCol
colorRampPalette(c(lowCol, midCol, highCol))(input$binNumber)
colorRampPalette(c(lowCol, midCol, highCol))(num_colors)
} else if (brightness_adj < 0) {
lowCol = darken(lowCol, brightness_adj)
midCol = darken(midCol, brightness_adj)
highCol = darken(highCol, brightness_adj)
colorRampPalette(c(lowCol, midCol, highCol))(input$binNumber)
colorRampPalette(c(lowCol, midCol, highCol))(num_colors)
} else {
lowCol = lowCol
midCol = midCol
highCol = highCol
colorRampPalette(get_brightness_adjusted_color_set(lowCol, midCol, highCol, brightness_adj))(input$binNumber)
colorRampPalette(get_brightness_adjusted_color_set(lowCol, midCol, highCol, brightness_adj))(num_colors)
}
}

Expand Down Expand Up @@ -658,7 +674,7 @@ shinyServer(function(input, output, session){
dendrogram = dend_select(),
Rowv = get_dendrograms()[[1]],
Colv = get_dendrograms()[[2]],
col = get_colour_palette(),#(input$binNumber),
col = get_colour_palette(),
scale = input$scale,
main = input$title,
xlab = input$xlab,
Expand Down Expand Up @@ -691,6 +707,22 @@ shinyServer(function(input, output, session){

################################## OUTPUT FUNCTIONS ##################################

# plot message of notice of reszing image
output$plotMesage <- renderText(
get_plot_message()
)

get_plot_message <- (
reactive({
file <- get_file()
if(!is.null(file) && nrow(file) > MIN_FILE_ROWS){
"Plot dimensions were auto-adjusted. See below in Advanced Options for plot size settings."
}else{
""
}
})
)

# heatmap.2 plot
output$heatmap <- renderPlot(

Expand All @@ -702,53 +734,43 @@ shinyServer(function(input, output, session){
)

get_plot_height <- (

reactive({
if(input$fullSize){
if(!is.null(values$rowMatrix) && !is.na(values$rowMatrix)){
input$plotWidth/ncol(values$rowMatrix) * nrow(values$rowMatrix)
}
else{
#input$plotHeight * get_image_weight()
#print (paste("Full size ", input$plotHeight))
input$plotHeight * 1
}
}
else{
#input$plotHeight * get_image_weight()
#print (paste("Not full size ", input$plotHeight))
input$plotHeight * 1
}
})
file <- get_file()
if(input$fullSize || (!is.null(file) &&nrow(file) > MIN_FILE_ROWS)){
if(!is.null(values$rowMatrix) && !is.na(values$rowMatrix)){
input$plotWidth/ncol(values$rowMatrix) * nrow(values$rowMatrix)
}
else{
#input$plotHeight * get_image_weight()
#print (paste("Full size ", input$plotHeight))
input$plotHeight * 1
}
}
else{
#input$plotHeight * get_image_weight()
#print (paste("Not full size ", input$plotHeight))
input$plotHeight * 1
}
})
)


# d3heatmap plot
output$d3map <- renderD3heatmap({
x <- get_data_matrix()

print(length(x))
# print(length(x))

validate(need(length(x) <= 400000,
"File is too large for this feature. Please select a smaller file with no more than 400,000 cells."))

tryCatch({

# Get number of colors to use in color palette, which depends on whether
# or not we are brightening the plot.
brightness_adj = as.integer(input$plotBrightness)
if (brightness_adj > 0) {
num_colors = q*2 + 1
} else {
num_colors = 3;
}

d3heatmap(x,
Rowv = get_dendrograms()[[1]],
Colv = get_dendrograms()[[2]],
colors = get_colour_palette()(num_colors),
scale = input$scale,
show_grid = FALSE,
Rowv = get_dendrograms()[[1]],
Colv = get_dendrograms()[[2]],
colors = get_colour_palette(),
scale = input$scale,
show_grid = FALSE,
anim_duration = 0)
},
error = function(err){
Expand Down
8 changes: 4 additions & 4 deletions expression/ui.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,9 +31,9 @@ shinyUI(list(HEAD_TASKS("#expressionTab"), fluidPage(title = "Expression Heat Ma

conditionalPanel(condition = "input.colourScheme == 'custom'",
fluidRow(
column(4,jscolourInput("lowColour", label = "Low Colour", value = "#FF0000")),
column(4, jscolourInput("midColour", label = "Middle Colour")),
column(4, jscolourInput("highColour", label = "High Colour", value = "#23B000")))
column(4,jscolourInput("lowColour", label = "Low Colour", value = "#0016DB")),
column(4, jscolourInput("midColour", label = "Middle Colour", value = "#FFFFFF")),
column(4, jscolourInput("highColour", label = "High Colour", value = "#FFFF00")))
),


Expand Down Expand Up @@ -130,7 +130,7 @@ shinyUI(list(HEAD_TASKS("#expressionTab"), fluidPage(title = "Expression Heat Ma

mainPanel(id = "mainPanel",
tabsetPanel(id = "tabSelections", type = "tabs",
tabPanel("Plot", tags$br(), plotOutput("heatmap")),
tabPanel("Plot", tags$br(), h4(textOutput("plotMesage")), plotOutput("heatmap")),

tabPanel("Interactive", tags$br(), d3heatmapOutput("d3map", height = 600)),

Expand Down
2 changes: 1 addition & 1 deletion geocoordinate/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,7 @@ shinyServer(function(input, output, session){
if(input$colourScheme == 'custom'){
palette <- colorRampPalette(c(input$lowColour, input$highColour))(n)
}else if(input$colourScheme == 'red/green'){
palette <- colorRampPalette(c("#FF0000", "#000000", "#23B000"))(n)
palette <- colorRampPalette(c("#FF0000", "#000000", "#33FF00"))(n)
}else if(input$colourScheme == 'blue/yellow'){
palette <- colorRampPalette(c("#0016DB", "#FFFFFF", "#FFFF00"))(n)
}else if(input$colourScheme == 'grayscale'){
Expand Down
2 changes: 1 addition & 1 deletion geomap/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -293,7 +293,7 @@ shinyServer(function(input, output, session) {

# Eight colors for eight buckets
if(input$colourScheme == 'red/green'){
values$palette <- colorRampPalette(c("#FF0000", "#000000", "#23B000"))(input$binNumber)
values$palette <- colorRampPalette(c("#FF0000", "#000000", "#33FF00"))(input$binNumber)
}else if(input$colourScheme == 'blue/yellow'){
values$palette <- colorRampPalette(c("#0016DB", "#FFFFFF", "#FFFF00"))(input$binNumber)
}else if(input$colourScheme == 'grayscale'){
Expand Down
22 changes: 11 additions & 11 deletions global_ui.R
Original file line number Diff line number Diff line change
Expand Up @@ -149,36 +149,36 @@ BRIGHTNESS_SLIDER <- function(){
}

# colour scheme dropdown selection
COLOUR_SCHEME_SELECT <- function(selected = 'blue/yellow'){
COLOUR_SCHEME_SELECT <- function(selected = 'custom'){
tipify(fluidRow(
column(3, tags$label("Colour Scheme")),
column(9,
selectInput('colourScheme', label = NULL,
choices = c(
'Custom' = "custom",
'Blue/Yellow' = "blue/yellow",
'Reg/Green' = "red/green",
'Red/Green' = "red/green",
'Pink/White/Green' = "piyg",
'Blue/Green/Yellow' = "topo",
'Grayscale' = "grayscale",
'PiYG' = "piyg",
'Custom' = "custom",
'Rainbow' = "rainbow",
'Topo' = "topo"
'Rainbow' = "rainbow"
),
selected = selected)
)
), "Select custom or preset colour scheme", placement = "right")
}

COLOUR_SCHEME_SELECT_LIMITED <- function(selected = 'blue/yellow'){
COLOUR_SCHEME_SELECT_LIMITED <- function(selected = 'custom'){
tipify(fluidRow(
column(3, tags$label("Colour Scheme")),
column(9,
selectInput('colourScheme', label = NULL,
choices = c(
'Custom' = "custom",
'Blue/Yellow' = "blue/yellow",
'Reg/Green' = "red/green",
'Grayscale' = "grayscale",
'PiYG' = "piyg",
'Custom' = "custom"
'Red/Green' = "red/green",
'Pink/White/Green' = "piyg",
'Grayscale' = "grayscale"
),
selected = selected)
)
Expand Down
8 changes: 4 additions & 4 deletions image/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -405,13 +405,13 @@ shinyServer(function(input, output, session){
get_colours <- reactive({

if(input$colourScheme == 'red/green'){
scale_fill_gradientn(colours = colorRampPalette(c("#FF0000", "#000000", "#23B000")))
scale_fill_gradientn(colours = colorRampPalette(c("#FF0000", "#000000", "#23B000"))(7))
}else if(input$colourScheme == 'blue/yellow'){
scale_fill_gradientn(colours = colorRampPalette(c("#0016DB", "#FFFFFF", "#FFFF00")))
scale_fill_gradientn(colours = colorRampPalette(c("#0016DB", "#FFFFFF", "#FFFF00"))(7))
}else if(input$colourScheme == 'piyg'){
scale_fill_gradientn(colours = colorRampPalette(c("#C9438C", "#f7f7f7", "#7BC134")))
scale_fill_gradientn(colours = colorRampPalette(c("#C9438C", "#f7f7f7", "#7BC134"))(7))
}else if(input$colourScheme == 'grayscale'){
scale_fill_gradientn(colours = colorRampPalette(c("#000000", "#bdbdbd", "#FFFFFF")))
scale_fill_gradientn(colours = colorRampPalette(c("#000000", "#bdbdbd", "#FFFFFF"))(7))
}else if(input$colourScheme == 'rainbow'){
scale_fill_gradientn(colours = rev(rainbow(7)))
}else if(input$colourScheme == 'topo'){
Expand Down
Loading

0 comments on commit 4eedd07

Please sign in to comment.