R[Shiny]：如何制作顯示動態系統模型的反應式閃亮應用程式？-有解無憂

我想構建一個反應式 Rshiny 應用程式，該應用程式顯示由 deSolve 包解決的動態模型的結果。

示例代碼復制自 Jim Duggans System Dynamics Modeling with R。

這是沒有 R-Shiny 的代碼，它是一個考慮資源消耗的經濟模型：

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)

您知道我是否可以在不更改功能的情況下實作反應性：模型或我必須使哪些功能/變數具有反應性以及如何實作？

非常感謝。

uj5u.com熱心網友回復：

需要一些小的調整。嘗試這個

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)

uj5u.com熱心網友回復：

感謝@YBS 基于 OP 的廣泛示例提供的答案。這里還有一個不需要observe函式的最小可重現示例。如果需要額外的功能，它可以很容易地擴展，包括reactive并且如果需要的話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 的動態模型的例子可以在過去的 userR 的教程中找到！會議在布魯塞爾這里和其他一些地方。

轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/336901.html

標籤：r 闪亮的解决

上一篇：如何根據分組變數計算所有列的總和并洗掉NA

下一篇：如何在R中將“year.month”格式更改為“Year-Month”格式