R Shiny Table Output - set decimal digits and value labels

Question

I have a shiny app with a table output including mean and std.error and can be grouped. This works fine. What I want now is to set the decimal digits of "mean" and "se" to 2 by using the options() function and "digits = 4" but without any change of the output. Second I group the mean and se by "gnrd" but can´t include the value labels (man, woman) in the output - it only shows "1" and "2". Any advice/help?

Here is my code:

library(shiny)
library(shinydashboard)
library(dplyr)
library(likert)
library(DT)
library(ggplot2)
library(likert)
library(expss)


dataset <- data.frame("netusoft" = sample(c(10:14), 100, 
                                          replace = TRUE),
                      "ppltrst" = sample(c(10:16), 100, 
                                         replace = TRUE),
                      "polintr" = sample(c(10:15), 100, 
                                         replace = TRUE),
                      "psppsgva" = sample(c(10:15), 100, 
                                          replace = TRUE),
                      "actrolga" = sample(c(10:14), 100, 
                                          replace = TRUE),
                      "gndr" = sample(c(1, 2), 100,
                                             replace = TRUE),
                      check.names = FALSE)

val_lab(dataset$gndr) = num_lab("
                                1 man
                                2 woman
                                ")


# ----- UI
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = "European Social Survey Österreich Dashboard", 
                    titleWidth = 300),
    dashboardSidebar(width = 300,
                     selectInput(inputId = "round", 
                                 label = "Wählen Sie eine ESS Runde aus",  
                                 c("ESS 9" = "9"),
                                 selected = "9", selectize = FALSE), 
                     #end selectinput
                     conditionalPanel(
                       condition = "input.round == '9'",
                       selectInput(inputId = "battery", 
                                   label = "Wählen Sie Themenfeld aus",
                                   c("A: Medien-, Internetnutzung, Soziales Vertrauen" = "A",
                                     "B: Politische Variablen, Immigration" = "B"), 
                                   selectize = FALSE), #end selectinput
                       uiOutput("question_placeholder")
                     ),
                     checkboxInput(
                       inputId = "group",
                       label = "Group Data",
                       value = FALSE), #end checkbox
                     
                     conditionalPanel(
                       condition = "input.group == true",
                       selectInput(
                         inputId = "UV",
                         label = "Daten gruppieren nach:",
                         c("Geschlecht" = "gndr")
                       ) # end conditionalPanel
                     )
    ), # end dashboardSidebar
    dashboardBody(
      fluidRow(
        
        box(width = 6, status = "info", solidHeader = TRUE, # hier width auf "auto"
            title = "Tabellarische Darstellung:",
            dataTableOutput("tabelle", width = "auto", height = 500)
      ))# end fluidRow
      
    
      
    ) #end dashboardBody
  )
)

server <- function(input, output, session) {

  
  output$question_placeholder <- renderUI({
    if (input$battery == "A") {
      choices <- c("A2|Häufigkeit Internetnutzung" = "netusoft",
                   "A4|Vertrauen in Mitmenschen" = "ppltrst")
    } else if (input$battery == "B") {
      choices <- c("B1|Interesse an Politik" = "polintr",
                   "B2|Politische Mitsprachemöglichkeit" = "psppsgva",
                   "B3|Fähigkeit politischen Engagements " = "actrolga")
    }
    selectInput(inputId = "question", 
                label = "Wählen Sie eine Frage aus",
                choices,
                selectize = FALSE)
  })
  


  output$tabelle <- renderDataTable({
      tab <- dataset %>%
        summarise(
          mean = mean(!! rlang::sym(input$question), na.rm = TRUE),
          se = std.error(!! rlang::sym(input$question), na.rm = TRUE)
        )
    
    
    if(input$group==TRUE) {
      tab <- dataset %>%
        group_by_at(input$UV) %>%
        summarise(
          mean = mean(!! rlang::sym(input$question), na.rm = TRUE),
          se = std.error(!! rlang::sym(input$question), na.rm = TRUE)
        )
      
    }
    
    #  if(controll_mean() >10 && input$group==TRUE) {
    #   tab <- get_data() %>%
    #    group_by_at(vars(grp)) %>%
    #   summarise(
    #    mean = mean(Antwortkategorie, na.rm = TRUE),
    #   se = std.error(Antwortkategorie, na.rm = TRUE)
    #)
    
    #  }
    
    tab
    
    #For getting a summary for all columns, use summarise_all(funs(sum(!is.na(.))))
    
  }, 
  server = FALSE, # to download all rows
  options = list(
    pageLength = 20,
    searching = FALSE,
    paging = FALSE,
    scrollX = TRUE,
    digits = 4))
  ## end renderDataTable
  
  

}

shinyApp(ui, server)

Answer 1

dplyr::summarize doesn't use value labels so you need to convert your variable to factor to utilize labels. The appropriate piece of code - changes are in the line with group_by:

        if(input$group==TRUE) {
            tab <- dataset %>%
                # we need assignment here to preserve original variable name
                group_by(!!input$UV := factor(!! rlang::sym(input$UV))) %>%
                summarise(
                    mean = mean(!! rlang::sym(input$question), na.rm = TRUE),
                    se = 1.96*sd(!! rlang::sym(input$question), na.rm = TRUE)
                )
            
        }