搜索
搜索

在 R Shiny 中，如何从不同的条件面板控制相同的对象？

Curious Jorge - user9788072 发表于 Dev
11
好奇的乔治 - user9788072

在我的应用程序中，我希望允许用户从两个不同的条件面板对同一对象进行更改。（相信我 - 从用户的角度来看，它将有助于运行复杂的模型。我知道这听起来很奇怪）。

该对象的共同点table4来自matrix4....用户应该能够table4从以下 MWE 代码中的两个条件面板之一中查看和更改它，来自condition="input.tabselected==4"（“负债模块”）或来自condition="input.tabselected==5"（“利率”）。

table4当table4从“利率”模块（选项卡 = 5）访问（或等效项）时，也应反应性地反映对“负债模块”（选项卡 = 4）的更改，反之亦然。

有没有一种干净简单的方法来做到这一点？

以我有限的经验，我希望在选项卡 4 和 5 中复制 2 个版本的table4/matrix4...进程，然后将两者链接起来。但这似乎重复且繁琐，我敢打赌，有更多经验的人知道如何更轻松地做到这一点。

如果解决方案附有解释，那肯定会有所帮助，因为我需要在 MWE 派生的完整代码中实现这一点。

下面是 MWE 代码：

library(shiny);library(shinyMatrix);library(shinyjs)

matrix4Default <- matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))

matrix4Input <- function(x,matrix4Input){matrixInput(
  x, value = matrix4Input, rows = list(extend=FALSE,names=TRUE),
  cols = list(extend=FALSE,names=FALSE,editableNames=FALSE),class = "numeric")}

vectorBaseRate <- function(x,y){
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

vectorBaseRatePlot <- function(w,x,y,z){plot(w[,1],sapply(w[,2],
    function(x)gsub("%","",x)),main=x,xlab=y,ylab=z)}

ui <- 
  pageWithSidebar(headerPanel("Model..."),
    sidebarPanel(fluidRow(helpText(h5(strong("Base Input Panel")))), uiOutput("Panels")), 
    mainPanel(
      tabsetPanel(
        tabPanel("Liabilities module", value=4,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   actionButton('showRatesValueBtn','Rates values'),
                   actionButton('showRatesPlotBtn','Rates plots')), # close fluid row
                 uiOutput('showTab4Results') 
        ), # close tab panel
        tabPanel("Interest rates", value=5,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   actionButton('showRatesValueBtn','Rates values'),
                   actionButton('showRatesPlotBtn','Rates plots')), # close fluid row
                 uiOutput('showTab5Results') 
        ), # close tab panel
        id = "tabselected"
      ))) # close tabset panel, main panel, page with sidebar

server <- function(input,output,session)({
  
  showTab4Results <- reactiveValues()
  showTab5Results <- reactiveValues()
  
  matrix4   <- reactive(input$matrix4)
  baseRate  <- function(){vectorBaseRate(60,input$matrix4[1,1])} # Must remain in server section
  
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(condition="input.tabselected==4",actionButton('modRates','Modify Rates')),
      conditionalPanel(condition="input.tabselected==5",actionButton('modRates','Modify Rates'))
    ) # close tagList
  }) # close renderUI

  vectorRates <- reactive({
    if (is.null(input$modRates)){df <- NULL}
    else {if(input$modRates < 1){df <- cbind(Period = 1:60,BaseRate = 0.2)}
      else {req(input$matrix4)
        df <- cbind(Period = 1:60,BaseRate = baseRate()[,2])
      } # close 2nd else
    } # close 1st else
    df
  }) # close reactive
  
  output$table4 <- renderTable({vectorRates()})

  observeEvent(input$resetRatesStruct, {updateMatrixInput(session,'matrix4', matrix4Default)})

  observeEvent(input$showRatesValueBtn,
               {showTab4Results$showme <- tagList(
                 fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
                 tableOutput("table4"))
               },ignoreNULL = FALSE)
  
  output$graph4 <-renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
  observeEvent(input$showRatesPlotBtn,{showTab4Results$showme <- tagList(
    fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
    plotOutput("graph4"))})
  
  output$showTab4Results <- renderUI({showTab4Results$showme})
  output$showTab5Results <- renderUI({showTab5Results$showme})
  
  observeEvent(input$modRates,
               {showModal(modalDialog(
                 matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
                 useShinyjs(),
                 footer = tagList(
                   actionButton("resetRatesStruct","Reset"),
                   modalButton("Close")
                 )))
                 showTab4Results$showme <- tagList(tableOutput("table4"))
               } # close modalDialog, showModal, and showModal function
  ) # close observeEvent
  
}) # close server

shinyApp(ui, server)
ismirsehshelf

我不是 100% 确定我是否正确，但我想你只需要or在你的 javascript 条件下conditionalPanel：

condition="input.tabselected==4 || input.tabselected==5"

请检查以下内容：

library(shiny);library(shinyMatrix);library(shinyjs)

matrix4Default <- matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))

matrix4Input <- function(x,matrix4Input){matrixInput(
  x, value = matrix4Input, rows = list(extend=FALSE,names=TRUE),
  cols = list(extend=FALSE,names=FALSE,editableNames=FALSE),class = "numeric")}

vectorBaseRate <- function(x,y){
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

vectorBaseRatePlot <- function(w,x,y,z){plot(w[,1],sapply(w[,2],
                                                          function(x)gsub("%","",x)),main=x,xlab=y,ylab=z)}

ui <- 
  pageWithSidebar(headerPanel("Model..."),
                  sidebarPanel(fluidRow(helpText(h5(strong("Base Input Panel")))), uiOutput("Panels")), 
                  mainPanel(
                    tabsetPanel(
                      tabPanel("Liabilities module", value=4,
                               fluidRow(h5(strong(helpText("Select model output to view:")))),
                               fluidRow(
                                 actionButton('showRatesValueBtnA','Rates values'),
                                 actionButton('showRatesPlotBtnA','Rates plots')), # close fluid row
                               uiOutput('showTab4Results') 
                      ), # close tab panel
                      tabPanel("Interest rates", value=5,
                               fluidRow(h5(strong(helpText("Select model output to view:")))),
                               fluidRow(
                                 actionButton('showRatesValueBtnB','Rates values'),
                                 actionButton('showRatesPlotBtnB','Rates plots')), # close fluid row
                               uiOutput('showTab5Results') 
                      ), # close tab panel
                      id = "tabselected"
                    ))) # close tabset panel, main panel, page with sidebar

server <- function(input,output,session)({
  
  showTab4Results <- reactiveValues()
  showTab5Results <- reactiveValues()
  
  matrix4   <- reactive(input$matrix4)
  baseRate  <- function(){vectorBaseRate(60,input$matrix4[1,1])} # Must remain in server section
  
  output$Panels <- renderUI({
    conditionalPanel(condition="input.tabselected==4 || input.tabselected==5",actionButton('modRates','Modify Rates'))
  }) # close renderUI
  
  vectorRates <- reactive({
    if (is.null(input$modRates)){df <- NULL}
    else {if(input$modRates < 1){df <- cbind(Period = 1:60,BaseRate = 0.2)}
      else {req(input$matrix4)
        df <- cbind(Period = 1:60,BaseRate = baseRate()[,2])
      } # close 2nd else
    } # close 1st else
    df
  }) # close reactive
  
  output$table5 <- output$table4 <- renderTable({vectorRates()})
  
  observeEvent(input$resetRatesStruct, {updateMatrixInput(session,'matrix4', matrix4Default)})
  
  observeEvent(input$showRatesValueBtnA,
               {showTab4Results$showme <- tagList(
                 fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
                 tableOutput("table4"))
               },ignoreNULL = FALSE)
  
  observeEvent(input$showRatesValueBtnB,
               {showTab5Results$showme <- tagList(
                 fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
                 tableOutput("table5"))
               },ignoreNULL = FALSE)
  
  output$graph5 <- output$graph4 <- renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
  
  observeEvent(input$showRatesPlotBtnA,{showTab4Results$showme <- tagList(
    fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
    plotOutput("graph4"))})
  
  observeEvent(input$showRatesPlotBtnB,{showTab5Results$showme <- tagList(
    fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
    plotOutput("graph5"))})
  
  output$showTab4Results <- renderUI({showTab4Results$showme})
  output$showTab5Results <- renderUI({showTab5Results$showme})
  
  observeEvent(input$modRates,
               {showModal(modalDialog(
                 matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
                 useShinyjs(),
                 footer = tagList(
                   actionButton("resetRatesStruct","Reset"),
                   modalButton("Close")
                 )))
                 showTab4Results$showme <- tagList(tableOutput("table4"))
               } # close modalDialog, showModal, and showModal function
  ) # close observeEvent
  
}) # close server

shinyApp(ui, server)

这是一个简化版本，避免了reactiveValues：

library(shiny)
library(shinyMatrix)
library(shinyjs)

matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))

matrix4Input <- function(x, matrix4Input) {
  matrixInput(
    x,
    value = matrix4Input,
    rows = list(extend = FALSE, names = TRUE),
    cols = list(
      extend = FALSE,
      names = FALSE,
      editableNames = FALSE
    ),
    class = "numeric"
  )
}

vectorBaseRate <- function(x, y) {
  a <- rep(y, x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)
}

vectorBaseRatePlot <- function(w, x, y, z) {
    plot(
      w[, 1],
      sapply(w[, 2], function(x)
        gsub("%", "", x)),
      main = x,
      xlab = y,
      ylab = z
    )
  }

ui <- pageWithSidebar(
  headerPanel("Model..."),
  sidebarPanel(fluidRow(helpText(h5(
    strong("Base Input Panel")
  ))), uiOutput("Panels")),
  mainPanel(tabsetPanel(
    tabPanel(
      "Liabilities module",
      value = 4,
      fluidRow(
        radioButtons(
          inputId = "showRates4",
          label = h5(strong(helpText(
            "Select model output to view:"
          ))),
          choices = c('Rates values', 'Rates plots'),
          selected = 'Rates values',
          inline = TRUE
        ),
        uiOutput('showTab4Results')
      )
    ),
    # close tab panel
    tabPanel(
      "Liabilities module",
      value = 5,
      fluidRow(
        radioButtons(
          inputId = "showRates5",
          label = h5(strong(helpText(
            "Select model output to view:"
          ))),
          choices = c('Rates values', 'Rates plots'),
          selected = 'Rates values',
          inline = TRUE
        ),
        uiOutput('showTab5Results')
      )
    ),
    # close tab panel
    id = "tabselected"
  ))
) # close tabset panel, main panel, page with sidebar

server <- function(input, output, session) {
  matrix4   <- reactive(input$matrix4)
  baseRate  <-
    function() {
      vectorBaseRate(60, input$matrix4[1, 1])
    } # Must remain in server section
  
  output$Panels <- renderUI({
    conditionalPanel(condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'))
  }) # close renderUI
  
  vectorRates <- reactive({
    if (is.null(input$modRates)) {
      DF <- NULL
    }
    else {
      if (input$modRates < 1) {
        DF <- cbind(Period = 1:60, BaseRate = 0.2)
      }
      else {
        req(input$matrix4)
        DF <- cbind(Period = 1:60, BaseRate = baseRate()[, 2])
      } # close 2nd else
    } # close 1st else
    DF
  }) # close reactive
  
  observeEvent(input$resetRatesStruct, {
    updateMatrixInput(session, 'matrix4', matrix4Default)
  })
  
  output$table5 <- output$table4 <- renderTable({
    vectorRates()
  })
  
  output$graph5 <- output$graph4 <- renderPlot({
    vectorBaseRatePlot(vectorRates(), "A Variable", "Period", "Rate")
  })
  
  output$showTab4Results <- renderUI({
    if (input$showRates4 == 'Rates values') {
      tagList(fluidRow(h5(strong(
        helpText("You are viewing Rates values:")
      ))),
      tableOutput("table4"))
    } else {
      tagList(fluidRow(h5(strong(
        helpText("You are viewing Rates plots:")
      ))),
      plotOutput("graph4"))
    }
  })
  
  output$showTab5Results <- renderUI({
    if (input$showRates5 == 'Rates values') {
      tagList(fluidRow(h5(strong(
        helpText("You are viewing Rates values:")
      ))),
      tableOutput("table5"))
    } else {
      tagList(fluidRow(h5(strong(
        helpText("You are viewing Rates plots:")
      ))),
      plotOutput("graph5"))
    }
  })
  
  observeEvent(input$modRates,
               {
                 showModal(modalDialog(
                   matrix4Input("matrix4", if (is.null(input$matrix4))
                     matrix4Default
                     else
                       input$matrix4),
                   useShinyjs(),
                   footer = tagList(
                     actionButton("resetRatesStruct", "Reset"),
                     modalButton("Close")
                   )
                 ))
               } # close modalDialog, showModal, and showModal function
              ) # close observeEvent
} # close server

shinyApp(ui, server)

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章

在Shiny R中嵌套条件面板

R Shiny中的Searchbox

R Shiny中的环境

R Shiny中的子集

在Shiny中获取R对象

在主面板中渲染条件面板时，在 R Shiny 中，单击操作按钮时如何更改视图？

DataTable R Shiny中的rclipButton

R Shiny中的内联uiOutput

在R Shiny中显示图

R Shiny中的动态AND滤镜

R Shiny中的动态selectInput

R Shiny中的多个图

在R Shiny中读取文件

dbSendQuery 中的错误 - Shiny R

在R Shiny中处理textInput

在R Shiny中调用exe

R Shiny中ggplot的结果

在R Shiny中叠加图像

R Shiny中盒子的高度

从R Shiny中的传单控制popupImage的大小

R Shiny：renderUI中的表条件格式

R Shiny 中数据帧的条件 cbind

带条件面板和反应堆的R Shiny模块

R Shiny：如何创建输出作为Shiny的输入？

在 R Shiny 中，可以在条件面板中使用多个条件吗？

如何避免R Shiny中重复的insertUI？

如何在R Shiny中对齐图像？

如何更新R Shiny中的按钮标签？

如何在R Shiny中查询元素

TOP 榜单

  1. 1

    UITableView的项目向下滚动后更改颜色，然后快速备份

  2. 2

    Linux的官方Adobe Flash存储库是否已过时？

  3. 3

    用日期数据透视表和日期顺序查询

  4. 4

    应用发明者仅从列表中选择一个随机项一次

  5. 5

    Mac OS X更新后的GRUB 2问题

  6. 6

    验证REST API参数

  7. 7

    Java Eclipse中的错误13，如何解决？

  8. 8

    带有错误“ where”条件的查询如何返回结果？

  9. 9

    ggplot：对齐多个分面图-所有大小不同的分面

  10. 10

    尝试反复更改屏幕上按钮的位置 - kotlin android studio

  11. 11

    如何从视图一次更新多行（ASP.NET - Core）

  12. 12

    计算数据帧中每行的NA

  13. 13

    蓝屏死机没有修复解决方案

  14. 14

    在 Python 2.7 中。如何从文件中读取特定文本并分配给变量

  15. 15

    离子动态工具栏背景色

  16. 16

    VB.net将2条特定行导出到DataGridView

  17. 17

    通过 Git 在运行 Jenkins 作业时获取 ClassNotFoundException

  18. 18

    在Windows 7中无法删除文件（2）

  19. 19

    python中的boto3文件上传

  20. 20

    当我尝试下载 StanfordNLP en 模型时，出现错误

  21. 21

    Node.js中未捕获的异常错误，发生调用

热门标签

归档