Merge pull request #13 from ahwbest/master

Merging to Justin's github

NAMESPACE

@@ -6,7 +6,9 @@ S3method(dr4pl,default)
 S3method(dr4pl,formula)
 S3method(plot,dr4pl)
 S3method(summary,dr4pl)
+export(FindHillBounds)
 export(FindInitialParms)
+export(FindLogisticGrids)
 export(Hessian)
 export(IC)
 export(MeanResponse)

R/auxiliary.R

@@ -18,16 +18,17 @@
 #' @details This function computes the confidence intervals of the parameters of the
 #'   4PL model based on the second order approximation to the Hessian matrix of the
 #'   loss function of the model. Please refer to Subsection 5.2.2 of 
-#'   Seber, G. A. F. and Wild, C. J. (1989). Nonlinear Regression. Wiley Series in
-#'   Probability and Mathematical Statistics: Probability and Mathematical
-#'   Statistics. John Wiley & Sons, Inc., New York.
+#'   Seber and Wild (1989).
 #'   
 #' @examples
 #'   obj.dr4pl <- dr4pl(Response ~ Dose, data = sample_data_1)
 #'   parm <- obj.dr4pl$parameters
 #'
 #'   confint(obj.dr4pl, parm = parm, level = 0.95)
 #' 
+#' @references
+#' \insertRef{Seber1989}{dr4pl}
+#' 
 #' @export
 confint.dr4pl <- function(object, parm, level, ...) {
 
@@ -82,9 +83,7 @@ coef.dr4pl <- function(object, ...) {
 #'   Chi squared distributions with the (n - 4) degrees of freedom where n is the
 #'   number of observations and 4 is the number of parameters in the 4PL model. For
 #'   detailed explanation of the method, please refer to Subsection 2.1.5 of
-#'   Seber, G. A. F. and Wild, C. J. (1989). Nonlinear Regression. Wiley Series in
-#'   Probability and Mathematical Statistics: Probability and Mathematical
-#'   Statistics. John Wiley & Sons, Inc., New York.
+#'   Seber and Wild (1989).
 #'
 #' @references
 #' \insertRef{Seber1989}{dr4pl}
@@ -243,6 +242,8 @@ IC <- function(object, inhib.percent) {
 #'      text.x = "Concentration", 
 #'      text.y = "Count")
 #' 
+#' @author Hyowon An and Justin T. Landis
+#' 
 #' @export
 plot.dr4pl <- function(x,
                        text.title = "Dose-response plot",

R/base.R

@@ -1,4 +1,35 @@
 
+#' Transform parameters of a 4PL model (theta) into re-parameterized parameters
+#' (theta.re)
+#' 
+#' @param theta Parameters of a 4PL model in the dose scale
+#' 
+#' @return Reparameterized parameters of a 4PL model among which the EC50 parameter
+#' is in the log 10 dose scale
+ParmToLog <- function(theta) {
+
+  # Check whether function arguments are 
+
+  theta.re <- c(theta[1], log10(theta[2]), theta[3], theta[4])
+
+  return(theta.re)
+}
+
+#' Transform reparameterized parameters (theta.re) back into original parameters 
+#' (theta)
+#' 
+#' @param theta.re Parameters of a 4PL model among which the EC50 parameter is
+#' in the log 10 dose scale
+#' 
+#' @return Parameters of a 4PL model among which the EC50 parameter is in the
+#' dose scale
+LogToParm <- function(theta.re) {
+
+  theta <- c(theta.re[1], 10^(theta.re[2]), theta.re[3], theta.re[4])
+
+  return(theta)
+}
+
 #' Compute an estimated mean response
 #'
 #' @param x Dose levels
@@ -245,7 +276,6 @@ DerivativeFLogIC50 <- function(theta.re, x) {
 #' @param y Response
 #'
 #' @return Gradient values of the sum-of-squares loss function.
-
 GradientSquaredLossLogIC50 <- function(theta.re, x, y) {
 
   f <- MeanResponseLogIC50(x, theta.re)  # Mean response values
@@ -319,14 +349,26 @@ Hessian <- function(theta, x, y) {
 
 #' Compute residuals.
 #' 
-#' @param x Doses
-#' @param y Responses
-#' @param theta Parameters
+#' @param theta Parameters of a 4PL model
+#' @param x Vector of doses
+#' @param y Vector of responses
 #' 
-#' @return Residuals
+#' @return Vector of residuals
 Residual <- function(theta, x, y) {
+
+  return(y - MeanResponse(x, theta))
+}
 
-  f <- theta[1] + (theta[4] - theta[1])/(1 + (x/theta[2])^theta[3])
+#' Compute residuals with a reparameterized model.
+#' 
+#' @param theta.re Parameters of a 4pl model among which the IC50 parameter is
+#' transformed into a log 10 scale.
+#' @param x Vector of doses
+#' @param y Vector of responses
+#' 
+#' @return Vector of residuals
+ResidualLogIC50 <- function(theta.re, x, y) {
+
 
-  return(y - f)
+  return(y - MeanResponseLogIC50(x, theta.re))
 }