Display value with highest number in Shiny

Question

In the code below I'm generating mode value for some days of the week, more precisely Monday and Sunday. Note from the generated table (attached image), I have a one value for Sunday and two values for Monday. So, I would like to make the following adjustment: whenever I get two values of mode, show only the value with the highest number, in this case for Monday, it just would appear with the value 6.

Code below:

library(shiny)
library(shinythemes)
library(dplyr)
library(tools)
library(DT)

Test <- structure(list(date1 = as.Date(c("2021-11-01","2021-11-01","2021-11-01","2021-11-01","2021-11-01")),
                       date2 = as.Date(c("2021-10-18","2021-10-18","2021-10-28","2021-10-30","2021-10-30")),
                       Week = c("Monday", "Monday", "Sunday", "Sunday","Sunday"),
                       Category = c("FDE", "FDE", "FDE", "FDE","FDE"),
                       time = c(4, 6, 3, 2,3)), class = "data.frame",row.names = c(NA, -5L))

ui <- fluidPage(
    
    shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                      br(),
                      tabPanel("",
                               sidebarLayout(
                                   sidebarPanel(
                                       uiOutput('daterange')
                                   ),
                                   mainPanel(
                                       dataTableOutput('table')
                                       
                                   )
                               ))
    ))

server <- function(input, output,session) {
    
    data <- reactive(Test)
    
    output$daterange <- renderUI({
        dateRangeInput("daterange1", "Period you want to see:",
                       min   = min(data()$date1))
    })
    
    observe({updateDateRangeInput(session,"daterange1",start = NA, end = NA)})
    
    wk_port2eng <- data.frame(
        WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
        WeekP = c("segunda-feira", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo")
    )
    
    data_subset <- reactive({
        req(input$daterange1)
        req(input$daterange1[1] <= input$daterange1[2])
        days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
        Test1 <- dplyr::filter(data(), date1 %in% days)
        weeks_inp <- unique(weekdays(days))  
        wk <- wk_port2eng[wk_port2eng$WeekP %in% weeks_inp,]  ###  if weekday is in Portuguese in your notebook
        #wk <- wk_port2eng[wk_port2eng$WeekE %in% weeks_inp,]  ###  if weekday is in English in your notebook
        weeks_ine <- wk$WeekE
        y <- function(x) {
            x <- table(as.vector(x))
            names(x)[x == max(x)]}
       mode<-data()%>%
            group_by(Week = tools::toTitleCase(Week)) %>%
            summarize(time=y(time),.groups = 'drop')
        mode <- mode[mode$Week %in% as.character(weeks_ine),]
    })
    
    output$table <- renderDataTable({
        data_subset()
    })
    
}

shinyApp(ui = ui, server = server)

user_3732271 · Answer

We may need to use slice_max

library(dplyr)
mode %>% 
   group_by(Week) %>%
   slice_max(n = 1, order_by = time)

In the code, the server code would be

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   min   = min(data()$date1))
  })
  
  observe({updateDateRangeInput(session,"daterange1",start = NA_integer_, end = NA_integer_)})
  
  wk_port2eng <- data.frame(
    WeekE = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"),
    WeekP = c("segunda-feira", "terca-feira", "quarta-feira", "quinta-feira",  "sexta-feira", "sabado", "domingo")
  )
  
  data_subset <- reactive({
    req(input$daterange1)
    req(input$daterange1[1] <= input$daterange1[2])
    days <- seq(as.Date(input$daterange1[1]), as.Date(input$daterange1[2]), by = 'day')
    Test1 <- dplyr::filter(data(), date1 %in% days)
    weeks_inp <- unique(weekdays(days))  
    wk <- wk_port2eng[wk_port2eng$WeekP %in% weeks_inp,]  ###  if weekday is in Portuguese in your notebook
    #wk <- wk_port2eng[wk_port2eng$WeekE %in% weeks_inp,]  ###  if weekday is in English in your notebook
    weeks_ine <- wk$WeekE
    y <- function(x) {
      x <- table(as.vector(x))
      names(x)[x == max(x)]}
    mode<-data()%>%
      group_by(Week = tools::toTitleCase(Week)) %>%
      summarize(time=y(time),.groups = 'drop')
    mode <- mode[mode$Week %in% as.character(weeks_ine),]
    mode %>% 
       group_by(Week) %>% 
      slice_max(n = 1, order_by = time)
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
}

shinyApp(ui = ui, server = server)

-output

Display value with highest number in Shiny

1 Answers