From 8f0123d617743c53f03431d9942eb2ec97d42e8e Mon Sep 17 00:00:00 2001 From: Areej Alsheikh Date: Sun, 19 Apr 2015 10:58:50 +1000 Subject: [PATCH 1/3] Added bar plot part --- plotTreeShiny/plotTree.R | 320 +++++++++++++++++++++++++++++++++++++++ plotTreeShiny/server.R | 90 +++++++++++ plotTreeShiny/ui.R | 70 +++++++++ 3 files changed, 480 insertions(+) create mode 100644 plotTreeShiny/plotTree.R create mode 100644 plotTreeShiny/server.R create mode 100644 plotTreeShiny/ui.R diff --git a/plotTreeShiny/plotTree.R b/plotTreeShiny/plotTree.R new file mode 100644 index 0000000..1bc9314 --- /dev/null +++ b/plotTreeShiny/plotTree.R @@ -0,0 +1,320 @@ +# read data and convert to data frame +readMatrix<-function(heatmapData){ +if (is.matrix(heatmapData)) { +x = data.frame(heatmapData) +} +else if (is.data.frame(heatmapData)) { +x = heatmapData +} +else { +x<-read.csv(heatmapData,row.names=1) +} +x +} + +getLayout<-function(infoFile,infoCols,heatmapData,barData,doBlocks,treeWidth=10,infoWidth=10,dataWidth=30,edgeWidth=1,labelHeight=10,mainHeight=100,barDataWidth=10,blockPlotWidth=10) { + +# m = layout matrix +# w = layout widths vector +# h = layout height vector + +# tree +w = c(edgeWidth,treeWidth) +m<-cbind(c(0,0,0),c(0,1,0)) # first two columns, edge + tree +x = 1 + +# info +if (!is.null(infoFile)) { # info is provided + +printCols = TRUE +if (!is.null(infoCols)) { +if (is.na(infoCols)) { +printCols = FALSE +}} + +if (printCols) { +x = x + 1 +m<-cbind(m,c(0,x,0)) +w = c(w,infoWidth) +} +} + +# heatmap +if (!is.null(heatmapData)) { +x = x + 1 +m<-cbind(m,c(x+1,x,0)) # add heatmap & labels +x = x + 2 +m[1,2] = x # add heatmap scale above tree +w = c(w,dataWidth) +} + +# barplot +if (!is.null(barData)) { +x = x + 1 +m<-cbind(m,c(0,x,x+1)) # barplot and scale bar +x = x + 1 +w = c(w,barDataWidth) +} + +if (doBlocks) { +x = x + 1 +m<-cbind(m,c(0,x,0)) # recomb blocks +w = c(w,blockPlotWidth) +} + +# empty edge column +m<-cbind(m,c(0,0,0)) +w = c(w,edgeWidth) + +if (!is.null(heatmapData) | !is.null(barData)) { h = c(labelHeight,mainHeight,labelHeight) } +else { h = c(edgeWidth,mainHeight,edgeWidth) } + +return(list(m=as.matrix(m),w=w,h=h)) +} + + +plotTree<-function(tree,heatmapData=NULL,barData=NULL,infoFile=NULL,blockFile=NULL,snpFile=NULL,gapChar="?",genome_size=5E6,blwd=5,block_colour="black",snp_colour="red",genome_offset=0,colourNodesBy=NULL,infoCols=NULL,outputPDF=NULL,outputPNG=NULL,w,h,heatmap.colours=rev(gray(seq(0,1,0.1))),tip.labels=F,tipLabelSize=1,offset=0,tip.colour.cex=0.5,legend=T,legend.pos="bottomleft",ancestral.reconstruction=F,cluster=NULL,tipColours=NULL,lwd=1.5,axis=F,axisPos=3,edge.color="black",infoCex=0.8,colLabelCex=0.8,treeWidth=10,infoWidth=10,dataWidth=30,edgeWidth=1,labelHeight=10,mainHeight=100,barDataWidth=10,blockPlotWidth=10,barDataCol=2,heatmapBreaks=NULL,heatmapDecimalPlaces=1,vlines.heatmap=NULL,vlines.heatmap.col=2,heatmap.blocks=NULL,pie.cex=0.5) { + +require(ape) + +# PREPARE TREE AND GET TIP ORDER +if (is.character(tree)){ +t<-read.tree(tree) +} +else t<-tree +tl<-ladderize(t) +tips<-tl$edge[,2] +tip.order<-tips[tips<=length(tl$tip.label)] +tip.label.order<-tl$tip.label[tip.order] # for ordering data. note that for tiplabel(), the order is the same as in t$tip (= tl$tip) + + +# PREPARE HEATMAP DATA +if (!is.null(heatmapData)) { + +# read heatmap data and convert to data frame +x<-readMatrix(heatmapData) + +# order rows of heatmap matrix to match tree +y.ordered<-x[tip.label.order,] + +# reorder columns? +if (!is.null(cluster)) { +if (!(cluster==FALSE)) { + +if (cluster=="square" & ncol(y.ordered)==nrow(y.ordered)) { +# order columns to match row order +original_order<-1:nrow(x) +names(original_order)<-rownames(x) +reordered<-original_order[tip.label.order] +y.ordered<-y.ordered[,rev(as.numeric(reordered))] +} + +else { +# cluster columns +if (cluster==TRUE) {cluster="ward"} # set default clustering algorithm +h<-hclust(dist(t(na.omit(y.ordered))),cluster) +y.ordered<-y.ordered[,h$order] +} + +}} # finished reordering columns + +} # finished setting up heatmap data + + +# PREPARE BAR PLOT +if (!is.null(barData)) { +b<-readMatrix(barData) +barData<-b[,1] +names(barData)<-rownames(b) +} + +# PREPARE INFO TO PRINT +if (!is.null(infoFile)) { +info<-readMatrix(infoFile) +info.ordered<-info[rev(tip.label.order),] +} +else {info.ordered=NULL} + + +# PREPARE DISCRETE TRAIT FOR COLOURING NODES AND INFERRING ANCESTRAL STATES +ancestral=NULL +nodeColourSuccess=NULL +if (!is.null(colourNodesBy) & !is.null(infoFile)) { + +if (colourNodesBy %in% colnames(info.ordered)) { +nodeColourSuccess = TRUE +loc1<-info.ordered[,which(colnames(info.ordered)==colourNodesBy)] + +# assign values +tipLabelSet <- character(length(loc1)) +names(tipLabelSet) <- rownames(info.ordered) +groups<-table(loc1,exclude="") +n<-length(groups) +groupNames<-names(groups) + +# set colours +if (is.null(tipColours)){ colours<-rainbow(n) } +else{ colours<-tipColours } + +# assign colours based on values +for (i in 1:n) { +g<-groupNames[i] +tipLabelSet[loc1==g]<-colours[i] +} +tipLabelSet <- tipLabelSet[tl$tip] + +# ancestral reconstruction +if (ancestral.reconstruction) { ancestral<-ace(loc1,tl,type="discrete") } + +}} +# finished with trait labels and ancestral reconstruction + + +# OPEN EXTERNAL DEVICE FOR DRAWING +# open PDF for drawing +if (!is.null(outputPDF)) { +pdf(width=w,height=h,file=outputPDF) +} +# open PNG for drawing +if (!is.null(outputPNG)) { +png(width=w,height=h,file=outputPNG) +} + + +# SET UP LAYOUT FOR PLOTTING +doBlocks <- (!is.null(blockFile) | !is.null(snpFile)) +l <- getLayout(infoFile,infoCols,heatmapData,barData,doBlocks,treeWidth=treeWidth,infoWidth=infoWidth,dataWidth=dataWidth,edgeWidth=edgeWidth,labelHeight=labelHeight,mainHeight=mainHeight,barDataWidth=barDataWidth,blockPlotWidth=blockPlotWidth) +layout(l$m, widths=l$w, heights=l$h) + + +# PLOT TREE +par(mar=rep(0,4)) +tlp<-plot.phylo(tl,no.margin=T,show.tip.label=tip.labels,label.offset=offset,edge.width=lwd,edge.color=edge.color,xaxs="i", yaxs="i", y.lim=c(0.5,length(tl$tip)+0.5),cex=tipLabelSize) + +# colour by trait +if (!is.null(nodeColourSuccess)) { +tiplabels(col= tipLabelSet,pch=16,cex=tip.colour.cex) +if (ancestral.reconstruction) { nodelabels(pie=ancestral$lik.anc, cex=pie.cex, piecol=colours) } +if (legend) { legend(legend.pos,legend=groupNames,fill=colours) } +} + +if (axis) { axisPhylo(axisPos) } + +# PLOT INFO +if (!is.null(infoFile)) { # info is provided + +printCols = TRUE +if (!is.null(infoCols)) { +if (is.na(infoCols)) { +printCols = FALSE +}} + +if (printCols) { + +par(mar=rep(0,4)) + +if (!is.null(infoCols)) {infoColNumbers = which(colnames(info.ordered) %in% infoCols)} +else { infoColNumbers = 1:ncol(info.ordered)} + +plot(NA,axes=F,pch="",xlim=c(0,length(infoColNumbers)+1.5),ylim=c(0.5,length(tl$tip)+0.5),xaxs="i",yaxs="i") + +# plot all info columns +for (i in 1:length(infoColNumbers)) { +j<-infoColNumbers[i] +text(x=rep(i+1,nrow(info.ordered)+1),y=c((nrow(info.ordered)):1),info.ordered[,j],cex=infoCex) +} + +} +} + + +# PLOT HEATMAP +if (!is.null(heatmapData)) { + +if (is.null(heatmapBreaks)) { heatmapBreaks = seq(min(y.ordered,na.rm=T),max(y.ordered,na.rm=T),length.out=length(heatmap.colours)+1) } + +# plot heatmap +par(mar=rep(0,4), xpd=TRUE) +image((1:ncol(y.ordered))-0.5,(1:nrow(y.ordered))-0.5, as.matrix(t(y.ordered)),col=heatmap.colours,breaks=heatmapBreaks,axes=F,xaxs="i", yaxs="i", xlab="",ylab="") + +# draw vertical lines over heatmap +if (!is.null(vlines.heatmap)) { +for (v in vlines.heatmap) {abline(v=v, col=vlines.heatmap.col)} +} + +# overlay blocks on heatmap +if (!is.null(heatmap.blocks)) { +for (coords in heatmap.blocks) {rect(xleft=coords[1], 0, coords[2], ncol(y.ordered), col=vlines.heatmap.col, border=NA)} +} + + +# data labels for heatmap +par(mar=rep(0,4)) +plot(NA, axes=F, xaxs="i", yaxs="i", ylim=c(0,2), xlim=c(0.5,ncol(y.ordered)+0.5)) +text(1:ncol(y.ordered)-0.5,rep(0,ncol(x)),colnames(y.ordered), srt=90, cex=colLabelCex, pos=4) + +# scale for heatmap +par(mar=c(2,0,0,2)) +#image(as.matrix(seq(min(y.ordered,na.rm=T),max(y.ordered,na.rm=T),length.out=length(heatmap.colours)+1)),col=heatmap.colours,yaxt="n",xlim=c(min(y.ordered,na.rm=T),max(y.ordered,na.rm=T))) +image(as.matrix(seq(min(y.ordered,na.rm=T),max(y.ordered,na.rm=T),length.out=length(heatmap.colours)+1)),col=heatmap.colours,yaxt="n",breaks=heatmapBreaks,axes=F) +axis(1,at=heatmapBreaks[-length(heatmapBreaks)]/max(y.ordered,na.rm=T),labels=round(heatmapBreaks[-length(heatmapBreaks)],heatmapDecimalPlaces)) +} + +# BARPLOT +if (!is.null(barData)) { +par(mar=rep(0,4)) +barplot(barData[tip.label.order], horiz=T, axes=F, xaxs="i", yaxs="i", xlab="", ylab="", ylim=c(0.25,length(barData)+0.25),xlim=c((-1)*max(barData,na.rm=T)/20,max(barData,na.rm=T)),col=barDataCol,border=0,width=0.5,space=1,names.arg=NA) + +# scale for barData plot +par(mar=c(2,0,0,0)) +plot(NA, yaxt="n", xaxs="i", yaxs="i", xlab="", ylab="", ylim=c(0,2), xlim=c((-1)*max(barData,na.rm=T)/20,max(barData,na.rm=T)),frame.plot=F) +} + +# SNPS AND RECOMBINATION BLOCKS +if (doBlocks) { +par(mar=rep(0,4)) +plot(NA,axes=F,pch="",xlim=c(genome_offset,genome_offset+genome_size+1.5),ylim=c(0.5,length(tl$tip)+0.5),xaxs="i",yaxs="i") # blank plotting area + +# plot snps +if (!is.null(snpFile)) { +snps<-read.csv(snpFile,header=F,row.names=1) # in case colnames start with numbers or contain dashes, which R does not like as column headers +snps_strainCols <- snps[1,] # column names = strain names +snps<-snps[-1,] # drop strain names + +for (strain in tip.label.order){ +# print SNPs compared to ancestral alleles in column 1 +s<-rownames(snps)[(as.character(snps[,1]) != as.character(snps[,which(snps_strainCols==strain)])) & (as.character(snps[,which(snps_strainCols==strain)])!=gapChar) & (as.character(snps[,1])!=gapChar)] +y <- which(tip.label.order==strain) +if (length(s)>0) { +for (x in s) { +points(x,y,pch="|",col=snp_colour,cex=0.25) +} +} +} +} + +# plot blocks +if (!is.null(blockFile)){ +blocks<-read.delim(blockFile,header=F) +for (i in 1:nrow(blocks)) { +if (as.character(blocks[i,1]) %in% tip.label.order) { +y <- which(tip.label.order==as.character(blocks[i,1])) +x1 <- blocks[i,2] +x2 <- blocks[i,3] +lines(c(x1,x2),c(y,y),lwd=blwd,lend=2,col=block_colour) +} +} +} + +} # finished with SNPs and recomb blocks + +# CLOSE EXTERNAL DRAWING DEVICE +if (!is.null(outputPDF) | !is.null(outputPNG)) { +dev.off() +} + +# RETURN ordered info and ancestral reconstruction object +if (!is.null(heatmapData)){mat=as.matrix(t(y.ordered))} +else {mat=NULL} +return(list(info=info.ordered,anc=ancestral,mat=mat,strain_order=tip.label.order)) +} diff --git a/plotTreeShiny/server.R b/plotTreeShiny/server.R new file mode 100644 index 0000000..d4d84d0 --- /dev/null +++ b/plotTreeShiny/server.R @@ -0,0 +1,90 @@ +library(shiny) +library(ape) +source("plotTree.R") + +shinyServer( function(input, output, session) { + + # An event observer for changes to INFO CSV file + observeEvent(input$infoFile, + { + # read the CSV file and get the column names. + # re-reading this file repeatedly is inefficient + df = read.table(input$infoFile$datapath, header=TRUE, sep=',') + # build a list of values, this is what is required by update methods + info_cols = list() + for (v in colnames(df)) { + info_cols[v] = v + } + # update the two input widgets using the column names + updateSelectInput(session, inputId='colour_tips_by', choices=c('NA',info_cols)) + updateSelectInput(session, inputId='print_column', choices=info_cols) + } + ) + + output$Tree <- renderPlot({ + + input$drawButton == 0 + + ### ALL VARIABLES PULLED FROM 'input' GO INSIDE HERE + isolate ( { + + treeFile <- input$tree$datapath + + # metadata variables + infoFile <- input$infoFile + tip_size <- input$tip_size + colour_tips_by <- input$colour_tips_by + print_column <- input$print_column + + # heatmap variables + heatmapFile <- input$heatmapFile + cluster <- input$clustering + heat_start_col <- input$start_col + heat_middle_col <- input$middle_col + heat_end_col <- input$end_col + heatmap_breaks <- as.integer(input$heatmap_breaks) + + # bar plot variables + barFile <- input$barFile + barPlotColour <- input$barPlotColour + + + # TRACK DATA TYPES TO PLOT + chk_info <- input$chk_info + chk_heatmap <- input$chk_heatmap + chk_barPlot <- input$chk_barPlot + + if (is.null(treeFile)) + return(NULL) + + if (!chk_info) { infoFile <- NULL } + else { infoFile <- infoFile$datapath } + + if (!chk_heatmap) { heatmapFile <- NULL } + else { heatmapFile <- heatmapFile$datapath } + + if (!chk_barPlot) { barFile <- NULL } + else { barFile <- barFile$datapath } + + + }) # end isolate + + + ### PLOT THE TREE + + # main plotting function + doPlotTree <-function() { + + # underlying call to plotTree(), drawn to screen and to file + plotTree(tree=treeFile, + infoFile=infoFile, infoCols=print_column, + colourNodesBy=colour_tips_by, tip.colour.cex=tip_size, + heatmapData=heatmapFile, cluster=cluster, barData=barFile, barDataCol=barPlotColour, + heatmap.colours=colorRampPalette(c(heat_start_col,heat_middle_col,heat_end_col),space="rgb")(heatmap_breaks)) + } + + doPlotTree() + + }) # end render plot + +}) # shinyServer diff --git a/plotTreeShiny/ui.R b/plotTreeShiny/ui.R new file mode 100644 index 0000000..6d976a0 --- /dev/null +++ b/plotTreeShiny/ui.R @@ -0,0 +1,70 @@ +library(shiny) +library(ape) +library(RLumShiny) +shinyUI(fluidPage( + titlePanel("Plot tree"), + sidebarLayout( + sidebarPanel( + + ### UPLOAD TREE + fileInput('tree', 'Upload tree file (nwk)', multiple=F, + accept=c('biotree/newick','.nwk', '.tree')), + + ### METADATA (info file) + checkboxInput("chk_info", "Metadata"), + + # OPTIONS TO DISPLAY IF METADATA CHECKED + conditionalPanel( + condition = "input.chk_info", + fileInput('infoFile', 'Upload metadata (CSV)'), + selectInput('print_column', 'Metadata columns to print:', c(''), multiple=TRUE), + selectInput('colour_tips_by', 'Colour tips by:', c('')), + sliderInput("tip_size", label = "Tip size", min = 0.1, max = 20, value = 0.5) + ), # finished metadata options + + ### HEATMAP DATA + checkboxInput("chk_heatmap", "Heatmap data", value=FALSE), + + # OPTIONS TO DISPLAY IF HEATMAP CHECKED + conditionalPanel( + condition = "input.chk_heatmap", + + fileInput('heatmapFile', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')), + selectInput("clustering", label = h5("Clustering:"), + choices = list("Select..."=F, "Cluster columns by values"=T, "Square matrix"="square"), + selected = "Select"), + + # OPTIONALLY DISPLAY COLOUR OPTIONS + checkboxInput("heatColoursPrompt", "Change heatmap colours", value=FALSE), + conditionalPanel( + condition = "input.heatColoursPrompt", h5("Heatmap colour ramp:"), + jscolorInput(inputId="start_col", label="Start colour:", value="FFFFFF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + jscolorInput(inputId="middle_col", label="Middle colour:", value="FFF94D", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + jscolorInput(inputId="end_col", label="End colour:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + textInput("heatmap_breaks", label = "Breaks:", value = "100") + ) + ), # finished heatmap options + + # BAR PLOT DATA + checkboxInput("chk_barPlot", "Bar plot data", value=FALSE), + + # OPTIONS TO DISPLAY IF BAR PLOT CHECKED + conditionalPanel( + condition="input.chk_barPlot", + fileInput("barFile", "Upload bar plot data file (CSV)", multiple=F, accept=c("text/csv", ".csv")), + selectInput("barPlotColour", label=h5("Bar plot colour:"), + choices=list("Black"=1, "Red"=2, "Green"=3, "Blue"=4, "Cyan"=5, "Magenta"=6, + "Yellow"=7, "Gray"=8), selected=1)), + + ### DRAW BUTTON + actionButton("drawButton", "Draw!") + + ), # finished sidebarPanel + + mainPanel( + plotOutput("Tree", height=800) + ) + + ) # finished sidebarLayout +) # fluidPage +) # shinyUI From 6c060170e1f0acb1ebdb59b72dd95ce50bb475e7 Mon Sep 17 00:00:00 2001 From: Areej Alsheikh Date: Sat, 25 Apr 2015 17:17:59 +1000 Subject: [PATCH 2/3] updated variables to follow underscore convention --- plotTreeShiny/plotTree.R | 6 +- plotTreeShiny/server.R | 151 ++++++++++++--------------------------- plotTreeShiny/ui.R | 98 +++++-------------------- 3 files changed, 65 insertions(+), 190 deletions(-) diff --git a/plotTreeShiny/plotTree.R b/plotTreeShiny/plotTree.R index df6d7c0..b208848 100644 --- a/plotTreeShiny/plotTree.R +++ b/plotTreeShiny/plotTree.R @@ -111,11 +111,9 @@ y.ordered<-y.ordered[,rev(as.numeric(reordered))] else { # cluster columns -<<<<<<< HEAD -if (cluster==TRUE) {cluster="ward"} # set default clustering algorithm -======= + if (cluster==TRUE) {cluster="ward.D2"} # set default clustering algorithm ->>>>>>> upstream/master + h<-hclust(dist(t(na.omit(y.ordered))),cluster) y.ordered<-y.ordered[,h$order] } diff --git a/plotTreeShiny/server.R b/plotTreeShiny/server.R index bd91fc0..e29f797 100644 --- a/plotTreeShiny/server.R +++ b/plotTreeShiny/server.R @@ -5,32 +5,19 @@ source("plotTree.R") shinyServer( function(input, output, session) { # An event observer for changes to INFO CSV file -<<<<<<< HEAD - observeEvent(input$infoFile, - { - # read the CSV file and get the column names. - # re-reading this file repeatedly is inefficient - df = read.table(input$infoFile$datapath, header=TRUE, sep=',') -======= observeEvent(input$info_file, { # read the CSV file and get the column names. # re-reading this file repeatedly is inefficient df = read.table(input$info_file$datapath, header=TRUE, sep=',') ->>>>>>> upstream/master + # build a list of values, this is what is required by update methods info_cols = list() for (v in colnames(df)) { info_cols[v] = v } # update the two input widgets using the column names -<<<<<<< HEAD - updateSelectInput(session, inputId='colour_tips_by', choices=c('NA',info_cols)) - updateSelectInput(session, inputId='print_column', choices=info_cols) - } - ) - -======= + updateSelectInput(session, inputId='colour_tips_by', choices=c('(none)',info_cols[-1])) updateSelectInput(session, inputId='print_column', choices=c(info_cols[-1])) @@ -40,7 +27,7 @@ shinyServer( function(input, output, session) { ) # An event observer for changes to HEATMAP file - observeEvent(input$heatmap, + observeEvent(input$heatmap_file, { # switch on the heatmap plotting option updateCheckboxInput(session, inputId='chk_heatmap', value=TRUE) @@ -48,7 +35,7 @@ shinyServer( function(input, output, session) { ) # An event observer for changes to BAR DATA file - observeEvent(input$barData, + observeEvent(input$bar_data_file, { # switch on the heatmap plotting option updateCheckboxInput(session, inputId='chk_barplot', value=TRUE) @@ -56,7 +43,7 @@ shinyServer( function(input, output, session) { ) # An event observer for changes to BLOCKS file - observeEvent(input$blockFile, + observeEvent(input$blocks_file, { # switch on the heatmap plotting option updateCheckboxInput(session, inputId='chk_blocks', value=TRUE) @@ -64,79 +51,38 @@ shinyServer( function(input, output, session) { ) # An event observer for changes to SNPs file - observeEvent(input$snpFile, + observeEvent(input$snps_file, { # switch on the heatmap plotting option updateCheckboxInput(session, inputId='chk_snps', value=TRUE) } ) ->>>>>>> upstream/master + output$Tree <- renderPlot({ - input$drawButton == 0 + input$draw_button == 0 ### ALL VARIABLES PULLED FROM 'input' GO INSIDE HERE isolate ( { -<<<<<<< HEAD - treeFile <- input$tree$datapath - - # metadata variables - infoFile <- input$infoFile - tip_size <- input$tip_size - colour_tips_by <- input$colour_tips_by - print_column <- input$print_column - - # heatmap variables - heatmapFile <- input$heatmapFile - cluster <- input$clustering - heat_start_col <- input$start_col - heat_middle_col <- input$middle_col - heat_end_col <- input$end_col - heatmap_breaks <- as.integer(input$heatmap_breaks) - - # bar plot variables - barFile <- input$barFile - barPlotColour <- input$barPlotColour - - - # TRACK DATA TYPES TO PLOT - chk_info <- input$chk_info - chk_heatmap <- input$chk_heatmap - chk_barPlot <- input$chk_barPlot - - if (is.null(treeFile)) - return(NULL) - - if (!chk_info) { infoFile <- NULL } - else { infoFile <- infoFile$datapath } - - if (!chk_heatmap) { heatmapFile <- NULL } - else { heatmapFile <- heatmapFile$datapath } - - if (!chk_barPlot) { barFile <- NULL } - else { barFile <- barFile$datapath } - - -======= l<-input$Layout t<-input$Tree i<-input$Info o<-input$Other d<-input$Data - treeFile <- input$tree$datapath + tree_file <- input$tree_file$datapath # tree plotting options label_tips <- input$label_tips tree_line_width <- as.integer(input$tree_line_width) branch_colour <- input$branch_colour - tipLabelSize <- as.integer(input$tipLabelSize) + tip_label_size <- as.integer(input$tip_label_size) offset <- as.integer(input$offset) # metadata variables - infoFile <- input$info_file$datapath + info_file <- input$info_file$datapath tip_size <- input$tip_size colour_tips_by <- input$colour_tips_by if (colour_tips_by == '(none)') {colour_tips_by <- NULL} @@ -149,10 +95,10 @@ shinyServer( function(input, output, session) { if (!print_metadata) { print_column <- NA } # heatmap variables - heatmapFile <- input$heatmap$datapath + heatmap_file <- input$heatmap_file$datapath cluster <- input$clustering - heatmapDecimalPlaces <- as.integer(input$heatmapDecimalPlaces) - colLabelCex <- as.integer(input$colLabelCex) + heatmap_decimal_places <- as.integer(input$heatmap_decimal_places) + col_label_cex <- as.integer(input$col_label_cex) vlines_heatmap_col <-input$vlines_heatmap_col vlines_heatmap <- input$vlines_heatmap @@ -166,17 +112,17 @@ shinyServer( function(input, output, session) { # } # barplot variables - barDataFile <- input$barData$datapath - barDataCol <- input$barDataCol + bar_data_file <- input$bar_data_file$datapath + bar_data_col <- input$bar_data_col # block plot variables - blockFile <- input$blockFile$datapath - block_colour <- input$block_colour + blocks_file <- input$blocks_file$datapath + blocks_colour <- input$blocks_colour blwd <- input$blwd genome_size <- input$genome_size - snpFile <- input$snpFile$datapath - snp_colour <- input$snp_colour + snps_file <- input$snps_file$datapath + snps_colour <- input$snps_colour # Layout/spacing tree_width <- as.numeric(input$tree_width) @@ -190,29 +136,29 @@ shinyServer( function(input, output, session) { # TRACK DATA TYPES TO PLOT chk_heatmap <- input$chk_heatmap - info_data <- input$info_data + chk_info <- input$chk_info chk_barplot <- input$chk_barplot chk_blocks <- input$chk_blocks chk_snps <- input$chk_snps - if (is.null(treeFile)) { return(NULL) } + if (is.null(tree_file)) { return(NULL) } - if (!info_data) { infoFile <- NULL } - else { infoFile <- infoFile } + if (!chk_info) { info_file <- NULL } + else { info_file <- info_file } - if (!chk_heatmap) { heatmapFile <- NULL } - else { heatmapFile <- heatmapFile } + if (!chk_heatmap) { heatmap_file <- NULL } + else { heatmap_file <- heatmap_file } - if (!chk_barplot) { barDataFile <- NULL } - else { barDataFile <- barDataFile } + if (!chk_barplot) { bar_data_file <- NULL } + else { bar_data_file <- bar_data_file } - if (!chk_blocks) { blockFile <- NULL } - else { blockFile <- blockFile } + if (!chk_blocks) { blocks_file <- NULL } + else { blocks_file <- blocks_file } - if (!chk_snps) { snpFile <- NULL } - else { snpFile <- snpFile } + if (!chk_snps) { snps_file <- NULL } + else { snps_file <- snps_file } + ->>>>>>> upstream/master }) # end isolate @@ -222,41 +168,32 @@ shinyServer( function(input, output, session) { doPlotTree <-function() { # underlying call to plotTree(), drawn to screen and to file -<<<<<<< HEAD - plotTree(tree=treeFile, - infoFile=infoFile, infoCols=print_column, - colourNodesBy=colour_tips_by, tip.colour.cex=tip_size, - heatmapData=heatmapFile, cluster=cluster, barData=barFile, barDataCol=barPlotColour, - heatmap.colours=colorRampPalette(c(heat_start_col,heat_middle_col,heat_end_col),space="rgb")(heatmap_breaks)) -======= - plotTree(tree=treeFile, - tip.labels=label_tips, tipLabelSize=tipLabelSize, offset=offset, + + plotTree(tree=tree_file, + tip.labels=label_tips, tipLabelSize=tip_label_size, offset=offset, lwd=tree_line_width, edge.color=branch_colour, - infoFile=infoFile, infoCols=print_column, + infoFile=info_file, infoCols=print_column, colourNodesBy=colour_tips_by, tip.colour.cex=tip_size, ancestral.reconstruction=ancestral, pie.cex=pie_size, legend=legend, legend.pos=legend_pos, - heatmapData=heatmapFile, cluster=cluster, + heatmapData=heatmap_file, cluster=cluster, heatmap.colours=heatmap_colours, - heatmapDecimalPlaces=heatmapDecimalPlaces, colLabelCex=colLabelCex, + heatmapDecimalPlaces=heatmap_decimal_places, colLabelCex=col_label_cex, vlines.heatmap=vlines_heatmap, vlines.heatmap.col=vlines_heatmap_col, - barData=barDataFile, barDataCol=barDataCol, - blockFile=blockFile, block_colour=block_colour, blwd=blwd, + barData=bar_data_file, barDataCol=bar_data_col, + blockFile=blocks_file, block_colour=blocks_colour, blwd=blwd, genome_size=genome_size, - snpFile=snpFile, snp_colour=snp_colour, + snpFile=snps_file, snp_colour=snps_colour, treeWidth=tree_width, infoWidth=info_width, dataWidth=heatmap_width, barDataWidth=bar_width, blockPlotWidth=genome_width, mainHeight=main_height, labelHeight=label_height, edgeWidth=edge_width ) ->>>>>>> upstream/master + } doPlotTree() }) # end render plot -<<<<<<< HEAD -}) # shinyServer -======= }) # shinyServer ->>>>>>> upstream/master + diff --git a/plotTreeShiny/ui.R b/plotTreeShiny/ui.R index cd86c16..22f5ec8 100644 --- a/plotTreeShiny/ui.R +++ b/plotTreeShiny/ui.R @@ -2,65 +2,7 @@ library(shiny) library(ape) library(RLumShiny) shinyUI(fluidPage( -<<<<<<< HEAD - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - ### UPLOAD TREE - fileInput('tree', 'Upload tree file (nwk)', multiple=F, - accept=c('biotree/newick','.nwk', '.tree')), - - ### METADATA (info file) - checkboxInput("chk_info", "Metadata"), - - # OPTIONS TO DISPLAY IF METADATA CHECKED - conditionalPanel( - condition = "input.chk_info", - fileInput('infoFile', 'Upload metadata (CSV)'), - selectInput('print_column', 'Metadata columns to print:', c(''), multiple=TRUE), - selectInput('colour_tips_by', 'Colour tips by:', c('')), - sliderInput("tip_size", label = "Tip size", min = 0.1, max = 20, value = 0.5) - ), # finished metadata options - - ### HEATMAP DATA - checkboxInput("chk_heatmap", "Heatmap data", value=FALSE), - - # OPTIONS TO DISPLAY IF HEATMAP CHECKED - conditionalPanel( - condition = "input.chk_heatmap", - - fileInput('heatmapFile', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')), - selectInput("clustering", label = h5("Clustering:"), - choices = list("Select..."=F, "Cluster columns by values"=T, "Square matrix"="square"), - selected = "Select"), - - # OPTIONALLY DISPLAY COLOUR OPTIONS - checkboxInput("heatColoursPrompt", "Change heatmap colours", value=FALSE), - conditionalPanel( - condition = "input.heatColoursPrompt", h5("Heatmap colour ramp:"), - jscolorInput(inputId="start_col", label="Start colour:", value="FFFFFF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - jscolorInput(inputId="middle_col", label="Middle colour:", value="FFF94D", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - jscolorInput(inputId="end_col", label="End colour:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - textInput("heatmap_breaks", label = "Breaks:", value = "100") - ) - ), # finished heatmap options - - # BAR PLOT DATA - checkboxInput("chk_barPlot", "Bar plot data", value=FALSE), - - # OPTIONS TO DISPLAY IF BAR PLOT CHECKED - conditionalPanel( - condition="input.chk_barPlot", - fileInput("barFile", "Upload bar plot data file (CSV)", multiple=F, accept=c("text/csv", ".csv")), - selectInput("barPlotColour", label=h5("Bar plot colour:"), - choices=list("Black"=1, "Red"=2, "Green"=3, "Blue"=4, "Cyan"=5, "Magenta"=6, - "Yellow"=7, "Gray"=8), selected=1)), - ### DRAW BUTTON - actionButton("drawButton", "Draw!") - -======= #titlePanel("Plot tree"), sidebarLayout( sidebarPanel( @@ -71,13 +13,13 @@ shinyUI(fluidPage( ### UPLOAD TREE br(), - fileInput('tree', 'Upload tree file (nwk)', multiple=F, + fileInput('tree_file', 'Upload tree file (nwk)', multiple=F, accept=c('biotree/newick','.nwk', '.tree')), checkboxInput("label_tips", "Label tree tips?", value=FALSE), conditionalPanel( condition = "input.label_tips", - textInput("tipLabelSize", label = "Text size", value = "1"), + textInput("tip_label_size", label = "Text size", value = "1"), textInput("offset", label = "Offset", value = "0") ), @@ -91,9 +33,9 @@ shinyUI(fluidPage( ### METADATA (info file) br(), fileInput('info_file', 'Upload metadata (CSV)'), - checkboxInput('info_data', 'Use metadata', value = FALSE), + checkboxInput('chk_info', 'Use metadata', value = FALSE), conditionalPanel( - condition = "input.info_data", + condition = "input.chk_info", checkboxInput('print_metadata', 'Print columns', value = FALSE), conditionalPanel( condition = "input.print_metadata", @@ -123,7 +65,7 @@ shinyUI(fluidPage( ### HEATMAP DATA br(), - fileInput('heatmap', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')), + fileInput('heatmap_file', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')), checkboxInput('chk_heatmap', 'Plot heatmap', value = FALSE), conditionalPanel( @@ -134,9 +76,9 @@ shinyUI(fluidPage( "--------", # OPTIONALLY DISPLAY COLOUR OPTIONS - checkboxInput("heatColoursPrompt", "Change heatmap colour ramp", value=FALSE), + checkboxInput("heat_colours_prompt", "Change heatmap colour ramp", value=FALSE), conditionalPanel( - condition = "input.heatColoursPrompt", + condition = "input.heat_colours_prompt", jscolorInput(inputId="start_col", label="Start colour:", value="FFFFFF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), jscolorInput(inputId="middle_col", label="Middle colour:", value="FFF94D", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), jscolorInput(inputId="end_col", label="End colour:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), @@ -148,8 +90,8 @@ shinyUI(fluidPage( # textInput("heatmap_colour_vector", label = "R code (vector), e.g. rev(gray(seq(0,1,0.1)))", value = "") # ), "--------", - textInput("heatmapDecimalPlaces", label = "Decimal places to show in heatmap legend:", value = "1"), - textInput("colLabelCex", label = "Text size for column labels:", value = "0.75") + textInput("heatmap_decimal_places", label = "Decimal places to show in heatmap legend:", value = "1"), + textInput("col_label_cex", label = "Text size for column labels:", value = "0.75") # textInput("vlines_heatmap", label = "y-coordinates for vertical lines (e.g. c(2,5)):", value = ""), # jscolorInput(inputId="vlines_heatmap_col", label=h5("Colour for vertical lines:"), value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) ) @@ -160,25 +102,25 @@ shinyUI(fluidPage( tabPanel("Barplots", br(), # bar plots - fileInput('barData', 'Upload data for bar plots (CSV)', multiple = F, accept = c('text/csv', '.csv')), + fileInput('bar_data_file', 'Upload data for bar plots (CSV)', multiple = F, accept = c('text/csv', '.csv')), checkboxInput('chk_barplot', 'Plot bar graphs', value = FALSE), conditionalPanel( condition = "input.chk_barplot", h5("Barplot options"), - jscolorInput(inputId="barDataCol", label="Colour for barplots:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) + jscolorInput(inputId="bar_data_col", label="Colour for barplots:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) ) ), tabPanel("Genome blocks", br(), # genome blocks - fileInput('blockFile', 'Upload genome block coordinates', multiple = F, accept = c('text/tab', '.txt')), + fileInput('blocks_file', 'Upload genome block coordinates', multiple = F, accept = c('text/tab', '.txt')), checkboxInput('chk_blocks', 'Plot genome blocks', value = FALSE), conditionalPanel( condition = "input.chk_blocks", h5("Genome block plotting options"), textInput("genome_size", label = "Genome size (bp):", value = "5E6"), - jscolorInput(inputId="block_colour", label="Colour for blocks:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + jscolorInput(inputId="blocks_colour", label="Colour for blocks:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), sliderInput("blwd", label = "Block size", min = 0.1, max = 20, value = 5) ) ), @@ -186,13 +128,13 @@ shinyUI(fluidPage( tabPanel("SNPs", br(), # snps - fileInput('snpFile', 'Upload SNP allele table (CSV)', multiple = F, accept = c('text/csv', '.csv')), + fileInput('snps_file', 'Upload SNP allele table (CSV)', multiple = F, accept = c('text/csv', '.csv')), checkboxInput('chk_snps', 'Plot SNPs', value = FALSE), conditionalPanel( condition = "input.chk_snps", h5("SNP plotting options"), textInput("genome_size", label = "Genome size (bp):", value = "5E6"), # make this linked to previous conditional - jscolorInput(inputId="snp_colour", label="Colour for SNPs:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) + jscolorInput(inputId="snps_colour", label="Colour for SNPs:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) ) ) ) #finished other data subtabs @@ -219,11 +161,11 @@ shinyUI(fluidPage( ### DRAW BUTTON br(), - actionButton("drawButton", "Draw!") + actionButton("draw_button", "Draw!") # ADD PRINT BUTTON HERE ->>>>>>> upstream/master + ), # finished sidebarPanel mainPanel( @@ -232,8 +174,6 @@ shinyUI(fluidPage( ) # finished sidebarLayout ) # fluidPage -<<<<<<< HEAD -) # shinyUI -======= + ) # shinyUI ->>>>>>> upstream/master + From 52d894f11b8b9586e0687d3b171ac472fd6242e3 Mon Sep 17 00:00:00 2001 From: Areej Alsheikh Date: Sun, 26 Apr 2015 23:41:06 +1000 Subject: [PATCH 3/3] changed layout of parameters settings and main panel --- plotTreeShiny/server.R | 16 +- plotTreeShiny/ui.R | 444 +++++++++++++++++++++++++---------------- 2 files changed, 278 insertions(+), 182 deletions(-) diff --git a/plotTreeShiny/server.R b/plotTreeShiny/server.R index e29f797..4399408 100644 --- a/plotTreeShiny/server.R +++ b/plotTreeShiny/server.R @@ -19,10 +19,10 @@ shinyServer( function(input, output, session) { # update the two input widgets using the column names updateSelectInput(session, inputId='colour_tips_by', choices=c('(none)',info_cols[-1])) - updateSelectInput(session, inputId='print_column', choices=c(info_cols[-1])) + updateSelectInput(session, inputId='select_columns', choices=c(info_cols[-1])) # switch on the meta data plotting option - updateCheckboxInput(session, inputId='info_data', value=TRUE) + updateCheckboxInput(session, inputId='chk_data', value=TRUE) } ) @@ -68,9 +68,9 @@ shinyServer( function(input, output, session) { l<-input$Layout t<-input$Tree - i<-input$Info + i<-input$Metadata o<-input$Other - d<-input$Data + d<-input$Heatmap tree_file <- input$tree_file$datapath @@ -90,9 +90,9 @@ shinyServer( function(input, output, session) { pie_size <- input$pie_size legend <- input$legend legend_pos <- input$legend_pos - print_column <- input$print_column - print_metadata <- input$print_metadata - if (!print_metadata) { print_column <- NA } + select_columns <- input$select_columns + chk_print_metadata <- input$chk_print_metadata + if (!chk_print_metadata) { select_columns <- NA } # heatmap variables heatmap_file <- input$heatmap_file$datapath @@ -172,7 +172,7 @@ shinyServer( function(input, output, session) { plotTree(tree=tree_file, tip.labels=label_tips, tipLabelSize=tip_label_size, offset=offset, lwd=tree_line_width, edge.color=branch_colour, - infoFile=info_file, infoCols=print_column, + infoFile=info_file, infoCols=select_columns, colourNodesBy=colour_tips_by, tip.colour.cex=tip_size, ancestral.reconstruction=ancestral, pie.cex=pie_size, legend=legend, legend.pos=legend_pos, diff --git a/plotTreeShiny/ui.R b/plotTreeShiny/ui.R index 22f5ec8..43f0ce5 100644 --- a/plotTreeShiny/ui.R +++ b/plotTreeShiny/ui.R @@ -2,178 +2,274 @@ library(shiny) library(ape) library(RLumShiny) shinyUI(fluidPage( - - #titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - tabsetPanel( - - tabPanel("Tree", - - ### UPLOAD TREE - br(), - fileInput('tree_file', 'Upload tree file (nwk)', multiple=F, - accept=c('biotree/newick','.nwk', '.tree')), - - checkboxInput("label_tips", "Label tree tips?", value=FALSE), - conditionalPanel( - condition = "input.label_tips", - textInput("tip_label_size", label = "Text size", value = "1"), - textInput("offset", label = "Offset", value = "0") - ), - - textInput("tree_line_width", label = "Branch width", value = "1.5"), - jscolorInput(inputId="branch_colour", label="Branch colour:", value="#000000", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - br() - ), # finished tree tab - - tabPanel("Info", - - ### METADATA (info file) - br(), - fileInput('info_file', 'Upload metadata (CSV)'), - checkboxInput('chk_info', 'Use metadata', value = FALSE), - conditionalPanel( - condition = "input.chk_info", - checkboxInput('print_metadata', 'Print columns', value = FALSE), - conditionalPanel( - condition = "input.print_metadata", - selectInput('print_column', 'Metadata columns to print:', c(''), multiple=TRUE) - ), - "--------", - selectInput('colour_tips_by', 'Colour tips by:', c('')), - # options if colouring by tips - conditionalPanel( - condition = "input.colour_tips_by != '(none)'", - sliderInput("tip_size", label = "Tip size", min = 0.1, max = 20, value = 0.5), - ### COLOUR PANELS - checkboxInput("legend", "Legend for node colours?", value=TRUE), - selectInput("legend_pos", label = "Position for legend", - choices = list( "bottomleft"="bottomleft", "bottomright"="bottomright", - "top-left"="topleft", "topright"="topright") - ), - "--------", - checkboxInput("ancestral", "Ancestral state reconstruction?", value=FALSE), - sliderInput("pie_size", label = "Pie graph size", min = 0.1, max = 20, value = 0.5) - ) - ) - ), # finished metadata tab - - - tabPanel("Data", - - ### HEATMAP DATA - br(), - fileInput('heatmap_file', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')), - checkboxInput('chk_heatmap', 'Plot heatmap', value = FALSE), - - conditionalPanel( - condition = "input.chk_heatmap", h4("Heatmap options"), - selectInput("clustering", label = h5("Clustering:"), - choices = list("Select..."=F, "Cluster columns by values"=T, "Square matrix"="square"), - selected = "Select"), - "--------", - - # OPTIONALLY DISPLAY COLOUR OPTIONS - checkboxInput("heat_colours_prompt", "Change heatmap colour ramp", value=FALSE), - conditionalPanel( - condition = "input.heat_colours_prompt", - jscolorInput(inputId="start_col", label="Start colour:", value="FFFFFF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - jscolorInput(inputId="middle_col", label="Middle colour:", value="FFF94D", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - jscolorInput(inputId="end_col", label="End colour:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - textInput("heatmap_breaks", label = "Breaks:", value = "100") - ), - # checkboxInput("heatColoursSpecify", "Specify heatmap colours manually", value=FALSE), - # conditionalPanel( - # condition = "input.heatColoursSpecify", - # textInput("heatmap_colour_vector", label = "R code (vector), e.g. rev(gray(seq(0,1,0.1)))", value = "") - # ), - "--------", - textInput("heatmap_decimal_places", label = "Decimal places to show in heatmap legend:", value = "1"), - textInput("col_label_cex", label = "Text size for column labels:", value = "0.75") - # textInput("vlines_heatmap", label = "y-coordinates for vertical lines (e.g. c(2,5)):", value = ""), - # jscolorInput(inputId="vlines_heatmap_col", label=h5("Colour for vertical lines:"), value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) - ) - ), # finished heatmap options - - tabPanel("Other", - tabsetPanel( - tabPanel("Barplots", - br(), - # bar plots - fileInput('bar_data_file', 'Upload data for bar plots (CSV)', multiple = F, accept = c('text/csv', '.csv')), - checkboxInput('chk_barplot', 'Plot bar graphs', value = FALSE), - - conditionalPanel( - condition = "input.chk_barplot", h5("Barplot options"), - jscolorInput(inputId="bar_data_col", label="Colour for barplots:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) - ) - ), - - tabPanel("Genome blocks", - br(), - # genome blocks - fileInput('blocks_file', 'Upload genome block coordinates', multiple = F, accept = c('text/tab', '.txt')), - checkboxInput('chk_blocks', 'Plot genome blocks', value = FALSE), - - conditionalPanel( - condition = "input.chk_blocks", h5("Genome block plotting options"), - textInput("genome_size", label = "Genome size (bp):", value = "5E6"), - jscolorInput(inputId="blocks_colour", label="Colour for blocks:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), - sliderInput("blwd", label = "Block size", min = 0.1, max = 20, value = 5) - ) - ), - - tabPanel("SNPs", - br(), - # snps - fileInput('snps_file', 'Upload SNP allele table (CSV)', multiple = F, accept = c('text/csv', '.csv')), - checkboxInput('chk_snps', 'Plot SNPs', value = FALSE), - - conditionalPanel( - condition = "input.chk_snps", h5("SNP plotting options"), - textInput("genome_size", label = "Genome size (bp):", value = "5E6"), # make this linked to previous conditional - jscolorInput(inputId="snps_colour", label="Colour for SNPs:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) - ) - ) - ) #finished other data subtabs - ), # finished other data tab - - tabPanel("Layout", - br(), - h5("Relative widths"), - textInput("tree_width", label = "Tree", value = 10), - textInput("info_width", label = "Info columns", value = 10), - textInput("heatmap_width", label = "Heatmap", value = 30), - textInput("bar_width", label = "Bar plots", value = 10), - textInput("genome_width", label = "Genome data (blocks, SNPs)", value = 10), - br(), - h5("Relative heights"), - textInput("main_height", label = "Main panels", value = 100), - textInput("label_height", label = "Heatmap labels", value = 10), - br(), - h5("Borders"), - textInput("edge_width", label = "Border width/height", value = 1) - ) - - ), # finish tabpanel - - ### DRAW BUTTON - br(), - actionButton("draw_button", "Draw!") - - # ADD PRINT BUTTON HERE - - - ), # finished sidebarPanel - - mainPanel( - plotOutput("Tree", height=800) - ) - - ) # finished sidebarLayout + fluidRow( ## top row to holds all dynamic input + ## column to hold all tabset panel + column(12, tabsetPanel( + ## Tree tab + tabPanel("Tree", + ## UPLOAD TREE + ## start tree fluidRow + fluidRow( + ## column for uploading tree + column(6, wellPanel( + br(), + fileInput('tree_file', 'Upload tree file (nwk)', multiple=F, + accept=c('biotree/newick','.nwk', '.tree')), + ## checkbox to display tree parameters list + checkboxInput("show_tree_param_list", "Show/hide tree display settings.", value=FALSE) + )), ## finish column for tree upload + + conditionalPanel( + condition = "input.show_tree_param_list", + ## column to hold tree parameters list on the right-hand side + column(6, wellPanel( + + ## checkbox to label tree tips with strain IDs + checkboxInput("label_tips", "Label tree tips?", value=FALSE), + conditionalPanel( + condition = "input.label_tips", + textInput("tip_label_size", label = "Text size", value = "1"), + textInput("offset", label = "Offset", value = "0")), ## finish condition for tips label + + ## Options for user to input branch thickness and colour + textInput("tree_line_width", label = "Branch width", value = "1.5"), + jscolorInput(inputId="branch_colour", label="Branch colour:", value="#000000", + position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) + )) ## finish column for param list + ) ## finish show param list condition + ) ## finish tree fluidRow + ), # Finished tree tab + + ## Metadata tab + tabPanel("Metadata", + + ### UPLOAD METADATA (info file) + ## start metadata fluidRow + fluidRow( + ## column for uploading metadata + column(6, wellPanel( + br(), + fileInput('info_file', 'Upload metadata (CSV)'), + + ## checkbox for server.R to track that metadata is uploaded + checkboxInput('chk_info', 'Use metadata', value = FALSE), + + ## checkbox to display metadata parameters list + checkboxInput("show_info_param_list", "Show/hide metadata display settings.", value=FALSE) + )), ## finish column for metadata upload + + conditionalPanel( + condition = "input.chk_info", + conditionalPanel( + condition="input.show_info_param_list", + fluidRow( + ## column for part1 of parameters list + column(3, wellPanel( + h4("Metadata options"), + + ## checkbox for printing metadata as text + checkboxInput('chk_print_metadata', 'Print metadata as text', value = FALSE), + conditionalPanel( + condition = "input.chk_print_metadata", + selectInput('select_columns', 'Metadata to print:', c(''), multiple=TRUE) + ), ## finish condition for metadata printing as text + "--------", + selectInput('colour_tips_by', 'Colour tips by:', c('')) + )), ## finish column for part1 + + # options if colouring tips + conditionalPanel( + condition = "input.colour_tips_by != '(none)'", + + ## column for part2 of parameters list + column(3, wellPanel( + + ## slider for adjusting tip node size + sliderInput("tip_size", label = "Tip size", min = 0.1, max = 20, value = 0.5), + + ## checkbox to display legend for selected metadata + checkboxInput("legend", "Legend for node colours?", value=TRUE), + + ## menu-list for location of the legened on user screen + selectInput("legend_pos", label = "Position for legend", + choices = list( "bottomleft"="bottomleft", "bottomright"="bottomright", + "top-left"="topleft", "topright"="topright") + ), + "--------", + ## checkbox for ancestral state reconstruction + checkboxInput("ancestral", "Ancestral state reconstruction?", value=FALSE), + + ## slider for adjusting pie-chart size, plotted on tree nodes + sliderInput("pie_size", label = "Pie graph size", min = 0.1, max = 20, value = 0.5) + )) ## finish column for part2 + ) ## finish condition for tips colouring + ) ## finish fluidRow for params part1 and part2 + )) ## finish conditions for chk_info && show param list + ) ## finish metadata fluidRow + ), # Finished metadata tab + + + ## Heatmap tab + tabPanel("Heatmap", + + ### UPLOAD HEATMAP DATA + ## Start heatmap fluidrow + fluidRow( + ## column for heatmap upload + column(6, wellPanel( + br(), + fileInput('heatmap_file', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')), + + ## xheckbox for server.R to track that heatmap is uploaded + checkboxInput('chk_heatmap', 'Plot heatmap', value = FALSE), + + ## checkbox to display heatmap parameters list + checkboxInput("show_heatmap_param_list", "Show/hide heatmap display settings.", value=FALSE) + )), ## finish column for heatmap upload + + conditionalPanel( + condition = "input.chk_heatmap", + conditionalPanel( + condition="input.show_heatmap_param_list", + fluidRow( + ## column for part1 of parameters list + column(3, wellPanel( + h4("Heatmap options"), + selectInput("clustering", label = h5("Clustering:"), + choices = list("Select..."=F, "Cluster columns by values"=T, "Square matrix"="square"), + selected = "Select"), + + # checkboxInput("heatColoursSpecify", "Specify heatmap colours manually", value=FALSE), + # conditionalPanel( + # condition = "input.heatColoursSpecify", + # textInput("heatmap_colour_vector", label = "R code (vector), e.g. rev(gray(seq(0,1,0.1)))", value = "") + # ), + "--------", + textInput("heatmap_decimal_places", label = "Decimal places to show in heatmap legend:", value = "1"), + textInput("col_label_cex", label = "Text size for column labels:", value = "0.75") + # textInput("vlines_heatmap", label = "y-coordinates for vertical lines (e.g. c(2,5)):", value = ""), + # jscolorInput(inputId="vlines_heatmap_col", label=h5("Colour for vertical lines:"), value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) + )), ## finish column for part1 + + ## column for part2 of parameters list + column(3, wellPanel( + + # OPTIONALLY DISPLAY COLOUR OPTIONS + checkboxInput("heat_colours_prompt", "Change heatmap colour ramp", value=FALSE), + conditionalPanel( + condition = "input.heat_colours_prompt", + jscolorInput(inputId="start_col", label="Start colour:", value="FFFFFF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + jscolorInput(inputId="middle_col", label="Middle colour:", value="FFF94D", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + jscolorInput(inputId="end_col", label="End colour:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + textInput("heatmap_breaks", label = "Breaks:", value = "100") + ) ## finish condition for heatmap colours prompt + )) ## finish column for part2 + ) ## finish fluidrow for part1 and part2 + )) ## finish conditions for chk_heatmap && show param list + ) ## finish heatmap fluidRow + ), # finished heatmap tab + + tabPanel("Other", + ## start Others fluidRow + fluidRow( + ## column for others upload section + column(6, wellPanel( + tabsetPanel( + tabPanel("Barplots", + br(), + # bar plots file upload + fileInput('bar_data_file', 'Upload data for bar plots (CSV)', multiple = F, accept = c('text/csv', '.csv')), + + ## checkox for server.R to track bar plot file upload + checkboxInput('chk_barplot', 'Plot bar graphs', value = FALSE), + + conditionalPanel( + condition = "input.chk_barplot", h4("Barplot options"), + + ## options to of bar plot colour + jscolorInput(inputId="bar_data_col", label="Colour for barplots:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) + ) ## finish condition on file upload + ), ## finish barplot tab + + tabPanel("Genome blocks", + br(), + + fileInput('blocks_file', 'Upload genome block coordinates', multiple = F, accept = c('text/tab', '.txt')), + + ## checkbox for server.R to track bar genome blocks file upload + checkboxInput('chk_blocks', 'Plot genome blocks', value = FALSE), + + conditionalPanel( + condition = "input.chk_blocks", h4("Genome block plotting options"), + + ## parameters settings for plotting genome blocks + textInput("genome_size", label = "Genome size (bp):", value = "5E6"), + jscolorInput(inputId="blocks_colour", label="Colour for blocks:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T), + sliderInput("blwd", label = "Block size", min = 0.1, max = 20, value = 5) + ) ## finish conditions for chk_blocks + ), ## finish genome blocks tab + + tabPanel("SNPs", + br(), + # snps file upload + fileInput('snps_file', 'Upload SNP allele table (CSV)', multiple = F, accept = c('text/csv', '.csv')), + + ## checkox for server.R to track snps file upload + checkboxInput('chk_snps', 'Plot SNPs', value = FALSE), + + conditionalPanel( + condition = "input.chk_snps", h4("SNP plotting options"), + + ## parameters settings for plotting snps data + textInput("genome_size", label = "Genome size (bp):", value = "5E6"), # make this linked to previous conditional + jscolorInput(inputId="snps_colour", label="Colour for SNPs:", value="1755FF", position = "bottom", color = "transparent", mode = "HSV", slider = T, close = T) + ) + ) ## finish snps tab + ) #finished other data subtabs + )))), # finished other data tab + + tabPanel("Layout", + ## start layout fluidrow + fluidRow( + ## column for all 'layout' contents + column(6, wellPanel( + br(), + h5("Relative widths"), + + ## options for adjusting tree/data dimensions + textInput("tree_width", label = "Tree", value = 10), + textInput("info_width", label = "Info columns", value = 10), + textInput("heatmap_width", label = "Heatmap", value = 30), + textInput("bar_width", label = "Bar plots", value = 10), + textInput("genome_width", label = "Genome data (blocks, SNPs)", value = 10), + br(), + h5("Relative heights"), + textInput("main_height", label = "Main panels", value = 100), + textInput("label_height", label = "Heatmap labels", value = 10), + br(), + h5("Borders"), + textInput("edge_width", label = "Border width/height", value = 1) + )) ## finish column layout + ) ## finish layout fluidrow + ) ## finish Layout tab + + ) # finish tabsetPanel + ) # finish tabsetpanel column + ), # finish first fluidRow + + ### DRAW BUTTON in a separate fluidRow + fluidRow( + column(12, + actionButton("draw_button", "Draw!"))), + + ## ADD PRINT BUTTON HERE ## + + br(), + ## main panel for displaying tree/data in a separate fluidRow + fluidRow( + column(12, wellPanel( + plotOutput("Tree", height=800) + ))) + ) # fluidPage - -) # shinyUI - +) # shinyUI \ No newline at end of file