How to use a user-written function within a shiny app? - r

Question

I'm trying to get a function work within a shiny app, but it doesn't work as expected.
Outside of the app it works fine,
But within the app, it doesn't work:
Is it because the input$var isn't working as expected? (The checkbox also doesn't work and I'm still trying to figure that out.) My main question is about the function.
Code:
library(shiny)
if (interactive()) {
one <- function(.data, var, na = TRUE) {
if (na == FALSE)
return({
.data %>%
group_by({{var}}) %>%
drop_na() %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
if (na == TRUE)
return({
.data %>%
group_by({{var}}) %>%
# drop_na() %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
}
ui <- fluidPage(
selectInput("var", label = "Select Variable", choices = c(" ", names(mtcars))),
checkboxInput("check", "Display missing", FALSE),
tableOutput("value")
)
server <- function(input, output) {
output$value <- renderTable({
req(input$var)
if (input$check) ({
mtcars %>%
one(input$var, na = TRUE)
})
if(!input$check) ({
mtcars %>%
one(input$var, na = FALSE)
})
})
}
shinyApp(ui, server)
}
Dataset with missing values:
df <- data.frame(col1 = c(1:3, NA),
col2 = c("this", NA,"is", "text"),
col3 = c(TRUE, FALSE, TRUE, TRUE),
col4 = c(2.5, 4.2, 3.2, NA),
stringsAsFactors = FALSE)

Answer 1

input$var is a character value whereas one function is written for unquoted variables. You can change your function to work for character values.
Other changes that I did in the code are -
Replace na == FALSE and na == TRUE to !na and na respectively.
Since you want to keep the first value in selectInput as blank, used if(input$var != '') instead of req(input$var) because input$var would always have a value.
library(shiny)
library(dplyr)
if (interactive()) {
one <- function(.data, var, na = TRUE) {
if (!na)
return({
.data %>%
group_by(.data[[var]]) %>%
filter(!is.na(.data[[var]])) %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
if (na)
return({
.data %>%
group_by(.data[[var]]) %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
}
ui <- fluidPage(
selectInput("var", label = "Select Variable", choices = c("", names(df))),
checkboxInput("check", "Display missing", FALSE),
tableOutput("value")
)
server <- function(input, output) {
output$value <- renderTable({
if(input$var != '') {
data <- df %>% one(input$var, na = input$check)
return(data)
}
})
}
shinyApp(ui, server)
}

Answer 2

Use get() to accomplish your needs. Also, you can use .data[[!!input$var]] to get the appropriate name in the header of the displayed table.
one <- function(.data, var, na = TRUE) {
if (na == FALSE)
return({
.data %>%
group_by({{var}}) %>%
filter(!is.na({{var}})) %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
if (na == TRUE)
return({
.data %>%
group_by({{var}}) %>%
# drop_na() %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
}
ui <- fluidPage(
selectInput("var", label = "Select Variable", choices = c(" ",names(mtcars))),
checkboxInput("check", "Display missing", FALSE),
tableOutput("value")
)
server <- function(input, output) {
output$value <- renderTable({
if (!is.null(input$var)) {
if (input$var == " " | is.na(input$var)) {
df <- mtcars ## choose what you want to display when input$var is missing; NULL if you want to show nothing
}else {
df <- mtcars %>% one(.data[[!!input$var]], na = req(input$check))
}
}else df <- NULL
df
})
}
shinyApp(ui, server)