Minh
16 lines
12 KiB
Plaintext
16 lines
12 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# Fit a parameterized model to the growth data in a well object. #\n# #\n# There are now three modelling choices: #\n# 1) Sigmoid model (no linear param c) #\n# 2) Linear Sigmoid model #\n# 3) Loess (with optional smoothing parameter) #\n########################################################################\n#' fit.model \n#' \n#' This function will use the function stored in the \"guess\" slot of \\code{growth.model} to calculate initial guesses \n#' for growth.model parameters, then it will use the \"formula\" slot with \\code{nls} to fit a non-linear least squares \n#' \\code{growth.model} or Local Polynomial Regression Fitting to the data. Richards model is first fitted. \n#' If the shape parameter is statisticaly significant then Richards is used. If it is within 2 SE of 1 or Zero than \n#' a simpler model is preferred. If the Richards fit fails, then Logistic is tried. If it fails, Gompertz is tried. \n#' Model fit failure is reported if none of the models can sucessfully fit the data \n#' \n#' @param input.well The well needed to be fitted with the given model. \n#' @param growth.model What growth model should be used? \n#' @param backup.growth.model If \\code{gowth.mode} fails, this model will be used. \n#' @param fit.if.no.growth should the function attempt to fit a well even if there was no growth detected? default is F \n#' @param silent output back to R console? \n#' @param use.linear.param: Should an additional linear parameter (c) be used when fitting the data to the model? \n#' @param use.loess: Should Local Polynomial Regression Fitting (loess function) be used instead of nls? \n#' @param smooth.param: If loess is used, an optional smoothing parameter. Default is .6 \nfit.model = function(input.well, growth.model, backup.growth.model = NULL, fit.if.no.growth = F, \n use.linear.param=F, use.loess=F, smooth.param, silent = T){\n \n # Conditional breakpoint: go into debugging mode when fitting a specific well\n #if (input.well@position[\"row\"] == \"A\" && input.well@position[\"col\"] == \"12\") browser()\n \n # Change all relevant slots to <NA> or blank values\n input.well@model.name = \"<NA>\"\n input.well@fit.par = list()\n input.well@equation = expression()\n \n # Get OD vs. time data from well\n input.data = data.from(input.well, na.rm = T)\n \n # Skip well if <no.growth> in slot \"curve.par\" is set to true, and <fit.if.no.growth> is false.\n if(!fit.if.no.growth & lacks.growth(input.well)){\n input.well@fit.info = \"skipped - no growth in well.\"\n if (!silent)\n cat(plate.name(input.well), well.name(input.well), \":\", input.well@fit.info, \"\\n\")\n return(input.well)\n }\n # Skip well if there are fewer than 5 data points left in the analysis.\n if (length(input.data$Time) < 5){\n input.well@fit.info = \"skipped - not enough points.\"\n if (!silent)\n cat(plate.name(input.well), well.name(input.well), \":\", input.well@fit.info, \"\\n\")\n return(input.well)\n }\n \n # Change column headers of input.data to the more general \"Time\" vs. \"y\"\n names(input.data) = c(\"Time\", \"y\")\n \n # Set a lower bound for nls model parameters A and b to slightly lower than min(y)\n low.y = min(input.data$y,na.rm=T)\n low.y = low.y - 0.1*abs(low.y)\n \n # Extract the model formula from <growth.model> (slot \"formula\")\n # Use the function from slot \"guess\" to calculate initial guesses for model parameters based on slope estimates in <input.well>\n # Attempt to fit a nonlinear least squares odel using <nls>\n \n # Creating loess, logistics, richards, and gompertz model. \n loess.e = expression(\"loess\")\n loess.f = formula(Time ~ y)\n loess.model = model(\"local polynomial regression fit.\", loess.e, loess.f, loess.g)\n \n ### Testing accessor method for class model.\n #print(getName(loess.model))\n #print(getFormula(loess.model))\n #print(getGuess(loess.model))\n ### End testing ###\n \n remove(loess.e, loess.f)\n \n ########################################################################\n # Create the logistic 4-parameter model (when v ~ 1) #\n ########################################################################\n logistic.g = function(well,smooth.param=0.75) {\n loess.model@guess(well,smooth.param)\n }\n \n ########################################################################\n # Create the Richards 5-parameter model #\n ########################################################################\n richards.g = function(well,smooth.param=0.75){\n c(loess.model@guess(well,smooth.param),v=0.5)\n }\n \n ########################################################################\n # Create the Gompertz model (might be useful as a #\n # limiting case of Richards model when v ~ 0) #\n ########################################################################\n gompertz.g = function(well,smooth.param=0.75){\n loess.model@guess(well,smooth.param)\n }\n \n logistic.e = expression((A/(1+exp((4*u/A)*(lam-Time)+2)))+b)\n logistic.f = formula(y~(A/(1+exp((4*u/A)*(lam-Time)+2)))+b)\n logistic = model(\"logistic sigmoid.\", logistic.e, logistic.f, logistic.g)\n remove(logistic.e, logistic.f, logistic.g)\n \n richards.e = expression(A*(1+v*exp(1+v)*exp((u/A)*(1+v)**(1+1/v)*(lam-Time)))**(-1/v)+b)\n richards.f = formula(y~A*(1+v*exp(1+v)*exp((u/A)*(1+v)**(1+1/v)*(lam-Time)))**(-1/v)+b)\n richards = model(\"richards sigmoid\", richards.e, richards.f, richards.g)\n remove(richards.e, richards.f, richards.g)\n \n gompertz.e = expression(A*exp(-exp((u*exp(1)/A)*(lam-Time)+1))+b)\n gompertz.f = formula(y~A*exp(-exp((u*exp(1)/A)*(lam-Time)+1))+b)\n gompertz = model(\"gompertz sigmoid\", gompertz.e, gompertz.f, gompertz.g)\n remove(gompertz.e, gompertz.f, gompertz.g)\n \n \n \n # 3) Loess (with optional smoothing parameter)\n if(use.loess){\n number.of.points = nrow(input.well@screen.data)\n if (smooth.param <= 1/number.of.points)\n exception(\"Invalid input\", \"Smoothing parameter is out of range.\")\n \n fit = try(loess(y~Time, data=input.data, span=smooth.param), silent=TRUE)\n input.well@loess = fit\n if (class(fit) != \"loess\") stop(\"loess fit failed on well\", paste(input.well@position,collapse=\" \"))\n input.well@fit.info = \"Loess model fit successfully.\"\n input.well@model.name = loess.model@name\n input.well@equation = loess.model@expression\n # There are no estimated params, so just return the initial guesses\n input.well@fit.par = append(as.list(loess.model@guess(input.well,smooth.param)),list(\"smoothing parameter\"=smooth.param))\n # Note: since there are no params there are no Std. Errors either\n input.well@inflection.time = inflection.time(input.well)\n # calculate Rss for loess\n input.well@rss = sum((input.data$y-predict(fit))**2)\n } else {\n fit = fit.nls.model(input.well,richards)\n # should we use richards? Yes, unless the v param is close to 1 or Zero\n if(class(fit) == \"nls\"){\n rich.fit = fit # if v is significant or other fits consequently fail\n fit.par = as.list(coef(fit))\n # is fit similar to the Logistic?\n if(fit.par$v >= .5 && abs(fit.par$v-1) < 2*summary(fit)$parameters[\"v\",\"Std. Error\"] ){\n fit = fit.nls.model(input.well,logistic)\n input.well@fit.info = paste(\"Logistic model fit successfully.\")\n input.well@model.name = logistic@name\n input.well@equation = logistic@expression\n # is fit similar to Gompertz?\n }else if(fit.par$v < .5 && abs(fit.par$v) < 2*summary(fit)$parameters[\"v\",\"Std. Error\"]){\n fit = fit.nls.model(input.well,gompertz)\n input.well@fit.info = \"Gompertz model fit successfully.\"\n input.well@model.name = gompertz@name\n input.well@equation = gompertz@expression\n # v param is significant. stick with Richards\n }else{\n input.well@fit.info = paste(\"Richards model fit successfully.\")\n input.well@model.name = richards@name\n input.well@equation = richards@expression\n }\n # just in case logistic or gompertz failed to fit...\n if(class(fit) != \"nls\"){\n fit = rich.fit\n input.well@fit.info = paste(\"Richards model fit successfully.\")\n input.well@model.name = richards@name\n input.well@equation = richards@expression\n }\n } else{\n # Richards failed. try backup models\n fit = fit.nls.model(input.well,logistic)\n if(class(fit) != \"nls\"){\n # last resort try gompertz\n fit = fit.nls.model(input.well,gompertz)\n if(class(fit) != \"nls\"){\n input.well@fit.info = \"Model fitting failed.\" \n } else{\n input.well@fit.info = \"Gompertz model fit successfully.\"\n input.well@model.name = gompertz@name\n input.well@equation = gompertz@expression\n }\n }else{\n input.well@fit.info = paste(\"Logistic model fit successfully.\")\n input.well@model.name = logistic@name\n input.well@equation = logistic@expression\n }\n }\n }\n \n # If no error was reported by the model fitting, add coefficients to slot \"fit.par\",\n # Also add the Standard Errors for each parameter\n if (class(fit) == \"nls\"){\n input.well@nls = fit\n input.well@inflection.time = inflection.time(input.well)\n input.well@fit.par = as.list(coef(fit))\n rSs = sum(residuals(fit)**2)\n \n if (length(rSs) != 0)\n input.well@rss = rSs\n else \n input.well@rss = NA\n input.well@fit.std.err = as.list(summary(fit)$parameters[,\"Std. Error\"])\n }\n # Output to console\n if (!silent)\n cat(plate.name(input.well), well.name(input.well), \":\", input.well@fit.info, \"\\n\")\n return(input.well)\n}\n\n# Fit nls model to a well using a specified model\n# Arguments:\n# input.well: object of class well\n# model: object of class model, e.g. richards, gompertz or logistic\nfit.nls.model <- function (input.well, model) {\n # Get OD vs. time data from well\n input.data = data.from(input.well, na.rm = T)\n # Change column headers of input.data to the more general \"Time\" vs. \"y\"\n names(input.data) = c(\"Time\", \"y\")\n \n # Set a lower bound for nls model parameters A and b to slightly lower than min(y)\n low.y = min(input.data$y,na.rm=T)\n low.y = low.y - 0.1*abs(low.y)\n \n # Set the initial guess\n start = model@guess(input.well)\n \n # Set lower bounds\n if (length(start) == 4) {\n lower = c(low.y,low.y,0,0)\n } else if (length(start) == 5) {\n lower = c(low.y,low.y,0,0,0.07)\n } else {\n stop(\"Unsupported model: \", model@name)\n }\n # Make sure initial guess values do not violate lower bounds\n start[start < lower] = lower[start < lower]\n \n # Fit the model\n try(nls(formula = model@formula, data = input.data, start = start, algorithm=\"port\", lower=lower), silent = TRUE)\n}\n",
|
|
"created" : 1425413287007.000,
|
|
"dirty" : false,
|
|
"encoding" : "UTF-8",
|
|
"folds" : "",
|
|
"hash" : "2355348307",
|
|
"id" : "B0B7416E",
|
|
"lastKnownWriteTime" : 1425509229,
|
|
"path" : "~/Documents/GCAT4/trunk/R/GCAT/R/fit.model.R",
|
|
"project_path" : "R/fit.model.R",
|
|
"properties" : {
|
|
},
|
|
"source_on_save" : false,
|
|
"type" : "r_source"
|
|
} |