аппроксимация уравнения первого порядка с помощью nlme и lsoda

Я пытаюсь приспособить дифференциальную модель первого порядка, используя nlme и lsoda. Вот основная идея: сначала я определяю функцию, позволяющую генерировать решение дифференциального уравнения:

library(deSolve)

ODE1 <- function(time, x, parms) {with(as.list(c(parms, x)), {
  import <- excfunc(time)
  dS <- import*k/tau - (S-yo)/tau 
  res <- c(dS)
  list(res)})}


solution_ODE1 = function(tau1,k1,yo1,excitation,time){
  excfunc <- approxfun(time, excitation, rule = 2)
  parms  <- c(tau = tau1, k = k1, yo = yo1, excfunc = excfunc)
  xstart = c(S = yo1)
  out <-  lsoda(xstart, time, ODE1, parms)
  return(out[,2])
}

Затем я генерирую данные в соответствии с уравнением для двух идентификаторов:

time <- 0:49
excitation <- c(rep(0,10),rep(1,10),rep(0,10),rep(1,10),rep(0,10))
simu_data <- data.frame(signal = c(solution_ODE1(3,2,0.1,excitation,time)+rnorm(length(time),0,0.1),
                                   solution_ODE1(3.2,1.5,0.3,excitation,time)+rnorm(length(time),0,0.1)),
                        time = rep(time,2),
                        excitation = rep(excitation,2),
                        ID = rep(c("A","B"),each = length(time)))

Вот как это выглядит:

library(ggplot2)
ggplot(simu_data)+
  geom_point(aes(time,signal,color = "signal"),size = 2)+
  geom_line(aes(time,excitation,color = "excitation"))+
  facet_wrap(~ID)

введите описание изображения здесь

Затем я пытаюсь использовать nlme:

fit1 <- nlme(signal ~ solution_ODE1(damping,gain,eq,excitation,time),
             data = simu_data,
             fixed = damping + gain + eq ~1,
             random =  damping   ~ 1 ,
             groups = ~ ID,
             start = c(damping = 5, gain = 1,eq = 0))

Я получаю ошибку, которую не понимаю:

Ошибка в eval (replace (expr), data, enclos = parent.frame ()): объект 'k' не найден

traceback показывает, что ошибка исходит из модели ODE1, которая работает при генерации значений.

16.    eval(substitute(expr), data, enclos = parent.frame()) 
15.    eval(substitute(expr), data, enclos = parent.frame()) 
14.    with.default(as.list(c(parms, x)), {
    import <- excfunc(time)
    dS <- import * k/tau - (S - yo)/tau
    res <- c(dS) ... 
13.    with(as.list(c(parms, x)), {
    import <- excfunc(time)
    dS <- import * k/tau - (S - yo)/tau
    res <- c(dS) ... 
12.    func(time, state, parms, ...) 
11.    Func2(times[1], y) 
10.    eval(Func2(times[1], y), rho) 
9.    checkFunc(Func2, times, y, rho) 
8.    lsoda(xstart, time, ODE1, parms) 
7.    solution_ODE1(damping, gain, eq, excitation, time) 
6.    eval(model, data.frame(data, pars)) 
5.    eval(model, data.frame(data, pars)) 
4.    eval(modelExpression[[2]], envir = nlEnv) 
3.    eval(modelExpression[[2]], envir = nlEnv) 
2.    nlme.formula(signal ~ solution_ODE1(damping, gain, eq, excitation, 
    time), data = simu_data, fixed = damping + gain + eq ~ 1, 
    random = damping ~ 1, groups = ~ID, start = c(damping = 5, 
        gain = 1, eq = 0)) 
1.    nlme(signal ~ solution_ODE1(damping, gain, eq, excitation, time), 
    data = simu_data, fixed = damping + gain + eq ~ 1, random = damping ~ 
        1, groups = ~ID, start = c(damping = 5, gain = 1, eq = 0)) 

У кого-нибудь есть идея, как мне действовать?


Редактировать

Я попытался изменить, следуя совету mikeck:

ODE1 <- function(time, x, parms) {
  import <- parms$excfunc(time)
  dS <- import*parms$k/parms$tau - (x["S"]-parms$yo)/parms$tau 
  res <- c(dS)
  list(res)}

Генерация данных работает без проблем. Но использование nlme теперь дает:

Ошибка в checkFunc (Func2, times, y, rho): количество производных, возвращаемых функцией func () (0), должно равняться длине вектора начальных условий (100)

со следующей трассировкой:

> traceback()
10: stop(paste("The number of derivatives returned by func() (", 
        length(tmp[[1]]), ") must equal the length of the initial conditions vector (", 
        length(y), ")", sep = ""))
9: checkFunc(Func2, times, y, rho)
8: lsoda(xstart, time, ODE1, parms) at #5
7: solution_ODE1(damping, gain, eq, excitation, time)
6: eval(model, data.frame(data, pars))
5: eval(model, data.frame(data, pars))
4: eval(modelExpression[[2]], envir = nlEnv)
3: eval(modelExpression[[2]], envir = nlEnv)
2: nlme.formula(signal ~ solution_ODE1(damping, gain, eq, excitation, 
       time), data = simu_data, fixed = damping + gain + eq ~ 1, 
       random = damping ~ 1, groups = ~ID, start = c(damping = 5, 
           gain = 1, eq = 0))
1: nlme(signal ~ solution_ODE1(damping, gain, eq, excitation, time), 
       data = simu_data, fixed = damping + gain + eq ~ 1, random = damping ~ 
           1, groups = ~ID, start = c(damping = 5, gain = 1, eq = 0))

person denis    schedule 22.05.2019    source источник
comment
вы пробовали пакет nlmeODE?   -  person Ben Bolker    schedule 27.05.2019
comment
Я действительно пытаюсь. Мне это нелегко, но, возможно, это поможет. Я все еще рад получить решение / объяснение этого странного поведения   -  person denis    schedule 27.05.2019
comment
Я внес несколько изменений - parms должны использовать list (), а не c (), и я сделал xstart <- yo1 (затем ссылаюсь непосредственно на x в ODE1, но я все еще получаю недопустимое сообщение ввода ...   -  person Ben Bolker    schedule 28.05.2019
comment
Вы пытались переопределить ODE1(), чтобы не использовать with(), т.е. вместо этого использовать parms$k и т. Д.? Сообщение об ошибке выглядит так, как будто это может быть проблема с областью видимости, которая каким-то образом возникает.   -  person mikeck    schedule 31.05.2019
comment
@mikeck Пробовал, изменилось сообщение об ошибке. Я отредактировал свой вопрос. Я не понимаю, что nlme делает внутри, но похоже, что он дает вектор начального состояния функции, создавая таким образом ошибки   -  person denis    schedule 03.06.2019
comment
@denis, это, вероятно, будет полезно: stackoverflow.com/questions/40025139/   -  person mikeck    schedule 03.06.2019


Ответы (1)


В вашем примере ваш вектор times не работает монотонно. Я думаю, что это плохо с lsoda. Каков контекст / значение того, как здесь работает время? На самом деле не имеет смысла подходить к модели случайных эффектов с двумя группами. Вы пытаетесь подогнать одну и ту же кривую к двум независимым временным рядам?

Вот урезанный пример с некоторыми корректировками (не все можно свернуть в числовой вектор без потери необходимой структуры):

library(deSolve)
ODE1 <- function(time, x, parms) {
    with(as.list(parms), {
        import <- excfunc(time)
        dS <- import*k/tau - (x-yo)/tau 
        res <- c(dS)
        list(res)
    })
}
solution_ODE1 = function(tau1,k1,yo1,excitation,time){
    excfunc <- approxfun(time, excitation, rule = 2)
    parms  <- list(tau = tau1, k = k1, yo = yo1, excfunc = excfunc)
    xstart = yo1
    out <-  lsoda(xstart, time, ODE1, parms)
    return(out[,2])
}
time <- 0:49
excitation <- c(rep(0,10),rep(1,10),rep(0,10),rep(1,10),rep(0,10))
simu_data <- data.frame(time = rep(time,2),
                        excitation = rep(excitation,2))
svec <- c(damping = 3, gain = 1.75, eq = 0.2)

Это работает:

with(c(simu_data, as.list(svec)),
     solution_ODE1(damping,gain,eq,excitation[1:50],time[1:50]))

Но если мы добавим еще один шаг (чтобы время сбрасывалось до 0), он не удастся:

with(c(simu_data, as.list(svec)),
     solution_ODE1(damping,gain,eq,excitation[1:51],time[1:51]))

Ошибка в lsoda (xstart, time, ODE1, parms): перед выполнением каких-либо шагов интеграции обнаружен недопустимый ввод - см. Письменное сообщение

person Ben Bolker    schedule 28.05.2019
comment
Я сделал на примере двух предметов. Цель состоит в том, чтобы соответствовать реальной панели (смоделированных) данных, например 100 человек. - person denis; 28.05.2019
comment
Вектор времени работает монотично для каждого предмета (ID переменная в simu_data). Конечно, если вы включите значения времени из второй темы в lsoda, это вызовет ошибку, потому что у вас будет дважды одинаковое значение времени. Здесь lsoda отлично работает для генерации данных, поскольку я использую ее для создания набора данных simu_data. Но кажется, что nlme что-то делает, изменяя параметры, вызывающие ошибку, и я не могу понять, что именно. - person denis; 28.05.2019