Только легенда Отображение содержания графика

У меня есть блестящее приложение с реактивным графиком ggvis, которое обновляется с указанными пользователем переменными и фильтрами, очень похожими на блестящее приложение, показанное здесь:

http://shiny.rstudio.com/gallery/movie-explorer.html

У меня есть столбец, содержащий около 130 имен людей, и когда я прошу легенду, отображающую заливку, отразить эти имена, он перечисляет каждое имя во фрейме данных, даже если это имя было отфильтровано и не отображается на графике . Это приводит к огромному списку имен в легенде, даже если есть только 5 человек, которые не были отфильтрованы. Легенда автоматически обновляется в зависимости от пола для заполнения, и я понятия не имею, почему это должно автоматически обновляться, как я хочу, а имена нет. Любая помощь, которую вы можете предоставить, приветствуется. Я предоставил упрощенный код, который воспроизводит проблему для фрейма данных радужной оболочки глаза, а также снимок экрана, показывающий только данные сетосы на графике, но все три вида все еще присутствуют в легенде снимок экрана с проблемой.

#Check packages to use in library
{
library('shiny') #allows for the shiny app to be used
library('RODBC') #allows for data to be loaded from the database
library('stringr') #string opperator
library('ggvis') #allows for interactive ploting
library('dplyr')
library('RSQLite')
}

alldata <- iris

#adds a column of a unique ID for each row
alldata$ID <- 1:nrow(alldata)

#establish options for drop down menus & Variable fixes
{
specieschoices <- unique(as.character(alldata$Species))
petalwchoices <- unique(as.character(alldata$Petal.Width))
petallchoices <- unique(as.character(alldata$Petal.Length))
sepallchoices <- unique(as.character(alldata$Sepal.Length))
sepalwchoices <- unique(as.character(alldata$Sepal.Width))
}
# UI

ui<-fluidPage(
titlePanel("Explorer"),
fluidRow(
column(4,
       wellPanel(
         h4("Apply Filters"),
         selectInput(inputId = "species", label="Select a Species:", choices = c("All Species", sort(specieschoices)), selected="setosa", multiple = TRUE, selectize = TRUE),
         selectInput(inputId = "petalw", label="Select Petal Width:", choices = c("All", sort(petalwchoices)), selected="All", multiple = TRUE, selectize = FALSE),
         selectInput(inputId = "petall", label="Select Petal Length", choices = c("All", petallchoices), selected="All", multiple = TRUE, selectize = FALSE),
         selectInput(inputId = "sepall", label="Select Sepal Length", choices = c("All",sort(sepallchoices)), selected="All", multiple = TRUE, selectize = FALSE),
         selectInput(inputId = "sepalw", label="Select Sepal Width", choices = c("All",sort(sepalwchoices)), selected="All", multiple = TRUE, selectize = FALSE)
         )),
column(8,
       ggvisOutput("plot1")
),
column(4,
       wellPanel(
         h4("Data Variables"),
         selectInput(inputId = "x", label="Select x-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Pedal.Length', multiple = FALSE),
         selectInput(inputId = "y", label="Select y-axis Variable:", choices=as.character(names(alldata[,1:4])),selected='Pedal.Width', multiple = FALSE)
       )),
column(4,
         wellPanel(
           h4("Data Visualization"),
           selectInput(inputId = "fill", label="Select Filter for Data Point Fill", choices=as.character(c("All Points Black", "Species", "Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")), selected = 'Species', multiple = FALSE)
         ))
))

#SERVER
server<-function(input,output,session)
{
#Set up select all for all aplicable inputs
{
# Species
{  
  observe({
    if("All Species" %in% input$species) {
      #choose all the choices _except_ "All Tests"
      selected_choices1 <- setdiff(specieschoices, "All Species")
      updateSelectInput(session, "species", selected = selected_choices1)
    }
  })
  output$selected <- renderText({
    paste(input$myselect1, collapse=",")
  })
}
# Pedal Width
{
  observe({
    if("All" %in% input$petalw) {
      #choose all the choices _except_ "All"
      selected_choices2 <- setdiff(petalwchoices, "All")
      updateSelectInput(session, "petalw", selected = selected_choices2)
    }
  })
  output$selected <- renderText({
    paste(input$myselect2, collapse=",")
  })
}
# Pedal Length
{
  observe({
    if("All" %in% input$petall) {
      #choose all the choices _except_ "All"
      selected_choices3 <- setdiff(petallchoices, "All")
      updateSelectInput(session, "petall", selected = selected_choices3)
    }
  })
  output$selected <- renderText({
    paste(input$myselect3, collapse=",")
  })
}
# Sepal Length
{
  observe({
    if("All" %in% input$sepall) {
      #choose all the choices _except_ "All"
      selected_choices4 <- setdiff(sepallchoices, "All")
      updateSelectInput(session, "sepall", selected = selected_choices4)
    }
  })
  output$selected <- renderText({
    paste(input$myselect4, collapse=",")
  })
}
# Sepal Width
{  
  observe({
    if("All" %in% input$sepalw) {
      #choose all the choices _except_ "All"
      selected_choices5 <- setdiff(sepalwchoices, "All")
      updateSelectInput(session, "sepalw", selected = selected_choices5)
    }
  })
  output$selected <- renderText({
    paste(input$myselect5, collapse=",")
  })
}
}

#Set up reactive variables
filteredData <- reactive({

# Apply filters
m <- alldata %>% filter(
  `Species` %in% input$species,
  `Petal.Width` %in% input$petalw,
  `Petal.Length` %in% input$petall,
  `Sepal.Width` %in% input$sepalw,
  `Sepal.Length` %in% input$sepall
)
m <- as.data.frame(m)
m
})

# Function for generating tooltip text
my_tooltip <- function(tt) {
if (is.null(tt)) return(NULL)
if (is.null(tt$ID)) return(NULL)

# Pick out the shot with this ID
alldata <- isolate(filteredData())
Datapoint <- alldata[alldata$ID == tt$ID, ]

paste0("<b>", "Species: ", Datapoint$`Species`, 
       "</b><br>", "ID: ", Datapoint$`ID`
)
}

vis <- reactive({

# Allows for points to be consistent if the user desires
if (input$fill == "All Points Black") {
  fillvar = "black"}
else {
  fillvar <- as.symbol(input$fill)
}

#Plot Data with Visualization Customization
xvar <- prop("x", as.symbol(input$x))
yvar <- prop("y", as.symbol(input$y))

filteredData() %>%
  ggvis(x = xvar, y = yvar) %>%
  layer_points(size.hover := 200,
               fillOpacity:= 0.5, fillOpacity.hover := 1,
               prop("fill", fillvar),
               key := ~ID
  ) %>%

  # Adds the previously defined tool_tip my_tooltip
  add_tooltip(my_tooltip, "hover") %>%

  # Specifies the size of the plot
  set_options(width = 800, height = 450, duration = 0)
})

#Actually plots the data
vis %>% bind_shiny("plot1")

}


#Run the Shiny App to Display Webpage
{
shinyApp(ui=ui, server=server)
}