Отменить ode.2D в R — изменение параметра в пространственных измерениях

#r #matrix #ode #cran

#r #матрица #ode #cran

Вопрос:

Я пытаюсь решить модель обыкновенных дифференциальных уравнений в 2D, используя функцию ode.2D в пакете отменяется в R. Мой текущий код:

 library(deSolve)
ModelDif <- function (time, y, pars, N, Da, dx) {
NN <- N*N
Nsp <- matrix(nrow = N, ncol = N,y[1:NN])

with (as.list(pars), {
dNsp <- Rmax * Nsp * (1- Nsp/K)
         zero <- rep(0, N)
         FluxNsp <- -Da * rbind(zero,(Nsp[2:N,] - Nsp[1:(N-1),]), zero)/dx
         dNsp    <- dNsp - (FluxNsp[2:(N 1),] - FluxNsp[1:N,])/dx
         FluxNsp <- -Da * cbind(zero,(Nsp[,2:N] - Nsp[,1:(N-1)]), zero)/dx
         dNsp    <- dNsp - (FluxNsp[,2:(N 1)] - FluxNsp[,1:N])/dx
         return(list(as.vector(dNsp)))
      })
     }
        
pars    <- c(Rmax  = 1.0,K=5)  
     R  <- 20                  
     N  <- 50                  
     dx <- R/N                   
     Da <- 0.03           
     NN <- N*N                    
     yini    <- rep(0, N*N)
     cc      <- c((NN/2):(NN/2 1) N/2, (NN/2):(NN/2 1)-N/2)
     yini[cc] <- 1
     
     tiempo   <- seq(0, 20, by = 1)
     Final <- ode.2D(y = yini, times = tiempo, func = ModelDif, parms = pars,dimens = c(N, N), names = c("Nsp"),N = N, dx = dx, Da = Da, method = rkMethod("rk45ck"))

##Plotting
     
P1 <- subset(Final, select = "Nsp", arr = TRUE)
for(i in 1:length(tiempo)){
TT<-tiempo[i]
image(as.matrix(P1[,,i]), xlab = "Lat", ylab = "Lon")
mtext(paste("tiempo = ", TT),side=3)
Sys.sleep(0.5)}
  

Однако теперь мне нужно заменить фиксированный параметр K в основном уравнении значением, полученным из соответствующей ячейки в матрице с тем же размером сетки, который использовался для решения модели.

Например, замените фиксированное значение K на K<-матрицу (rbinom(N * N,10,0.3), ncol=N,nrow =N) и при каждой оценке модели заменяйте K в уравнении значением в соответствующей ячейке.

У меня есть поиск решения на сайте, но ни одно из них не сработало. Я буду признателен за любой совет. Спасибо

Ответ №1:

Если вы используете K<-matrix(rbinom(N*N,10,0.3),ncol=N,nrow=N) , то вам нужно заменить все нули положительным числом, поскольку вы используете его в качестве знаменателя.

В приведенной ниже модели я заменяю 0 на 1. Вы можете заменить его другим числом по вашему выбору.

 ModelDif <- function (time, y, pars, N, Da, dx) {
  NN <- N*N
  Nsp <- matrix(nrow = N, ncol = N,y[1:NN])
  KK<-matrix(rbinom(N*N,10,0.3),ncol=N,nrow=N)
  for (i in 1:NN) {
    if (round(KK[i],1) == 0) {KK[i] <- 1}  ###  replace all zeros with 1
  }
  NspK <- Nsp/KK
  
  with (as.list(pars), {
    dNsp <- Rmax * Nsp * (1- NspK)
    zero <- rep(0, N)
    FluxNsp <- -Da * rbind(zero,(Nsp[2:N,] - Nsp[1:(N-1),]), zero)/dx
    dNsp    <- dNsp - (FluxNsp[2:(N 1),] - FluxNsp[1:N,])/dx
    FluxNsp <- -Da * cbind(zero,(Nsp[,2:N] - Nsp[,1:(N-1)]), zero)/dx
    dNsp    <- dNsp - (FluxNsp[,2:(N 1)] - FluxNsp[,1:N])/dx
    return(list(as.vector(dNsp)))
  })
}
  

Кроме того, для запуска требуется некоторое время, и выдается следующее предупреждение:
Предупреждение в rk(y, times, func, parms, метод = метод, …) :
Количество временных шагов 104651 превысило maxsteps при t = 16.6229

Возможно, вам потребуется дополнительно настроить некоторые параметры.