Optimierung der nichtlinearen Langmuir-Parameterschätzung in R

Question

Ich bin daran interessiert, nls zu verwenden, um bei der Anpassung der Langmuir-Gleichung Y =(Qmax*k*X)/(1+(k*X)) ähnlich wie in diesem Beitrag Fitting Non-linear Langmuir Isotherm in R zu helfen. Der Parameter der Gleichung, an der ich interessiert bin, ist , was der horizontalen Asymptote (grüne Linie) der unten dargestellten Sorptionsdaten entspricht. Gibt es einen robusteren Ansatz als nls oder eine Möglichkeit zur Verbesserung meiner Verwendung von nls, die ich verwenden könnte, um einen Wert so nahe wie möglich an die visuelle Asymptote (grüne Linie) um Qmax=3200 zu erhalten?

Lang <- nls(formula = Y ~ (Qmax*k*X)/(1+(k*X)), data = data, start = list(Qmax = 3600, k = 0.015), algorith = "port") 

Unter Verwendung der folgenden Daten:

 X  Y 
1 3.08 84.735 
2 5.13 182.832 
3 6.67 251.579 
4 9.75 460.077 
5 16.30 779.350 
6 25.10 996.540 
7 40.80 1314.739 
8 68.90 1929.422 
9 111.00 2407.668 
10 171.00 3105.850 
11 245.00 3129.240 
12 300.00 3235.000 

Ich erhalte eine Qmax = 4253.63 (rote Linie) - rund 1000 Einheiten entfernt. Die Verwendung von oberen und unteren Grenzwerten führt nur zu einer Qmax von dem, wofür ich die Obergrenze festlege, und das Ändern der Anfangswerte scheint das Ergebnis nicht zu verändern. Ist dies eine Herausforderung, die mit einem anderen Ansatz zur nichtlinearen Regression gelöst werden kann, als ich in der Basis R angenommen habe, oder ist dies in erster Linie ein statistisch/mathematisches Problem?

Plot of Non-linear Langmuir Isotherm

summary(Lang) 

    Formula: Y ~ (Qmax * k * X)/(1 + (k * X)) 

Parameters: 
     Estimate Std. Error t value Pr(>|t|)  
Qmax 4.254e+03 1.554e+02 27.37 9.80e-11 *** 
k 1.209e-02 1.148e-03 10.53 9.87e-07 *** 
--- 
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

Residual standard error: 99.14 on 10 degrees of freedom 

Algorithm "port", convergence message: relative convergence (4) 

Mein Versuch an der Linearisierung des Modells war weniger erfolgreich:

z <- 1/data 
plot(Y~X,z) 
abline(lm(Y~X,z)) 
M <- lm(Y~X,z) 

Qmax <- 1/coef(M)[1] 
#4319.22 

k <- coef(M)[1]/coef(M)[2] 
#0.00695 

Haftungsausschluss: Dies ist mein erster Beitrag so bitte Geduld mit mir, und ich bin relativ neu zu R. Mit diesem gesagt würde jede technische Beratung, die mir helfen könnte, meine Technik oben zu verbessern, sehr geschätzt werden.

Answer 1

nicht sicher, warum Sie erwarten, dass niedrig sein

ich Ihre Abhängigkeit in einer einfachsten Form neu geschrieben, Multiplikation zu entfernen und durch Zugabe zu ersetzen (a => 1/k) durch beide Zähler und Nenner dividiert durch k . Das Ergebnis sieht perfekt für mein Auge aus.

library(ggplot2) 
library(data.table) 

dt <- fread("R/Langmuir.dat", sep = " ") 

Lang <- nls(formula = Y ~ (Qmax*X)/(a+X), data = dt, start = list(Qmax = 3600, a = 100.0), algorithm = "port") 
q <- summary(Lang) 

Qmax <- q$coefficients[1,1] 
a <- q$coefficients[2,1] 

f <- function(x, Qmax, a) { 
    (Qmax*x)/(a+x) 
} 

p <- ggplot(data = dt, aes(x = X, y = Y)) 
p <- p + geom_point() 
p <- p + xlab("T") + ylab("Q") + ggtitle("Langmuir Fit") 
p <- p + stat_function(fun = function(x) f(x, Qmax=Qmax, a=a)) 
print(p) 

print(Qmax) 
print(a) 

Ausgabe

4253.631 
82.68501 

Graph

UPDATE

Grundsätzlich zu viele Punkte bei niedrigen X, die Kurve schwer zu bekommen für niedrigere Qmax Biegen. Eine Möglichkeit, Kurven zu biegen, besteht darin, Gewichte hinzuzufügen.Fügen Sie zum Beispiel, wenn ich Gewichte Spalte nach Datentabelle zu lesen:

dt[, W := (as.numeric(N)/12.0)^3] 

und nls mit Gewichten

Lang <- nls(formula = Y ~ (Qmax*X)/(a+X), data = dt, start = list(Qmax = 3600, a = 100.0), weights = dt$W, algorithm = "port") 

I und a

[1] 4121.114 
[1] 74.89386 

mit der folgenden Grafik werden erhalten laufen