Блестящий создание реактивной легенды

Question

Я следую решению, указанному в R блестящая Эстетика должна быть либо длины 1, либо такой же, как данные (8): y для той надоедливой проблемы, которую я успешно исправила.

Следующая проблема, которую я хочу решить, состоит в том, что я хочу, чтобы на моем графике была реактивная легенда - я только хочу, чтобы легенда отображала то, что было выбрано на самом деле и на графике

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

Вот воспроизводимый пример (закомментированный код - моя попытка решить свои проблемы.

Как видите, закомментированный раздел - это то, как я пытался получить легенду и цвета, которые я хочу:

library(shiny)
library(tidyverse)
library(reshape2)
library(scales)

time <- seq(-9, 60, 1)
var1 <- rnorm(70, 35, 2)
var2 <- rnorm(70, 50, 2)
var3 <- rnorm(70, 24, 2)
var4 <- rnorm(70, 17, 2)

data <- data.frame(time = time, 
                   var1 = var1, 
                   var2 = var2,
                   var3 = var3,
                   var4 = var4)

datamelt <- melt(data, "time")

p <- ggplot(datamelt, aes(x = time, y = value, color = variable)) +
  # scale_color_manual(values = c(
  # 'first' = 'red',
  # 'second' = 'blue',
  #   'third' = 'green',
  #   'fourth' = 'orange'
  #   ),
  # breaks = c("first", "second", "third", "fourth")) +
  #  labs(color = 'Legend') +
  theme_classic() +
  theme(axis.ticks = element_blank()) +
  labs(title = 'it means nothing',
       subtitle = 'these are made up data') +
  theme(plot.title = element_text(hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5)) +
  scale_x_continuous(name ="a y variable", breaks = seq(-9, 60, 1)) +
  scale_y_continuous(name = "yep an x variable", 
                     breaks = seq(0, 60, 5), labels = comma) + geom_blank()


ui <- fluidPage(
  titlePanel("trying to make this work"),
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("whichone", "Choose something:", 
                         choiceNames = c("first", 
                                         "second", 
                                         "third",
                                         "fourth"), 
                         choiceValues = c("var1", 
                                          "var2",
                                          "var3",
                                          "var4"))
    ),
    ###the plot
    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output) {
   output$plot <- renderPlot({
      data_filtered <- datamelt %>% filter(variable %in% input$whichone)
      p + geom_line(data = data_filtered)
   })
}

shinyApp(ui, server)

Answer 1

Проблема возникает из-за того, что ggplot использует все уровни факторов, которые остаются на месте при фильтрации. Так что сначала вам нужно сбросить эти уровни.

Во-вторых, вы генерируете сюжет статически со всеми уровнями. Поэтому вам необходимо обновить данные в Plto, чтобы ggplot знал, какие уровни отображать в легенде. Собрав это вместе, вы можете использовать следующее:

server <- function(input, output) {
   output$plot <- renderPlot({
      ## 1. drop unused levels from teh filtered database
      data_filtered <- datamelt %>% filter(variable %in% input$whichone) %>%
          droplevels()
      ## 2. tell ggplot to update the data
      p %+% data_filtered + geom_line()
   })
}

Примечание. Этот подход имеет неприятный (?) Побочный эффект: если вы не выберете какие-либо данные для отображения, вы увидите только пустой холст. Это также может быть исправлено, но потребует некоторых изменений в логике вашего кода (в основном перемещая конструкцию ggplot внутри renderPlot)

---

Скриншоты