R [Shiny]: Как сделать реактивные блестящие приложения, отображающие модели динамических систем?

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

Код примера был скопирован из Джима Дагганса System Dynamics Modeling с R.

Вот код без R-Shiny, это экономическая модель, которая учитывает истощение ресурсов:

      library(deSolve)
library(ggplot2)
library(gridExtra)

##Values Specification for Model 
START <-0; FINISH<-200; STEP<-0.25
simtime <- seq(START, FINISH, by = STEP)
stocks <- c(sCapital=5, sResource=1000)
auxs <- c(aDesired.Growth = 0.07,
         aDepreciation  = 0.05,
         aCost.Per.Investment = 2,
         aFraction.Reinvested =0.12,
         aRevenue.Per.Unit =3.00)

x.Resource <- seq(0,1000, by=100)
y.Efficiency<- c(0,0.25,0.45,0.63,0.75,0.86,0.92, 0.96,0.98, 0.99,1.0)

func.Efficiency <- approxfun(x=x.Resource,
                             y=y.Efficiency,
                             method = "linear",
                             yleft = 0, yright = 1.0)

#The Model 
model <- function(time,stocks,auxs){
  with(as.list(c(stocks,auxs)),{
    aExtr.Efficiency <- func.Efficiency(sResource)
    
    fExtraction      <- aExtr.Efficiency*sCapital
    
    aTotal.Revenue   <- aRevenue.Per.Unit * fExtraction
    aCapital.Costs   <- sCapital *0.1
    aProfit          <- aTotal.Revenue - aCapital.Costs
    aCapital.Funds   <- aFraction.Reinvested * aProfit
    aMaximum.Investment <- aCapital.Funds/aCost.Per.Investment
    
    aDesired.Investment <- sCapital * aDesired.Growth
    
    fInvestment      <- min(aMaximum.Investment,
                            aDesired.Investment)
    fDepreciation    <- sCapital * aDepreciation
    
    dS_dt            <- fInvestment -fDepreciation
    dR_dt            <- -fExtraction
    
    return(list(c(dS_dt, dR_dt),
                DesiredInvestment=aDesired.Investment,
                MaximumInvestment=aMaximum.Investment,
                Investment=fInvestment,
                Depreciation=fDepreciation,
                Extraction=fExtraction))
  })
}

### Using the deSolve Package to solve the differential equation
o <- data.frame(ode(y=stocks, times=simtime, func = model,
                    parms = auxs, method = "euler"))

##different Plots

flow_plot <- ggplot(data = o, mapping = aes(time, Investment)) + theme_classic() +
              geom_line(data = o, mapping = aes(time, Investment), size = 1, color = "blue", linetype =2)+
              geom_line(data = o, mapping = aes(time, Depreciation), size = 1, color = "red",linetype =2)+
              geom_line(data = o, mapping = aes(time, Investment-Depreciation), size = 1, color = "black")

capital_plot <- ggplot(data = o, mapping = aes(time, sCapital)) + theme_classic() +
                geom_line(data = o, mapping = aes(time, sCapital), size = 1, color = "blue", linetype =2)+
                geom_line(data = o, mapping = aes(time, Extraction), size = 1, color = "black")

ressource_plot <- ggplot(data = o, mapping = aes(time, sCapital)) + theme_classic() +
                    geom_line(data = o, mapping = aes(time, sResource), size = 1, color = "black", linetype =1)

grid.arrange(flow_plot,capital_plot,ressource_plot, nrow = 3)

Часть R-Shiny React

Теперь я попытался обернуть все это в очень простое приложение R-Shiny, код следующий:

      library(shiny)
library(deSolve)
library(ggplot2)
library(gridExtra)


ui <- fluidPage(
  sliderInput("iDesired.Growth", "Desired.Growth", min = 0, max = 0.15, step = 0.01, value = 0.07),
  sliderInput("iDepreciation", "Depreciation", min = 0, max = 0.15, step = 0.01, value = 0.07),
  
  plotOutput(outputId = "arrange")
  
)



server <- function(input, output, session) {
  
  
  START <-0; FINISH<-200; STEP<-0.25
  simtime <- seq(START, FINISH, by = STEP)
  stocks <- c(sCapital=5, sResource=1000)
  auxs <- list(aDesired.Growth = reactiveVal(input$iDesired.Growth),
              aDepreciation  = reactiveVal(input$iDepreciation),
              aCost.Per.Investment = 2,
              aFraction.Reinvested =0.12,
              aRevenue.Per.Unit =3.00)
    

  
  x.Resource <- seq(0,1000, by=100)
  y.Efficiency<- c(0,0.25,0.45,0.63,0.75,0.86,0.92, 0.96,0.98, 0.99,1.0)
  
  func.Efficiency <- approxfun(x=x.Resource,
                               y=y.Efficiency,
                               method = "linear",
                               yleft = 0, yright = 1.0)
  
  
  model <- function(time,stocks,auxs){
    with(as.list(c(stocks,auxs)),{
      aExtr.Efficiency <- func.Efficiency(sResource)
      
      fExtraction      <- aExtr.Efficiency*sCapital
      
      aTotal.Revenue   <- aRevenue.Per.Unit * fExtraction
      aCapital.Costs   <- sCapital *0.1
      aProfit          <- aTotal.Revenue - aCapital.Costs
      aCapital.Funds   <- aFraction.Reinvested * aProfit
      aMaximum.Investment <- aCapital.Funds/aCost.Per.Investment
      
      aDesired.Investment <- sCapital * aDesired.Growth
      
      fInvestment      <- min(aMaximum.Investment,
                              aDesired.Investment)
      fDepreciation    <- sCapital * aDepreciation
      
      dS_dt            <- fInvestment -fDepreciation
      dR_dt            <- -fExtraction
      
      return(list(c(dS_dt, dR_dt),
                  DesiredInvestment=aDesired.Investment,
                  MaximumInvestment=aMaximum.Investment,
                  Investment=fInvestment,
                  Depreciation=fDepreciation,
                  Extraction=fExtraction))
    })
  }
  
  o <- data.frame(ode(y=stocks, times=simtime, func = model,
                      parms = auxs, method = "euler"))
  
  
  flow_plot <- ggplot(data = o, mapping = aes(time, Investment)) + theme_classic() +
    geom_line(data = o, mapping = aes(time, Investment), size = 1, color = "blue", linetype =2)+
    geom_line(data = o, mapping = aes(time, Depreciation), size = 1, color = "red",linetype =2)+
    geom_line(data = o, mapping = aes(time, Investment-Depreciation), size = 1, color = "black")
  
  f <-   renderPlot({
          flow_plot <- ggplot(data = o, mapping = aes(time, Investment)) + theme_classic() +
            geom_line(data = o, mapping = aes(time, Investment), size = 1, color = "blue", linetype =2)+
            geom_line(data = o, mapping = aes(time, Depreciation), size = 1, color = "red",linetype =2)+
            geom_line(data = o, mapping = aes(time, Investment-Depreciation), size = 1, color = "black")
  })
  
  capital_plot <- ggplot(data = o, mapping = aes(time, sCapital)) + theme_classic() +
    geom_line(data = o, mapping = aes(time, sCapital), size = 1, color = "blue", linetype =2)+
    geom_line(data = o, mapping = aes(time, Extraction), size = 1, color = "black")
  
  ressource_plot <- ggplot(data = o, mapping = aes(time, sCapital)) + theme_classic() +
    geom_line(data = o, mapping = aes(time, sResource), size = 1, color = "black", linetype =1)
  
  output$arrange <- renderPlot({
    grid.arrange(flow_plot,capital_plot,ressource_plot, nrow = 3)
    })
}



shinyApp(ui, server)

Теперь я почти уверен, что проблема в типе переменной auxs:

        auxs <- list(aDesired.Growth = reactiveVal(input$iDesired.Growth),
              aDepreciation  = reactiveVal(input$iDepreciation),
              aCost.Per.Investment = 2,
              aFraction.Reinvested =0.12,
              aRevenue.Per.Unit =3.00)

Знаете ли вы, могу ли я реализовать реактивность без изменения функции: модель или какие функции / переменные мне нужно сделать реактивными и как?

Заранее большое спасибо.

Источник

2 ответа

Требовались незначительные корректировки. Попробуй это

      library(shiny)
library(deSolve)
library(ggplot2)
library(gridExtra)

ui <- fluidPage(
  sliderInput("iDesired.Growth", "Desired.Growth", min = 0, max = 0.15, step = 0.01, value = 0.07),
  sliderInput("iDepreciation", "Depreciation", min = 0, max = 0.15, step = 0.01, value = 0.07),
  
  plotOutput(outputId = "arrange")
)

server <- function(input, output, session) {
  
  growth <- reactiveVal(1)
  dep <- reactiveVal(1)
  
  START <-0; FINISH<-200; STEP<-0.25
  simtime <- seq(START, FINISH, by = STEP)
  stocks <- c(sCapital=5, sResource=1000)
  
  x.Resource <- seq(0,1000, by=100)
  y.Efficiency<- c(0,0.25,0.45,0.63,0.75,0.86,0.92, 0.96,0.98, 0.99,1.0)
  func.Efficiency <- approxfun(x=x.Resource,
                               y=y.Efficiency,
                               method = "linear",
                               yleft = 0, yright = 1.0)
  
  observe({
    
    model <- function(time,stocks,auxs){
      with(as.list(c(stocks,auxs)),{
        aExtr.Efficiency <- func.Efficiency(sResource)
        
        fExtraction      <- aExtr.Efficiency*sCapital
        
        aTotal.Revenue   <- aRevenue.Per.Unit * fExtraction
        aCapital.Costs   <- sCapital *0.1
        aProfit          <- aTotal.Revenue - aCapital.Costs
        aCapital.Funds   <- aFraction.Reinvested * aProfit
        aMaximum.Investment <- aCapital.Funds/aCost.Per.Investment
        
        aDesired.Investment <- sCapital * aDesired.Growth
        
        fInvestment      <- min(aMaximum.Investment,
                                aDesired.Investment)
        fDepreciation    <- sCapital * aDepreciation
        
        dS_dt            <- fInvestment -fDepreciation
        dR_dt            <- -fExtraction
        
        return(list(c(dS_dt, dR_dt),
                    DesiredInvestment=aDesired.Investment,
                    MaximumInvestment=aMaximum.Investment,
                    Investment=fInvestment,
                    Depreciation=fDepreciation,
                    Extraction=fExtraction))
      })
    }
    
    growth(input$iDesired.Growth)
    dep(input$iDepreciation)
    
    auxs <- list(aDesired.Growth = growth(),
                 aDepreciation  = dep(),
                 aCost.Per.Investment = 2,
                 aFraction.Reinvested =0.12,
                 aRevenue.Per.Unit =3.00)
    
    o <- data.frame(ode(y=stocks, times=simtime, func = model,
                        parms = auxs, method = "euler"))
    
    
    flow_plot <- ggplot(data = o, mapping = aes(time, Investment)) + theme_classic() +
      geom_line(data = o, mapping = aes(time, Investment), size = 1, color = "blue", linetype =2)+
      geom_line(data = o, mapping = aes(time, Depreciation), size = 1, color = "red",linetype =2)+
      geom_line(data = o, mapping = aes(time, Investment-Depreciation), size = 1, color = "black")
    
    f <-   renderPlot({
      flow_plot <- ggplot(data = o, mapping = aes(time, Investment)) + theme_classic() +
        geom_line(data = o, mapping = aes(time, Investment), size = 1, color = "blue", linetype =2)+
        geom_line(data = o, mapping = aes(time, Depreciation), size = 1, color = "red",linetype =2)+
        geom_line(data = o, mapping = aes(time, Investment-Depreciation), size = 1, color = "black")
    })
    
    capital_plot <- ggplot(data = o, mapping = aes(time, sCapital)) + theme_classic() +
      geom_line(data = o, mapping = aes(time, sCapital), size = 1, color = "blue", linetype =2)+
      geom_line(data = o, mapping = aes(time, Extraction), size = 1, color = "black")
    
    ressource_plot <- ggplot(data = o, mapping = aes(time, sCapital)) + theme_classic() +
      geom_line(data = o, mapping = aes(time, sResource), size = 1, color = "black", linetype =1)
    
    output$arrange <- renderPlot({
      grid.arrange(flow_plot,capital_plot,ressource_plot, nrow = 3)
    })
  
  })
}

shinyApp(ui, server)
Источник

Спасибо @YBS за ответ, основанный на обширном примере OP. А вот и минимальный воспроизводимый пример, не требующий функции. Его можно легко расширить, если потребуется дополнительная функциональность, в том числе, а при необходимости также observe. Хорошо то, что reactive кэширует свои результаты, пока ввод остается неизменным.

      library("deSolve")
library("shiny")

brusselator <- function(t, y, p) {
  with(as.list(c(y, p)), {
    dX <- k1*A   - k2*B*X    + k3*X^2*Y - k4*X
    dY <- k2*B*X - k3*X^2*Y
    list(c(X=dX, Y=dY))
  })
}

server <- function(input, output) {
  output$brussels <- renderPlot({
    parms <- c(A=input$A, B=input$B, k1=1, k2=1, k3=1, k4=1)
    out <- ode(y = c(X=1, Y=1), times=seq(0, 100, .1), brusselator, parms)
    matplot.0D(out)
  })
}

ui <- fluidPage(
  numericInput("A", label = "A", value = 1),
  numericInput("B", label = "B", value = 3),
  plotOutput("brussels")
)

shinyApp(ui=ui, server=server)

Больше примеров с динамическими моделями с блестящими и R можно найти в учебнике от предыдущего пользователя! конференция в Брюсселе здесь и в некоторых других местах.

Источник
Другие вопросы по тегам