闪亮：反应性元素只能工作一次？在gglot2上设置颜色以与系列保持一致

Question

我有一个数据框，其中有多个随时间变化的动物“应变”。

我创建了一个闪亮的应用程序，以查看这些菌株随时间的相对比例。

我希望能够对情节进行过滤，以便查看位置和时间的不同组合。

我的问题是我想为菌株组设置特定的颜色-因此葡萄球菌保持黄色，芽孢杆菌蓝和肠球菌红色等。但是，当我创建闪亮的反应性元素来过滤数据时，似乎没有更改我创建的颜色矢量。我不确定自己在做什么错

我创建了这个数据的一个小例子，并将当前代码放在下面。

library(plyr)
library(dplyr)
library(shiny)
library(ggplot2)
library(reshape2)
library(RColorBrewer)

# Toy Data

Strains <- c("Enterococcus faecium","Wickerhamomyces anomalus", "Staphylococcus vitulinus","Staphylococcus lentus", "Staphylococcus succinus", "Bacillus licheniformis", "Lysinibacillus sphaericus","Staphylococcus succinus", "Bacillus licheniformis", "Lysinibacillus sphaericus","Staphylococcus aureus" )
Location <- c("A", "B", "C", "B", "A", "A", "C", "C", "C", "B", "B" )
Time <- c( "2", "1", "3", "3", "4", "2", "1", "4", "1", "3", "1")

toy <- data.frame(Strains,Location, Time)
toy$count <- 1


# define colors by Genus
staphcol <- colorRampPalette(brewer.pal(9, 'YlGn')[c(2)])
colicol <- colorRampPalette(brewer.pal(9, 'RdPu')[c(3)])
baccol <- colorRampPalette(brewer.pal(9, 'PuBu')[c(3)])
othercol <- colorRampPalette(brewer.pal(9, 'YlOrRd')[c(9)])

# Colour function 
colourFunction <- function(data){
  species <- data.frame(table(data$Strains)) # Frequency table of strains
  species <- species[order(species$Freq), ] #Ordered smallest to largest frequency
   # Order species by genus 
   specieslist <- as.character(species$Var1[order(species$Freq, decreasing = TRUE)])
  staphlist <- grep('Staph', specieslist, value = TRUE)
  baclist <- c(grep('Bac', specieslist, value = TRUE),grep('bacillus', specieslist, value = TRUE))
  colilist <- c(grep('Enterococcus', specieslist, value = TRUE))
  all <- c(staphlist, baclist, colilist)
  otherlist <- specieslist[!specieslist %in% all] # All species that haven't already been selected 
  # Create colour vector
  c(staphcol(length(staphlist))[seq(length(staphlist), 1, -1 )], 
colicol(length(colilist))[seq(length(colilist), 1, -1 )], 
baccol(length(baclist))[seq(length(baclist), 1, -1 )],
othercol(length(otherlist))[seq(length(otherlist), 1, -1 )])
}

# Factor function 
factorFunction <- function(data){
  species <- data.frame(table(data$Strains)) # Frequency table of strains
  species <- species[order(species$Freq), ] #Ordered smallest to largest frequency
  # Order species by genus 
  specieslist <- as.character(species$Var1[order(species$Freq, decreasing = TRUE)])
  staphlist <- grep('Staph', specieslist, value = TRUE)
  baclist <- c(grep('Bac', specieslist, value = TRUE),grep('bacillus', specieslist, value = TRUE))
  colilist <- grep('Enterococcus', specieslist, value = TRUE)
  all <- c(staphlist, baclist, colilist)
  otherlist <- specieslist[!specieslist %in% all] # All species that haven't already been selected 
  c( staphlist, colilist, baclist, otherlist)
}


 ui <- fluidPage(
  #Add application title
  titlePanel("Relative abundance of strains"),
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("LocationInput", "Location",
                         choices = c('A','B','C'),
                         selected = c('A','B','C')),
      checkboxGroupInput("TimeInput", "Time",
                         choices = c('1', "2", "3", "4"),
                         selected = c('1', "2", "3", "4")),
      textInput("titleInput","Enter Title for Graph:")
    ),
    mainPanel(
      plotOutput("plot")
    ))
  )

server <- function(input, output) {
  filtered <- reactive({
    subset(toy, Time %in% input$TimeInput & Location %in% input$LocationInput)
  })

  output$plot <- renderPlot({
    data <- ddply(filtered(), c("Strains", "Time", "Location"), summarize, tot = sum(count))
    #Set colours for filtered plot
    col <- colourFunction(data)
    levels <- factorFunction(filtered())
    data$Strains <- factor(data$Strains,levels = levels )

    p <-  ggplot(data = data, aes(y = tot, x = Time, fill = Strains), colour = "black") + 
      geom_bar(position = "fill", stat = "identity") + 
      theme_bw() +
      scale_fill_manual(values = col) + 
       ylab("Relative Proportion") + theme_bw() + 
      theme(legend.position="right")+
      theme(axis.text = element_text(size = 12),
            axis.title = element_text(size = 12), 
            panel.grid.major = element_blank(), 
            panel.grid.minor = element_blank(),
            legend.key=element_blank())   +
      ggtitle(input$titleInput)
    p
  })
}
shinyApp(ui = ui, server = server)