I am trying to fit non parametric functions to curve using nls.
When I try to fit all the parameters nls was not able to solve the equations. So, I split the equations and applied nls on individual equations and later again as a final fit
Here is the data
Below is the code for what I did
#Readin Data
library(readr)
library(nls2)
Data <- read_csv("data.csv")
t<- Data$`Elasped Time (min)`
w <-Data$`S2 Weight`
t2<- Data$`Elasped Time (min)`
w2 <-Data$`S2 Weight`
# Parametric functions to be fitted to the curve
Func <- function(t,t1,t2,t3,t4,t5,t6,a1,a2,a3,a4,a5,a6,b1,b2,c1,c2,c3,c4,c5,c6){
(t<t1) * t * 0 +
(t>=t1&t<t2) * (a1*t+c1) +
(t>=t2&t<t3) * (a2*t+c2) +
(t>=t3&t<t4) * (a3*t+c3) +
(t>=t4&t<t5) * (a4*t**2 + b1*t+c4) +
(t>=t5&t<t6) * (a5*t**2 + b2*t+c5) +
(t>=t6) * (a6*t+c6)
}
#functions split into individual
Func1 <- function(t,a1,c1){
a1*t+c1
}
Func2 <- function(t,a2,c2){
a2*t+c2
}
Func3 <- function(t,a3,c3){
a3*t+c3
}
Func4 <- function(t,a4,c4,b1){
a4*t**2+b1*t + c4
}
Func5 <- function(t,a5,c5,b2){
a5*t**2+b2*t + c5
}
Func6 <- function(t,a6,c6){
a6*t+c6
}
# fit for individual functions
Data2 <-Data[Data$`Elasped Time (min)`<14.1,]
t <- Data2$`Elasped Time (min)`
w<- Data2$`S2 Weight`
fit1 <- nls(w~Func1(t, a1,c1),
start = list(a1=0.0022, c1=0.0063),
trace= TRUE)
fit1
plot(t,w, type = "l")
curve(Func1(x,coef(fit1)[1], coef(fit1)[2]), add = TRUE)
Data2 <-Data[Data$`Elasped Time (min)`>=14.1&Data$`Elasped Time (min)`<41.8,]
t <- Data2$`Elasped Time (min)`
w<- Data2$`S2 Weight`
fit2 <- nls(w~Func2(t,a2,c2),
start = list(a2=0.0029, c2=-0.0433),
trace= TRUE)
fit2
plot(t,w, type = "l")
curve(Func2(x,coef(fit2)[1], c2=coef(fit2)[2]), add = TRUE)
Data2 <-Data[Data$`Elasped Time (min)`>=41.8&Data$`Elasped Time (min)`<60.3,]
t <- Data2$`Elasped Time (min)`
w<- Data2$`S2 Weight`
fit3 <- nls(w~Func3(t,a3,c3),
start = list(a3=0.0016, c3=-0.0022),
trace= TRUE)
fit3
plot(t,w, type = "l")
curve(Func3(x,a3=coef(fit3)[1], c3=coef(fit3)[2]), add = TRUE)
Data2 <-Data[Data$`Elasped Time (min)`>=60.3&Data$`Elasped Time (min)`<194.3,]
t <- Data2$`Elasped Time (min)`
w<- Data2$`S2 Weight`
fit4 <- nls(w~Func4(t,a4,c4,b1),
start = list(a4=0.000013, c4=0.00408, b1=0.0001),
trace= TRUE)
fit4
plot(t,w, type = "l")
curve(Func4(x,a4=coef(fit4)[1], c4=coef(fit4)[2], b1=coef(fit4)[3]), add = TRUE)
Data2 <-Data[Data$`Elasped Time (min)`>=194.3&Data$`Elasped Time (min)`<527,]
t <- Data2$`Elasped Time (min)`
w<- Data2$`S2 Weight`
fit5 <- nls(w~Func5(t,a5,c5,b2),
start = list(a5=0.000013, c5=0.2337, b2=-0.0006),
trace= TRUE)
fit5
plot(t,w, type = "l")
curve(Func5(x,a5=coef(fit5)[1], c5=coef(fit5)[2], b2=coef(fit5)[3]), add = TRUE)
Data2 <-Data[Data$`Elasped Time (min)`>=527,]
t <- Data2$`Elasped Time (min)`
w<- Data2$`S2 Weight`
fit6 <- nls(w~Func6(t,a6,c6),
start = list(a6=0.0168, c6=-5.3732),
trace= TRUE)
fit6
plot(t,w, type = "l")
curve(Func6(x,a6=coef(fit6)[1], c6=coef(fit6)[2]), add = TRUE)
Finalfun <- function(t,t1,t2,t3,t4,t5,t6){
(t<t1) * t * 0 +
(t>=t1&t<t2) * Func1(t, coef(fit1)[1], coef(fit1)[2]) +
(t>=t2&t<t3) * Func2(t,coef(fit2)[1], coef(fit2)[2]) +
(t>=t3&t<t4) * Func3(t,a3=coef(fit3)[1], c3=coef(fit3)[2]) +
(t>=t4&t<t5) * Func4(t,a4=coef(fit4)[1], c4=coef(fit4)[2], b1=coef(fit4)[3]) +
(t>=t5&t<t6) * Func5(t,a5=coef(fit5)[1], c5=coef(fit5)[2], b2=coef(fit5)[3]) +
(t>=t6) * Func6(t,a6=coef(fit6)[1], c6=coef(fit6)[2])
}
t <- Data$`Elasped Time (min)`
w<- Data$`S2 Weight`
plot(t, w, type = "l")
curve(Finalfun(x,1.4,14.4,41.8,60.3,194.3,527),add=TRUE, col="red")
FInalfit <- nls(w~Finalfun(t,t1,t2,t3,t4,t5,t6),
start=list(t1=1.4,t2=14.4,t3=41.8,t4=60.3,t5=194.3,
t6=527.0),trace = TRUE, algorithm="port")
grd <- data.frame(t1=c(1.2,2),
t2=c(14.0, 16),
t3=c(41.0,43.0),
t4=c(59.0,61.0),
t5=c(193.0,195.0),
t6=c(526, 528))
FInalfit <- nls(w~Finalfun(t,t1,t2,t3,t4,t5,t6),
start=list(t1=1.4,t2=14.4,t3=41.8,t4=60.3,t5=194.3,
t6=527.0),trace = TRUE)
FInalfit <- nls(w~Finalfun(t,t1,t2,t3,t4,t5,t6),
start=grd,trace = TRUE, algorithm = "plinear")
w2 <- Finalfun(t,1.4,14.4,41.8,60.3,194.3,527)
df = as.data.frame(cbind(t,w2))
FInalfit2 <- nls2(w~Finalfun(t,t1,t2,t3,t4,t5,t6),data=df,
start = grd, trace = TRUE,
algorithm = "plinear-brute",all=TRUE)
I tried with nls and nls2 also but it didn't work. Objective of this to find time where the curve is changing shape and apply this to all samples and equations are as per the process