блестящий: реактивные элементы работают только один раз?Установите цвета на gglot2, чтобы остаться с серией - PullRequest
Новая
       11

блестящий: реактивные элементы работают только один раз?Установите цвета на gglot2, чтобы остаться с серией

0 голосов
/ 15 декабря 2018

У меня есть фрейм данных, в котором у меня есть несколько «штаммов», обнаруженных у животных с течением времени.

Я создал блестящее приложение, чтобы посмотреть на относительные пропорции этих штаммов с течением времени.

Я хочу иметь возможность фильтровать график так, чтобы он смотрел на различные комбинации местоположений и времени.

Моя проблема в том, что я хочу установить определенные цвета для групп штаммов - таким образом, Staphylococcus остается желтым, Bacillus blue и Enterococcus red и т. Д. Однако, когда я создаю блестящий реактивный элемент для фильтрации данных, он некажется, не изменить цветовой вектор, который я создал.Я не уверен, что я делаю неправильно

Я создал небольшой пример этих данных и поместил свой текущий код ниже.

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)
...