library(shiny)
server <- function(input, output) {
data(reagent_limits)
df <- srms::roc_re_v26b(
daterange = c(
strftime(lubridate::floor_date(Sys.time(), 'month'), format = '%m-%d-%Y'),
strftime(Sys.time(), format = '%m-%d-%Y')
)
) %>%
dplyr::filter(
!(Call_Subject %in% c('UDA', 'MULT'))
) %>%
srms::add_clre_tech(., write = FALSE)
call_subjs <- df %>%
dplyr::group_by(Call_Subject) %>%
dplyr::summarise(count = n()) %>%
dplyr::arrange(-count) %>%
.$Call_Subject
days_elapsed <- as.numeric(
ceiling(difftime(Sys.time(), lubridate::floor_date(Sys.time(), 'month')))
)
days_in_month <- as.numeric(
ceiling(difftime(lubridate::ceiling_date(Sys.time(), 'month'),
lubridate::floor_date(Sys.time(), 'month')))
)
output$reagtab <- DT::renderDataTable({
reagtab <- df %>%
dplyr::group_by(
Technology,
Call_Subject
) %>%
dplyr::summarise(
count = n()
) %>%
dplyr::ungroup() %>%
dplyr::left_join(
y = reagent_limits %>%
dplyr::filter(
str_callsubject != 'Default'
) %>%
dplyr::select(
-Technology
),
by = c('Call_Subject' = 'str_callsubject')
)
reagtab$Alert.Limit[reagtab$Technology == 'MicroSlide' &
is.na(reagtab$Alert.Limit)
] <- reagent_limits$Alert.Limit[
reagent_limits$Technology == 'MicroSlide' &
reagent_limits$str_callsubject == 'Default']
reagtab$Alert.Limit[reagtab$Technology == 'MicroTip' &
is.na(reagtab$Alert.Limit)
] <- reagent_limits$Alert.Limit[
reagent_limits$Technology == 'MicroTip' &
reagent_limits$str_callsubject == 'Default']
reagtab$Alert.Limit[reagtab$Technology == 'MicroWell' &
is.na(reagtab$Alert.Limit)
] <- reagent_limits$Alert.Limit[
reagent_limits$Technology == 'MicroWell' &
reagent_limits$str_callsubject == 'Default']
reagtab$projection <- ceiling(reagtab$count / days_elapsed * days_in_month)
reagtab %<>%
dplyr::filter(
projection >= Alert.Limit
) %>%
dplyr::select(
Technology,
Call_Subject,
count,
projection,
Alert.Limit
)
names(reagtab) <- c('Technology', 'Call Subject',
'Count of Month to Date Complaints',
'End of Month Projection',
'Alert Limit'
)
return(reagtab)
})
paretoInput <- reactive({
srms::ggpareto(
df = df,
filter = paste0('Call_Subject == "',
input$callsubject,
'"')
)$plot
})
output$pareto <- renderPlot({
paretoInput()
})
output$callsubject <- renderUI({
selectInput('callsubject', 'Call Subject', call_subjs)
})
output$dlpareto <- downloadHandler(
filename = function() {
paste0(input$callsubject, '_pareto', input$date, '.png')
},
content = function(file) {
ggsave(file, paretoInput(), width = 12)
}
)
rawparetoInput <- reactive({
srms::ggpareto(
df = df,
filter = paste0('Call_Subject == "',
input$callsubject,
'"')
)$data %>%
dplyr::mutate(
Call_Area = modality,
Complaints = frequency,
Cumulative_Percentage = paste0(round(cumperc, digits = 1), '%')
) %>%
dplyr::select(
Call_Area,
Complaints,
Cumulative_Percentage
)
})
output$rawpareto <- renderTable({
rawparetoInput()
})
output$dlparraw <- downloadHandler(
file = function() {
paste0(
input$callsubject, '_pareto_raw_', input$date,
switch(input$parfiletype, .xlsx = '.xlsx', .csv = '.csv')
)
},
content = function(file) {
switch(
input$parfiletype,
.xlsx = openxlsx::write.xlsx(x = rawparetoInput(), file),
.csv = write.csv(x = rawparetoInput(), file, row.names = FALSE)
)
}
)
# raw data output
rawdataInput <- reactive({
rawdf <- df
names(rawdf)[1:7] <- c('YYYYMM', 'Analyzer', 'Family_Code',
'Product_Number', 'Call_Subject', 'Call_Area',
'Complaint_Nbr')
names(rawdf)[(ncol(rawdf)-1):ncol(rawdf)] <- c('startdate', 'enddate')
rawdf[sapply(rawdf, class) %in% c('numeric', 'integer')] <- lapply(
rawdf[sapply(rawdf, class) %in% c('numeric', 'integer')], factor)
rawdf$Call_Subject <- factor(rawdf$Call_Subject)
rawdf$Call_Area <- factor(rawdf$Call_Area)
rawdf %<>%
dplyr::select(
-Device_Count,
-startdate,
-enddate
)
return(rawdf)
})
output$rawdf <- DT::renderDataTable(
rawdataInput(), filter = 'top', server = FALSE, selection = 'none'
)
output$dlrawdata <- downloadHandler(
filename = function() {
paste0(
'rawdata.', switch(input$rawdatafiletype, .xlsx = 'xlsx', .csv = 'csv')
)
},
content = function(file) {
s = input$rawdf_rows_all
switch(
input$rawdatafiletype,
.xlsx = openxlsx::write.xlsx(x = rawdataInput()[s, , drop = FALSE ], file),
.csv = write.csv(x = rawdataInput()[s, , drop = FALSE ], file,
row.names = FALSE)
)
}
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.