Variable sort (ascending/descending) based on user input for Shiny app-CodePudding

I am creating this shiny app to sort through and find the top 5 instances for each of the categories in my fantasy baseball league history. The issue I am running into, is for 2 categories (ERA/WHIP) the lower value is considered 'top'. Is there a way to set the code so that for those 2 variable selections, the data is sorted ascending instead of descending?

If that doesn't work, is there a way to set up a new user input, to select "highest/lowest" values, so that I can still get to essentially the same results, while also getting an ability to see the worst outcomes for teams. I have included a small sample of the data, in addition to my code.

library(shiny)
library(dplyr)

WeeklyLeagueData <- structure(list(Season = c(2016, 2016, 2016, 2016, 2016), Week = c("1", 
"1", "1", "1", "1"), Team = c("Allan", "Pre-Carter", "Jared", 
"Urby", "Ryan D"), R = c(20, 26, 23, 34, 32), HR = c(5, 3, 9, 
12, 8), RBI = c(20, 27, 26, 30, 33), SB = c(5, 2, 1, 2, 3), OBP = c(0.318, 
0.359, 0.303, 0.341, 0.329), SLG = c(0.36, 0.424, 0.442, 0.447, 
0.42), K = c(53, 50, 37, 58, 29), W = c(6, 5, 2, 4, 2), SV = c(3, 
5, 2, 5, 4), HLD = c(4, 0, 4, 1, 2), ERA = c(3, 3.49, 1.87, 3.39, 
5.02), WHIP = c(0.979, 1.02, 0.715, 1.213, 1.327), Row = 1:5, 
    WeekType = c("Normal", "Normal", "Normal", "Normal", "Normal"
    )), row.names = c(NA, 5L), class = "data.frame")

ui <- fluidPage(
        titlePanel("PPBDL Records"),
        sidebarLayout(
          sidebarPanel(
            selectInput(
              inputId = "cat",
              label = "Category",
              choices = c("R","HR","RBI","SB","OBP","SLG","W","K","SV","HLD","ERA","WHIP"),
              selected = "R"),
            selectInput(
              inputId = "season",
              label = "Season",
              choices = c("Entire History","2022","2021","2020","2019","2018","2017","2016"),
              selected = "Entire History"),
            selectInput(
              inputId = "team",
              label = "Team",
              choices = c("All","Allan","Alex","Carter","Derek","Eddie","Hammy","Jared","Josh","Niska","Ryan C","Ryan D","Urby"),
              selected = "All"),
            selectInput(
              inputId = "weektype",
              label = "Week Type",
              choices = c("All","Normal","Long","Short"),
              selected = "All")
            ),
          mainPanel(
            fluidRow(
              column(5,
                dataTableOutput('table')
                    )
                  )
                )
              )
)              
# Define server logic
server <- function(input, output) {
  x <- reactive({
    asc <- function(x) {
      xtfrm(x)
    }
    a <- input$cat
    b <- list("2022","2021","2020","2019","2018","2017","2016")
    c <- case_when(input$season == "Entire History" ~ b,
                   TRUE ~ list(input$season))
    d <- list("Allan","Alex","Carter","Derek","Eddie","Hammy","Jared","Josh","Niska","Ryan C","Ryan D","Urby")
    e <- case_when(input$team == "All" ~ d,
                   TRUE ~ list(input$team))
    f <- list("Normal","Long","Short")
    g <- case_when(input$weektype == "All" ~ f,
                   TRUE ~ list(input$weektype))
    e <- WeeklyLeagueData %>% 
          filter(.data[[input$cat]] != 0) %>%
          filter(Season %in% c) %>% 
          filter(Team %in% e) %>% 
          filter(WeekType %in% g) %>% 
          select(Team,input$cat,Season,Week,WeekType) %>% 
          arrange(-.data[[input$cat]]) %>% 
          head(5)
    return(e)
  })
  
  output$table <- renderDataTable(
    {x()},
    options = list("searching"=FALSE,
                   "info"=FALSE,
                   "lengthChange"=FALSE,
                   "autoWidth"=TRUE,
                   "ordering"=FALSE,
                   "paging"=FALSE)
    )
}

# Run the application 
shinyApp(ui = ui, server = server)

CodePudding user response：

You can do this by modifying the call to arrange that is part of your x reactive in response to changes to the cat selectInput.

  x <- reactive({
    asc <- function(x) {
      xtfrm(x)
    }
    a <- input$cat
    b <- list("2022","2021","2020","2019","2018","2017","2016")
    c <- case_when(input$season == "Entire History" ~ b,
                   TRUE ~ list(input$season))
    d <- list("Allan","Alex","Carter","Derek","Eddie","Hammy","Jared","Josh","Niska","Ryan C","Ryan D","Urby")
    e <- case_when(input$team == "All" ~ d,
                   TRUE ~ list(input$team))
    f <- list("Normal","Long","Short")
    g <- case_when(input$weektype == "All" ~ f,
                   TRUE ~ list(input$weektype))
    e <- WeeklyLeagueData %>% 
          filter(.data[[input$cat]] != 0) %>%
          filter(Season %in% c) %>% 
          filter(Team %in% e) %>% 
          filter(WeekType %in% g) %>% 
          select(Team,input$cat,Season,Week,WeekType)
    
    if (input$cat %in% c("ERA", "WHIP")) {
       e <- e %>% 
          arrange(get(input$cat)) %>% 
          head(5)
    } else {
      e <- e %>% 
        arrange(desc(get(input$cat))) %>% 
        head(5)
    }
    return(e)
  })

Giving

and

Everything else remains unchanged.