Reputation: 820
I have created a shiny app that pulls software components and their versions off of a list of nodes. The goal here is to make all of our nodes consistent when possible and this app helps us see which nodes are inconsistent.
Currently you can modify the version in the 'baseline' handsontable and it will reactively update the pivot table below with the change as well as the BaselineStats column within the handsontable. This works as expected. I have been asked to add the ability to upload a csv file that would overwrite the baseline table so a user does not have to change these 'baseline' versions each time they load the app.
In addition, there are some components that are 100% consistent. Currently those do not appear in the 'baseline' handsontable (since this is a tool to show inconsistency) but I have added a checkbox so that the user can still report on those components that are 100% consistent.
For some reason neither the fileUpload nor the checkboxInput are updating and no matter how much I poke and prod at my code, I cannot figure out why.
server.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"))
)
)
)
)
)
)
I have worked with reactivity quite often but I do not frequently use observe or isolate so that may be where I am running into an issue. I did also try out the new reactlog package but I am still not sure of a path forward.
Here is a picture of the reactlog output before I click the check box or upload new baseline data: And after:
Upvotes: 1
Views: 2659
Reputation: 1721
Actually the given structure of the Shiny App is very tangled and it does not use reactivity efficiently. So first we can start with a simpler app to make sure the basic components are working, then add more.
Some of the problems
the included dataframe df.consistency
interferes with the real reactive components you want to add. For instance, the if/else
flow is problematic because it always jumps to the first else
since the csv does not exist when the app is launched and the expression to read it is not accurate, however df.consistency
is always available.
there is duplication of the same component like output$baseline_table
which is defined twice.
with read.csv
, you passed an argument header = input$header
which is not defined (if you took this from the example here, it refers to the checkbox, but it is not valid here).
Minimal app
If you want to start with a minimal app, you can start with the following code. This will allow you to:
csv
to override the default.rhandsontable
in the middle.Notice that:
baseline_data
is reactive, that's why the other expressions that use it are also reactive.
if you want to have different calculations of df.componentVersionCounts
depending on the checkbox, you can add the if/else
inside the expression to write the calculations for both cases.
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)
Upvotes: 2