Minh
16 lines
31 KiB
Plaintext
16 lines
31 KiB
Plaintext
{
|
|
"contents" : "#Copyright 2012 The Board of Regents of the University of Wisconsin System.\n#Contributors: Jason Shao, James McCurdy, Enhai Xie, Adam G.W. Halstead, \n#Michael H. Whitney, Nathan DiPiazza, Trey K. Sato and Yury V. Bukhman\n#\n#This file is part of GCAT.\n#\n#GCAT is free software: you can redistribute it and/or modify\n#it under the terms of the GNU Lesser General Public License as published by\n#the Free Software Foundation, either version 3 of the License, or\n#(at your option) any later version.\n#\n#GCAT is distributed in the hope that it will be useful,\n#but WITHOUT ANY WARRANTY; without even the implied warranty of\n#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n#GNU Lesser General Public License for more details.\n#\n#You should have received a copy of the GNU Lesser General Public License \n#along with GCAT. If not, see <http://www.gnu.org/licenses/>.\n\nrequire(pheatmap)\nrequire(gplots)\n\n########################################################################\n# #\n# Graphic output functions for fitted well objects. The functions are #\n# fairly complicated and intertwined and may need revision. #\n# #\n########################################################################\n\n########################################################################\n# Basic function plots time vs. OD from a well object #\n########################################################################\n#' plot.data \n#' \n#' Basic function plots time vs. OD from a well object \n#' \n#' @param input.well The well object that need to be plottedd \n#' @param unlog should data be plotted on a linear (vs. logarithmic) scale? \n#' @param view.raw.data should the raw data be plotted? ( \n#' @param number.points should points be labeled with numeric indices? \n#' @param scale determines the font scale for the entire graph. all cex values are calculated from this. \n#' @param draw.symbols - should <check.slopes> be called on the well and markings drawn on the graph? \n#' @param ... additional arguments passed to plot() \n\nplot.data = function(input.well, view.raw.data = F, unlog = F, scale = 1, \n main = paste(plate.name(input.well), well.name(input.well)), number.points = T, \n draw.symbols = F, constant.added,...){\n \n # Get data as well as a vector showing which points were removed. \n\tinput.data = data.from(input.well, remove = F, remove.tanking = F, raw.data=view.raw.data)\n\tremoved.points = !(rownames(input.data) %in% rownames(data.from(input.well, remove = T, remove.tanking = T)))\n point.colors = as.character(factor(removed.points,levels=c(F,T),labels=c(\"black\",\"gray80\")))\n\n # Draw the axes and all text labels first.\n\tpar(mar = c(5, 4, 4, 5)+0.1)\n\tplot(input.data, main = main, xlab = \"Time(hours)\", ylab = \"log(OD - blank + const)\",\n mex = scale, cex.main = 1.5*scale, cex.axis = 1.2*scale, cex.lab = 1.2*scale, type =\"n\",...)\n \n\t# Draw a second vertical axis, showing unlogged OD scale\n\t# - Determine the range of the labels: from min.OD to max.OD\n if (class(try(ylim,silent=T)) == \"try-error\") {\n OD = unlog(input.data[,2],constant.added)\n baseline.OD = unlog(baseline(input.well),constant.added)\n min.OD = min(min(OD,na.rm=T),baseline.OD,na.rm=T)\n plateau.OD = unlog(plateau(input.well),constant.added)\n max.OD = max(max(OD,na.rm=T),plateau.OD,na.rm=T)\n } else {\n min.OD = unlog(ylim[1],constant.added)\n max.OD = unlog(ylim[2],constant.added)\n }\n\t# - Compute labels and their positions\n\tOD.labels = seq(from = min.OD, to = max.OD, length.out = 5)\n\tOD.labels = signif(OD.labels,2)\n\tOD.at = log(OD.labels+constant.added)\n # - Draw the axis\n\taxis(side=4, at=OD.at, labels=OD.labels, cex.axis = 1.2*scale, cex.lab = 1.2*scale)\n\tmtext(4, text = \"OD - blank\", line = 3, cex=1.2)\n \n\t# If <number.points> is true, then label each point with the index of its timepoint and plot removed points in grey, others in black. \n if (number.points)\n\t\ttext(input.data$Time, input.data[,2], rownames(input.data), col = point.colors, cex = 0.5*scale)\n\t# Otherwise plot all points, using a different plotting character for removed points. \t\n else\n\t\tpoints(input.data$Time, input.data[,2], pch = 1 + removed.points*15)\n\n # If <check.slopes> is set to T, then draw all the markings that <check.slopes> makes to determine curve parameters. \n\tif (draw.symbols & !view.raw.data)\n\t\tcheck.slopes(input.well, draw = T)\n\treturn()\n\t}\n\t\n########################################################################\n# Plots the fitted model curve from a well object if it exists #\n########################################################################\n#\n# time: specify which points (in units of time) to plot fitted OD values for. if not specifies, plot all timepoints in range of well. \n\nplot.model = function(input.well, col = 1, scale = 1, lty = 1, time = NULL, unlog = F, constant.added=1){\n\t \n input.data = data.from(input.well)\n\tgrowth = input.data[,2]\n\n # If no list of timepoints is specified, get a list of 360 timepoints (should be smooth enough) from the well's range. \n\tif (is.null(time)){\n\t\ttime.fin = max(data.from(input.well, raw.data = T, remove = F, remove.tanking = F)$Time)\n\t\ttime = seq(0, time.fin, length.out = 360)\n\t}\n \n # Evaluate the predicted OD at the specified timepoints based on the fitted model. \n\tpredicted.OD = well.eval(input.well, time) \n # If any values were returned, plot the lines on the current graph. Otherwise, just return without doing anything.\n\tif (is.numeric(predicted.OD))\n\t\tlines(time, predicted.OD, col = col, lty = lty, lw = 2 * scale) \n else\n return()\t\n \n}\n\t\n########################################################################\n# Put various parameters and info in text form on the graphs #\n########################################################################\n#\t\t\t\ndraw.text = function(input.well, scale = 0.5, xlim = 0, ylim = 0,...){\n\n\tinput.data = data.from(input.well, remove = F, remove.tanking = F)\n\tfit = input.well@fit.par\n \n # <text2> - fit information (fit status, model name if available, jump detection output, fit parameters if available) from well \n # color = red if no fit, blue if fit, green if skipped\n # <text1> - empty or inoculated well.\n # color = green if empty, blue if inoculated, red if inoculated but has no growth or empty but has growth. \n \n \tcol2 = \"blue\" \n\ttext2 = paste(input.well@fit.info, input.well@model.name, input.well@add.info, \"\\n\", parameter.text(input.well))\n\n\tif (length(input.well@fit.par) == 0) # no fit\n\t\tcol2 = \"red\"\n\n\tif (is.empty(input.well)){\n\t\t text1 = \"empty well\"\n\t\tif(!lacks.growth(input.well) | length(input.well@fit.par) == 0) # growth curve fit for an empty well\n\t\t\tcol1 = \"red\"\n\t\telse\n\t\t\tcol1 = \"forestgreen\"\n\t\tif (length(input.well@model.name) == 0) # well was skipped \n\t\t\tcol1 = col2 = \"forestgreen\"\n\t\t}\n\telse{\n\t\ttext1 = \"inoculated well\"\n\t\tif(lacks.growth(input.well) | length(input.well@fit.par) == 0) # failure to fit an inoculated well\n\t\t\tcol1 = \"red\"\n\t\telse\n\t\t\tcol1 = \"forestgreen\"\n\t\t}\n\t\t\n\t# <text1.5> - goodness of fit metric. \n\t# color = red if below 2, yellow if between 2 and 2.72, and green if above 2.72. \n\t\n\tif(!is.na(model.good.fit(input.well))){\n\t\t#if (model.good.fit(input.well, unlog = F) > 2.72)\n\t\t#\tcol1.5 = \"forestgreen\"\n\t\t#else if (model.good.fit(input.well, unlog = F)> 2.0)\n\t\t#\tcol1.5 = \"gold2\"\n\t\t#else\n\t\t#\tcol1.5 = \"red\"\n col1.5 = \"forestgreen\"\n\t\ttext1.5 = paste(\"R squared:\", round(model.good.fit(input.well),3))\n\t\t}\n\telse\n\t col1.5 = text1.5 = NULL\n\t \n # Print all text at the top of the graph with approprate positions and scaling \t\n \ttext(x = xlim[1] + 0.50 * diff(xlim), y = ylim[2] - 0.025 * diff(ylim), \n \t\ttext1.5, cex = 1.5*scale, col = col1.5) \n \t\t\n\ttext(x = xlim[1] + 0.50 * diff(xlim), y = ylim[2] - 0 * diff(ylim), \n\t\t\ttext1, cex = 1.5*scale, col = col1)\n\n\ttext(x = xlim[1] + 0.50 * diff(xlim), y = ylim[2] - 0.03 * diff(ylim), \n\t\t\ttext2, pos = 1, cex = 1.5*scale, col = col2)\t\n\t}\t\n\n########################################################################\n# Draw lines on graph denoting calculated parameters #\n########################################################################\n#\t\n# <show.num> - should curve parameters be labeled? \n\t\t\ndraw.calc.par = function(input.well, scale = 0.5, unlog = F, constant.added, show.num = T){\n\n # Don't do anything if well was not fit. \n\tif (is.null(well.eval(input.well)))\n\t\treturn()\n \n # Collect values for various curve parameters. \n\tbaseline = baseline(input.well)\n\tinoc.log.OD = inoc.log.OD(input.well)\n\tmax.log.OD = max.log.OD(input.well) \n\tplateau = plateau(input.well) \n\tinflection.time = input.well@inflection.time # was a param in model\n\tfin.time = (inflection.time+max(data.from(input.well)[,1]))/2\n\n\t# <inflection.time> = timepoint at greatest growth \n\t# <max.y> = OD measurement at <inflection.time>, minus the constant added before taking the log (if reversing the transformation)\n\t# <max.slope> = slope (on log scale) at <inflection.time> (specific growth)\n # had to add the unlog code. was calculated differently before NWD 7/21/14\n\tmax.slope = max.spec.growth.rate(input.well)\n\tmax.y = well.eval(input.well, inflection.time)\n\tlag.x = lag.time(input.well) \n lag.y = baseline\n\t\n\t# ---- Specific growth rate ---- #\n\tlines(c(lag.x, inflection.time), c(lag.y, max.y), lty = 2, col = \"red\")\n\n\n # Blue dotted line at time of maximum growth, with text label for specific growth rate. \n\tabline(v = inflection.time, lty = 2, lw = (scale^2)*2, col = \"blue\")\n if(show.num) text(inflection.time, max.y, round(max.slope,3), col = \"blue\", cex = 1.5*scale, pos = 2)\n\n # inoculation OD and baseline of the fitted model\n abline(h = inoc.log.OD, lw = scale*2, lty = 3)\n abline(h = baseline, col = \"red\", lw = (scale^2)*2, lty = 2)\n if(show.num) {\n text(fin.time, inoc.log.OD, paste(round(inoc.log.OD,3),\"\\n\",sep=\"\") , col = \"black\", cex = 1.5*scale, pos = 2)\n text(fin.time, baseline, paste(\"\\n\\n\", round(baseline,3), sep=\"\") , col = \"red\", cex = 1.5*scale, pos = 2)\n }\n\n # ---- Lag time ---- #\n # Do not draw a horizontal line to lag time if it is 0 or negative. \n # Otherwise draw a red line from the starting point to the lag time, and label with the lag time \n \tif (lag.time(input.well) == 0){\n\t\tif(show.num) text(0, inoc.log.OD, \"\\n\\n0.000\", col = \"red\", cex = 1.5*scale, pos = 4)\n\t\t}\n\telse{\n\t\tlines(c(0, lag.x), c(baseline, baseline), col = \"red\", lw = (scale^2)*2, lty = 2)\n\t\tif(show.num) text(lag.x, lag.y, paste(\"\\n\\n\", round(lag.time(input.well),3)), col = \"red\", cex = 1.5*scale, pos = 2)\n\t}\n\n # ---- Total growth ---- #\n\n # Draw horizontal lines for the max.log.OD in black, the plateau in green and the initial OD in black.\n abline(h = max.log.OD, lty = 3, lw = scale*2)\n abline(h = plateau, lty = 2, lw = (scale^2)*2, col = \"forestgreen\")\n\t\n\t# Draw a vertical line from the initial OD to the final OD in black, and then to the plateau in gray. \n\tlines(c(fin.time, fin.time), c(inoc.log.OD, max.log.OD), lw = (scale^2)*2, lty = 3)\n\tlines(c(fin.time, fin.time), c(max.log.OD, plateau), lw = (scale^2)*2, lty = 3, col = \"grey\")\n\n # Text: plateau and initial ODs (on left), difference between initial and final OD on right\n\tif(show.num){\n text(fin.time, plateau, paste(round(plateau,3),\"\\n\",sep=\"\") , col = \"forestgreen\", cex = 1.5*scale, pos = 2)\n text(fin.time, max.log.OD, paste(\"\\n\\n\\n\",round(max.log.OD,3),sep=\"\") , col = \"black\", cex = 1.5*scale, pos = 2)\n text(fin.time, .5*(max.log.OD-inoc.log.OD)+inoc.log.OD, round(max.log.OD - inoc.log.OD,3), cex = 1.5*scale, pos = 4)\n # difference between final and plateau OD (if large enough) \n if (!reach.plateau(input.well))\n\t\t text(fin.time, .5*(plateau-max.log.OD)+max.log.OD, paste(\"(\", round(plateau - max.log.OD,3), \")\", sep = \"\"), col = \"grey\", cex = 1.5*scale, pos = 2) \n }\n }\n\t\n########################################################################\n# Draw residuals from the nonlinear fit with option for lowess line #\n########################################################################\n#\t\t\nplot.residuals = function(well, xlim = NULL, lowess = T){\n\n\tdata = data.from(well, remove = F, remove.tanking = F)\n\n\tif (is.null(xlim))\n\t\txlim = c(min(data$Time, 0)-1, max(data$Time))\n\t\t\n\tplot(data.from(well)[,1], model.residuals(well), main = paste(plate.name(well), well.name(well), \"\\n[Residuals]\"),\n\t\txlab = \"Time(hours)\", ylab = paste(\"Residual\", names(data)[2]), xlim = xlim)\n\t\n\tabline(0,0, lty = 2)\n\t\n\tif (lowess)\n\t\tlines(lowess(data.from(well)[,1], model.residuals(well)), lw = 2, col = \"red\")\n\t}\n\n##############################################################################\n# This function is used to create a heatmap using: \n# specific growth, total growth, and lag time\n# for each well on a plate.\n#\n# @params\n# fitted.well.array: matrix containing well array object data\n# attribute: the data type we should use to create a heatmap\n# @returns\n# path of heatmap pdf file\n##############################################################################\ncreate.heatmap = function(fitted.well.array, attribute, unlog=NULL){\n attr.name <- deparse(substitute(attribute))\n pdf.name <- \"\"\n if(class(fitted.well.array) == \"matrix\"){\n #We may want to sub() out periods from plate.ID if it causes problems\n plate.ID = unique(unlist(aapply(fitted.well.array,plate.name)))[1]\n if(is.null(unlog)) {\n spec.growth = unlist(aapply(fitted.well.array, attribute))\n }\n # currently only total growth needs to be unlogged if unlog == T\n else {\n spec.growth = unlist(aapply(fitted.well.array, attribute))\n }\n num.dig = 3 #how many digits should be put on pdf?\n max = round(max(spec.growth, na.rm=T), digits=num.dig)\n min = round(min(spec.growth, na.rm=T), digits=num.dig)\n avg = round(mean(spec.growth, na.rm=T), digits=num.dig)\n heat.text = paste(toupper(sub(\"\\\\.\", \" \", attr.name)), \":\\n\", plate.ID, \"\\n\",\n paste(\"Max:\",max ,\"Min:\" ,min ,\"Avg:\", avg, sep=\"\"))\n \n attr.name <- sub(\"\\\\.\", \"_\", attr.name) #do not want periods in file path\n letters <- attr(fitted.well.array, \"dimnames\")[[1]]\n for(i in 1:length(letters)) letters[i] = paste(\" \", letters[i], \" \")\n nums <- attr(fitted.well.array, \"dimnames\")[[2]]\n for(i in 1:length(nums)) nums[i] = paste(\" \", nums[i], \" \")\n heat <- matrix(spec.growth, nrow=dim(fitted.well.array)[1], ncol=dim(fitted.well.array)[2], dimnames=list(letters,nums))\n pdf.name <- paste(getwd(), \"/\", plate.ID, \"_\", attr.name, \".pdf\", sep=\"\")\n pdf(pdf.name)\n #heatmap(heat, Rowv=NA, Colv=NA, revC=T, scale=\"none\", na.rm=T, main=plate.ID, col=rainbow(100), margins=c(6,6))\n #mtext(paste(\"Max:\", round(max(spec.growth, na.rm=T), digits=4),\"Min:\", round(min(spec.growth, na.rm=T), digits=4), \"Avg:\", round(mean(spec.growth, na.rm=T), digits=4)), side=1, line=3)\n pheatmap(heat, color=colorpanel(100, \"red\", \"orange\", \"yellow\"),\n border_color=\"black\", cell_width=2, cell_height=3,\n cluster_rows=F, cluster_cols=F, scale='none', main=heat.text, fontsize=16)\n dev.off()\n }\n else {\n return(\"Error\") \n }\n return(pdf.name)\n}\n\n########################################################################\n# Draw grids of 96 points as a visual representation of fit status, #\n# and other info for an array of fitted well objects, plate by plate #\n########################################################################\n#\n\t\nplate.overview = function(fitted.well.array, scale = 1){\n \n \n # Start with a list of the unique plate names in the fitted well array \n # and an appropriately-sized grid of coordinates to plot wells on.\n\tplates = unique(unlist(aapply(fitted.well.array,plate.name)))\n \n\tgrid = data.frame(x = rep(rep(1:plate.ncol, each = plate.nrow), length(plates)),\n\t\t\t y = rep( rep(-(1:plate.nrow), times = plate.ncol), length(plates)))\n\n\n # Gather information on each well to display on each of the coordinates in <grid>:\n # - was it marked as empty in the plate layout?\n # - did the program find it to contain no growth (\"dead\")? \n # - was the fitting procedure successful? \n # - did the curve tank? if so, at what timepoint? if not, or if the curve was marked as dead anyway, do not display the value. \n # - does the \"additional info\" slot indicate that any points were removed or the whole well discarded?\n \n\tempty = unlist(aapply(fitted.well.array, is.empty))\n\tdead = unlist(aapply(fitted.well.array, lacks.growth))\n\tfit = unlist(aapply(fitted.well.array, contains.fit))\n \n\ttanking = unlist(aapply(fitted.well.array, tanking.start))\n\ttanking[is.na(tanking) | tanking == 1 | dead] = \"\"\n\n\terrors = unlist(aapply(fitted.well.array, function(well){\n\t\tif (length(well@add.info) == 0)\n\t\t\t\"\"\n\t\telse if (grepl(\"removed\", well@add.info))\n\t\t\t\"-\"\n else if (grepl(\"detected\", well@add.info))\n \"+\"\n\t\telse if (grepl(\"discarded\", well@add.info))\n\t\t\t\"!\"\n\t\telse\n\t\t\t\"\"\n\t\t}))\n\t\n # Color and plotting character vectors (length = the number of wells in the array)\n # Default = 1 (open point, black)\n\tcolors = char = rep(1, length(tanking))\n\n # Desired colors\n colors[empty & dead] = \"green3\" # Empty well with no growth.\n colors[!empty & fit] = \"blue\" # Inoculated well with successfully fitted growth curve.\n \n # Undesired colors \n colors[empty & !dead] = \"darkolivegreen4\" # Inoculated well with some growth. \n colors[!empty & !fit] = \"red\" # Inoculated well with no successfully fit (either no growth or unsuccessful fit).\n \n char[!dead & fit] = 19 # Filled points for non-empty wells with successful fits \n char[!dead & !fit] = 4 # an X for non-empty wells with failed fits. \n \n char[errors == \"!\"] = 8 # Asterisk for discarded wells. \n char[errors == \"-\" & dead ] = 5 # Open diamond for empty wells (after removing points).\n char[errors == \"-\" & !dead & fit] = 23 # Filled diamond for non-empty wells with removed points and successful fits. \n char[errors == \"-\" & !dead & !fit] = 8 # Asterisk for wells with removed points and failed fits.\n \n \n\tfor (plate in 1:length(plates)){\n \n\t\tindices = (plate - 1) * plate.nrow*plate.ncol + 1:(plate.nrow*plate.ncol)\n\n # Plot the grid using colors and plotting characters determined above. \n\t\tplot(grid[indices,], col = colors[indices], bg = colors[indices], pch = char[indices], \n\t\t\t main = plates[plate], mex = scale, cex = scale, cex.main = 1.5*scale, cex.axis = 1.2*scale, \n\t\t\t xaxt = \"n\", yaxt = \"n\", xlim = c(-0.5,plate.ncol + 0.5), ylim = c(-(plate.nrow + 1.5), 0.5), xlab = \"\", ylab = \"\")\n \n # Symbol legends\n \n legend.xpos = (c(-1,2.75,6.5,6.86,10.25)+0.5)*(plate.ncol+1)/13 - 0.5\n legend.ypos = -(plate.nrow + 0.5)\n \n legend(x=legend.xpos[1], y= legend.ypos, cex = 0.7 * scale, y.intersp = 1.5, bty=\"n\", \n legend=c(\"Empty, no growth\",\"Empty with growth\"),\n pch = c(1,19),\n pt.bg = c(\"green3\",\"darkolivegreen4\"),\n col = c(\"green3\",\"darkolivegreen4\")\n )\n legend(x=legend.xpos[2], y= legend.ypos, cex = 0.7 * scale, y.intersp = 1.5, bty=\"n\", \n legend=c(\"Inoculated with growth\", \"Inoculated, no growth\"),\n pch = c(19,1),\n pt.bg = c(\"blue\",\"red\"),\n col = c(\"blue\",\"red\")\n )\n legend(x=legend.xpos[3], y= legend.ypos, cex = 0.7 * scale, y.intersp = 1.5, bty=\"n\", \n legend=c(\"Well tanks at specified index\", \"Some points removed\"),\n pch = c(21,23),\n pt.bg = c(\"grey\",\"grey\"),\n col = c(\"black\",\"black\")\n ) \n \n text(x=legend.xpos[4], y=legend.ypos - 0.29,\"#\",cex=0.5*scale) \n \n legend(x=legend.xpos[5], y=legend.ypos, cex = 0.7 * scale, y.intersp = 1.5, bty=\"n\", \n legend=c(\"Model fitting failed\", \"Well discarded\"),\n pch = c(4,8),\n pt.bg = c(\"black\",\"black\"),\n col = c(\"black\",\"black\")\n )\n \n # Add tanking indices if any were found. \n \ttext(grid[indices,] + 0.30, cex = 0.75*scale, \n labels = tanking[indices], col = colors[indices])\n\n # Label rows and columns\n\t\ttext(-1, -1:-plate.nrow, pos = 4, LETTERS[1:plate.nrow], cex = scale) \n\t\ttext( 1:plate.ncol, 0 , 1:plate.ncol, cex = scale) \t\n\t\t}\n \n\t}\n\n########################################################################\n# Draw each well in an array of fitted well objects in succession. #\n# Include options for adding notations, text info and fit parameters. #\n########################################################################\n#\n\nview.fit = function(fitted.data, indices = 1:length(fitted.data), \n unlog = F, constant.added, xlim = NULL, ylim = NULL, display.legend = T, \n\t\t show.text = T, show.calc = T, draw.guess = NULL, draw.symbols = F, number.points = T, \n\t\t\tuser.advance = T, show.residuals = F, scale = 1,...){\n\n if(!is.array(fitted.data))\n fitted.data = list(fitted.data)\n\n # Determine the boundaries for the axes (if user did not specify them)\n if(is.null(ylim)){\n min.y = min(unlist(aapply(fitted.data, function(well){\n \tif (unlog) well@use.log = F\n \tmin.y = min(data.from(well, remove = F, remove.tanking = F)[,2], na.rm = T)\n min(min.y, well@fit.par$b)\n \t})))\n max.y = max(unlist(aapply(fitted.data, function(well){\n if (unlog) well@use.log = F\n \tmax.y = max(data.from(well, remove = F, remove.tanking = F)[,2], na.rm = T)\n max(max.y, well@fit.par$b + well@fit.par$A)\n \t})))\n ylim = c(min.y, min.y + (max.y-min.y)*1.15) - unlog*constant.added\n }\n if(is.null(xlim)){\n min.x = min(unlist(aapply(fitted.data, function(well){\n min(data.from(well, remove = F, remove.tanking = F)[,1], na.rm = T)\n \t})))\n max.x = max(unlist(aapply(fitted.data, function(well){\n \tmax(data.from(well, remove = F, remove.tanking = F)[,1], na.rm = T)\n \t})))\n xlim = c(min.x - 0.05 * (max.x-min.x), max.x)\n }\n \n # Display a figure legend\n if(display.legend){\n well.fit.legend(xlim=xlim,ylim=ylim,scale=scale,constant.added=constant.added)\n if(user.advance){\n prompt = readline(\"<Enter> to continue or Q to quit >>\")\n if (toupper(prompt) == \"Q\") break\n }\n }\n # Start to cycle through the wells \n\twell.number = 1\n\twhile (well.number <= length(fitted.data)) {\t\t\n\t\t# Only show wells specified by <indices> (default all wells)\n if (well.number %in% indices){ \n # plot the well\n fitted.well = fitted.data[[well.number]]\n plot(x=fitted.well, constant.added = constant.added, xlim = xlim, ylim = ylim,\n unlog = unlog, well.number = well.number, scale = scale, number.points = T, draw.symbols = F, show.text = T, show.calc = T, draw.guess = NULL, ...)\n \n if(user.advance)\n cat(\"\\n[\", well.number, \"] \", plate.name(fitted.well), \" \", well.name(fitted.well), \".\", sep = \"\")\n \n if (show.residuals & is.numeric(model.residuals(fitted.well))){\n if(user.advance)\n if (toupper(readline(\"<Enter> for residuals >>\")) == \"Q\") break\n plot.residuals(fitted.well)\n }\n \n # Allow user to advance the currently shown well if specified. \n\t\t\tif (user.advance){\n \n\t\t\t\tprompt = readline(\"<Enter> to continue, or type # of next well or Q to quit >>\")\n\t\t\t\tif (toupper(prompt) == \"Q\") break\n\n user.input = suppressWarnings(try(as.numeric(prompt),silent=T))\n \n # Go onto the next well unless input is a number. \n\t\t\t\tif (is.numeric(user.input) & !is.na(user.input) & length(user.input) > 0)\n\t\t\t\t\twell.number = user.input - 1\n\t\t\t }\n\t\t\t}\n # Advance the loop\n well.number = well.number + 1\n\t\t}\t\t\n\t}\t\n\n\nwell.fit.legend = function(xlim, ylim, scale = 1, constant.added){\n par(mar = c(5, 4, 4, 5)+0.1)\n plot(0,0, main = \"[Index] <Plate Name> <Well Position>\\n<Strain Name>; <Media Definition>\",\n xlim = xlim, ylim = ylim, xlab = \"Time\", ylab = \"log(OD - blank + const)\", \n mex = scale, cex.main = 1.5*scale, cex.axis = 1.2*scale, cex.lab = 1.2*scale, type = \"n\")\n \n # Draw a second vertical axis, showing unlogged OD scale\n min.OD = unlog(ylim[1],constant.added)\n max.OD = unlog(ylim[2],constant.added)\n OD.labels = seq(from = min.OD, to = max.OD, length.out = 5)\n OD.labels = round(OD.labels,1)\n OD.at = log(OD.labels+constant.added)\n axis(side=4, at=OD.at, labels=OD.labels, cex.axis = 1.2*scale, cex.lab = 1.2*scale)\n mtext(4, text = \"OD - blank\", line = 3, cex=1.2)\n \n # Sample max. slope line\n abline(v=min(xlim)+0.5*max(xlim), col=\"blue\", lty=2)\n text(mean(xlim),min(ylim)+0.4*diff(ylim),labels=\"Maximum specific\\ngrowth rate\",col=\"blue\",pos=2,cex=0.75*scale)\n \n # Sample plateau line\n abline(h=min(ylim)+0.8*diff(ylim),col=\"forestgreen\",lty=2)\n text(min(xlim)+0.9*diff(xlim),ylim+0.8*diff(ylim),labels=\"Growth plateau\",col=\"forestgreen\",pos=3,cex=0.75*scale)\n\n # Sample max.log.OD line\n abline(h=min(ylim)+0.7*diff(ylim),col=\"black\",lty=3)\n text(min(xlim)+0.9*diff(xlim),ylim+0.7*diff(ylim),labels=\"max.log.OD\",col=\"black\",pos=1,cex=0.75*scale)\n \n # Sample inoc.log.OD\n abline(h=min(ylim)+0.1*diff(ylim),col=\"black\",lty=3)\n text(min(xlim)+0.1*diff(xlim),min(ylim)+0.1*diff(ylim),labels=\"Fitted growth\\nat inoculation\",col=\"black\",pos=3,cex=0.75*scale)\n \n # Sample baseline\n abline(h=min(ylim)+0.05*diff(ylim),col=\"red\",lty=2)\n text(min(xlim)+0.1*diff(xlim),min(ylim)+0.05*diff(ylim),labels=\"Baseline\",col=\"red\",pos=1,cex=0.75*scale)\n\n # Sample lag time\n lines(min(xlim)+c(0.1,0.25,0.50)*max(xlim),min(ylim)+c(0.05,0.05,0.4)*diff(ylim),col=\"red\",lty=2)\n text(min(xlim)+0.25*max(xlim),min(ylim)+0.05*diff(ylim),labels=\"Lag time\",col=\"red\",pos=1,cex=0.75*scale)\n \n # Sample achieved growth\n lines(min(xlim)+c(0.75,0.75)*max(xlim),min(ylim)+c(0.1,0.7)*diff(ylim),col=\"black\",lty=3)\n text(min(xlim)+0.75*max(xlim),min(ylim)+0.3*diff(ylim),labels=\"Achieved growth\",col=\"black\",cex=0.75*scale)\n \n # Sample plateau - achieved growth\n lines(min(xlim)+c(0.75,0.75)*max(xlim),min(ylim)+c(0.7,0.8)*diff(ylim),col=\"grey\",lty=3)\n text(min(xlim)+0.75*max(xlim),min(ylim)+0.75*diff(ylim),labels=\"Projected minus achieved growth\",col=\"grey\",cex=0.75*scale)\n \n # Symbol legend\n legend(x=\"right\", title = \"Timepoint Symbols\", legend = c(\"Normal point\", \"Ignored point\"),\n cex = 0.75*scale, pt.cex = c(0.6,0.6)*scale, pch = c(35,35), col=c(\"black\",\"gray80\"),\n x.intersp=1, xjust = 1, y.intersp=1.5)\n}\n\npdf.by.plate = function(fitted.data, out.prefix = \"\", upload.timestamp = NULL, \n out.dir = getwd(), unlog = F, constant.added, silent = T, overview.jpgs = T, ...){\n \n # Prepare timestamp for addition to output file names. \n filename.timestamp = strftime(upload.timestamp, format=\"_%Y-%m-%d_%H.%M.%S\")\n \n # Start file list with the overview pdf\n file.list.out = paste(out.dir,\"/\",out.prefix, \"_overview\", filename.timestamp, \".pdf\",sep=\"\")\n \n # Call <plate.overview> to draw a graphic representation of each plate in this file. \n pdf(file.list.out, title = paste(out.prefix, \"plate overview\"))\n plate.overview.out = try(plate.overview(fitted.data),silent=T)\n if(class(plate.overview.out) == \"try-error\")\n stop(\"Error in <plate.overview>: \", plate.overview.out)\n \n # Close devices\n while(dev.cur() != 1)\n dev.off() \n \n # Cycle through each plate \n for(i in 1:dim(fitted.data)[3]){\n \n # Get plate ID and position in data array.\n plate.ID = dimnames(fitted.data)[[3]][i]\n plate.indices = (i-1) * plate.nrow*plate.ncol + 1:(plate.nrow*plate.ncol)\n if(overview.jpgs){\n # most be > 1 to partition value breaks for heatmap\n well.matrix <- aapply(fitted.data[,,i], max.spec.growth.rate) \n num.wells <- length(well.matrix[!sapply(well.matrix, is.na)])\n if(num.wells > 1){\n #Heatmap block##########################################################\n #alongside the jpgs file create 3 heatmaps for each plate. NWD\n spec.heat.file = create.heatmap(fitted.data[,,i], max.spec.growth.rate)\n if(spec.heat.file == \"Error\")\n stop(\"Error in <create.heatmap> for specific growth\")\n lag.heat.file = create.heatmap(fitted.data[,,i], lag.time)\n if(lag.heat.file == \"Error\")\n stop(\"Error in <create.heatmap> for lag time\")\n total.heat.file = create.heatmap(fitted.data[,,i], achieved.growth)\n if(total.heat.file == \"Error\")\n stop(\"Error in <create.heatmap> for total growth\")\n # Add name of file if successfully written to file list output. Including heatmap files NWD\n file.list.out = c(file.list.out, spec.heat.file, lag.heat.file, total.heat.file)\n ########################################################################\n }\n jpg.name = paste(out.dir, \"/\", plate.ID, \"_overview\", \".jpg\", sep=\"\")\n jpeg(jpg.name, quality = 90, width = 600, height = 480)\n plate.overview.out = try(plate.overview(fitted.data[,,i]),silent = T)\n if(class(plate.overview.out) == \"try-error\")\n stop(\"Error in <plate.overview>: \", plate.overview.out)\n }\n else\n jpg.name = c()\n \n # Open a separate PDF for each plate.\n if(!silent) cat(\"\\nprinting PDF for\", plate.ID)\n pdf.name = paste(out.dir, \"/\", plate.ID, \"_plots\", filename.timestamp, \".pdf\", sep=\"\")\n pdf(pdf.name, title = paste(\"R Graphics output for plate\", plate.ID))\n \n # Call <view.fit> to draw each well on the plate to the pdf. \n view.fit.out = try(view.fit(fitted.data, indices = plate.indices, unlog=unlog, constant.added=constant.added, user.advance=F,...),silent=T) \n \n if(class(view.fit.out) == \"try-error\")\n stop(\"Error in <view.fit>: \", view.fit.out)\n\n # Close all devices\n while(dev.cur() != 1)\n dev.off() \n \n if(!silent) cat(\"...done!\\n\\twritten to\", pdf.name, \"\\n\") \n file.list.out = c(file.list.out, jpg.name , pdf.name)\n }\n return(file.list.out)\n } \n",
|
|
"created" : 1423869024830.000,
|
|
"dirty" : false,
|
|
"encoding" : "UTF-8",
|
|
"folds" : "",
|
|
"hash" : "197404081",
|
|
"id" : "7189AD56",
|
|
"lastKnownWriteTime" : 1423869067,
|
|
"path" : "~/Documents/GCAT4_old/trunk/R/GCAT/R/plot.fit.R",
|
|
"project_path" : "plot.fit.R",
|
|
"properties" : {
|
|
},
|
|
"source_on_save" : false,
|
|
"type" : "r_source"
|
|
} |