Решения системы дифференциальных уравнений в R

у меня есть простая модель потока в R. она сводится к двум дифференциальным уравнениям, которые моделируют две переменные состояния в модели, мы назовем их A и B. Они вычисляются как простые разностные уравнения четырехкомпонентных потоков flux1-flux4, 5 параметров p1-p5, и 6-й параметр, of_interest, который может принимать значения от 0-1.

parameters<- c(p1=0.028, p2=0.3, p3=0.5, p4=0.0002, p5=0.001, of_interest=0.1) 
state     <- c(A=28, B=1.4)

model<-function(t,state,parameters){
  with(as.list(c(state,parameters)),{
  #fluxes
  flux1  = (1-of_interest) * p1*(B / (p2 + B))*p3
  flux2  = p4* A          #microbial death
  flux3  = of_interest * p1*(B / (p2 + B))*p3 
  flux4  = p5* B      

  #differential equations of component fluxes
  dAdt<- flux1 - flux2
  dBdt<- flux3 - flux4
  list(c(dAdt,dBdt))
  })

я хотел бы написать функцию, чтобы взять производную dAdt С уважением of_interest задайте производные уравнение до 0, затем переставить и решить для значения of_interest. Это будет значение параметра of_interest это максимизирует функцию dAdt.

до сих пор я был в состоянии решить модель в устойчивом состоянии, через возможные значения of_interest для демонстрации должен быть максимум.

require(rootSolve)
range<- seq(0,1,by=0.01)
for(i in range){
of_interest=i
parameters<- c(p1=0.028, p2=0.3, p3=0.5, p4=0.0002, p5=0.001, of_interest=of_interest) 
state     <- c(A=28, B=1.4)
ST<- stode(y=y,func=model,parms=parameters,pos=T)
out<- c(out,ST$y[1])

затем заговор:

plot(out~range, pch=16,col='purple')
lines(smooth.spline(out~range,spar=0.35), lwd=3,lty=1)

enter image description here

как я могу аналитически решить для значения of_interest что максимизирует dAdt в R? Если аналитическое решение невозможно, как я могу знать, и как я могу решить это численно?

Update: я думаю, что эта проблема может быть решена с помощью пакета deSolve в R, linked здесь, однако у меня возникли проблемы реализации на конкретном примере.

1 ответов


ваше уравнение в B(t) как раз-о разделяемом, так как вы можете разделить B(t), из которого вы можете получить это

B(t) = C * exp{-p5 * t} * (p2 + B(t)) ^ {of_interest * p1 * p3}

это неявное решение для B(t) который мы решим точечно.

вы можете решить для C учитывая ваше начальное значение B. Я полагаю t = 0 изначально? В таком случае

C = B_0 / (p2 + B_0) ^ {of_interest * p1 * p3}

это также дает несколько более приятное выражение для A(t):

dA(t) / dt = B_0 / (p2 + B_0) * p1 * p3 * (1 - of_interest) *
   exp{-p5 * t} * ((p2 + B(t) / (p2 + B_0)) ^ 
   {of_interest * p1 * p3 - 1} - p4 * A(t)

это можно решить интегрирующим фактором (= exp{p4 * t}), через численное интегрирование термина, включающего B(t). Мы определяем нижний предел интеграла как 0, чтобы нам никогда не приходилось оценивать B вне диапазона [0, t], что означает, что интегрирующая константа просто A_0 и так:

A(t) = (A_0 + integral_0^t { f(tau; parameters) d tau}) * exp{-p4 * t}

основная суть B(t) управляет всем в этой системе -- подход будет: решите для поведения B(t), затем используйте это, чтобы выяснить, что происходит с A(t), тогда максимизировать.

во-первых, "внешние" параметры, мы также нужны nleqslv и B:

library(nleqslv)

t_min <- 0
t_max <- 10000
t_N <- 10

#we'll only solve the behavior of A & B over t_rng
t_rng <- seq(t_min, t_max, length.out = t_N)

#I'm calling of_interest ttheta
ttheta_min <- 0
ttheta_max <- 1
ttheta_N <- 5

tthetas <- seq(ttheta_min, ttheta_max, length.out = ttheta_N)

B_0 <- 1.4
A_0 <- 28

#No sense storing this as a vector when we'll only ever use it as a list
parameters <- list(p1 = 0.028, p2 = 0.3, p3 = 0.5, 
                   p4 = 0.0002, p5 = 0.001)

отсюда основной план:

  1. учитывая значения параметров (в частности ttheta), решения для BB над t_rng С помощью решения нелинейных уравнений
  2. дано BB и значения параметров, решить для AA над t_rng путем численного интегрирования
  3. дано AA и ваше выражение для dAdt, plug & максимизировать.

derivs

#declare a function we'll use to solve for B (see above)
b_slv <- function(b, t) 
  with(params, b - B_0 * ((p2 + b)/(p2 + B_0)) ^ 
         (ttheta * p1 * p3) * exp(-p5 * t))

#solving point-wise (this is pretty fast)
#  **See below for a note**
BB <- sapply(t_rng, function(t) nleqslv(B_0, function(b) b_slv(b, t))$x)

#this is f(tau; params) that I mentioned above;
#  we have to do linear interpolation since the
#  numerical integrator isn't constrained to the grid.
#  **See below for note**
a_int <- function(t){
  #approximate t to the grid (t_rng)
  #  (assumes B is monotonic, which seems to be true)
  #  (also, if t ends up negative, just assign t_rng[1])
  t_n <- max(1L, which.max(t_rng - t >= 0) - 1L)
  idx <- t_n:(t_n+1)
  ts <- t_rng[idx]

  #distance-weighted average of the local B values
  B_app <- sum((-1) ^ (0:1) * (t - ts) / diff(ts) * BB[idx])
  #finally, f(tau; params)
  with(params, (1 - ttheta) * p1 * p3 * B_0 / (p2 + B_0) *
         ((p2 + B_app)/(p2 + B_0)) ^ (ttheta * p1 * p3 - 1) *
         exp((p4 - p5) * t))
}

#a_int only works on scalars; the numeric integrator
#  requires a version that works on vectors
a_int_v <- function(t) sapply(t, a_int)

AA <- exp(-params$p4 * t_rng) * 
  sapply(t_rng, function(tt)
    #I found the subdivisions constraint binding in some cases
    #  at the default value; no trouble at 1000.
    A_0 + integrate(a_int_v, 0, tt, subdivisions = 1000L)$value)

#using the explicit version of dAdt given as flux1 - flux2
max(with(params, (1 - ttheta) * p1 * p3 * BB / (p2 + BB) - p4 * AA))})

Finally, simply run `tthetas[which.max(derivs)]` to get the maximizer.

Примечание:

этот код не оптимизирован для повышения эффективности. Есть несколько мест, где есть некоторые потенциальные ускорение:

  • вероятно, быстрее запустить решатель уравнений рекурсивно, так как он будет сходиться быстрее с лучшими начальными догадками - используя Предыдущее значение вместо начальное значение, безусловно, лучше
  • будет быстрее просто использовать суммы Римана для интеграции; компромисс в точности, но должен быть в порядке, если у вас достаточно плотная сетка. Одна из прелестей Римана заключается в том, что вам не придется интерполировать вообще, а численно это простая линейная алгебра. Я запустил это с
  • вероятно, можно векторизовать a_int напрямую, а не просто sapplyИнг на ем, которое сопутствующее ускорение-вверх Больше прямое обращение к Бласу.
  • множество других мелких вещей. Pre-compute ttheta * p1 * p3 так как он повторно использован так много и т. д.

я не стал включать ничего из этого, хотя, потому что вам, честно говоря, лучше перенести это на более быстрый язык - Джулия - мой любимый питомец, но, конечно, R хорошо говорит С C++, C, Fortran и т. д.