1

deSolve パッケージによって解決される動的モデルからの結果を表示するリアクティブな Rshiny アプリを構築したいと考えています。

サンプル コードは、Jim Duggans System Dynamics Modeling with 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)

関数を変更せずにリアクティブを実装できるかどうか知っていますか: モデルまたはどの関数/変数をリアクティブにする必要がありますか?

よろしくお願いします。

4

2 に答える 2

1

OPの広範な例に基づいて、答えてくれた@YBSに感謝します。さらに、関数を必要としない最小限の再現可能な例を次に示し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 のチュートリアルにあります。ここブリュッセルと他の場所での会議。

于 2021-10-26T05:53:53.500 に答える