Question

我正在尝试使用nls将非参数函数拟合为曲线。

当我尝试拟合所有参数时，nls无法解决方程式。因此，我将方程分开并在单个方程上应用nls，然后再作为最终拟合

以下是data

以下是我所做的代码

#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，但它没有用。这样做的目的是找到曲线改变形状的时间并将其应用于所有样本和方程式按照过程

使用nls将多个参数方程拟合为曲线

0 个答案: