通过多种功能拟合数据

如何解决通过多种功能拟合数据

我正在尝试使用包含多个变量的多个拟合函数来拟合我的数据。下面是两个变量的示例。在某些情况下，某些变量的拟合度不好，并且我得到了奇异的梯度误差。我想忽略这些情况并继续进行操作，此外，通过比较偏差，其余变量在两个拟合函数之间采用更好的解决方案。像在此示例中，对于type1和type2而言，第一个函数的残差之和较小 sum(resid(myfitfun1)^2) sum(resid(myfitfun2)^2)，所以对于两个变量都采用第一个函数。

myfun1<-function(x,a,b){1/(1+exp(-(x/a)+b))}
myfun2<-function(x,b){1+b*exp(-(x)/a)} 
   
mydata <- data.frame(v=c("type1","type1","type2","type2"),m=c(1.116975672,1.38641493,1.423833959,1.482008121,1.513588607,1.527179033,1.543512539,1.555874185,1.607579807,1.721182154,1.729059048,1.748226681,1.774814055,1.815147988,1.835638421,1.854582642,1.861972,1.887704144,1.915360975,1.948689331,1.97516491,1.985962227,2.011310496,2.043716548,2.068918438,2.091184665,2.120366813,2.126865141,2.148241318,2.15871161,2.193529738,2.256197915,2.302364722,2.316381935,2.31909683,2.325213451,2.336299128,2.410419652,2.473160411,2.478302702,2.5238233,2.651124474,2.70470831,2.927536062,-0.1736072,0.1235610,0.5848941,0.9016486,0.9744832,1.2767238),n=c(0.022727273,0.045454545,0.068181818,0.090909091,0.113636364,0.136363636,0.159090909,0.181818182,0.204545455,0.227272727,0.25,0.272727273,0.295454545,0.318181818,0.340909091,0.363636364,0.386363636,0.409090909,0.431818182,0.454545455,0.477272727,0.5,0.522727273,0.545454545,0.568181818,0.590909091,0.613636364,0.636363636,0.659090909,0.681818182,0.704545455,0.727272727,0.75,0.772727273,0.795454545,0.818181818,0.840909091,0.863636364,0.886363636,0.909090909,0.931818182,0.954545455,0.977272727,1,0.1666667,0.3333333,0.5000000,0.6666667,0.8333333,1))
myfitfun1 <- nls(n~myfun1(m,b),mydata,start=list(a=1,b=1))
myfitfun2 <- nls(n~myfun2(m,b=1))

我想对它进行编程，使其针对各种type自动处理两个函数之间的最佳匹配，并在出现错误时忽略。任何帮助表示赞赏。

解决方法

您可以将两个函数都放到一个函数中并使用tryCatch。在一个tryCatch中，只需抛出NA即可克服该错误。在另一个tryCatch中，当发生错误时将值设置为Inf，以确保“更好”地适合于非失败功能。在正常情况下，选择最小值。使用`attr<-`，我们可以将MSE作为拟合结果的属性。

fun <- function(data) {
  myfitfun1 <- tryCatch(
    nls(n ~ myfun1(m,a,b),data,start=list(a=1,b=1)),error=function(e) NA)
  myfitfun2 <- tryCatch(
    nls(n ~ myfun2(m,error=function(e) NA)
  L <- list(myfitfun1,myfitfun2)
  res <- sapply(L,function(x) {
    tryCatch(sum(resid(x)^2),error=function(e) Inf)
    })
  `attr<-`(L[[which.min(res)]],"MSE",min(res))
}

fun(mydata)
# Nonlinear regression model
# model: n ~ myfun1(m,b)
# data: data
# a      b 
# 0.3465 5.6461 
# residual sum-of-squares: 2.323
# 
# Number of iterations to convergence: 26 
# Achieved convergence tolerance: 7.675e-06

要获取MSE属性，请使用：

attr(fun(mydata),"MSE")
# [1] 2.322945