I have an app which allows users to recode variables in a dataset. Note that in the example below, all the UI is generated in the server. This is because although in this example, I am using a fixed dataset, diamonds, in the actual use case, this dataset comes from a user upload, so this must take place in the server.
My desired behavior is that by default, all numeric columns are loaded and rendered in the tableOutput "table". However, for some reason, this only takes place after I click "Variable Transformations". Prior to doing that, I get an error message saying, "Warning: Error in data.frame: arguments imply differing number of rows: 10, 0". Is there anyway I can modify this app so that the data frame loads before "Variable Transformations" is clicked?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Recode Application", titleWidth = 375),
## dashboard sidebar
dashboardSidebar(
width = 375,
sidebarMenu(
menuItem("Variable Transformations",
uiOutput("selectors")))),
dashboardBody(
tableOutput("table"))
)
server <- function(input, output, session) {
## obtain default classes for data frame
var_recode_default <- sapply(diamonds, class) %>%
data.frame %>%
filter(row_number() == 2) %>%
gather(key = var_name, value = var_type) %>%
mutate(var_type = ifelse(var_type %in% c("numeric", "integer"), "continuous", "categorical"))
## obtain variable names and default column type
output$selectors <- renderUI({
# re code selectors
var_recode_select <- function(var_name, var_type) {
input_name <- paste0(var_name, "_recode")
radioButtons(inputId = input_name,
label = var_name,
choices = c("continuous", "categorical"),
selected = var_type)
}
## left-side recode number by row (i.e. row 1 = 1, row 2 = 3, row 3 = 5)
recode_row_idx <- var_recode_default %>% nrow %>% seq_len
recode_row_idx <- recode_row_idx[recode_row_idx %% 2 == 1]
recode_row_func <- function(x) {var_recode_default %>% filter(row_number() == x)}
## render re-coding options
recode_row_idx %>%
map(~ if(.x + 1 %in% (var_recode_default %>% nrow %>% seq_len)) {
recode_left_name <- recode_row_func(.x) %>% .$var_name
recode_left_type <- recode_row_func(.x) %>% .$var_type
recode_right_name <- recode_row_func(.x + 1) %>% .$var_name
recode_right_type <- recode_row_func(.x +1) %>% .$var_type
fluidRow(c("left", "right") %>%
map(~column(width = 6,
var_recode_select(var_name = get(paste0("recode_", .x, "_name")),
var_type = get(paste0("recode_", .x, "_type"))))))
} else {
## generate ui when last predictor is an odd number
recode_left_name <- recode_row_func(.x) %>% .$var_name
recode_left_type <- recode_row_func(.x) %>% .$var_type
fluidRow(column(width = 6,
var_recode_select(var_name = recode_left_name,
var_type = recode_left_type)))
})
})
## generate reactive dataframe based on variable recoding
dat <- reactive({
df <- diamonds %>% sample_n(500)
data.frame(var = var_recode_default %>% .$var_name,
var_recode = var_recode_default %>% .$var_name %>%
map(~input[[paste0(.x, "_recode")]]) %>% unlist) %>%
mutate(var_recode_statement = paste0(var, " %>% ",
ifelse(var_recode == "continuous", "as.numeric", "as.factor"))) %>%
pmap(~df %>%
transmute(!! ..1 :=
eval(rlang::parse_expr(..3)))) %>%
bind_cols(.)
})
## render table of numeric columns based on variable transformations
output$table <- renderTable({
dat() %>% select_if(is.numeric)
})
}
shinyApp(ui, server)