From 49679639ded05e7ef954c23f50d3d94d3d6dc1dd Mon Sep 17 00:00:00 2001
From: ranke <ranke@5fad18fb-23f0-0310-ab10-e59a3bee62b4>
Date: Thu, 22 Mar 2007 16:44:33 +0000
Subject: Start of the integration of nonlinear calibration models

git-svn-id: http://kriemhild.uft.uni-bremen.de/svn/chemCal@19 5fad18fb-23f0-0310-ab10-e59a3bee62b4
---
 R/calfunctions.R       |  2 ++
 R/inverse.predict.lm.R | 20 +++++++++++++++++++-
 2 files changed, 21 insertions(+), 1 deletion(-)
 create mode 100644 R/calfunctions.R

(limited to 'R')

diff --git a/R/calfunctions.R b/R/calfunctions.R
new file mode 100644
index 0000000..6ce29f7
--- /dev/null
+++ b/R/calfunctions.R
@@ -0,0 +1,2 @@
+powfunc <- function(x,a,b) a * x^b
+ipowfunc <- function(y,a,b) (y/a)^1/b
diff --git a/R/inverse.predict.lm.R b/R/inverse.predict.lm.R
index 927e672..d57275c 100644
--- a/R/inverse.predict.lm.R
+++ b/R/inverse.predict.lm.R
@@ -11,7 +11,7 @@ inverse.predict <- function(object, newdata, ...,
 inverse.predict.default <- function(object, newdata, ...,
   ws = "auto", alpha = 0.05, var.s = "auto")
 {
-  stop("Inverse prediction only implemented for univariate lm objects.")
+  stop("Inverse prediction only implemented for univariate lm and nls objects.")
 }
 
 inverse.predict.lm <- function(object, newdata, ...,
@@ -46,6 +46,24 @@ inverse.predict.rlm <- function(object, newdata, ...,
     ws = ws, alpha = alpha, var.s = var.s, w = w, xname = xname, yname = yname)
 }
 
+inverse.predict.nls <- function(object, newdata, ...,
+  ws = "auto", alpha = 0.05, var.s = "auto")
+{
+  yname = names(object$model)[[1]]
+  xname = names(object$model)[[2]]
+  if (ws == "auto") {
+    ws <- ifelse(length(object$weights) > 0, mean(object$weights), 1)
+  }
+  if (length(object$weights) > 0) {
+    wx <- split(object$weights,object$model[[xname]])
+    w <- sapply(wx,mean)
+  } else {
+    w <- rep(1,length(split(object$model[[yname]],object$model[[xname]])))
+  }
+  if (length(object$coef) > 2)
+    stop("More than one independent variable in your model - not implemented")
+}
+
 .inverse.predict <- function(object, newdata, ws, alpha, var.s, w, xname, yname)
 {
   if (length(object$coef) > 2)
-- 
cgit v1.2.1