Fitting multiple parametric equations to curve using nls

问题

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

来源：https://stackoverflow.com/questions/42643638/fitting-multiple-parametric-equations-to-curve-using-nls

标签

curve-fitting

nls