Reputation: 51
I have two tabpanel in shiny dashbaord where in one (Tab - "Data Summary") the reactive output DT::dataTableOutput the table is rendered. On the other one (Tab -"Raw Data"), I was only seeing Processing.... but no table being rendered. So added Processing = FALSE in options, which removed the processing.. banner.. yet I see no output rendered.
**Input data frame: (dat) **
Ad.ID Coder
75905818 deroy
75910661 deroy
75914385 deroy
75902382 deroy
75902383 jishuroy
75902384 jishuroy
75902386 jishuroy
75902391 jishuroy
75902393 jishuroy
75902396 jishuroy
75902418 jishuroy
75902419 jishuroy
75902421 jishuroy
75902422 mrroy
75902423 mrroy
75902424 mrroy
75902432 mrroy
75902435 mrroy
75902442 mrroy
75902443 rande
75902446 rande
75902452 rande
75902454 rande
75914354 rande
75914361 rande
75915439 rande
75915440 rande
75915449 rande
75915453 rande
75915471 rande
75915472 rande
75915522 rande
75905841 jishuroy
75905842 mrroy
75905867 mrroy
75905869 mrroy
75905870 deroy
75905871 deroy
75905887 deroy
75905888 deroy
75905889 deroy
75905890 deroy
Below is the code I have now.
set.seed(4656)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(DT)
library(plyr)
library(dplyr)
library(readr)
# Load data file & Model --------------------------------------------------
setwd("xxx....")
files <- list.files(pattern = '*.csv')
y=NULL
for(i in files ) {
x <- read.csv(i, header=TRUE, skip= 8,stringsAsFactors = FALSE)
y= rbind(y,x)
}
dat <- y[,c(9,19)]
dat <- dat[!apply(is.na(dat) | dat == "", 1, all),]
# Simple header -----------------------------------------------------------
header <- dashboardHeader(title="Test)", titleWidth = 500)
# No sidebar --------------------------------------------------------------
sidebar <- dashboardSidebar(
width = 300,
sidebarMenu(
menuItem("Inputs to Generate Audit Sample", icon = icon("list-ol"),
# Input directly under menuItem
pickerInput("in5","Coder", c(unique(as.character(dat$Coder))),options = list(`actions-box` = TRUE),multiple = T),
numericInput("num", "Audit Sample (%)", value = 25)
)
),
sidebarMenu(
menuItem("Export Audit Samples", icon=icon('download')),
downloadButton("downloadData", "Download ...")
)
)
# Compose dashboard body --------------------------------------------------
body <- dashboardBody(
fluidRow(
tabBox(
title = "Testing",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1", height = "800px", width = "50px",
tabPanel("Data Summary", DT::dataTableOutput("summary")),
tabPanel("Raw Data", DT::dataTableOutput("table"))
)
)
)
# Setup Shiny app UI components -------------------------------------------
ui <- dashboardPage(header, sidebar, body, skin="blue")
# Setup Shiny app back-end components -------------------------------------
server = function(input, output,session) {
data <- reactive({
validate(
need(input$in5 != "Please Select Coder", "Please select Coder to view number of available records & sample count"))
dist <- as((count(dat, "Coder")),"data.frame")
dist$sample <- ceiling((dist[,2]*(input$num/100)))
dist
dist[dist$Coder %in% input$in5, ]
})
# Generate summary
output$summary <- DT::renderDataTable({
d <- data()
DT::datatable(d, rownames = FALSE, escape = c(TRUE, FALSE, FALSE),
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: center;',
'Team Selection: ', htmltools::em('Select your team by using picklist in agent column')),
#caption = 'Select your team by using picklist in agent column',
colnames = c('Agent Name' = 'Coder', 'Number of Ads' = 'freq',"Sample Size"= 'sample'),
filter = 'top', options = list(pageLength = 15, autoWidth = TRUE))
})
data1 <- reactive({
validate(
need(input$in5 != "Please Select Coder", "Please select Coder to view number of available records & sample count"))
names(dat)[2]<-"ID"
observe({
print("Renaming done")
})
per <-(input$num/100)
observe({
print("sample size captured")
})
new_df <- dat %>% group_by(ID) %>% sample_frac(per,replace = FALSE)
observe({
print("Samples generated")
})
new_df$ID <- gsub(" ", "", new_df$ID)
observe({
print("WhiteSpaces Removed")
})
inFile <- c(input$in5)
observe({
print("Input Filter Captured")
})
exp <- new_df[new_df$ID %in% inFile, ]
observe({
print("Ouptut Filtered")
})
exp
})
# Generate table of Samples
output$table <- DT::renderDataTable({
d1 <- data1()
DT::datatable(d1, extensions = 'Responsive', rownames = FALSE, escape = c(TRUE, FALSE, FALSE),
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: center;',
'Team Selection: ', htmltools::em('Select your team by using picklist in agent column')),
#caption = 'Select your team by using picklist in agent column',
# colnames = c('Agent Name' = 'Coder', 'Number of Ads' = 'freq',"Sample Size"= 'sample'),
filter = 'top', options = list(pageLength = 15, autoWidth = TRUE,processing=FALSE))
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(c(input$in5), ".csv", sep = "")
},
content = function(file) {
write.csv(exp, file, row.names = FALSE)
}
)
}
# Render Shiny app --------------------------------------------------------
shinyApp(ui, server)
Have been breaking my head over this for the last 30 hours.. Any help will be a BIG help!!
Upvotes: 0
Views: 1293
Reputation: 51
Thanks @Bertil, your suggestion pointed me out to the issue. The problem was in the way I was trying to filter out and capture picker input.
Changed existing code to:
per <-(input$num/100)
newdf <- dat %>% group_by(Coder) %>% sample_frac(per,replace = FALSE)
newdf
newdf[newdf$Coder %in% input$in5, ]
Solved it!
Upvotes: 0
Reputation: 5003
Your problem is in the escape parameter. You only have two columns but three values and datatable throws an error message. You notices it when you run it in console but not in the (web)browser. Just remove one of the values and it runs perfectly
Upvotes: 0