【问题标题】:Shiny reactive outputs are not updating as expected闪亮的反应输出没有按预期更新
【发布时间】:2019-01-23 16:49:01
【问题描述】:

我创建了一个闪亮的应用程序,它可以从节点列表中提取软件组件及其版本。这里的目标是尽可能使我们所有的节点保持一致,这个应用程序可以帮助我们查看哪些节点不一致。

目前,您可以修改“基线”handsontable 中的版本,它会通过更改以及handsontable 中的 BaselineStats 列反应性地更新下面的数据透视表。这按预期工作。我被要求添加上传 csv 文件的功能,该文件将覆盖基线表,因此用户不必在每次加载应用程序时更改这些“基线”版本。

此外,还有一些组件是 100% 一致的。目前那些没有出现在“基线”handsontable 中(因为这是一个显示不一致的工具),但我添加了一个复选框,以便用户仍然可以报告那些 100% 一致的组件。

由于某种原因,fileUpload 和 checkboxInput 都没有更新,无论我如何戳我的代码,我都无法弄清楚原因。

服务器.R

library(shiny)
library(rhandsontable)
library(rpivotTable)
library(dplyr)
library(stringr)
library(lubridate)

shinyServer(function(input, output) {

  # Create dataframe
df.consistency <- structure(list(Node = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 
                                    2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L), .Label = c("A", "B", "C", 
                                                                                    "D"), class = "factor"), Component = structure(c(3L, 4L, 1L, 2L, 3L, 
                                                                                                                                     4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L), .Label = c("docker.version", 
                                                                                                                                                                                             "kernel.version", "os.name", "os.version"), class = "factor"), 
                 Version = structure(c(10L, 3L, 1L, 6L, 10L, 3L, 1L, 7L, 10L, 
                                     5L, 1L, 8L, 10L, 4L, 2L, 9L), .Label = c("1.12.1", "1.13.1", 
                                                                              "16.04", "17.04", "18.04", "3.10.0", "3.11.0", "3.12.0", 
                                                                              "3.13.0", "RedHat"), class = "factor")), class = "data.frame", row.names = c(NA, 
                                                                                                                                                                     -16L))

# Get Date Time
Report.Date <- Sys.Date()

df.baseline <- reactive({

  inputFile <- input$uploadBaselineData

  if(!is.null(inputFile)){

    read.csv(inputFile$datapath, header = input$header)

  } else{
    if(input$showConsistent == FALSE){

      # Count the number of occurrences for Version and Component, then remove the Components that are consistent (not duplicated => nn == 1) and then remove nn column
      df.clusterCons.countComponent <- df.consistency %>%
        add_count(Version, Component) %>%
        add_count(Component) %>%
        filter(nn > 1) %>%
        select(-nn)

      # Change back to dataframe after grouping
      df.clusterCons.countComponent <- as.data.frame(df.clusterCons.countComponent)

      # Components and Versions are shown for every node/cluster. 
      # Reduce this df to get only a unique Component:Version combinations
      df.clusterCons.dist_tbl <- df.clusterCons.countComponent %>%
        distinct(Component, Version, .keep_all = TRUE)

      #Create a df that contains only duplicated rows (rows that are unique i.e. versions are consistent, are removed)
      df.clusterCons.dist_tbl.dup <- df.clusterCons.dist_tbl %>%
        filter(Component %in% unique(.[["Component"]][duplicated(.[["Component"]])]))

      #Create a baseline df to be used to filter larger dataset later 
      #(baseline = max(n) for Version -- but must retain Component since that is the parameter we will use to filter on later)
      df.clusterCons.baseline <- df.clusterCons.dist_tbl.dup[order(df.clusterCons.dist_tbl.dup$Component, df.clusterCons.dist_tbl.dup$n, decreasing = TRUE),]
      df.clusterCons.baseline <- df.clusterCons.baseline[!duplicated(df.clusterCons.baseline$Component), ]
      df.clusterCons.baseline <- df.clusterCons.baseline %>% 
        select(Component, Version)



    }
    else{
      # Count the number of occurrences for Version and Component, then remove the Components that are consistent (not duplicated => nn == 1) and then remove nn column
      df.clusterCons.countComponent <- df.consistency %>%
        add_count(Version, Component) %>%
        add_count(Component) %>%
        select(-nn)

      # Change back to dataframe after grouping
      df.clusterCons.countComponent <- as.data.frame(df.clusterCons.countComponent)

      # Components and Versions are shown for every node/cluster. 
      # Reduce this df to get only a unique Component:Version combinations
      df.clusterCons.dist_tbl <- df.clusterCons.countComponent %>%
        distinct(Component, Version, .keep_all = TRUE)

      df.clusterCons.baseline <- df.clusterCons.dist_tbl[order(df.clusterCons.dist_tbl$Component, df.clusterCons.dist_tbl$n, decreasing = TRUE),]
      df.clusterCons.baseline <- df.clusterCons.baseline[!duplicated(df.clusterCons.baseline$Component), ]
      df.clusterCons.baseline <- df.clusterCons.baseline %>% 
        select(Component, Version)
    }
  }
})


df.componentVersionCounts <- df.consistency %>%
  add_count(Component) %>%
  rename("CountComponents" = n) %>%
  add_count(Component, Version) %>%
  rename("CountComponentVersions" = n) %>%
  mutate("BaselineStats" = paste0("Baseline: ", round(CountComponentVersions / CountComponents * 100, 2), "% of Total: ", CountComponents)) %>%
  select(Component, Version, BaselineStats) %>%
  distinct(.keep_all = TRUE)

df.componentVersions_tbl <- reactive({
  df.componentVersions_tbl <- df.baseline() %>%
    distinct(Component, .keep_all = TRUE) %>%
    select(Component, Version) %>%
    left_join(df.componentVersionCounts, by = c("Component" = "Component", "Version" = "Version"))

})

# Report Date Output
output$reportDate <- renderText({
  return(paste0("Report last run: ", Report.Date))
})

# handsontable showing baseline and allowing for an updated baseline
output$baseline_table <- rhandsontable::renderRHandsontable({

  rhandsontable(df.componentVersions_tbl(), rowHeaders = NULL) %>%
    hot_col("Component", readOnly = TRUE) %>%
    hot_col("BaselineStats", readOnly = TRUE) %>%
    hot_cols(columnSorting = TRUE) %>%
    hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE, filters = TRUE)

})

observe({
  hot = isolate(input$baseline_table)
  if(!is.null(input$baseline_table)){
    handsontable <- hot_to_r(input$baseline_table)

    df.clusterCons.baseline2 <- handsontable %>%
      select(-BaselineStats)

    df.componentVersions_tbl <- df.clusterCons.baseline2  %>%
      left_join(df.componentVersionCounts, by = c("Component" = "Component", "Version" = "Version"))

    output$baseline_table <- rhandsontable::renderRHandsontable({

      rhandsontable(df.componentVersions_tbl, rowHeaders = NULL) %>%
        hot_col("Component", readOnly = TRUE) %>%
        hot_col("BaselineStats", readOnly = TRUE) %>%
        hot_cols(columnSorting = TRUE) %>%
        hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE, filters = TRUE)

    })

    df.clusterIncons <- anti_join(df.consistency, handsontable, by = c("Component" = "Component", "Version" = "Version"))
    df.clusterIncons <- df.clusterIncons

    # Pivot Table showing data with inconsistencies 
    output$pivotTable <- rpivotTable::renderRpivotTable({
      rpivotTable::rpivotTable(df.clusterIncons, rows = c("Cluster", "Node"), cols = "Component", aggregatorName = "List Unique Values", vals = "Version", 
                               rendererName = "Table", 
                               inclusions = list(Component = list("os.version", "os.name", "kernel.version", "docker.version")))


    })

    output$downloadBaselineData <- downloadHandler(
      filename = function() {
        paste('baselineData-', Sys.Date(), '.csv', sep='')
      },
      content = function(file) {
        baseline_handsontable <- handsontable %>%
          select(-BaselineStats)
        write.csv(baseline_handsontable, file, row.names = FALSE)
      }
    )


    output$downloadPivotData <- downloadHandler(
      filename = function() {
        paste('pivotData-', Sys.Date(), '.csv', sep='')
      },
      content = function(file) {
        write.csv(df.clusterIncons, file, row.names = FALSE)
      }
    )

  }
})

})

ui.R

library(shiny)
library(shinydashboard)
library(rhandsontable)
library(rpivotTable)

dashboardPage(

  dashboardHeader(title = "Test Dashboard", titleWidth = "97%"),

  dashboardSidebar(
    collapsed = TRUE,
    sidebarMenu(
      menuItem("App", tabName = "app", icon = icon("table"))
    )
  ),

  dashboardBody(

    tabItems(
      tabItem("app",
              fluidRow(
                box(width = 3, background = "light-blue",
                    "This box includes details to the user about how the application works", br(), br(), br(), 
                    verbatimTextOutput("reportDate")
                ),
                box(width = 7, status = "info", title = "Version baselines based on greatest occurance",
                    rHandsontableOutput("baseline_table", height = "350px")
                ),
                column(width = 2, 
                       fluidRow(
                         fileInput("uploadBaselineData", "Upload Other Baseline Data:", multiple = FALSE, 
                                   accept = ".csv")
                       ),
                       fluidRow(
                         downloadButton("downloadBaselineData", "Download Baseline Data")
                       ),
                       br(), 
                       fluidRow(
                         downloadButton("downloadPivotData", "Download Pivot Table Data")
                       ),
                       br(), 
                       fluidRow(
                         checkboxInput("showConsistent", "Show Consistent Components in baseline")
                       )
                )
              ),
              fluidRow(
                box(width = 12, status = "info", title = "Nodes with versions inconsistent with baseline",
                    div(style = 'overflow-x: scroll', rpivotTable::rpivotTableOutput("pivotTable", height = "500px"))
                )
              )
              )
    )
)
    )

我经常使用反应性,但我不经常使用观察或隔离,所以这可能是我遇到问题的地方。我也尝试了新的 reactlog 包,但我仍然不确定前进的道路。

这是我单击复选框或上传新基线数据之前的 reactlog 输出图片: 之后:

【问题讨论】:

  • df&lt;-read.csv(inputFile$datapath, header = input$header); return(df) 是否解决了 csv 问题?
  • @MaxwellChandler,不。几天前我也试过:(
  • inFile &lt;- input$uploadBaselineData if (is.null(inFile)) return(NULL) df &lt;- read.csv(inFile$datapath, header = TRUE) return(df) if( 注意到我在这里删除了 else 怎么样
  • 当应用程序首次运行时:没有适用于“distinct_”的方法应用于“NULL”类的对象。不过,它至少现在似乎对 csv 输入做出了响应……进度
  • 我收到此错误:could not find function "widgetFunc"。我也不会在observe() 中包含几个render* 函数和downloadHandlers,而是重构您的代码,以便在reactives 中处理数据,然后传递给render* 函数。这使得调试变得困难,并可能导致奇怪的行为。

标签: r shiny


【解决方案1】:

实际上,Shiny App 的给定结构非常复杂,并没有有效地使用响应性。所以首先我们可以从一个更简单的应用开始,以确保基本组件正常工作,然后添加更多。

一些问题

  • 包含的数据框 df.consistency 会干扰您要添加的真实反应组件。例如,if/else 流是有问题的,因为它总是跳转到第一个 else,因为启动应用程序时 csv 不存在并且读取它的表达式不准确,但是 df.consistency 始终可用。

  • 存在重复的相同组件,例如定义两次的 output$baseline_table

  • 使用read.csv,您传递了一个未定义的参数header = input$header(如果您从示例here 中获取它,它指的是复选框,但在这里无效) .

极简应用

如果你想从一个最小的应用开始,你可以从下面的代码开始。这将允许您:

  • 使用默认数据或上传csv 以覆盖默认值。
  • 在中间的rhandsontable查看结果。

注意:

  • baseline_data 是响应式的,这就是为什么使用它的其他表达式也是响应式的。

  • 如果您想根据复选框对df.componentVersionCounts 进行不同的计算,您可以在表达式中添加if/else 来编写两种情况的计算。

library(shiny)
library(rpivotTable)
library(dplyr)
library(stringr)
library(lubridate)
library(shinydashboard)
library(rhandsontable)

## UI ------------------------------------------------------------------------------
ui <- dashboardPage(

  dashboardHeader(title = "Test Dashboard", titleWidth = "97%"),

  dashboardSidebar(
    collapsed = TRUE,
    sidebarMenu(
      menuItem("App", tabName = "app", icon = icon("table"))
    )
  ),

  dashboardBody(

    tabItems(
      tabItem("app",
              fluidRow(
                box(width = 3, background = "light-blue",
                    "This box includes details to the user about how the application works", br(), br(), br(), 
                    verbatimTextOutput("reportDate")
                ),
                box(width = 7, status = "info", title = "Version baselines based on greatest occurance",
                    rHandsontableOutput("baseline_table", height = "350px")
                ),

                column(width = 2, 
                       fluidRow(
                         fileInput("uploadBaselineData", "Upload Other Baseline Data:", multiple = FALSE, 
                                   accept = ".csv")
                       ),

                       fluidRow(
                         checkboxInput("showConsistent", "Show Consistent Components in baseline")
                       )
                )
              )
      )
    )
  )
)


## define default baseline data
df.consistency <- structure(list(Node = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 
                                                    2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L),
                                                  .Label = c("A", "B", "C", 
                                                                                                    "D"), class = "factor"), Component = structure(c(3L, 4L, 1L, 2L, 3L, 
                                                                                                                                                     4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L), .Label = c("docker.version", 
                                                                                                                                                                                                             "kernel.version", "os.name", "os.version"), class = "factor"), 
                                 Version = structure(c(10L, 3L, 1L, 6L, 10L, 3L, 1L, 7L, 10L, 
                                                       5L, 1L, 8L, 10L, 4L, 2L, 9L),
                                                     .Label = c("1.12.1", "1.13.1", 
                                                                                                "16.04", "17.04", "18.04", "3.10.0", "3.11.0", "3.12.0", 
                                                                                                "3.13.0", "RedHat"), class = "factor")), class = "data.frame", row.names = c(NA, 
                                                                                                                                                                             -16L))


## Server ------------------------------------------------------------------
server <- function(input, output) {

  ## Get Date Time
  Report.Date <- Sys.Date()

  baseline_data <- reactive({

    inputFile <- input$uploadBaselineData
    if(!is.null(inputFile)){
      ## WHEN A CSV IS UPLOADED
      read.csv(inputFile$datapath)
    }else{
      ## DEFAULT
      df.consistency #or write the any other expression to read from a certain path or query
    }
  })

  ## df.componentVersionCounts ---------------------------------------------------------------
  df.componentVersionCounts <- reactive({
    req(baseline_data())

    baseline_data() %>%
      add_count(Component) %>%
      rename("CountComponents" = n) %>%
      add_count(Component, Version) %>%
      rename("CountComponentVersions" = n) %>%
      mutate("BaselineStats" = paste0("Baseline: ", round(CountComponentVersions / CountComponents * 100, 2), "% of Total: ", CountComponents)) %>%
      select(Component, Version, BaselineStats) %>%
      distinct(.keep_all = TRUE)
  })

  ## df.componentVersions_tbl ------------------------------------------------------------ 
  df.componentVersions_tbl <- reactive({
    req(baseline_data())

    baseline_data() %>% ##df.baseline()
      distinct(Component, .keep_all = TRUE) %>%
      select(Component, Version) %>%
      left_join(df.componentVersionCounts(),
                by = c("Component" = "Component", "Version" = "Version"))

  })

  # handsontable showing baseline and allowing for an updated baseline ---------------------
  output$baseline_table <- rhandsontable::renderRHandsontable({

    rhandsontable(df.componentVersions_tbl(), rowHeaders = NULL) %>%
      hot_col("Component", readOnly = TRUE) %>%
      hot_col("BaselineStats", readOnly = TRUE) %>%
      hot_cols(columnSorting = TRUE) %>%
      hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE, filters = TRUE)

  })

  # Report Date Output -------------------------------------------------------
  output$reportDate <- renderText({
    return(paste0("Report last run: ", Report.Date))
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

【讨论】:

  • 我想我们在上面的 cmets 中彼此交谈过。我不只是希望用户上传自己的数据作为基线。应用加载时读取的数据应该是默认值。然后,如果用户选择上传 csv 文件,则可以覆盖该基线数据。
猜你喜欢
  • 2015-02-16
  • 1970-01-01
  • 2017-01-24
  • 2020-04-20
  • 1970-01-01
  • 2020-12-28
  • 1970-01-01
  • 2019-06-30
  • 2018-08-01
相关资源
最近更新 更多