在Shiny中顯示數字最高的值

在下面的代碼中，我為一周中的某些天生成模式值，更準確地說是周一和周日。從生成的表（附圖）中注意，我有一個星期日的值和兩個星期一的值。所以，我想做以下調整：每當我得到兩個模式值時，只顯示數字最大的值，在這種情況下星期一，它只會顯示值為 6。

代碼如下：

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)

uj5u.com熱心網友回復：

我們可能需要使用 slice_max

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

在代碼中，server代碼將是

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)

-輸出

標籤：r 闪亮的

上一篇：提取R中矩陣列中每個值的列名

下一篇：在Shiny中按周順序調整選擇