Use fct_reorder function inside case_when function in Shiny app

[hopnstop]

So I have a Shiny app that has a selectInput with the options of "RB", "WR", and "TE". As part of the server, I then use the fct_reorder() function from the forcats package. I want what's in the fct_reorder() to change based on what's selected in the selectInput so I used a case_when() function to help with that, but it doesn't seem to be working. Below are each aspects of the code I'm dealing with.

UI:

selectInput(inputId = "position_sort",
                     label = "Sort by position",
                     choices = c("RB", "WR", "TE"), selected = "RB")

Server:

  team_targets <- reactive({
  
    pos_sort <- input$position_sort
   
    fp_team_targets(season = 2019, start_week = 1, end_week = 17) %>%
    select(
      team, 
      ends_with("percent")
    ) %>%
    mutate(
      team = case_when(pos_sort == "RB" ~ fct_reorder(team, rb_percent),
                       pos_sort == "WR" ~ fct_reorder(team, wr_percent),
                       pos_sort == "TE" ~ fct_reorder(team, te_percent))
    ) %>%
    gather("position", "percent", -team) %>%
    mutate(
      pos = factor(
        position, 
        levels = c("te_percent", "wr_percent", "rb_percent"), 
        labels = c("TE", "WR", "RB")
      )
    )})

For further clarification, if "RB" is selected, then I want the portion inside the fct_reorder to read (team, rb_percent). Any thoughts on why this isn't working and what an alternative might be?

[woodward]

case_when works on vectors. So the conditions and the results are all recycled to be vectors. It won't work the way you want.

You could put the orders into a list.

orders <- list(RB = rb_percent, WR = wr_percent, TE = te_percent)
...
mutate(
  team = fct_reorder(team, orders[[pos_sort]])
)

[hopnstop]

Gotcha. I tried using that but I kept getting an error in the "orders <- list(RB = rb_percent, WR = wr_percent, TE = te_percent)" part that says "Error: object 'rb_percent' not found" - any idea why this would be happening?

[woodward]

Oh I think I misunderstood what you are trying to do.

It seems to work if you put the case_when inside fct_reorder.

library(forcats)
library(dplyr)

data <- tibble(team = LETTERS[1:10],
                   rb_percent = runif(10),                   
                   wr_percent = runif(10),                   
                   te_percent = runif(10))

pos_sort <- c("RB", "WR", "TE")[2]

data %>% 
  mutate(
    team = case_when(pos_sort == "RB" ~ fct_reorder(team, rb_percent),
                     pos_sort == "WR" ~ fct_reorder(team, wr_percent),
                     pos_sort == "TE" ~ fct_reorder(team, te_percent))
  ) %>% 
  arrange(team) %>% 
  print()
#> # A tibble: 10 x 4
#>    team  rb_percent wr_percent te_percent
#>    <fct>      <dbl>      <dbl>      <dbl>
#>  1 A         0.0720     0.366      0.0371
#>  2 J         0.169      0.703      0.570 
#>  3 I         0.177      0.340      0.862 
#>  4 G         0.541      0.756      0.337 
#>  5 E         0.598      0.319      0.930 
#>  6 H         0.616      0.526      0.186 
#>  7 C         0.645      0.467      0.725 
#>  8 D         0.686      0.0144     0.769 
#>  9 B         0.847      0.124      0.572 
#> 10 F         0.861      0.706      0.105

data %>% 
  mutate(
    team = fct_reorder(team, case_when(pos_sort == "RB" ~ rb_percent,
                                       pos_sort == "WR" ~ wr_percent,
                                       pos_sort == "TE" ~ te_percent))
  ) %>% 
  arrange(team) %>% 
  print()
#> # A tibble: 10 x 4
#>    team  rb_percent wr_percent te_percent
#>    <fct>      <dbl>      <dbl>      <dbl>
#>  1 D         0.686      0.0144     0.769 
#>  2 B         0.847      0.124      0.572 
#>  3 E         0.598      0.319      0.930 
#>  4 I         0.177      0.340      0.862 
#>  5 A         0.0720     0.366      0.0371
#>  6 C         0.645      0.467      0.725 
#>  7 H         0.616      0.526      0.186 
#>  8 J         0.169      0.703      0.570 
#>  9 F         0.861      0.706      0.105 
#> 10 G         0.541      0.756      0.337

^{Created on 2020-06-17 by the reprex package (v0.3.0)}

[hopnstop]

I'm just now seeing this, and it works! such a simple fix - thank you very much!

[woodward]

Please mark my answer as the solution if you feel that this solves it. Cheers.