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)
CodePudding user response:
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