Модель SIR в Rstudio блестящая

Question

Я пытаюсь построить базовую c модель SIR в Rstudio Блестящий. Модель принимает 2 параметра (бета = уровень заражения / день, гамма = дата / день выздоровления), 3 начальных значения (S = количество восприимчивых, I = инфекционный, R = выздоровевший), а последней переменной является время (в днях).

Вот код этого кода только в уценке R:

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 блестящий, где пользователь может ввести значение бета, гаммы и дней (ползунок, или просто введите), то он будет отображать результат. Я довольно новичок в R и пробовал некоторые варианты здесь, например, помещая пользовательский ввод в ,, UI ,, вычисление в ,, server ,, затем объединяя его в виде блестящего приложения (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

Полагаю, что-то вроде этого вы хотите?

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 2

Здесь другое решение без необходимости использования функции наблюдателя. Больше о 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 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 не отобразит три из них, а только последний.