Rstudio中的SIR模型闪亮

Question

我正在尝试在 Rstudio Shiny 中构建基本的 SIR 模型。该模型采用 2 个参数（beta = 感染率/天，gamma = 恢复日期/天），3 个初始值（S = 易感者数量，I = 传染性，R = 恢复），最后一个变量是时间（以天为单位）。

这是它在 R markdown 中的代码：

library(deSolve)

sir_equations <- function(time, variables, parameters) {
  with(as.list(c(variables, parameters)), {
    dS <- -beta * I * S
    dI <-  beta * I * S - gamma * I
    dR <-  gamma * I
    return(list(c(dS, dI, dR)))
  })
}

parameters_values <- c(
  beta  = 0.05, # infectious rate/day
  gamma = 0.5    # recovery rate/day
)

initial_values <- c(
  S = 1000,  # susceptibles
  I =   1,  # infectious
  R =   0   # recovered (immune)
)

time_values <- seq(0, 10) #number of days (0-10)

sir_values_1 <- ode(
  y = initial_values,
  times = time_values,
  func = sir_equations,
  parms = parameters_values 
)

sir_values_1 <- as.data.frame(sir_values_1) # convert to data frame

with(sir_values_1, {
  plot(time, S, type = "l", col = "blue",
       xlab = "period (days)", ylab = "number of people")
  lines(time, I, col = "red")
  lines(time, R, col = "green")
})

legend("right", c("susceptibles", "infectious", "recovered"),
       col = c("blue", "red", "green"), lty = 1, bty = "n")

现在我想将它添加到 R Shiny 中，用户可以在其中输入 beta、gamma 和 days 值（滑块，或者只是输入），然后它会绘制结果。我对 R 很陌生，在这里尝试了一些变体，比如将用户输入放入 ,,UI, 将计算放入 ,,server, 然后像这样将其组合在一起 shinyApp(ui = ui, server = server)。下面这段代码我试过了，但它不起作用。你们能帮我吗，我做错了什么，以及如何将代码放入闪亮的 R 中？

library(deSolve)
library(shiny)


ui <- fluidPage(




  sliderInput(inputId = "time_values", label = "Dny", value = 10, min = 1, max = 100),
  sliderInput(inputId = "beta", label ="Míra nákazy", value = 0.05, min = 0.00, max = 1, step = 0.01),
  sliderInput(inputId = "gamma", label ="Míra uzdravení", value = 0.5, min = 0.00, max = 1, step = 0.1),

  plotOutput("plot")
)



server <- function(input, output) {
  sir_equations <- function(time, variables, parameters) {
  with(as.list(c(variables, parameters)), {
    dS <- -beta * I * S
    dI <-  beta * I * S - gamma * I
    dR <-  gamma * I
    return(list(c(dS, dI, dR)))
  })
  }

  initial_values <- c(S = 1000, I = 1, R = 0)

  sir_values_1 <- ode(
  y = initial_values,
  times = time_values,
  func = sir_equations,
  parms = parameters_values 
)

  output$plot <- renderPlot({
    plot(rnorm(input$time_values))
    plot(rnorm(input$beta))
    plot(rnorm(input$gamma))
  })


}

shinyApp(ui = ui, server = server)

谢谢 迈克尔

Answer 1

这里是另一个不需要观察者功能的解决方案。有关 deSolve 和闪亮的更多信息，请访问：https://tpetzoldt.github.io/deSolve-shiny/deSolve-shiny.html

library("deSolve")

sir_equations <- function(time, variables, parameters) {
  with(as.list(c(variables, parameters)), {
    dS <- -beta * I * S
    dI <-  beta * I * S - gamma * I
    dR <-  gamma * I
    return(list(c(dS, dI, dR)))
  })
}

ui <- fluidPage(
  sliderInput(inputId = "time_values", label = "Dny", value = 10, min = 1, max = 100),
  sliderInput(inputId = "beta", label ="Míra nákazy", value = 0.05, min = 0.00, max = 1, step = 0.01),
  sliderInput(inputId = "gamma", label ="Míra uzdravení", value = 0.5, min = 0.00, max = 1, step = 0.1),

  plotOutput("plot")
)

server <- function(input, output) {
  output$plot <- renderPlot({
    initial_values <- c(S = 1000, I = 1, R = 0)
    sir_values <- ode(
      y = initial_values,
      times = seq(0, input$time_values, length.out=1000),
      func = sir_equations,
      parms = c(beta=input$beta, gamma=input$gamma)
    )

    ## easiest is to use the deSolve plot function
    #plot(sir_values, mfrow=c(1,3))
    ## but you can also do it with own plot functions, e.g.:
    matplot(sir_values[,1], sir_values[,-1], type="l", xlab="time", ylab="S, I, R")
    legend("topright", col=1:3, lty=1:3, legend=c("S", "I", "R"))
  })
}

shinyApp(ui = ui, server = server)

Answer 2

我猜你想要的是这样的东西？

library(deSolve)
library(shiny)

ui <- fluidPage(
  sliderInput(inputId = "time_values", label = "Dny", value = 10, min = 1, max = 100),
  sliderInput(inputId = "beta", label ="Míra nákazy", value = 0.05, min = 0, max = 1, step = 0.01),
  sliderInput(inputId = "gamma", label ="Míra uzdravení", value = 0.5, min = 0, max = 1, step = 0.1),

  plotOutput("plot")
)

server <- function(input, output) {
  sir_equations <- function(time, variables, parameters) {
    with(as.list(c(variables, parameters)), {
      dS <- -beta * I * S
      dI <-  beta * I * S - gamma * I
      dR <-  gamma * I
      return(list(c(dS, dI, dR)))
    })
  }

  initial_values <-  c(S = 1000, I = 1, R = 0)

  sir_values_1 <- reactiveValues(val = data.frame())

  observe({
    sir_values_1$val <- as.data.frame(ode(
      y = initial_values,
      times = seq(0, input$time_values),
      func = sir_equations,
      parms = c(beta=input$beta, gamma=input$gamma) 
    ))
  })

  output$plot <- renderPlot({
    with(sir_values_1$val, {
    plot(sir_values_1$val$time, sir_values_1$val$S, type = "l", col = "blue",
         xlab = "period (days)", ylab = "number of people")
    lines(sir_values_1$val$time, sir_values_1$val$I, col = "red")
    lines(sir_values_1$val$time, sir_values_1$val$R, col = "green")
    legend("right", c("susceptibles", "infectious", "recovered"),
           col = c("blue", "red", "green"), lty = 1, bty = "n")
    })
  })
}

shinyApp(ui = ui, server = server)

Answer 3

只看错误：

警告：ode 中的错误：objet 'time_values' introuvable

在ode() 中，您应该将time_values 替换为input$time_values，并将完整的ode() 函数置于反应式环境中，因为您使用了一些输入：

  sir_values_1 <- reactive({
    ode(
    y = initial_values,
    times = input$time_values,
    func = sir_equations,
    parms = parameters_values 
  )
  })

那么你的情节中有一些错误，但设置 xlim 和 ylim 应该可以让它工作。但是，如果要显示多个图，则必须定义多个 plotOutput 和 renderPlot。将三个plot 放在一个renderPlot 中不会显示三个，而只会显示最后一个。