Minh
16 lines
17 KiB
Plaintext
16 lines
17 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\n########################################################################\n# #\n# <well> class definition and functions. Objects contain raw #\n# data from screening runs on single wells from 96-well plates, and #\n# other slots for processing and model-fitting details. #\n# #\n########################################################################\n\n# Windows OS compatibility\nSys.setlocale(locale=\"C\")\n#require(RExcelXML)\n\n# Treat nls and loess as S4 classes to avoid warnings\nsetOldClass(\"nls\")\nsetOldClass(\"loess\")\nsetClass(\"well\", representation(position = \"character\",\n\t\t\t\t\t well.info = \"list\",\n\t\t\t\t\t screen.data = \"data.frame\", \n start.index = \"numeric\",\n\t\t\t\t\t use.log = \"logical\",\n\t\t\t\t\t norm = \"numeric\",\n\t\t\t\t\t curve.par = \"list\", \n\t\t\t\t\t fit.par = \"list\",\n fit.std.err = \"list\",\n\t\t\t\t\t equation = \"expression\",\n\t\t\t\t\t model.name = \"character\",\n\t\t\t\t\t fit.info = \"character\",\n\t\t\t\t\t add.info = \"character\",\n inflection.time = \"numeric\",\n rss = \"numeric\",\n loess = \"loess\",\n nls = \"nls\"))\n\n# Slots:\n# position - 3-member vector containing identifying information for the well: row (letters), column (numbers) and plate ID. \n# well.info - a list containing strain and media names if provided\n# screen.data - a data frame with Time and raw OD values. This is the only slot that is filled upon creation of a well object. \n# as different functions are run on the well the data frame gets filled with additional columns. \n# use.log - a single logical value denoting whether to return log-transformed values when data is requested from the well\n# norm - a value to subtract from all OD values before returning data. filled by <normalize.ODs> (see normalize.and.transform.R)\n# curve.par - a list of parameters that denote whether the well is empty, whether it contains ODs indicating a viable culture, whether it tanks at a certain timepoint. \n\n# if model fitting using <fit.model> is successful:\n# fit.par - will be a list containing the fitted model parameters\n# fit.std.err - will be a list containing the standard errors for the fitted model parameters\n# equation - will contain an expression for evaluating the successfully fitted model \n# model.name - will contain the name of the successfully fit model\n\n# fit.info - a message with info about whether the fit was successful, failed, or skipped. \n# add.info - a message with info about whether jumps in OD were detected or removed, or if ODs were detected below the blank OD.\n# inflection.time - the Time value at the point where the specific growth is located. no longer a formula param NWD\n# rss - residual sum of squares\n# loess - object returned by running loess on the normalized well data\n# nls - object returned by running nls on the normalized well data\n\nsetGeneric(\"getPosition\", function(object){standeardGeneric(\"getPosition\")})\nsetMethod(\"getPosition\", \"well\", \n function(object){\n return(object@position)\n })\n\nsetGeneric(\"getWellInfo\", function(object){standeardGeneric(\"getWellInfo\")})\nsetMethod(\"getWellInfo\", \"well\", \n function(object){\n return(object@well.info)\n })\n\nsetGeneric(\"getScreenData\", function(object){standeardGeneric(\"getScreenData\")})\nsetMethod(\"getScreenData\", \"well\", \n function(object){\n return(object@screen.data)\n })\n\nsetGeneric(\"getStartIndex\", function(object){standeardGeneric(\"getStartIndex\")})\nsetMethod(\"getStartIndex\", \"well\", \n function(object){\n return(object@start.index)\n })\n\nsetGeneric(\"getUseLog\", function(object){standeardGeneric(\"getUseLog\")})\nsetMethod(\"getUseLog\", \"well\", \n function(object){\n return(object@use.log)\n })\n\nsetGeneric(\"getNorm\", function(object){standeardGeneric(\"getNorm\")})\nsetMethod(\"getNorm\", \"well\", \n function(object){\n return(object@norm)\n })\n\nsetGeneric(\"getCurPar\", function(object){standeardGeneric(\"getCurPar\")})\nsetMethod(\"getCurPar\", \"well\", \n function(object){\n return(object@curve.par)\n })\n\nsetGeneric(\"getFitErr\", function(object){standeardGeneric(\"getFitErr\")})\nsetMethod(\"getFitErr\", \"well\", \n function(object){\n return(object@fit.std.err)\n })\n\nsetGeneric(\"getEquation\", function(object){standeardGeneric(\"getEquation\")})\nsetMethod(\"getEquation\", \"well\", \n function(object){\n return(object@equation)\n })\n\nsetGeneric(\"getModelName\", function(object){standeardGeneric(\"getModelName\")})\nsetMethod(\"getModelName\", \"well\", \n function(object){\n return(object@model.name)\n })\n\nsetGeneric(\"getFitInfo\", function(object){standeardGeneric(\"getFitInfo\")})\nsetMethod(\"getFitInfo\", \"well\", \n function(object){\n return(object@fit.info)\n })\n\nsetGeneric(\"getAddInfo\", function(object){standeardGeneric(\"getAddInfo\")})\nsetMethod(\"getAddInfo\", \"well\", \n function(object){\n return(object@add.info)\n })\n\nsetGeneric(\"getInflectionTime\", function(object){standeardGeneric(\"getInflectionTime\")})\nsetMethod(\"getInflectionTime\", \"well\", \n function(object){\n return(object@inflection.time)\n })\n\nsetGeneric(\"getRSS\", function(object){standeardGeneric(\"getRSS\")})\nsetMethod(\"getRSS\", \"well\", \n function(object){\n return(object@rss)\n })\n\nsetGeneric(\"getLoess\", function(object){standeardGeneric(\"getLoess\")})\nsetMethod(\"getLoess\", \"well\", \n function(object){\n return(object@loess)\n })\n\nsetGeneric(\"getnls\", function(object){standeardGeneric(\"getnls\")})\nsetMethod(\"getnls\", \"well\", \n function(object){\n return(object@nls)\n })\n\nsetGeneric(\"getFitPar\", function(object){standeardGeneric(\"getFitPar\")})\nsetMethod(\"getFitPar\", \"well\", \n function(object){\n return(object@fit.par)\n })\n\n# --------------------------------------------------------------------\n# Function to create a new well (requires only Time and OD vectors, which will fill slot \"screen.data\")\n# slots \"nls\" and \"loess\" are initialized to empty lists\nwell = function(Time = NULL, OD = NULL){\n x = list()\n class(x) = \"loess\"\n y = list()\n class(y) = \"nls\"\n\tnew(\"well\", screen.data = data.frame(Time, OD, stringsAsFactors=F), loess=x, nls=y)\n}\n\n# -----------------------------------------------------------------------\n#### A show method for well ####\nsetMethod(\"show\", \"well\",\n function(object) {\n print(\"Object of class well\")\n print(\"@position:\")\n print(object@position)\n print(\"@well.info:\")\n print(object@well.info)\n print(\"@screen.data:\")\n print(head(object@screen.data))\n print(\"...\")\n print(paste(nrow(object@screen.data),\"rows of data\"))\n print(paste(\"@start.index:\",object@start.index))\n print(paste(\"@use.log:\",object@use.log))\n print(paste(\"@norm:\",object@norm))\n print(\"@curve.par:\")\n print(object@curve.par)\n print(\"@fit.par:\")\n print(object@fit.par)\n print(\"@fit.std.err:\")\n print(object@fit.std.err)\n print(paste(\"@equation:\",object@equation))\n print(paste(\"@model.name:\",object@model.name))\n print(paste(\"@fit.info:\",object@fit.info))\n print(paste(\"@add.info:\",object@add.info))\n print(paste(\"@inflection.time:\",object@inflection.time))\n print(paste(\"@rss:\",object@rss))\n if (length(object@nls) > 0) {\n print(\"@nls:\")\n print(object@nls)\n } else {\n print(\"no nls model\")\n }\n if (length(object@loess) > 0) {\n print(\"@loess:\")\n print(object@loess)\n } else {\n print(\"no loess model\")\n }\n }\n )\n\n#### A plot method for well ####\n# x - object of class well\n# y - not used\n# constant.added - used to readjust for the constant added during the log transform: log.OD = log(OD - blank + constant.added)\n# xlim - x axis limits, vector of length 2\n# ylim - y axis limits, vector of length 2\n# scale - determines the font scale for the entire graph. all cex values are calculated from this\n# number.points - should points be labeled with numeric indices?\n# draw.symbols - should <check.slopes> be called on the well and markings drawn on the graph?\n# show.text - show R^2 and growth curve parameters as text on the plot\n# show.calc - draw lines that illustrate growth curve parameters\n# draw.guess - initial guess model. Drawn if specified\n# well.number - the number of the well in an array of wells\n# ... - additional arguments passed to the generic plot function\n\nsetMethod(\"plot\",\n signature(x = \"well\", y=\"missing\"),\n function (x, y, constant.added = 1.0, xlim = NULL, ylim = NULL,\n well.number = NULL, scale = 1, number.points = T, draw.symbols = F, show.text = T, show.calc = T, draw.guess = NULL, ...) \n {\n # Determine the boundaries for the axes (if user did not specify them)\n if(is.null(ylim)){\n min.y = min(data.from(x, remove = F, remove.tanking = F)[,2], na.rm = T)\n min.y = min(min.y, x@fit.par$b)\n max.y = max(data.from(x, remove = F, remove.tanking = F)[,2], na.rm = T)\n max.y = max(max.y, x@fit.par$b + x@fit.par$A)\n ylim = c(min.y, min.y + (max.y-min.y)*1.15)\n }\n if(is.null(xlim)){\n min.x = min(data.from(x, remove = F, remove.tanking = F)[,1], na.rm = T)\n max.x = max(data.from(x, remove = F, remove.tanking = F)[,1], na.rm = T)\n xlim = c(min.x - 0.05 * (max.x-min.x), max.x)\n }\n \n \n # Title of plot: [well number] plate name; well name;\n # strain name; media name\n \n main = paste(plate.name(x), \" \", well.name(x), \"\\n\",\n strain.name(x), \"; \", media.name(x), sep = \"\")\n if (!is.null(well.number)) main = paste(\"[\", well.number , \"] \", main, sep=\"\")\n \n # Draw the data and symbols if <draw.symbols> is true.\n plot.data(x, main = main, scale = scale, constant.added=constant.added, \n number.points = number.points, draw.symbols = draw.symbols, xlim = xlim, ylim = ylim, ...)\n \n # Draw the fitted model.\n plot.model(x, scale = scale, constant.added=constant.added)\n \n # Draw text info if specified. \n if(show.text)\n draw.text(x, scale = scale * 0.5, xlim = xlim, ylim = ylim,...)\n \n # Show calculated parameters if specified. \n if (show.calc)\n draw.calc.par(x, scale = scale * 0.5, constant.added = constant.added)\n \n # Draw initial guess if a model is specified. \n if (class(draw.guess) == \"model\"){\n Time = data.from(x)$Time\n guess = eval(getExpression(draw.guess), as.list(getGuess(draw.guess)(x)))\n try(lines(Time, guess, col = \"brown2\"), silent = T)\n }\n }\n)\n\n########################################################################\n# Some miscellaneous functions to extract info from well objects #\n# Most of these return a single value from the well. #\n########################################################################\n#\n# Since many of these need to be applied to all wells over an array, while conserving the dimensions of \n# that array, this file includes a wrapper function <aapply> (see bottom of file).\n\nplate.name = function(well)\n\tgetPosition(well)[1]\n\n# Return the full alphanumeric well name (with leading zeros if applicable)\nwell.name = function(well){\n\trow = getPosition(well)[2]\n\tcol = as.numeric(getPosition(well)[3])\n\tif (col>9)\n\t\tcol = as.character(col)\n\telse\n\t\tcol = paste(\"0\", col, sep = \"\")\n\n\tpaste(row,col,sep = \"\")\n\t}\n\nis.empty = function(well)\n\tgetCurPar(well)$empty.well\n\nlacks.growth = function(well)\n\tgetCurPar(well)$no.growth\n\ntanking.start = function(well)\n\tgetCurPar(well)$tanking.start\n\nremoved.points = function(well)\n\t(1:length(well))[getScreenData(well)$Remove]\n\nremaining.points = function(well,...){\n\tas.numeric(rownames(data.from(well,...)))\n\t}\n\nstrain.name = function(well){\n if(is.null(getWellInfo(well)$Strain))\n return(\"<NA>\")\n else\n return(getWellInfo(well)$Strain)\n }\nmedia.name = function(well){\n if(is.null(getWellInfo(well)$Media))\n return(\"<NA>\")\n else\n return(getWellInfo(well)$Media)\n }\n\nraw.data = function(well)\n\tdata.from(well, remove.tanking = F, remove = F, na.rm = F, raw.data = T)\n\ncontains.fit = function(well)\n\tlength(getFitPar(well)) > 0\n\nsetMethod(\"length\", signature(x = \"well\"), function(x) length(x@screen.data[,1]))\n\n# The <data.from> function has some options: by default it returns a two-column data frame with time and OD \n# (or log OD if the <use.log> slot is true in the object), after normalization to the value specified in <norm> slot. \n# - With <remove> set to true the rows specified in the <remove> column of the <screen.data> slot are not returned. \n# - With <remove.tanking> set to true all the rows after the <tanking.start> index are removed. \n# - Setting <raw.data> to true overrides all these settings and just returns 2 columns with Time and Raw OD.\n\ndata.from = function(well, remove = T, remove.tanking = T, raw.data = F, na.rm = F){\n\t\n\tif (length(getUseLog(well)) == 0)\n\t\tOD.column = \"OD\"\n\telse if (getUseLog(well))\n\t\tOD.column = \"log.OD\"\n\telse\n\t\tOD.column = \"OD\"\n\t\n\tif (raw.data){\n\t\tOD.column = \"OD\"\n\t\tnorm = 0\n\t\t}\n\telse if (!getUseLog(well))\n\t\tnorm = getNorm(well)\n\telse\n\t\tnorm = 0\n\n\tif(remove.tanking & is.numeric(tanking.start(well)))\n\t\twell = remove.points(well, (tanking.start(well)):length(well))\n\tif (!remove | is.null(getScreenData(well)$Remove))\n\t\toutput = getScreenData(well)[c(\"Time\", OD.column)]\n\telse\n\t\toutput = getScreenData(well)[!getScreenData(well)$Remove ,c(\"Time\", OD.column)]\n\n\toutput[,2] = output[,2] - norm\n\n\tif (!raw.data){\n\t\tif (!length(getUseLog(well)))\n\t\t\tnames(output)[2] = \"Corrected.OD\"\n\t\tif (!getUseLog(well))\n\t\t\tnames(output)[2] = \"Corrected.OD\"\n\t\t}\n\n\tif (na.rm)\n\t\toutput[!is.na(output[,2]),]\t \n\telse\n\t\toutput\n\t}\n\n\n# Functions much like <data.from> but gives a single vector containing the \n# slope at each point. Has a parameter allowing removal of NA values. \n\nslopes = function(well, remove = T, remove.tanking = T, na.rm = F){\n\n\tif(remove.tanking & is.numeric(tanking.start(well)))\n\t\twell = remove.points(well, (tanking.start(well)):length(well))\n\tif (!remove | is.null(getScreenData(well)$Remove))\n\t\toutput = getScreenData(well)$Slope\n\telse\n\t\toutput = getScreenData(well)$Slope[!getScreenData(well)$Remove]\n\n\tif (na.rm)\n\t\toutput[!is.na(output)]\t \n\telse\n\t\toutput\n\t}\n\n# -----------------------------------------------------------------------\n# Well array functions: these must be used on entire arrays of well objects\n# instead of single ones. \n\nplate.names = function(well.array)\n\tdimnames(well.array)[[3]]\n\ntanking.start.values = function(well.array, array = F){\n\tif (array)\n\t\taapply(well.array, function(well) tanking.start(well))\n\telse\n\t\tsapply(well.array, function(well) tanking.start(well))\n\t}\n\n",
|
|
"created" : 1425413290697.000,
|
|
"dirty" : false,
|
|
"encoding" : "UTF-8",
|
|
"folds" : "",
|
|
"hash" : "2437520955",
|
|
"id" : "4DC8D1",
|
|
"lastKnownWriteTime" : 1425509121,
|
|
"path" : "~/Documents/GCAT4/trunk/R/GCAT/R/class.well.R",
|
|
"project_path" : "R/class.well.R",
|
|
"properties" : {
|
|
},
|
|
"source_on_save" : false,
|
|
"type" : "r_source"
|
|
} |