R Shiny reactive element not reacting as intended

Cross Posted: https://stackoverflow.com/questions/61878955/r-shiny-reactive-element-not-reacting-as-intended


I have an R Shiny app with lots of reactive values in it, and one of them in particular is not reacting as I'd like it to. Here's the minimal reprex of what I'm working with (explanation follows):

   if(interactive()){
     
     ## load required packages
     library(shiny)

     library(tidyverse)
     library(dplyr)
     
     source("https://raw.githubusercontent.com/samhoppen/2020_FF_Analysis/master/Functions/set_vor.R")
     projections <- read_csv("https://raw.githubusercontent.com/samhoppen/2020_FF_Analysis/master/Test_Data/Projections.csv")
 
    
      ui <- fluidPage(
        titlePanel("2020 Fantasy Football Draft Evaluator"),
        sidebarLayout(
          sidebarPanel(id = "tPanel",style = "overflow-y:scroll; max-height: 600px; position:relative;",
                       p(strong("Select draft settings")),
                       fluidRow(
                         column(6, selectInput(inputId = "league_size",
                                               label = "Select league size",
                                               choices = c("8", "10", "12", "14", "16"), selected = "12")),
                         column(6, selectInput(inputId = "draft_position",
                                               label = "Select draft position",
                                               choices = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16"), selected = "1"))),
                       p(strong("Select roster spots")),
                       fluidRow(
                         column(6, numericInput(inputId = "starting_qbs",
                                                label = "# of starting QBs",
                                                value = 1,
                                                min = 0,
                                                max = 6)),
                         column(6, numericInput(inputId = "starting_rbs",

                                            label = "# of starting RBs",
                                            value = 2,
                                            min = 0,
                                            max = 6))),
                   p(strong("4. Draft your team!")),
                   uiOutput(outputId = "draftUI")
      ),
      mainPanel(
        plotOutput("draftPlot"))  
    )
  )
  
  server <- function(input, output) {
    
    total <- reactive(input$starting_qbs + input$starting_rbs)
    output$draftUI <- renderUI({
      count <- total()
      list <- seq(count)
      list <- lapply(list, function(x) selectInput(paste0("draft_pick_",x),
                                                   paste0("Round ", x, " Selection"),
                                                   c("Select player" ="", final_vor_table()$player)))
      
      
      tagList(list)})
            
    vor_table <- reactive({
      default_baseline <- c(QB = 15, RB =72, WR = 90, TE = 30, K = 6)
      
      set_vor(projections,
              vor_baseline = default_baseline,
              vor_var = "fpts")})
    
    final_vor_table <- reactive({
      vor_table() %>% 
        arrange(desc(fpts_vor))
    })
    
    draft_picks <- reactive({
      paste0('draft_pick_',1:total()) %>% sapply(function(x) input[[x]])
    })
    
    drafted_players <- reactive({     
      is_even <- function(x) x %% 2 == 0
      lg_sz <- as.numeric(input$league_size)
      draft_pos <- as.numeric(input$draft_position)
      
      new_vor_table <- final_vor_table() %>% 
        filter(player %in% draft_picks()) 
      
      new_vor_table %>% 
        mutate(round = seq.int(nrow(new_vor_table)),
               ovr_pick_num = if_else(is_even(round), 
                                      ((round * lg_sz) - draft_pos + 1),
                                      ((round -1) * lg_sz) + draft_pos))
    })
    
  }
}

shinyApp(ui = ui, server = server)

The crux of the issue comes in the final section of the server that starts "drafted_players <- ", which is in the server section. I'll start by explaining that the output from final_vor_table (just above the "drafted_players" area) looks something like this (with more rows of data):

  player               position   fpts_vor   fpts_rank
1 Christian McCaffrey  RB         100        1
2 Aaron Jones          RB         80         2
3 Dalvin Cook          RB         60         3
4 Alvin Kamara         RB         40         4
5 Michael Thomas       RB         20         5

From there, there are multiple selections to be made as part of the "draftUI" dynamic input, which is selecting players to be drafted in Rounds 1, 2, 3, etc. One example of this would be if I drafted Dalvin Cook with my 1st round pick and Aaron Jones with my 2nd round pick. The intent of the "drafted_players <-" line of code is to create a new data frame that would look like this:

  player               position   fpts_vor   fpts_rank    round
1 Dalvin Cook          RB         60         3            1
2 Aaron Jones          RB         80         2            2

I want the "round" value from Dalvin Cook to be 1 and the "round" value for Aaron Jones to be 2, and this new value is being brought in via the mutate() code (in the middle of the "drafted_players" section). For some reason, it's spitting out the opposite and outputting values like this:

  player               position   fpts_vor   fpts_rank    round
1 Aaron Jones          RB         80         2            1
2 Dalvin Cook          RB         60         3            2

It seems like it's reading either the arrange() in the "final_vor_table" section or reading the fpts_rank and somehow ordering by that. The end output is a ggplot using these values, but I excluded that so as to minimize the code posted. Any suggestions on how to have this fixed?

1 Like

You've made a great start, but I think you can make your reprex even more minimal. There are some hints at https://mastering-shiny.org/action-workflow.html#making-a-minimal-reprex. For your specific case, I'd suggest pulling the drafted_players() code out in to a separate function so you can check that it works independently of your app.

I modified your UI

mainPanel(
        plotOutput("draftPlot"),
        tableOutput("seedata"))  
    )

and your server code

 output$seedata <- renderTable({
      drafted_players()
    })

Then I picked Dalvin Cook
and Aaron Jones.
I got this.


i.e. its not reversed rounds order as in your complaint. ?

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.