diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..715ad6e --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/INDEX \ No newline at end of file diff --git a/plotTreeShiny/.Rhistory b/plotTreeShiny/.Rhistory new file mode 100644 index 0000000..4b56293 --- /dev/null +++ b/plotTreeShiny/.Rhistory @@ -0,0 +1 @@ +setwd("G:/01_Research/Scripts/plotTree/plotTreeShiny") diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/build_options b/plotTreeShiny/.Rproj.user/ED8AE702/build_options new file mode 100644 index 0000000..8bdd3a3 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/build_options @@ -0,0 +1,4 @@ +auto_roxygenize_for_build_and_reload="0" +auto_roxygenize_for_build_package="1" +auto_roxygenize_for_check="1" +makefile_args="" diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/pcs/files-pane.pper b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/files-pane.pper new file mode 100644 index 0000000..ac3f7ee --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/files-pane.pper @@ -0,0 +1,9 @@ +{ + "path" : "G:/01_Research/Scripts/plotTree/plotTreeShiny", + "sortOrder" : [ + { + "ascending" : true, + "columnIndex" : 2 + } + ] +} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/pcs/source-pane.pper b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/source-pane.pper new file mode 100644 index 0000000..1743e40 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/source-pane.pper @@ -0,0 +1,3 @@ +{ + "activeTab" : 0 +} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/pcs/windowlayoutstate.pper b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/windowlayoutstate.pper new file mode 100644 index 0000000..b63d122 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/windowlayoutstate.pper @@ -0,0 +1,14 @@ +{ + "left" : { + "panelheight" : 998, + "splitterpos" : 420, + "topwindowstate" : "NORMAL", + "windowheight" : 1036 + }, + "right" : { + "panelheight" : 998, + "splitterpos" : 631, + "topwindowstate" : "NORMAL", + "windowheight" : 1036 + } +} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/pcs/workbench-pane.pper b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/workbench-pane.pper new file mode 100644 index 0000000..7135db5 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/pcs/workbench-pane.pper @@ -0,0 +1,4 @@ +{ + "TabSet1" : 0, + "TabSet2" : 0 +} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/saved_source_markers b/plotTreeShiny/.Rproj.user/ED8AE702/saved_source_markers new file mode 100644 index 0000000..2b1bef1 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/saved_source_markers @@ -0,0 +1 @@ +{"active_set":"","sets":[]} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/sdb/per/t/3C7EE37E b/plotTreeShiny/.Rproj.user/ED8AE702/sdb/per/t/3C7EE37E new file mode 100644 index 0000000..dcbe4e5 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/sdb/per/t/3C7EE37E @@ -0,0 +1,17 @@ +{ + "contents" : "library(shiny)\nlibrary(ape)\nlibrary(RLumShiny)\nsource(\"plotTree.R\")\n\n# Please run this application in an external web browser but not in the built-in browser of shiny\n# Files: bin\\app.R and bin\\plotTree.R\n# Use runApp(appDir = \"bin\") to execute this application\n\n#======================== User interface ========================\n\nui <- fluidPage(\n \n #titlePanel(\"Plot tree\"),\n sidebarLayout(\n sidebarPanel(\n tabsetPanel(\n tabPanel(\"Tree\", \n ### UPLOAD TREE\n br(),\n fileInput('tree_file', 'Upload tree file (nwk)', multiple = FALSE,\n accept = c('biotree/newick','.nwk', '.tree')),\n checkboxInput(\"label_tips\", \"Label tree tips?\", value = FALSE),\n conditionalPanel(\n condition = \"input.label_tips\",\n textInput(\"tip_label_size\", label = \"Text size\", value = \"1\"),\n textInput(\"offset\", label = \"Offset\", value = \"0\")\n ), \n textInput(\"tree_line_width\", label = \"Branch width\", value = \"1.5\"),\n jscolorInput(inputId = \"branch_colour\", label = \"Branch colour:\", value = \"#000000\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T),\n br()\n ), # finished tree tab\t\n \n tabPanel(\"Info\", \n ### METADATA (info file)\n br(),\n fileInput('info_file', 'Upload metadata (CSV)'),\n checkboxInput('chk_info', 'Use metadata', value = FALSE),\n conditionalPanel(\n condition = \"input.chk_info\",\n checkboxInput('print_metadata', 'Print columns', value = FALSE),\n conditionalPanel(\n condition = \"input.print_metadata\",\n selectInput('print_column', 'Metadata columns to print:', c(''), multiple=TRUE)\n ),\n \"--------\",\n selectInput('colour_tips_by', 'Colour tips by:', c('')),\n # options if colouring by tips\n conditionalPanel(\n condition = \"input.colour_tips_by != '(none)'\",\n sliderInput(\"tip_size\", label = \"Tip size\", min = 0.1, max = 20, value = 0.5),\n ### COLOUR PANELS\n checkboxInput(\"legend\", \"Legend for node colours?\", value=TRUE),\n selectInput(\"legend_pos\", label = \"Position for legend\", \n choices = list( \"bottomleft\"=\"bottomleft\", \"bottomright\"=\"bottomright\",\n \"top-left\"=\"topleft\", \"topright\"=\"topright\")\n ), \n \"--------\",\n checkboxInput(\"ancestral\", \"Ancestral state reconstruction?\", value=FALSE),\n sliderInput(\"pie_size\", label = \"Pie graph size\", min = 0.1, max = 20, value = 0.5)\n )\n )\n ),\t# finished metadata tab\t\n \n tabPanel(\"Data\", \n ### HEATMAP DATA\n br(),\n fileInput('heatmap_file', 'Upload heatmap file (CSV)', multiple = F, accept = c('text/csv', '.csv')),\n checkboxInput('chk_heatmap', 'Plot heatmap', value = FALSE), \n conditionalPanel(\n condition = \"input.chk_heatmap\", h4(\"Heatmap options\"),\n selectInput(\"clustering\", label = h5(\"Clustering:\"), \n choices = list(\"Select...\" = F, \"Cluster columns by values\" = T, \"Square matrix\"=\"square\"),\n selected = \"Select\"), \n \"--------\",\n # OPTIONALLY DISPLAY COLOUR OPTIONS\n checkboxInput(\"heat_colours_prompt\", \"Change heatmap colour ramp\", value = FALSE),\n conditionalPanel(\n condition = \"input.heat_colours_prompt\", \n jscolorInput(inputId = \"start_col\", label = \"Start colour:\", value = \"FFFFFF\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T),\n jscolorInput(inputId = \"middle_col\", label = \"Middle colour:\", value = \"FFF94D\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T),\n jscolorInput(inputId = \"end_col\", label = \"End colour:\", value = \"1755FF\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T),\n textInput(\"heatmap_breaks\", label = \"Breaks:\", value = \"100\")\n ),\n #\t\t\t\t\tcheckboxInput(\"heatColoursSpecify\", \"Specify heatmap colours manually\", value=FALSE),\n #\t\t\t\t\tconditionalPanel(\n #\t\t\t\t\t\tcondition = \"input.heatColoursSpecify\",\n #\t\t\t\t\t\ttextInput(\"heatmap_colour_vector\", label = \"R code (vector), e.g. rev(gray(seq(0,1,0.1)))\", value = \"\")\n #\t\t\t\t\t),\n \"--------\",\n textInput(\"heatmap_decimal_places\", label = \"Decimal places to show in heatmap legend:\", value = \"1\"),\n textInput(\"col_label_cex\", label = \"Text size for column labels:\", value = \"0.75\")\n #\t\t\t\t\ttextInput(\"vlines_heatmap\", label = \"y-coordinates for vertical lines (e.g. c(2,5)):\", value = \"\"),\n #\t\t\t\t\tjscolorInput(inputId=\"vlines_heatmap_col\", label=h5(\"Colour for vertical lines:\"), value=\"1755FF\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T)\n )\n ), # finished heatmap options\n \n tabPanel(\"Other\",\n tabsetPanel(\n tabPanel(\"Barplots\",\n br(),\n # bar plots\n fileInput('bar_data_file', 'Upload data for bar plots (CSV)', multiple = F, accept = c('text/csv', '.csv')),\n checkboxInput('chk_barplot', 'Plot bar graphs', value = FALSE),\n conditionalPanel(\n condition = \"input.chk_barplot\", h5(\"Barplot options\"),\n jscolorInput(inputId = \"bar_data_col\", label = \"Colour for barplots:\", value=\"1755FF\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T)\n )\n ),\n tabPanel(\"Genome blocks\",\n br(),\n # genome blocks\n fileInput('blocks_file', 'Upload genome block coordinates', multiple = F, accept = c('text/tab', '.txt')),\n checkboxInput('chk_blocks', 'Plot genome blocks', value = FALSE),\n conditionalPanel(\n condition = \"input.chk_blocks\", h5(\"Genome block plotting options\"),\n textInput(\"genome_size\", label = \"Genome size (bp):\", value = \"5E6\"),\n jscolorInput(inputId = \"blocks_colour\", label = \"Colour for blocks:\", value=\"1755FF\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T),\n sliderInput(\"blwd\", label = \"Block size\", min = 0.1, max = 20, value = 5)\n )\n ),\n \n tabPanel(\"SNPs\",\n br(),\n # snps\n fileInput('snps_file', 'Upload SNP allele table (CSV)', multiple = F, accept = c('text/csv', '.csv')),\n checkboxInput('chk_snps', 'Plot SNPs', value = FALSE),\n conditionalPanel(\n condition = \"input.chk_snps\", h5(\"SNP plotting options\"),\n textInput(\"genome_size\", label = \"Genome size (bp):\", value = \"5E6\"), # make this linked to previous conditional \n jscolorInput(inputId = \"snps_colour\", label = \"Colour for SNPs:\", value=\"1755FF\", position = \"bottom\", color = \"transparent\", mode = \"HSV\", slider = T, close = T)\n )\n )\n ) #finished tabsetPanels\n ), # finished other data tab\n \n tabPanel(\"Layout\",\n br(),\n h5(\"Relative widths\"),\n textInput(\"tree_width\", label = \"Tree\", value = 10),\n textInput(\"info_width\", label = \"Info columns\", value = 10),\n textInput(\"heatmap_width\", label = \"Heatmap\", value = 30),\n textInput(\"bar_width\", label = \"Bar plots\", value = 10),\n textInput(\"genome_width\", label = \"Genome data (blocks, SNPs)\", value = 10),\n br(),\n h5(\"Relative heights\"),\n textInput(\"main_height\", label = \"Main panels\", value = 100),\n textInput(\"label_height\", label = \"Heatmap labels\", value = 10),\n br(),\n h5(\"Borders\"),\n textInput(\"edge_width\", label = \"Border width/height\", value = 1)\n ),\n \n # Settings and the button for printing\n tabPanel(\"Save\",\n br(), # prints an empty line in the html file that is displayed as the UI\n radioButtons(inputId = \"format\", label = \"Download type:\",\n choices = c(\"PNG\" = \"png\", \"PDF\" = \"pdf\"), selected = \"png\"),\n sliderInput(inputId = \"w\", label = \"width (A4 = 210mm):\", min = 180, max = 1200, value = 210, width = '80%', ticks = FALSE),\n sliderInput(inputId = \"h\", label = \"height (A4 = 297mm):\", min = 180, max = 1200, value = 297, width = '80%', ticks = FALSE),\n textInput(\"file_name\", label = \"File name\", value = \"figure\"), # The default file name is \"figure\".\n downloadButton('downloadButton') # This will generate a new variable 'downloadbutton'\n ) # end of tabPanel \"Save\"\n ), # finish tabsetPanel\n \n ### DRAW BUTTON\n br(),\n actionButton(\"draw_button\", \"Draw!\")\n ), # end of the sidebarPanel\n \n mainPanel(\n plotOutput(\"Tree\", height = 800)\n )\n ) # finished sidebarLayout\n) # end of fluidPage and the ui\n\n#======================== Server =========================\n\nserver <- function(input, output, session) {\n \n # An event observer for changes to INFO CSV file\n observeEvent(input$info_file, \n {\n # read the CSV file and get the column names.\n # re-reading this file repeatedly is inefficient\n df <- read.table(input$info_file$datapath, header = TRUE, sep = ',')\n \n # build a list of values, this is what is required by update methods\n info_cols <- list()\n for (v in colnames(df)) {\n info_cols[v] <- v\n }\n # update the two input widgets using the column names\n \n updateSelectInput(session, inputId = 'colour_tips_by', choices=c('(none)',info_cols[-1]))\n updateSelectInput(session, inputId = 'print_column', choices=c(info_cols[-1]))\n \n # switch on the meta data plotting option\n updateCheckboxInput(session, inputId = 'info_data', value=TRUE)\n }) # end of observeEvent\n\n # An event observer for changes to HEATMAP file\n observeEvent(input$heatmap_file, \n {\n # switch on the heatmap plotting option\n updateCheckboxInput(session, inputId = 'chk_heatmap', value=TRUE)\n })\t\n \n # An event observer for changes to BAR DATA file\n observeEvent(input$bar_data_file, \n {\n # switch on the heatmap plotting option\n updateCheckboxInput(session, inputId = 'chk_barplot', value=TRUE)\n })\t\n \n # An event observer for changes to BLOCKS file\n observeEvent(input$blocks_file, \n {\n # switch on the heatmap plotting option\n updateCheckboxInput(session, inputId = 'chk_blocks', value=TRUE)\n })\t\n \n # An event observer for changes to SNPs file\n observeEvent(input$snps_file, \n {\n # switch on the heatmap plotting option\n updateCheckboxInput(session, inputId = 'chk_snps', value=TRUE)\n })\n \n ### PLOT THE TREE: defines the main plotting function which will be called by downloadHandler() as well\n doPlotTree <-function() {\n ### ALL VARIABLES PULLED FROM 'input' GO INSIDE HERE\n isolate ({\n \n l <- input$Layout\n t <- input$Tree\n i <- input$Info\n o <- input$Other\n d <- input$Data\n \n tree_file <- input$tree_file$datapath\n \n # tree plotting options\n label_tips <- input$label_tips\n tree_line_width <- as.integer(input$tree_line_width)\n branch_colour <- input$branch_colour\n tip_label_size <- as.integer(input$tip_label_size)\n offset <- as.integer(input$offset)\n \n # metadata variables\n info_file <- input$info_file$datapath\n tip_size <- input$tip_size\n colour_tips_by <- input$colour_tips_by\n if (colour_tips_by == '(none)') {colour_tips_by <- NULL}\n ancestral <- input$ancestral\n pie_size <- input$pie_size\n legend <- input$legend\n legend_pos <- input$legend_pos\n print_column <- input$print_column\n print_metadata <- input$print_metadata\n if (!print_metadata) { print_column <- NA }\n \n # heatmap variables\n heatmap_file <- input$heatmap_file$datapath\n cluster <- input$clustering\n heatmap_decimal_places <- as.integer(input$heatmap_decimal_places)\n col_label_cex <- as.integer(input$col_label_cex)\n vlines_heatmap_col <-input$vlines_heatmap_col\n vlines_heatmap <- input$vlines_heatmap\n \n # \theatColoursSpecify <- input$heatColoursSpecify\n \n #\t\t\tif (heatColoursSpecify) {\n #\t\t\t\theatmap_colours <- input$heatmap_colour_vector\n #\t\t\t}\n #\t\t\telse {\n heatmap_colours <- colorRampPalette(c(input$start_col,input$middle_col,input$end_col),space=\"rgb\")(as.integer(input$heatmap_breaks))\n #\t\t\t}\n \n # barplot variables\n bar_data_file <- input$bar_data_file$datapath\n bar_data_col <- input$bar_data_col\n \n # block plot variables\n blocks_file <- input$blocks_file$datapath\n blocks_colour <- input$blocks_colour\n blwd <- input$blwd\n genome_size <- input$genome_size\n \n snps_file <- input$snps_file$datapath\n snps_colour <- input$snps_colour\n \n # Layout/spacing\n tree_width <- as.numeric(input$tree_width)\n info_width <- as.numeric(input$info_width)\n heatmap_width <- as.numeric(input$heatmap_width)\n bar_width <- as.numeric(input$bar_width)\n genome_width <- as.numeric(input$genome_width)\n main_height <- as.numeric(input$main_height)\n label_height <- as.numeric(input$label_height)\n edge_width <- as.numeric(input$edge_width)\n \n # TRACK DATA TYPES TO PLOT\n chk_heatmap <- input$chk_heatmap\n chk_info <- input$chk_info\n chk_barplot <- input$chk_barplot\n chk_blocks <- input$chk_blocks\n chk_snps <- input$chk_snps\n \n if (is.null(tree_file)) { return(NULL) }\n \n if (!chk_info) { info_file <- NULL } \n else { info_file <- info_file }\n \n if (!chk_heatmap) { heatmap_file <- NULL } \n else { heatmap_file <- heatmap_file }\n \n if (!chk_barplot) { bar_data_file <- NULL } \n else { bar_data_file <- bar_data_file }\n \n if (!chk_blocks) { blocks_file <- NULL } \n else { blocks_file <- blocks_file }\n \n if (!chk_snps) { snps_file <- NULL } \n else { snps_file <- snps_file } \n \n }) # end isolate\n \n # underlying call to plotTree(), drawn to screen and to file\n plotTree(tree = tree_file, \n tip.labels = label_tips, tipLabelSize = tip_label_size, offset = offset,\n lwd = tree_line_width, edge.color = branch_colour,\n infoFile = info_file, infoCols = print_column, \n colourNodesBy = colour_tips_by, tip.colour.cex = tip_size, \n ancestral.reconstruction = ancestral, pie.cex = pie_size, \n legend = legend, legend.pos = legend_pos,\n heatmapData = heatmap_file, cluster = cluster,\n heatmap.colours = heatmap_colours,\n heatmapDecimalPlaces = heatmap_decimal_places, colLabelCex = col_label_cex,\n vlines.heatmap = vlines_heatmap, vlines.heatmap.col = vlines_heatmap_col,\n barData = bar_data_file, barDataCol = bar_data_col,\n blockFile = blocks_file, block_colour = blocks_colour, blwd = blwd,\n genome_size = genome_size,\n snpFile = snps_file, snp_colour = snps_colour,\n treeWidth = tree_width, infoWidth = info_width, dataWidth = heatmap_width,\n barDataWidth = bar_width, blockPlotWidth = genome_width, \n mainHeight = main_height, labelHeight = label_height, edgeWidth = edge_width\n ) \n }\n \n output$Tree <- renderPlot({\n input$draw_button # do not need to reset the draw_button value which increases by every click\n doPlotTree()\n }) # end render plot\n \n # downloads a high-definition plot of the input data\n # This function is called when the download button is clicked\n output$downloadButton <- downloadHandler(\n \n filename = function() {\n # This is the default file name displayed in the download box poped up after clicking the download button.\n # You can change the filename in the download box.\n f <- input$file_name\n if(input$format == \"pdf\"){\n return(paste(f, \".pdf\", sep = \"\"))\n } else {\n return(paste(f, \".png\", sep = \"\"))\n }\n },\n \n content = function(tmp) {\n # tmp: the file name of a non-existent temp file.\n if(input$format == \"pdf\"){\n MM2Inch <- 0.03937 # convert to millimetres to inches because the unit for pdf(..) is inch.\n pdf(tmp, width = as.numeric(input$w) * MM2Inch, height = as.numeric(input$w) * MM2Inch, paper = \"special\") \n # \"special\": the paper size is specified by the width and height; a4r: landscape orientation\n doPlotTree() # redraw the plot\n dev.off()\n } else {\n png(tmp, width = as.numeric(input$w), height = as.numeric(input$w), units = \"mm\", res = 72)\n # res: the resolution is set to 72 ppi\n doPlotTree() # redraw the plot\n dev.off()\n }\n }\n )\n} # end of the function server(..)\n\n#======================== Executes the whole script =========================\n\nshinyApp(ui = ui, server = server)", + "created" : 1442378666405.000, + "dirty" : false, + "encoding" : "UTF-8", + "folds" : "", + "hash" : "4000526187", + "id" : "3C7EE37E", + "lastKnownWriteTime" : 1435447656, + "path" : "G:/01_Research/Scripts/plotTree/plotTreeShiny/app.R", + "project_path" : "app.R", + "properties" : { + }, + "relative_order" : 1, + "source_on_save" : false, + "type" : "r_source" +} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/BB3849AE b/plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/BB3849AE new file mode 100644 index 0000000..7a73a41 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/BB3849AE @@ -0,0 +1,2 @@ +{ +} \ No newline at end of file diff --git a/plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/FA5A19B6 b/plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/FA5A19B6 new file mode 100644 index 0000000..7a73a41 --- /dev/null +++ b/plotTreeShiny/.Rproj.user/ED8AE702/sdb/prop/FA5A19B6 @@ -0,0 +1,2 @@ +{ +} \ No newline at end of file diff --git a/plotTreeShiny/app.R b/plotTreeShiny/app.R new file mode 100644 index 0000000..88862ce --- /dev/null +++ b/plotTreeShiny/app.R @@ -0,0 +1,391 @@ +library(shiny) +library(ape) +library(RLumShiny) +source("plotTree.R") + +# Please run this application in an external web browser but not in the built-in browser of shiny +# Files: bin\app.R and bin\plotTree.R +# Use runApp(appDir = "bin") to execute this application + +#======================== User interface ======================== + +ui <- fluidPage( + + #titlePanel("Plot tree"), + sidebarLayout( + sidebarPanel( + tabsetPanel( + tabPanel("Tree", + ### UPLOAD TREE + br(), + fileInput('tree_file', 'Upload tree file (nwk)', multiple = FALSE, + 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 tabsetPanels + ), # 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) + ), + + # Settings and the button for printing + tabPanel("Save", + br(), # prints an empty line in the html file that is displayed as the UI + radioButtons(inputId = "format", label = "Download type:", + choices = c("PNG" = "png", "PDF" = "pdf"), selected = "png"), + sliderInput(inputId = "w", label = "width (A4 = 210mm):", min = 180, max = 1200, value = 210, width = '80%', ticks = FALSE), + sliderInput(inputId = "h", label = "height (A4 = 297mm):", min = 180, max = 1200, value = 297, width = '80%', ticks = FALSE), + textInput("file_name", label = "File name", value = "figure"), # The default file name is "figure". + downloadButton('downloadButton') # This will generate a new variable 'downloadbutton' + ) # end of tabPanel "Save" + ), # finish tabsetPanel + + ### DRAW BUTTON + br(), + actionButton("draw_button", "Draw!") + ), # end of the sidebarPanel + + mainPanel( + plotOutput("Tree", height = 800) + ) + ) # finished sidebarLayout +) # end of fluidPage and the ui + +#======================== Server ========================= + +server <- function(input, output, session) { + + # An event observer for changes to INFO CSV file + 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 = ',') + + # 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('(none)',info_cols[-1])) + updateSelectInput(session, inputId = 'print_column', choices=c(info_cols[-1])) + + # switch on the meta data plotting option + updateCheckboxInput(session, inputId = 'info_data', value=TRUE) + }) # end of observeEvent + + # An event observer for changes to HEATMAP file + observeEvent(input$heatmap_file, + { + # switch on the heatmap plotting option + updateCheckboxInput(session, inputId = 'chk_heatmap', value=TRUE) + }) + + # An event observer for changes to BAR DATA file + observeEvent(input$bar_data_file, + { + # switch on the heatmap plotting option + updateCheckboxInput(session, inputId = 'chk_barplot', value=TRUE) + }) + + # An event observer for changes to BLOCKS file + observeEvent(input$blocks_file, + { + # switch on the heatmap plotting option + updateCheckboxInput(session, inputId = 'chk_blocks', value=TRUE) + }) + + # An event observer for changes to SNPs file + observeEvent(input$snps_file, + { + # switch on the heatmap plotting option + updateCheckboxInput(session, inputId = 'chk_snps', value=TRUE) + }) + + ### PLOT THE TREE: defines the main plotting function which will be called by downloadHandler() as well + doPlotTree <-function() { + ### ALL VARIABLES PULLED FROM 'input' GO INSIDE HERE + isolate ({ + + l <- input$Layout + t <- input$Tree + i <- input$Info + o <- input$Other + d <- input$Data + + 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 + tip_label_size <- as.integer(input$tip_label_size) + offset <- as.integer(input$offset) + + # metadata variables + 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} + ancestral <- input$ancestral + 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 } + + # heatmap variables + heatmap_file <- input$heatmap_file$datapath + cluster <- input$clustering + 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 + + # heatColoursSpecify <- input$heatColoursSpecify + + # if (heatColoursSpecify) { + # heatmap_colours <- input$heatmap_colour_vector + # } + # else { + heatmap_colours <- colorRampPalette(c(input$start_col,input$middle_col,input$end_col),space="rgb")(as.integer(input$heatmap_breaks)) + # } + + # barplot variables + bar_data_file <- input$bar_data_file$datapath + bar_data_col <- input$bar_data_col + + # block plot variables + blocks_file <- input$blocks_file$datapath + blocks_colour <- input$blocks_colour + blwd <- input$blwd + genome_size <- input$genome_size + + snps_file <- input$snps_file$datapath + snps_colour <- input$snps_colour + + # Layout/spacing + tree_width <- as.numeric(input$tree_width) + info_width <- as.numeric(input$info_width) + heatmap_width <- as.numeric(input$heatmap_width) + bar_width <- as.numeric(input$bar_width) + genome_width <- as.numeric(input$genome_width) + main_height <- as.numeric(input$main_height) + label_height <- as.numeric(input$label_height) + edge_width <- as.numeric(input$edge_width) + + # TRACK DATA TYPES TO PLOT + chk_heatmap <- input$chk_heatmap + chk_info <- input$chk_info + chk_barplot <- input$chk_barplot + chk_blocks <- input$chk_blocks + chk_snps <- input$chk_snps + + if (is.null(tree_file)) { return(NULL) } + + if (!chk_info) { info_file <- NULL } + else { info_file <- info_file } + + if (!chk_heatmap) { heatmap_file <- NULL } + else { heatmap_file <- heatmap_file } + + if (!chk_barplot) { bar_data_file <- NULL } + else { bar_data_file <- bar_data_file } + + if (!chk_blocks) { blocks_file <- NULL } + else { blocks_file <- blocks_file } + + if (!chk_snps) { snps_file <- NULL } + else { snps_file <- snps_file } + + }) # end isolate + + # underlying call to plotTree(), drawn to screen and to file + 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, + colourNodesBy = colour_tips_by, tip.colour.cex = tip_size, + ancestral.reconstruction = ancestral, pie.cex = pie_size, + legend = legend, legend.pos = legend_pos, + heatmapData = heatmap_file, cluster = cluster, + heatmap.colours = heatmap_colours, + heatmapDecimalPlaces = heatmap_decimal_places, colLabelCex = col_label_cex, + vlines.heatmap = vlines_heatmap, vlines.heatmap.col = vlines_heatmap_col, + barData = bar_data_file, barDataCol = bar_data_col, + blockFile = blocks_file, block_colour = blocks_colour, blwd = blwd, + genome_size = genome_size, + 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 + ) + } + + output$Tree <- renderPlot({ + input$draw_button # do not need to reset the draw_button value which increases by every click + doPlotTree() + }) # end render plot + + # downloads a high-definition plot of the input data + # This function is called when the download button is clicked + output$downloadButton <- downloadHandler( + + filename = function() { + # This is the default file name displayed in the download box poped up after clicking the download button. + # You can change the filename in the download box. + f <- input$file_name + if(input$format == "pdf"){ + return(paste(f, ".pdf", sep = "")) + } else { + return(paste(f, ".png", sep = "")) + } + }, + + content = function(tmp) { + # tmp: the file name of a non-existent temp file. + if(input$format == "pdf"){ + MM2Inch <- 0.03937 # convert to millimetres to inches because the unit for pdf(..) is inch. + pdf(tmp, width = as.numeric(input$w) * MM2Inch, height = as.numeric(input$w) * MM2Inch, paper = "special") + # "special": the paper size is specified by the width and height; a4r: landscape orientation + doPlotTree() # redraw the plot + dev.off() + } else { + png(tmp, width = as.numeric(input$w), height = as.numeric(input$w), units = "mm", res = 72) + # res: the resolution is set to 72 ppi + doPlotTree() # redraw the plot + dev.off() + } + } + ) +} # end of the function server(..) + +#======================== Executes the whole script ========================= + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/plotTreeShiny/checkHash.R b/plotTreeShiny/checkHash.R new file mode 100644 index 0000000..f3e9e3d --- /dev/null +++ b/plotTreeShiny/checkHash.R @@ -0,0 +1,15 @@ +checkHash <- function(s) { + # This function is designed to fix the problem of wrong colour paramters from the widget jscolorInput. + # colorRampPalette() of plotTree() uses col2rgb(), which takes strings like "#FFFFFF" but not "FFFFFF" as the input. + # therefore a '#' must be added to the beginnging of every initial input$*_col which does not contain the hash sign. + # However, the value picked up from the pop-up palette returns value starting from '#'. + # This disconsistancy between return values from the input box and the pop-up palette could be a bug of jscolorInput. + # FYI, errors of col2rgb: + # col2rgb("FFFFFF"): invalid color name 'FFFFFF' + # col2rgb("##FFFFFF"): invalid RGB specification + if (substring(s, 1, 1) != '#') { # for values from the input box of jscolorInput + return(paste('#', s, sep = '')) + } else { + return(s) # for values picked up from the pop-up palette + } +} \ No newline at end of file diff --git a/plotTreeShiny/plotTree.R b/plotTreeShiny/plotTree.R index f252869..991a191 100644 --- a/plotTreeShiny/plotTree.R +++ b/plotTreeShiny/plotTree.R @@ -73,31 +73,16 @@ return(list(m=as.matrix(m),w=w,h=h)) } -plotTree<-function(tree,ladderise=NULL,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) { +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, CHOOSE LADDERISATION OR NOT, AND GET TIP ORDER +# PREPARE TREE AND GET TIP ORDER if (is.character(tree)){ t<-read.tree(tree) } else t<-tree -if (is.null(ladderise)) -{ -tl<-t -} -else if (ladderise=="descending") -{ -tl<-ladderize(t, T) -} -else if (ladderise=="ascending") -{ -tl<-ladderize(t, F) -} -else if (!is.null(ladderise)) -{ -print("Ladderise option should be exactly 'ascending' or 'descending'. Any other command will raise this error. Leave option empty to order branches as per input 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) diff --git a/plotTreeShiny/plotTreeShiny.Rproj b/plotTreeShiny/plotTreeShiny.Rproj new file mode 100644 index 0000000..a6b0ae1 --- /dev/null +++ b/plotTreeShiny/plotTreeShiny.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Yes +SaveWorkspace: No +AlwaysSaveHistory: No + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plotTreeShiny/server.R b/plotTreeShiny/server.R deleted file mode 100644 index b39f094..0000000 --- a/plotTreeShiny/server.R +++ /dev/null @@ -1,192 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer( function(input, output, session) { - - # An event observer for changes to INFO CSV file - 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=',') - # 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('(none)',info_cols[-1])) - updateSelectInput(session, inputId='print_column', choices=c(info_cols[-1])) - - # switch on the meta data plotting option - updateCheckboxInput(session, inputId='info_data', value=TRUE) - } - ) - - # An event observer for changes to HEATMAP file - observeEvent(input$heatmap, - { - # switch on the heatmap plotting option - updateCheckboxInput(session, inputId='chk_heatmap', value=TRUE) - } - ) - - # An event observer for changes to BAR DATA file - observeEvent(input$barData, - { - # switch on the heatmap plotting option - updateCheckboxInput(session, inputId='chk_barplot', value=TRUE) - } - ) - - # An event observer for changes to BLOCKS file - observeEvent(input$blockFile, - { - # switch on the heatmap plotting option - updateCheckboxInput(session, inputId='chk_blocks', value=TRUE) - } - ) - - # An event observer for changes to SNPs file - observeEvent(input$snpFile, - { - # switch on the heatmap plotting option - updateCheckboxInput(session, inputId='chk_snps', value=TRUE) - } - ) - - output$Tree <- renderPlot({ - - input$drawButton == 0 - - ### ALL VARIABLES PULLED FROM 'input' GO INSIDE HERE - isolate ( { - - l<-input$Layout - t<-input$Tree - i<-input$Info - o<-input$Other - d<-input$Data - - treeFile <- input$tree$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) - offset <- as.integer(input$offset) - - # metadata variables - infoFile <- 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} - ancestral <- input$ancestral - 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 } - - # heatmap variables - heatmapFile <- input$heatmap$datapath - cluster <- input$clustering - heatmapDecimalPlaces <- as.integer(input$heatmapDecimalPlaces) - colLabelCex <- as.integer(input$colLabelCex) - vlines_heatmap_col <-input$vlines_heatmap_col - vlines_heatmap <- input$vlines_heatmap - -# heatColoursSpecify <- input$heatColoursSpecify - -# if (heatColoursSpecify) { -# heatmap_colours <- input$heatmap_colour_vector -# } -# else { - heatmap_colours <- colorRampPalette(c(input$start_col,input$middle_col,input$end_col),space="rgb")(as.integer(input$heatmap_breaks)) -# } - - # barplot variables - barDataFile <- input$barData$datapath - barDataCol <- input$barDataCol - - # block plot variables - blockFile <- input$blockFile$datapath - block_colour <- input$block_colour - blwd <- input$blwd - genome_size <- input$genome_size - - snpFile <- input$snpFile$datapath - snp_colour <- input$snp_colour - - # Layout/spacing - tree_width <- as.numeric(input$tree_width) - info_width <- as.numeric(input$info_width) - heatmap_width <- as.numeric(input$heatmap_width) - bar_width <- as.numeric(input$bar_width) - genome_width <- as.numeric(input$genome_width) - main_height <- as.numeric(input$main_height) - label_height <- as.numeric(input$label_height) - edge_width <- as.numeric(input$edge_width) - - # TRACK DATA TYPES TO PLOT - chk_heatmap <- input$chk_heatmap - info_data <- input$info_data - chk_barplot <- input$chk_barplot - chk_blocks <- input$chk_blocks - chk_snps <- input$chk_snps - - if (is.null(treeFile)) { return(NULL) } - - if (!info_data) { infoFile <- NULL } - else { infoFile <- infoFile } - - if (!chk_heatmap) { heatmapFile <- NULL } - else { heatmapFile <- heatmapFile } - - if (!chk_barplot) { barDataFile <- NULL } - else { barDataFile <- barDataFile } - - if (!chk_blocks) { blockFile <- NULL } - else { blockFile <- blockFile } - - if (!chk_snps) { snpFile <- NULL } - else { snpFile <- snpFile } - - }) # end isolate - - - ### PLOT THE TREE - - # main plotting function - doPlotTree <-function() { - - # underlying call to plotTree(), drawn to screen and to file - plotTree(tree=treeFile, - tip.labels=label_tips, tipLabelSize=tipLabelSize, offset=offset, - lwd=tree_line_width, edge.color=branch_colour, - infoFile=infoFile, 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, - heatmap.colours=heatmap_colours, - heatmapDecimalPlaces=heatmapDecimalPlaces, colLabelCex=colLabelCex, - vlines.heatmap=vlines_heatmap, vlines.heatmap.col=vlines_heatmap_col, - barData=barDataFile, barDataCol=barDataCol, - blockFile=blockFile, block_colour=block_colour, blwd=blwd, - genome_size=genome_size, - snpFile=snpFile, snp_colour=snp_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 - ) - } - - doPlotTree() - - }) # end render plot - -}) # shinyServer \ No newline at end of file diff --git a/plotTreeShiny/ui.R b/plotTreeShiny/ui.R deleted file mode 100644 index b360dd1..0000000 --- a/plotTreeShiny/ui.R +++ /dev/null @@ -1,175 +0,0 @@ -library(shiny) -library(ape) -library(RLumShiny) -shinyUI(fluidPage( - #titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - tabsetPanel( - - tabPanel("Tree", - - ### UPLOAD TREE - br(), - fileInput('tree', '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("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('info_data', 'Use metadata', value = FALSE), - conditionalPanel( - condition = "input.info_data", - 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', '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("heatColoursPrompt", "Change heatmap colour ramp", value=FALSE), - conditionalPanel( - condition = "input.heatColoursPrompt", - 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("heatmapDecimalPlaces", label = "Decimal places to show in heatmap legend:", value = "1"), - textInput("colLabelCex", 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('barData', '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) - ) - ), - - tabPanel("Genome blocks", - br(), - # genome blocks - fileInput('blockFile', '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), - sliderInput("blwd", label = "Block size", min = 0.1, max = 20, value = 5) - ) - ), - - tabPanel("SNPs", - br(), - # snps - fileInput('snpFile', '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) - ) - ) - ) #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("drawButton", "Draw!") - - # ADD PRINT BUTTON HERE - - ), # finished sidebarPanel - - mainPanel( - plotOutput("Tree", height=800) - ) - - ) # finished sidebarLayout -) # fluidPage -) # shinyUI \ No newline at end of file diff --git a/server_modified/server.R b/server_modified/server.R deleted file mode 100644 index 04847b6..0000000 --- a/server_modified/server.R +++ /dev/null @@ -1,27 +0,0 @@ -library(shiny) - -shinyServer( - - function(input, output, session) { - - # An event observer for changes to INFO CSV file - 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=',') - - # 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, 'highlight_column', choices=info_cols) - updateSelectInput(session, 'show_column', choices=info_cols) - } - ) - - } -) \ No newline at end of file diff --git a/server_modified/ui.R b/server_modified/ui.R deleted file mode 100644 index 1911c0a..0000000 --- a/server_modified/ui.R +++ /dev/null @@ -1,27 +0,0 @@ -library(shiny) - -shinyUI( - fluidPage( - titlePanel('tester'), - sidebarLayout( - sidebarPanel( - - fileInput('treeFile', 'Tree'), - - # Test widgets for selecting INFO CSV file and - # display column selection options. - checkboxInput("info_data", "Info Data"), - conditionalPanel( - condition = "input.info_data", - fileInput('info_file', 'Info CSV'), - selectInput('show_column', 'Show Columns', c(''), multiple=TRUE), - selectInput('highlight_column', 'Highlight By', c('')) - ), - - actionButton("update", "Update") - ), - - mainPanel() - ) - ) -) diff --git a/shiny_practice/print_statemtn.r b/shiny_practice/print_statemtn.r deleted file mode 100644 index 09e172d..0000000 --- a/shiny_practice/print_statemtn.r +++ /dev/null @@ -1,14 +0,0 @@ - sidebarPanel( - checkboxInput('returnDownload', 'Download figure?', FALSE), - conditionalPanel( - condition = "input.returnDownload == true", - radioButtons("download_type", "Download type:", - c("PDF" = "PDF", - "PNG" = "PNG")), - sliderInput(inputId="w", label = "width (A4=210mm):", min=60, max=600, value=210, width='80%', ticks=F), - sliderInput(inputId="h", label = "height (A4=297mm):", min=60, max=600, value=297, width='80%', ticks=F), - br(), - downloadLink('pdflink') - ), - actionButton("printButton", "Update print settings") - ), \ No newline at end of file diff --git a/shiny_practice/reactive/plot.pdf b/shiny_practice/reactive/plot.pdf deleted file mode 100644 index 7fb468c..0000000 Binary files a/shiny_practice/reactive/plot.pdf and /dev/null differ diff --git a/shiny_practice/reactive/plotTree.R b/shiny_practice/reactive/plotTree.R deleted file mode 100644 index 991a191..0000000 --- a/shiny_practice/reactive/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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.D2"} # 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/shiny_practice/reactive/server.R b/shiny_practice/reactive/server.R deleted file mode 100644 index ff072e6..0000000 --- a/shiny_practice/reactive/server.R +++ /dev/null @@ -1,80 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer(function(input, output, session) { - - tree <- input$tree - info <- input$info_file - heatmap <- input$heatmap - cluster <- input$clustering - colour_nodes <- input$colour_nodes - tip_size <- input$tip_size - - # heatmap colours - start_col <- input$start_col - middle_col <- input$middle_col - end_col <- input$end_col - heatmap_breaks <- as.integer(input$heatmap_breaks) - - highlight_column <- input$highlight_column - show_column <- input$show_column - - # track data types - chk_heatmap <- input$chk_heatmap - info_data <- input$info_data - - # An event observer for changes to INFO CSV file - 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=',') - - # 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='highlight_column', choices=info_cols) - updateSelectInput(session, inputId='show_column', choices=info_cols) - } - ) - - # we don't do anything if there's no tree file - if (is.null(treeFile)) { return(NULL) } - - # switch off metadata plotting if the box is unchecked - if (!info_data) { infoFile <- NULL } - else { infoFile <- info$datapath } - - # switch off heatmap plotting if the box is unchecked - if (!chk_heatmap) { heatmapFile <- NULL } - else { heatmapFile <- heatmap$datapath } - - # plotTree wrapping (to allow calling for plotting to screen or file) - doPlotTree <-function() { - plotTree(tree=tree$datapath, - infoFile=infoFile,colourNodesBy=highlight_column,tip.colour.cex=tip_size, - infoCols=show_column, - heatmapData=heatmapFile,cluster=cluster, - heatmap.colours=colorRampPalette(c(start_col,middle_col,end_col),space="rgb")(heatmap_breaks) - ) - } - - # PLOT THE TREE when button is pressed - - plot_tree <- F - plot_tree <- eventReactive(input$drawButton, function() { - plot_tree <- T - }) - - output$Tree <- renderPlot({ - if (!plot_tree) { return (NULL) } - doPlotTree() - plot_tree <- F - }) - -}) diff --git a/shiny_practice/reactive/ui.R b/shiny_practice/reactive/ui.R deleted file mode 100644 index 982b3bf..0000000 --- a/shiny_practice/reactive/ui.R +++ /dev/null @@ -1,48 +0,0 @@ -library(shiny) -library(ape) -library(RLumShiny) -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick','.nwk', '.tree')), - checkboxInput("info_data", "Info Data"), - conditionalPanel( - condition = "input.info_data", - fileInput('info_file', 'Info CSV'), - selectInput('show_column', 'Show Columns', c(''), multiple=TRUE), - selectInput('highlight_column', 'Highlight By', c('location')), - sliderInput("tip_size", label = h4("Tip size"), min = 0.1, - max = 20, value = 0.5) - ), - ### HEATMAP DATA - checkboxInput("chk_heatmap", "Heatmap file", value=FALSE), - - conditionalPanel( - condition = "input.chk_heatmap", "Heatmap", - fileInput('heatmap', 'Choose heatmap file', multiple = F, accept = c('text/csv', '.csv')), - - # HEATMAP OPTIONS - checkboxInput("optionsPrompt", "Check box if you wish to not use the default values.", value=FALSE), - conditionalPanel( - condition = "input.optionsPrompt", - selectInput("clustering", label = "Columns clustering:", - choices = list("Select"=F, "Cluster based on density"=T, "Cluster according to tree"="square"), selected = "Select"), - "Note: You can only cluster according to tree if your rows are equal to your tree tips. I.e. if you're viewing the dataset against itself.", - - 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") - ) - ), - actionButton("drawButton", "Draw!") - ), - - mainPanel( - plotOutput("Tree", height=800) - ) -) -) -) \ No newline at end of file diff --git a/shiny_practice/reactive_stable/plotTree.R b/shiny_practice/reactive_stable/plotTree.R deleted file mode 100644 index 991a191..0000000 --- a/shiny_practice/reactive_stable/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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.D2"} # 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/shiny_practice/reactive_stable/server.R b/shiny_practice/reactive_stable/server.R deleted file mode 100644 index 8f95db9..0000000 --- a/shiny_practice/reactive_stable/server.R +++ /dev/null @@ -1,132 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer(function(input, output, session) { - - tree <- eventReactive(input$drawButton, { - input$tree - }) - - info <- eventReactive(input$drawButton, { - input$info_file - }) - - heatmap <- eventReactive(input$drawButton, { - input$heatmap - }) - - cluster <- eventReactive(input$drawButton, { - input$clustering - }) - - colour_nodes <- eventReactive(input$drawButton, { - input$colour_nodes - }) - - tip_size <- eventReactive(input$drawButton, { - input$tip_size - }) - - - # heatmap colours - start_col <- eventReactive(input$drawButton, { - input$start_col - }) - middle_col <- eventReactive(input$drawButton, { - input$middle_col - }) - end_col <- eventReactive(input$drawButton, { - input$end_col - }) - heatmap_breaks <- eventReactive(input$drawButton, { - input$heatmap_breaks - }) - - - highlight_column <- eventReactive(input$drawButton, { - input$highlight_column - }) - - show_column <- eventReactive(input$drawButton, { - input$show_column - }) - - - # track data types - chk_heatmap <- eventReactive(input$drawButton, { - input$chk_heatmap - }) - - info_data <- eventReactive(input$drawButton, { - input$info_data - }) - - # An event observer for changes to INFO CSV file - 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=',') - - # 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='highlight_column', choices=info_cols) - updateSelectInput(session, inputId='show_column', choices=info_cols) - } - ) - - - output$Tree <- renderPlot({ - - highlight_column <- highlight_column() - show_column <- show_column() - treeFile <- tree() - infoFile <- info() - heatmapFile <- heatmap() - cluster <- cluster() - colour_nodes <- colour_nodes() - tip_size <- tip_size() - start_col <- start_col() - middle_col <- middle_col() - end_col <- end_col() - heatmap_breaks <- as.integer(heatmap_breaks()) - - chk_heatmap <- chk_heatmap() - info_data <- info_data() - - if (is.null(treeFile)) - return(NULL) - - if (!info_data) { - infoFile <- NULL - } - else { - infoFile <- infoFile$datapath - } - - if (!chk_heatmap) { - heatmapFile <- NULL - } else { - heatmapFile <- heatmapFile$datapath - } - - - doPlotTree <-function(){ - - plotTree(tree=treeFile$datapath,infoFile=infoFile, - heatmapData=heatmapFile,cluster=cluster,colourNodesBy=highlight_column, - infoCols=show_column, - tip.colour.cex=tip_size,heatmap.colours=colorRampPalette(c(start_col,middle_col,end_col),space="rgb")(heatmap_breaks)) - } - - doPlotTree() - - }) - -}) diff --git a/shiny_practice/reactive_stable/ui.R b/shiny_practice/reactive_stable/ui.R deleted file mode 100644 index 982b3bf..0000000 --- a/shiny_practice/reactive_stable/ui.R +++ /dev/null @@ -1,48 +0,0 @@ -library(shiny) -library(ape) -library(RLumShiny) -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick','.nwk', '.tree')), - checkboxInput("info_data", "Info Data"), - conditionalPanel( - condition = "input.info_data", - fileInput('info_file', 'Info CSV'), - selectInput('show_column', 'Show Columns', c(''), multiple=TRUE), - selectInput('highlight_column', 'Highlight By', c('location')), - sliderInput("tip_size", label = h4("Tip size"), min = 0.1, - max = 20, value = 0.5) - ), - ### HEATMAP DATA - checkboxInput("chk_heatmap", "Heatmap file", value=FALSE), - - conditionalPanel( - condition = "input.chk_heatmap", "Heatmap", - fileInput('heatmap', 'Choose heatmap file', multiple = F, accept = c('text/csv', '.csv')), - - # HEATMAP OPTIONS - checkboxInput("optionsPrompt", "Check box if you wish to not use the default values.", value=FALSE), - conditionalPanel( - condition = "input.optionsPrompt", - selectInput("clustering", label = "Columns clustering:", - choices = list("Select"=F, "Cluster based on density"=T, "Cluster according to tree"="square"), selected = "Select"), - "Note: You can only cluster according to tree if your rows are equal to your tree tips. I.e. if you're viewing the dataset against itself.", - - 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") - ) - ), - actionButton("drawButton", "Draw!") - ), - - mainPanel( - plotOutput("Tree", height=800) - ) -) -) -) \ No newline at end of file diff --git a/shiny_practice/runPlotTree.download/plotTree.R b/shiny_practice/runPlotTree.download/plotTree.R deleted file mode 100644 index 1bc9314..0000000 --- a/shiny_practice/runPlotTree.download/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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/shiny_practice/runPlotTree.download/server.R b/shiny_practice/runPlotTree.download/server.R deleted file mode 100644 index 3fac8d6..0000000 --- a/shiny_practice/runPlotTree.download/server.R +++ /dev/null @@ -1,51 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer(function(input, output) { - output$Tree <- renderPlot({ - - treeFile <- input$tree - infoFile <- input$info - heatmapFile <- input$heatmap - - if (is.null(treeFile)) - return(NULL) - - if(input$returnDownload){ -if(input$type == 'PDF'){ - pdf("plot.pdf", width=as.numeric(input$w*3.94), height=as.numeric(input$h*3.94)) - plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath,heatmapData=heatmapFile$datapath) - dev.off() - - output$pdflink <- downloadHandler( - filename <- "myplot.pdf", - content <- function(file) { - file.copy("plot.pdf", file) - }) -#} else if (input$type == "SVG"){ -#svg("myplot.svg", width=as.numeric(input$w*3.94), height=as.numeric(input$h*3.94)) -# plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath,heatmapData=heatmapFile$datapath) -# dev.off() -# output$pdflink <- downloadHandler( -# filename <- "myplot.svg", -# content <- function(file) { -# file.copy("plot.svg", file) -# }) -} else if (input$type == "PNG"){ -png("plot.png", width=as.numeric(input$w*3.94), height=as.numeric(input$h*3.94)) - plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath,heatmapData=heatmapFile$datapath) - dev.off() - output$pdflink <- downloadHandler( - filename <- "myplot.png", - content <- function(file) { - file.copy("plot.png", file) - }) -} else { -stop(paste("Unexpected type returned:", input$type)) -} - } -plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath,heatmapData=heatmapFile$datapath) - - }) -}) diff --git a/shiny_practice/runPlotTree.download/ui.R b/shiny_practice/runPlotTree.download/ui.R deleted file mode 100644 index 895e28f..0000000 --- a/shiny_practice/runPlotTree.download/ui.R +++ /dev/null @@ -1,38 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', - '.nwk', '.tree')), - - fileInput('info', 'Choose info file', multiple=F, - accept=c('text/csv', - '.csv')), - - fileInput('heatmap', 'Choose heatmap file', multiple=F, - accept=c('text/csv', - '.csv')), - checkboxInput('returnDownload', 'download?', FALSE), - conditionalPanel( - condition = "input.returnDownload == true", - sliderInput(inputId="w", label = "width (A4=210mm):", min=60, max=600, value=210, width='80%', ticks=F), - sliderInput(inputId="h", label = "height (A4=297mm):", min=60, max=600, value=297, width='80%', ticks=F), -radioButtons("type", "Download type:", - c(#"SVG" = "SVG", - "PDF" = "PDF", - "PNG" = "PNG")), - br(), - downloadLink('pdflink') - ) - - ), - mainPanel( - plotOutput("Tree", height=2000)) - ) - ) -) diff --git a/shiny_practice/runPlotTree/plotTree.R b/shiny_practice/runPlotTree/plotTree.R deleted file mode 100644 index 1bc9314..0000000 --- a/shiny_practice/runPlotTree/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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/shiny_practice/runPlotTree/server.R b/shiny_practice/runPlotTree/server.R deleted file mode 100644 index 2871187..0000000 --- a/shiny_practice/runPlotTree/server.R +++ /dev/null @@ -1,18 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer(function(input, output) { - output$Tree <- renderPlot({ - - treeFile <- input$tree - infoFile <- input$info - heatmapFile <- input$heatmap - - if (is.null(treeFile)) - return(NULL) - - plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath,heatmapData=heatmapFile$datapath) - - }) -}) \ No newline at end of file diff --git a/shiny_practice/runPlotTree/ui.R b/shiny_practice/runPlotTree/ui.R deleted file mode 100644 index 47fb8d9..0000000 --- a/shiny_practice/runPlotTree/ui.R +++ /dev/null @@ -1,26 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', - '.nwk', '.tree')), - - fileInput('info', 'Choose info file', multiple=F, - accept=c('text/csv', - '.csv')), - - fileInput('heatmap', 'Choose heatmap file', multiple=F, - accept=c('text/csv', - '.csv')) - - ), - mainPanel( - plotOutput("Tree", height=2000)) - ) - ) -) \ No newline at end of file diff --git a/shiny_practice/runPlotTree_conditional/plotTree.R b/shiny_practice/runPlotTree_conditional/plotTree.R deleted file mode 100644 index 1bc9314..0000000 --- a/shiny_practice/runPlotTree_conditional/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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/shiny_practice/runPlotTree_conditional/server.R b/shiny_practice/runPlotTree_conditional/server.R deleted file mode 100644 index 2dd5c7e..0000000 --- a/shiny_practice/runPlotTree_conditional/server.R +++ /dev/null @@ -1,23 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer(function(input, output) { - output$Tree <- renderPlot({ - - treeFile <- input$tree - infoFile <- input$info - heatmapFile <- input$heatmap - cluster <- input$heat_cluster - colour_nodes <- input$colour_nodes - tip_size <- input$tip_size - - if (is.null(treeFile)) - return(NULL) - - plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath, - heatmapData=heatmapFile$datapath,cluster=cluster,colourNodesBy=colour_nodes, - tip.colour.cex=tip_size) - - }) -}) \ No newline at end of file diff --git a/shiny_practice/runPlotTree_conditional/ui.R b/shiny_practice/runPlotTree_conditional/ui.R deleted file mode 100644 index 537aff6..0000000 --- a/shiny_practice/runPlotTree_conditional/ui.R +++ /dev/null @@ -1,33 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', - '.nwk', '.tree')), - - fileInput('info', 'Choose info file', multiple=F, - accept=c('text/csv', - '.csv')), - - textInput("colour_nodes", label = h4("Colour nodes by"), value = "Enter variable name"), - - sliderInput("tip_size", label = h4("Tip size"), min = 0.1, - max = 20, value = 0.5), - - fileInput('heatmap', 'Choose heatmap file', multiple=F, - accept=c('text/csv', - '.csv')), - - checkboxInput("heat_cluster", label = "Cluster heatmap", value = TRUE) - - ), - mainPanel( - plotOutput("Tree", height=800)) - ) - ) -) \ No newline at end of file diff --git a/shiny_practice/runPlotTree_conditional_clustering/plotTree.R b/shiny_practice/runPlotTree_conditional_clustering/plotTree.R deleted file mode 100644 index 1bc9314..0000000 --- a/shiny_practice/runPlotTree_conditional_clustering/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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/shiny_practice/runPlotTree_conditional_clustering/server.R b/shiny_practice/runPlotTree_conditional_clustering/server.R deleted file mode 100644 index 7753778..0000000 --- a/shiny_practice/runPlotTree_conditional_clustering/server.R +++ /dev/null @@ -1,42 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -### END R PLOTTING CODE - -shinyServer(function(input, output) { - - output$Tree <- renderPlot({ - - treeFile <- input$tree$datapath - heatmapFile = NULL - infoFile = NULL - clusteringOption = NULL - - if (is.null(treeFile)) - return(NULL) - - if(input$chk_meta) { - infoFile <- input$info$datapath - if (input$chk_heatmap) { - heatmapFile <- input$heatmap$datapath - } - } - if (input$chk_heatmap) { - heatmapFile <- input$heatmap$datapath - } - - if(!is.null(heatmapFile)) { - if(input$optionsPrompt) { - if(input$clustering == "Cluster based on density") { - clusteringOption = T - } else - if (input$clustering == "Cluster according to tree") { - clusteringOption = "square" - } - } - } - - plotTree(treeFile, heatmapFile, infoFile, cluster=clusteringOption) - }) -}) \ No newline at end of file diff --git a/shiny_practice/runPlotTree_conditional_clustering/ui.R b/shiny_practice/runPlotTree_conditional_clustering/ui.R deleted file mode 100644 index 9d74ecd..0000000 --- a/shiny_practice/runPlotTree_conditional_clustering/ui.R +++ /dev/null @@ -1,36 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', '.nwk', '.tree')), - # This prompts the user for metadata file - checkboxInput("chk_meta", "Meta file"), - conditionalPanel( - condition = "input.chk_meta", - fileInput('info', 'Choose info file', multiple = F, accept = c('text/csv', '.csv')) - ), - - # This prompts the user for pan genome file - checkboxInput("chk_heatmap", "Heatmap file"), - conditionalPanel( - condition = "input.chk_heatmap", "Heatmap", - fileInput('heatmap', 'Choose heatmap file', multiple = F, accept = c('text/csv', '.csv')), - - # This displays a check box if the user wants to change tree options - checkboxInput("optionsPrompt", "Check box if you wish to not use the default values.", value=FALSE), - conditionalPanel( - condition = "input.optionsPrompt", - selectInput("clustering", label = "Columns clustering:", - choices = c("Select", "Cluster based on density", "Cluster according to tree"), selected = "Select"), "Note: You can only cluster according to tree if your rows are equal to your tree tips. - I.e. if you're viewing the dataset against itself.") - ) - ), - - mainPanel(plotOutput("Tree", height=2000)) - ) -) -) \ No newline at end of file diff --git a/shiny_practice/runPlotTree_tabs/plotTree.R b/shiny_practice/runPlotTree_tabs/plotTree.R deleted file mode 100644 index 1bc9314..0000000 --- a/shiny_practice/runPlotTree_tabs/plotTree.R +++ /dev/null @@ -1,320 +0,0 @@ -# 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/shiny_practice/runPlotTree_tabs/server.R b/shiny_practice/runPlotTree_tabs/server.R deleted file mode 100644 index 2871187..0000000 --- a/shiny_practice/runPlotTree_tabs/server.R +++ /dev/null @@ -1,18 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -shinyServer(function(input, output) { - output$Tree <- renderPlot({ - - treeFile <- input$tree - infoFile <- input$info - heatmapFile <- input$heatmap - - if (is.null(treeFile)) - return(NULL) - - plotTree(tree=treeFile$datapath,infoFile=infoFile$datapath,heatmapData=heatmapFile$datapath) - - }) -}) \ No newline at end of file diff --git a/shiny_practice/runPlotTree_tabs/ui.R b/shiny_practice/runPlotTree_tabs/ui.R deleted file mode 100644 index db538a5..0000000 --- a/shiny_practice/runPlotTree_tabs/ui.R +++ /dev/null @@ -1,33 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - tabsetPanel( - - tabPanel("tree", - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', '.nwk', '.tree')) - ), - - tabPanel("metadata", - fileInput('info', 'Choose info file', multiple=F, - accept=c('text/csv', '.csv')) - ), - - tabPanel("heatmap", - fileInput('heatmap', 'Choose heatmap file', multiple=F, - accept=c('text/csv', - '.csv')) - ) - ) - - ), - mainPanel( - plotOutput("Tree", height=2000)) - ) - ) -) \ No newline at end of file diff --git a/shiny_practice/uploadTree2/server.R b/shiny_practice/uploadTree2/server.R deleted file mode 100644 index e7b753c..0000000 --- a/shiny_practice/uploadTree2/server.R +++ /dev/null @@ -1,21 +0,0 @@ -library(shiny) -library(ape) - -shinyServer(function(input, output) { - output$Tree <- renderPlot({ - - # input$file1 will be NULL initially. After the user selects - # and uploads a file, it will be a data frame with 'name', - # 'size', 'type', and 'datapath' columns. The 'datapath' - # column will contain the local filenames where the data can - # be found. - - inFile <- input$tree - - if (is.null(inFile)) - return(NULL) - - t<-read.tree(inFile$datapath) - plot(t) - }) -}) \ No newline at end of file diff --git a/shiny_practice/uploadTree2/ui.R b/shiny_practice/uploadTree2/ui.R deleted file mode 100644 index 8a8448e..0000000 --- a/shiny_practice/uploadTree2/ui.R +++ /dev/null @@ -1,22 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', - '.nwk', '.tree')) - - fileInput('info', 'Choose info file', multiple=F, - accept=c('text/csv', - '.csv')) - - ), - mainPanel( - plotOutput("Tree", height=2000)) - ) - ) -) \ No newline at end of file diff --git a/shiny_practice/variable_relationships.txt b/shiny_practice/variable_relationships.txt deleted file mode 100644 index 86ab11c..0000000 --- a/shiny_practice/variable_relationships.txt +++ /dev/null @@ -1,127 +0,0 @@ -TO DO: choose colour palettes for node colours - -manually specifying R code for colour palette in heatmap isn't working... - -bar plots are not lined up - -plotting area for blocks isn't working properly - - -INPUTS: - -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) { - - -REQUIRED INPUT, NOT CONDITIONAL: -tree -> require input file in newick format. - -tree options: - -(1) lwd=1.5 -[width of lines in tree] - -(2) edge.color="black" -[colour of tree branches] - -(3) tip.labels=F -print tip labels next to the leaves - if TRUE then can change: - tipLabelSize=1 - offset=0 - -CONDITIONAL RELATIONSHIPS: - -(1) metadata -> if this is checked, then display: - - - input file to select table (to be passed to the function as infoFile=) - - - name of column to use to colour tree tips [optional] - - to be passed to colourNodesBy= - - only valid options are column names in the info file, so ideally would load this file first and then display the column names as a dropdown list to select from) - - => if this is selected, display more options: - -> change size of the leaf node circles by setting tip.colour.cex=0.5 - -> perform ancestral reconstruction? ancestral.reconstruction=F - -> if yes, optionally change pie.cex=0.5 - -> change the default colour panel by setting tipColours= - -> turn off legend (set legend=F) - -> legend.pos - - - by default, if input file is provided, all columns will be printed next to the tree (infoCols=NULL) - - => options: - - select names of columns to display (check boxes? or type list) infoCols=c() - - switch off (set to infoCols=NA) - - -(2) heatmap data -> if this is checked, then display: - - - input file to select datatable (to be passed to the function as heatmapData=) - - - option to change colour scheme (default heatmap.colours=rev(gray(seq(0,1,0.1)))) - - - option to switch on clustering of columns (set cluster=T) - OR - option to switch on ordering of columns according to the tree - (IF the matrix is a square matrix, i.e. with columns names = tree tips as well as - row names = tree tips) (set cluster="square") - - EXPERT OPTIONS - - option to manually supply vector of breakpoints for heatmap values (heatmapBreaks=NULL) - - - - - option to specify decimal places to display in heatmap legend heatmapDecimalPlaces=1 - - - option to change size of column labels (colLabelCex=) - - - option to draw vertical lines after columns - e.g. lines after column 5 and 10, vlines.heatmap=c(5,10) - - set colour for these lines: vlines.heatmap.col=2 - - - manually specify colour scheme - -(3) bar plots -> if this is checked, then display: - - - input file to select table of data to be plotted as barplot (barData=) - - - set colour to use for plotting bar graphs: barDataCol= - -(4) genome blocks -> if this is checked, then display: - - - input file to select table of blocks (blockFile=NULL) - - MUST specify genome size for plotting (genome_size=) [*same as for snps] - - - optionally: - - line width for drawing blocks (blwd=5) - - change colour for blocks (block_colour="black") - -<== DONE ==> - -(5) SNPs -> if this is checked, then display: - - - input file to select table of blocks (snpFile=NULL) - - MUST specify genome size for plotting (genome_size=) [*same as for blocks] - - - optionally: - - character representing unknown bases/baps (gapChar="?") - - change colour for SNPs (snp_colour="red") - - - -CONTROLLING THE RELATIVE SIZES OF THE ELEMENTS: - -WIDTHS (this is the order displayed) -treeWidth=10 -infoWidth=10 -dataWidth=30 -barDataWidth=10 -blockPlotWidth=10 - -HEIGHTS: -mainHeight=100 -labelHeight=10 - -EDGES (TOP, BOTTOM, LEFT, RIGHT) -edgeWidth=1 - diff --git a/shiny_practice/wan/server.R b/shiny_practice/wan/server.R deleted file mode 100644 index eda3157..0000000 --- a/shiny_practice/wan/server.R +++ /dev/null @@ -1,36 +0,0 @@ -library(shiny) -library(ape) -source("plotTree.R") - -### END R PLOTTING CODE - -shinyServer(function(input, output) { - output$Tree <- renderPlot({ - - treeFile <- input$tree - - if (is.null(treeFile)) - return(NULL) - - if (input$chk_metadata) { - infoFile <- input$info - } else { - infoFile <- NULL - } - - if (input$chk_heatmap) { - heatmapFile <- input$heatmap - } else { - heatmapFile <- NULL - } - - if (input$chk_barplot) { - barplotFile <- input$barplot - } else { - barplotFile <- NULL - } - - plotTree(tree=treeFile$datapath, heatmapData = heatmapFile$datapath, infoFile = infoFile$datapath, - barData = barplotFile$datapath) - }) -}) \ No newline at end of file diff --git a/shiny_practice/wan/ui.R b/shiny_practice/wan/ui.R deleted file mode 100644 index 87d3c00..0000000 --- a/shiny_practice/wan/ui.R +++ /dev/null @@ -1,28 +0,0 @@ -library(shiny) -library(ape) - -shinyUI(fluidPage( - titlePanel("Plot tree"), - sidebarLayout( - sidebarPanel( - fileInput('tree', 'Choose tree file', multiple=F, - accept=c('biotree/newick', '.nwk', '.tree')), - - checkboxInput("chk_metadata", "Metadata file", value = FALSE), - - conditionalPanel( - condition = "input.chk_metadata", - fileInput('info', 'Choose metadata file', multiple = FALSE, accept = c('text/csv', '.csv')) - ), - - checkboxInput("chk_heatmap", "Heatmap file", value = FALSE), - conditionalPanel( - condition = "input.chk_heatmap", - fileInput('heatmap', 'Choose heatmap file', multiple = F, accept = c('text/csv', '.csv')) - ) - ), - - mainPanel(plotOutput("Tree", height=2000)) - ) -) -) \ No newline at end of file diff --git a/tree_example_april2015/.Rhistory b/tree_example_april2015/.Rhistory deleted file mode 100644 index 0b3f077..0000000 --- a/tree_example_april2015/.Rhistory +++ /dev/null @@ -1,450 +0,0 @@ -d<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv",header=T) -d[1:5,1:5] -d<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv") -d<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet.csv") -d[1:5,1:5] -d<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet.csv",row.names=1,header=T) -d[1:5,1:5] -d<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet.csv",row.names=1,header=F) -write.csv(t(d),file="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv") -write.csv(t(d),file="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv",row.names=F) -d<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv",row.names=1,header=T) -d[1:5,1:5] -plotTree(tree,infoFile=info_file,colourNodesBy="K",tip.colour.cex=2,infoCols=c("K","OC"),treeWidth=10,infoWidth=2,tipColours=c(KL1,KL12,KL15,KL17,KL1a,KL1b,KL1c,KL20,KL25,KL4,KL40),tip.label=T,offset=0.0001,edge.color=c(KL1,KL1,KL12,KL15,KL1a,KL1b,KL25,KL4,KL1)[as.factor(edge_colours)],lwd=2,heatmapData="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv",heatmap.colours=c("grey","red"),dataWidth=20,cluster=F) -dd<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv") -head(dd) -dd[1:5,1:5] -dd<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose.csv",header=T,row.names=1) -image(dd) -image(as.matrix(dd)) -image(as.matrix(dd),col=rev(grey(seq(0,10,1)/10))) -image(as.matrix(dd),col=(grey(seq(0,10,1)/10))) -image(as.matrix(dd),col=rev(grey(seq(0,10,1)/10))) -image(as.matrix(dd),col=(grey(seq(0,10,1)/10))) -plotTree(tree,infoFile=info_file,colourNodesBy="K",tip.colour.cex=2,infoCols=c("K","OC"),treeWidth=10,infoWidth=2,tipColours=c(KL1,KL12,KL15,KL17,KL1a,KL1b,KL1c,KL20,KL25,KL4,KL40),tip.label=T,offset=0.0001,edge.color=c(KL1,KL1,KL12,KL15,KL1a,KL1b,KL25,KL4,KL1)[as.factor(edge_colours)],lwd=2,heatmapData=dd,heatmap.colours=c("grey","red"),dataWidth=20,cluster=F) -plotTree(tree,infoFile=info_file,colourNodesBy="K",tip.colour.cex=2,infoCols=c("K","OC"),treeWidth=10,infoWidth=2,tipColours=c(KL1,KL12,KL15,KL17,KL1a,KL1b,KL1c,KL20,KL25,KL4,KL40),tip.label=T,offset=0.0001,edge.color=c(KL1,KL1,KL12,KL15,KL1a,KL1b,KL25,KL4,KL1)[as.factor(edge_colours)],lwd=2,heatmapData="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose_raxID.csv",heatmap.colours=c("grey","red"),dataWidth=20,cluster=F) -plotTree(tree,infoFile=info_file,colourNodesBy="K",tip.colour.cex=2,infoCols=c("K","OC"),treeWidth=10,infoWidth=2,tipColours=c(KL1,KL12,KL15,KL17,KL1a,KL1b,KL1c,KL20,KL25,KL4,KL40),tip.label=T,offset=0.0001,edge.color=c(KL1,KL1,KL12,KL15,KL1a,KL1b,KL25,KL4,KL1)[as.factor(edge_colours)],lwd=2,heatmapData="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose_raxID.csv",dataWidth=20,cluster=F) -plotTree(tree,infoFile=info_file,colourNodesBy="K",tip.colour.cex=2,infoCols=c("K","OC"),treeWidth=10,infoWidth=2,tipColours=c(KL1,KL12,KL15,KL17,KL1a,KL1b,KL1c,KL20,KL25,KL4,KL40),tip.label=T,offset=0.0001,edge.color=c(KL1,KL1,KL12,KL15,KL1a,KL1b,KL25,KL4,KL1)[as.factor(edge_colours)],lwd=2,heatmapData="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose_raxID.csv",heatmap.colours=(grey(seq(0,10,1)/10)),dataWidth=20,cluster=F) -plotTree(tree,infoFile=info_file,colourNodesBy="K",tip.colour.cex=2,infoCols=c("OC"),treeWidth=10,infoWidth=2,tipColours=c(KL1,KL12,KL15,KL17,KL1a,KL1b,KL1c,KL20,KL25,KL4,KL40),tip.label=T,offset=0.0001,edge.color=c(KL1,KL1,KL12,KL15,KL1a,KL1b,KL25,KL4,KL1)[as.factor(edge_colours)],lwd=2,heatmapData="/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/mapping_final/KTA1_GeneSummary_finalStrainSet_transpose_raxID.csv",heatmap.colours=(grey(seq(0,10,1)/10)),dataWidth=20,cluster=F) -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/ISAba1_insertSites.csv") -abar -head(abar) -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/ISAba1_insertSites.csv",row.names=1) -abar[1:5,1:5] -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/AbaR_detail",row.names=1) -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/AbaR_detail.csv",row.names=1) -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/plotting/AbaR_detail.csv",row.names=1) -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/plotting/AbaR_detail.csv") -head(abar) -nrow(abar) -ncol <- 100# -ns <- 44# -plot(c(0:ncol),0:(ns+1),pch="") -ncol <- 100# -ns <- 44# -plot(c(0,ncol),c(0,ns+1),pch="") -abar<-read.csv("/Users/kat/Documents/acinetobacter/GC1/GC1_paper_july2014/resistance/plotting/AbaR_detail.csv") -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -plot(1,i,pch=16,cex=3,col=abar$AbaR_group[i])# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="") -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,i,pch=16,cex=3,col=abar$AbaR_group[i])# -}# -} -set up plotting frame# -ncol <- 100# -ns <- 44# -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,abar$tree.order,pch=16,cex=3,col=abar$AbaR_group[i])# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,abar$tree.order[i],pch=16,cex=2,col=abar$AbaR_group[i])# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,abar$tree.order[i],pch=16,cex=1,col=abar$AbaR_group[i])# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -} -label with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$AbaR_group[i],2,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -} -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$AbaR_group[i],2,ns-i,pch=16,cex=1)# -}# -} -plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$AbaR_group[i],x=2,y=ns-i,pch=16,cex=1)# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=2,y=ns-i,pch=16,cex=1)# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=4,y=ns-i,pch=16,cex=1)# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=4,y=ns-i,pch=16,cex=1,cex=0.5)# -}# -} -label with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=4,y=ns-i,pch=16,cex=0.5)# -}# -} -label AbaR type with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=4,y=ns-i,pch=16,cex=0.5,col=abar$AbaR_group[i])# -}# -} -add sul1# -sul_col <- 3# -for (i in 1:nrow(abar)) {# -if (abar$SulI_Sul[i] != "-") {# -points(7,ns-i,pch=17,cex=1,col=sul_col)# -}# -} -add sul1# -sul_col <- 3# -for (i in 1:nrow(abar)) {# -if (abar$SulI_Sul[i] != "-") {# -points(7,ns-i,pch=15,cex=1,col=sul_col)# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label AbaR type with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=4,y=ns-i,pch=16,cex=0.5,col=abar$AbaR_group[i])# -}# -}# -# -# add sul1# -sul_col <- 3# -for (i in 1:nrow(abar)) {# -if (abar$SulI_Sul[i] != "-") {# -points(7,ns-i,pch=15,cex=1,col=sul_col)# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(1,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label AbaR type with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=4,y=ns-i,pch=16,cex=0.5)# -}# -}# -# -# add sul1# -sul_col <- 3# -for (i in 1:nrow(abar)) {# -if (abar$SulI_Sul[i] != "-") {# -points(7,ns-i,pch=15,cex=1,col=sul_col)# -}# -} -plot(c(0,ncol),c(0,ns+1),pch="")# -# -# plot circle to indicate AbaR presence, colour by main group, label with specific variant# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -points(4,ns-i,pch=16,cex=1,col=abar$AbaR_group[i])# -}# -}# -# -# label AbaR type with number# -for (i in 1:nrow(abar)) {# -if (abar$AbaR_group[i] != "na") {# -text(abar$type[i],x=1,y=ns-i,pch=16,cex=0.5)# -}# -}# -# -# add sul1# -sul_col <- 3# -for (i in 1:nrow(abar)) {# -if (abar$SulI_Sul[i] != "-") {# -points(7,ns-i,pch=15,cex=1,col=sul_col)# -}# -} -aminogly_col <- 4# -for (i in 1:nrow(abar)) {if (abar$Aac3-I_AGly[i] != "-") {# -points(9,ns-i,pch=15,cex=1,col=aminogly_col) } } -aminogly_col <- 4# -for (i in 1:nrow(abar)) {if (abar$Aac3.I_AGly[i] != "-") {# -points(9,ns-i,pch=15,cex=1,col=aminogly_col) } } -for (i in 1:nrow(abar)) {if (abar$AadA.AGly[i] != "-") {# -points(11,ns-i,pch=15,cex=1,col=aminogly_col) } } -head(abar) -for (i in 1:nrow(abar)) {if (abar$AadA_AGly[i] != "-") {# -points(11,ns-i,pch=15,cex=1,col=aminogly_col) } } -90*8+3200 -4000/8 -400*500 -7+9+5+8 -29*50 -360/5 -72+324 -324-72 -72+36 -129+90 -109*2 -132.62*2 -132.62*2*10 -2610/9 -176/2 -install.packages('knitr', dependencies = TRUE) -library(apoe) -library(ape) -library(knitr) -?knit -236/4 -load("/Users/kat/Documents/PROJECTS/CAS_NHMCR_2013/virus_bact_data_221014_yr1paper/virus_bacteria_forKat_22oct.Rdata") -ls() -head(virus_bacteria) -table(virus_bacteria$MPG,virus_bacteria$Category) -14+34 -48/(174+333) -489/(174+333) -4/174 -360/5 -324-72 -324+72 -324+72-360 -4804510-354000-180000 -0.6*0.6 -m <- "/Users/kat/Downloads/VRE_metadataInclClinical_12022015.xlsx\ -\ baseline\ screening.csv" -t <- "/Users/kat/Documents/Efaecium/VRE_Alfred/reddog/run2/CP006620_CP006620_alleles_var_cons0.95_noOutgroups.tree" -source('~/code/holtlab/Rcode/plotTree.R', chdir = TRUE) -getwd() -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST")) -colnames(m) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn2549")) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549")) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Swab.date")) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Swab_date")) -d<-read.csv(m) -head(m) -head(d) -colnames(d) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number")) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community")) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community") -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community",colours=c(2,1)) -plotTree -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community", tipColours =c(2,1)) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community", tipColours =c(2,1),tipColourCex=3) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community", tipColours =c(2,1),tip.colour.cex=3) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community", tipColours =c(2,1),tip.colour.cex=2) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community", tipColours =c(2,1),tip.colour.cex=2) -colnames(d) -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549.S.L","Swab_date","Swab.Number","community"),colourNodesBy="community", tipColours =c(2,1),tip.colour.cex=2,"H_admission_to_swab","abtmt") -plotTree(t,infoFile=m,infoCols=c("Study.id","Name.code","MLST","Tn1549.S.L","Swab_date","Swab.Number","community","H_admission_to_swab","abtmt"),colourNodesBy="community", tipColours =c(2,1),tip.colour.cex=2) -694+789+478+742+651+379+600 -60+81+38+10 -4333+ 189 -27+42 -5/6 -0.23*22 -17/23 -17/22 -/5 -96/5 -48/5 -20/4 -96*2 -26*5 -130/48 -5*52 -r<-read.csv("~/Downloads/Aussie conferences (Responses) - Form Responses.csv") -colnames(r) -plot(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.) -lm(r$Invited.talks~r$Contributed.talks..selected.from.abstacts.) -summary(lm(r$Invited.talks~r$Contributed.talks..selected.from.abstacts.)) -cor.test(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.) -cor.test(r$Invited.talks,r$Organisers) -cor.test(r$Contributed.talks..selected.from.abstacts.,r$Organisers) -plot(r$Contributed.talks..selected.from.abstacts.,r$Organisers) -cor.test(r$Invited.talks,r$Organisers) -lm(r$Invited.talks~r$Contributed.talks..selected.from.abstacts.) -cor.test(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.) -plot(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.,pch=16) -abline(coef(lm(r$Contributed.talks..selected.from.abstacts.~r$Invited.talks))) -plot(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.,pch=16,ylab="Contributed",xlab="Invited") -abline(coef(lm(r$Contributed.talks..selected.from.abstacts.~r$Invited.talks))) -plot(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.,pch=16,ylab="% Female speakers (Contributed talks)",xlab="% Fmale speakers (Invited talks)") -plot(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.,pch=16,ylab="% Female speakers (Contributed talks)",xlab="% Fmale speakers (Invited talks)",col=2) -abline(coef(lm(r$Contributed.talks..selected.from.abstacts.~r$Invited.talks))) -text(x=70,y=30,"Correlation=0.5, p=0.03") -text(x=70,y=30,"Correlation=0.5, p=0.03")e -plot(r$Invited.talks,r$Contributed.talks..selected.from.abstacts.,pch=16,ylab="% Female speakers (Contributed talks)",xlab="% Female speakers (Invited talks)",col=2) -text(x=70,y=30,"R2=0.2, p=0.03") -abline(coef(lm(r$Contributed.talks..selected.from.abstacts.~r$Invited.talks))) -lm(r$Contributed.talks..selected.from.abstacts.~r$Invited.talks) -summary(lm(r$Contributed.talks..selected.from.abstacts.~r$Invited.talks)) -summary(lm(r$Contributed.talks..selected.from.abstacts.+r$Invited.talks~r$Organisers)) -plot(r$Organisers,r$Contributed.talks..selected.from.abstacts.,pch=16,ylab="% Female speakers (Contributed talks)",xlab="% Female organisers",col=2) -head(r) -14/(14+38) -13/(13+430) -38/(14+38) -430/(13+430) -5/7 -2/7 -9/45 -24+87+46+36 -193-4-15 -140/0.35 -35/2 -3.1*6.9 -install.packages("shiny") -library(shiny) -runExample("01_hello") -source("~/code/plotTree/plotTree.R") -plotTree(tree="tree.nwk",infoFile="info.csv") -plotTree(tree="tree.nwk") -ls() -plotTree(tree="tree.nwk",barData="bar.csv") -plotTree(tree="tree.nwk",barData="bar.csv") -plotTree(tree="tree.nwk",barData="bar.csv",blockFile="blocks.csv"genome_size=5E6) -plotTree(tree="tree.nwk",barData="bar.csv",blockFile="blocks.csv",genome_size=5E6) -plotTree(tree="tree.nwk",barData="bar.csv",blockFile="blocks.csv",genome_size=5E6) -plotTree(tree="tree.nwk",barData="bar.csv",blockFile="blocks.txt",genome_size=5E6) -plotTree(tree="tree.nwk",barData="bar.csv",blockFile="blocks.txt",genome_size=5E6) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5E6) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5E6) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5E7) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5E1) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5E) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=5) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=10,blwd=10) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=100,blwd=10) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=50,blwd=10) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=20,blwd=10) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=10,blwd=10) -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10) -source("~/code/plotTree/plotTree2.R") -source("~/code/holtlab/Rcode/plotTree2.R") -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10) -?lines -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10,snpFile="alleles.csv") -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10,snpFile="alleles.csv") -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10,snpFile="alleles.csv") -plotTree(tree="tree.nwk",genome_size=5E6,blwd=10,snpFile="alleles.csv") -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5,blwd=10,snpFile="alleles.csv") -plotTree(tree="tree.nwk",blockFile="blocks.txt",genome_size=5E6,blwd=10,snpFile="alleles.csv") -runApp("~/code/plotTree/shiny_practice/reactive/") -library(shiny) -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") -runApp("~/code/plotTree/shiny_practice/reactive/") diff --git a/tree_example_april2015/myplot.pdf b/tree_example_april2015/myplot.pdf deleted file mode 100644 index 2680a25..0000000 Binary files a/tree_example_april2015/myplot.pdf and /dev/null differ diff --git a/tree_example_april2015/myplot4.pdf b/tree_example_april2015/myplot4.pdf deleted file mode 100644 index b37903b..0000000 Binary files a/tree_example_april2015/myplot4.pdf and /dev/null differ