Подгонка нескольких параметрических уравнений к кривой с использованием nls

Я пытаюсь подогнать непараметрические функции к кривой, используя nls.

Когда я пытался подобрать все параметры, nls не смог решить уравнения. Итак, я разделил уравнения и применил nls к отдельным уравнениям, а затем еще раз для окончательной подгонки.

Вот данные

Ниже приведен код того, что я сделал

#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)

Я также пробовал с nls и nls2, но это не сработало. Цель этого - найти время, когда кривая меняет форму, и применить это ко всем образцам, а уравнения соответствуют процессу.