Как вы реализуете задержку конвейера в стиле системной динамики в deSolve (R)?

Я пытаюсь смоделировать задержку конвейера с помощью deSolve в R. У меня есть одна акция (worktodo) с постоянным вводом (work_arrival), и я хочу выполнить задержку конвейера (work_rate), когда акции снижаются с той же скоростью прибытия с задержка в 3 шага. В настоящее время я могу инициализировать задержку конвейера, но, похоже, она сбрасывается после задержки (включена на 3 шага, выключена на 3 шага, ...). Он должен оставаться включенным, чтобы соответствовать work_arrival. Есть идеи?

####System Dyanmics Model - Pipeline Delay
library(deSolve)
library(tidyverse)

#model setup
finaltime  =  50
initialtime  =  0
timestep  =  1

#create a time vector
simtime <- seq(initialtime, finaltime, by= timestep)

#add auxs
auxs <- c(
   work_arrival = 50
)

#add stocks
stocks <- c(
   worktodo= 600 )



# This is the model function
model <- function(time, stocks, auxs){
  with(as.list(c(stocks, auxs)),{
#add aux calculations

   tlag <- 3
   if(time < tlag){
      work_rate = 0
   }
   else{
      ylag <- lagderiv(time - tlag)
      work_rate <- ylag
   }

   #if(time == 3) print(structure(ylag))


#add stock calculations

   worktodo  =  work_arrival - work_rate

#return data
return(list(c(

   worktodo),
   work_rate = work_rate,
   work_arrival = work_arrival))
  })
}

data <- data.frame(dede(y= stocks, times = simtime, func = model, parms = auxs, method = "lsodar"))

df <- data %>% 
   pivot_longer(-time, names_to = 'variable')


ggplot(df, aes(time, value, color = variable))+
   geom_line(size =1.25)+
   theme_minimal()

В настоящее время поведение модели --- Рабочая скорость модулируется, а не остается неизменной


person JD Caddell    schedule 05.03.2020    source источник
comment
Правильно ли я понимаю, что ваша модель возвращает новое состояние, а не производное? И это модель дискретного времени, а не непрерывная? Тогда решатель lsodar (и все остальные, поддерживаемые dede) не подходят. Подойдет решатель iteration, но он не поддерживает задержки. Хорошая новость заключается в том, что такой решатель для шагов дискретного времени не должен быть слишком сложным для реализации непосредственно в R.   -  person tpetzoldt    schedule 06.03.2020
comment
Я полностью согласен с тем, что итерация была бы идеальной ситуацией. Тем не менее, я пытаюсь сохранить этот метод и пакет, потому что ими легко манипулировать, и они хорошо известны тем, кто конвертирует модели SD в R. Я думаю, что нашел способ сохранить это, но мне пришлось сделать свою скорость запас. Пакет (deSolve) и dede, кажется, хранят запасы в своей памяти истории только для доступа к задержке. Кажется, это значительно улучшает скорость. Я сравнил deSolve с несколькими стандартными итераторами в R и не смог его превзойти. Моя скорость также резко снижается, когда я пытаюсь включить лаги.   -  person JD Caddell    schedule 05.04.2020


Ответы (1)


Изменив поступление работы на запас (переменная состояния), вы можете получить к ней доступ как к задержке. Пакет (deSolve), кажется, оптимизирует скорость, сохраняя в своей истории только переменные состояния при выполнении вычислений.

####System Dyanmics Model - Pipeline Delay
library(deSolve)
library(tidyverse)

#model setup
finaltime  =  50
initialtime  =  0
timestep  =  1

#create a time vector
simtime <- seq(initialtime, finaltime, by= timestep)

#add auxs
auxs <- c(
  work_arrival = 50
)

#add stocks
stocks <- c(
  worktodo= 600 ,
  work_arrival_stock = 50
  )



# This is the model function
model <- function(time, stocks, auxs){
  with(as.list(c(stocks, auxs)),{
    #add aux calculations
    #work_arrival_stock_depletion = work_arrival_stock
    tlag <- 3
    if(time < tlag){
      work_rate = 0
    }
    else{
      ylag <- lagvalue(time - tlag)[2] #[2] grabs the value of the second stock
      work_rate <- ylag
    }

    #if(time == 3) print(structure(ylag))


    #add stock calculations
    worktodo  =  work_arrival - work_rate
    work_arrival_stock = 0


    #return data
    return(list(c(
      worktodo,
      work_arrival_stock),
      work_rate = work_rate,
      work_arrival = work_arrival))
  })
}

data <- data.frame(dede(y= stocks, times = simtime, func = model, parms = auxs, method = "lsodar"))

df <- data %>% 
  pivot_longer(-time, names_to = 'variable')


ggplot(df, aes(time, value, color = variable))+
  geom_line(size =1.25)+
  theme_minimal()

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

person JD Caddell    schedule 05.04.2020