Установка разных цветов линий на графике в R - PullRequest
0 голосов
/ 07 октября 2019

Я бы хотел установить разные цвета для каждой линии на графике. В настоящее время, когда я выбираю один и тот же продукт из двух списков, я получаю одинаковые цвета на графике. Как я могу установить разные цвета для одного и того же продукта разных лет? Ниже приведен мой код и примеры графиков:

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(readxl)
library(tidyr)

df1 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = rep(LETTERS[1:10], each = 12), 
                  Value = sample(c(0:300),120, replace = T), stringsAsFactors = F)
df2 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = rep(LETTERS[1:10], each = 12), 
                  Value = sample(c(0:300),120, replace = T), stringsAsFactors = F)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette

# UI
ui <- fluidPage(
    column(
        6,fluidRow(column(6, selectizeInput("All", "Year: 2018", multiple = T,choices = unique(df1$Product), 
                                            options = list(maxItems = 5, placeholder = 'Choose a product:'))),
                   column(6, selectizeInput("All2", "Year: 2019", multiple = T,choices = unique(df2$Product), 
                                            options = list(maxItems = 5, placeholder = 'Choose a product:'))))
    ),
     column(
        12,fluidRow(column(12, plotlyOutput('plot'))
    )
   ) 
)


# Server code
server <- function(input, output) {

    outVar <- reactive({
        df1 %>%
            filter(Product %in% input$All) %>%
            arrange(Month) %>%
            droplevels()
    })

    outVar2 <- reactive({
        df2 %>%
            filter(Product %in% input$All2) %>%
            arrange(Month) %>%
            droplevels()
    })

    output$plot <- renderPlotly({
        plot_ly(data=outVar(), x=~Month,  y = ~Value,
                type = 'scatter', mode = 'lines', legendgroup = "1",
                color = ~Product , colors = trend_pal) %>%
        add_trace(data=outVar2(), x=~Month,  y = ~Value,
            type = 'scatter', mode = 'lines', legendgroup = "2",
            color = ~Product , colors = "Dark2")  %>%
            layout(legend = list(orientation = 'h'))         
    }) 
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

enter image description here

1 Ответ

1 голос
/ 07 октября 2019

Очень наивный трюк. Я добавил место для продукта во втором столбце. Это делает разные расцветки. Спасибо за воспроизводимый пример.

library(plotly)
library(dplyr)
library(shiny)
library(shinyWidgets)
library(readxl)
library(tidyr)

df1 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = rep(LETTERS[1:10], each = 12), 
                  Value = sample(c(0:300),120, replace = T), stringsAsFactors = F)
df2 <- data.frame(Month = rep(month.abb[1:12],10,replace = TRUE), Product = rep(LETTERS[1:10], each = 12), 
                  Value = sample(c(0:300),120, replace = T), stringsAsFactors = F)

df2$Product <- paste0(" ",df2$Product)

trend_pal <-  c('red','blue', 'yellow', 'green') #Palette

trend_pal2 <-  c('cyan','magenta', 'black', 'orange') #Palette2

# UI
ui <- fluidPage(
  column(
    6,fluidRow(column(6, selectizeInput("All", "Year: 2018", multiple = T,choices = unique(df1$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))),
               column(6, selectizeInput("All2", "Year: 2019", multiple = T,choices = unique(df2$Product), 
                                        options = list(maxItems = 5, placeholder = 'Choose a product:'))))
  ),
  column(
    12,fluidRow(column(12, plotlyOutput('plot'))
    )
  ) 
)


# Server code
server <- function(input, output) {

  outVar <- reactive({
    df1 %>%
      filter(Product %in% input$All) %>%
      arrange(Month) %>%
      droplevels()
  })

  outVar2 <- reactive({
    df2 %>%
      filter(Product %in% input$All2) %>%
      arrange(Month) %>%
      droplevels() %>% 
      mutate(year = 2019)
  })

  output$plot <- renderPlotly({
    plot_ly(data=outVar(), x=~Month,  y = ~Value,
            type = 'scatter', mode = 'lines', legendgroup = "1",
            color = ~Product , colors = trend_pal) %>%
      add_trace(data=outVar2(), x=~Month,  y = ~Value,
                type = 'scatter', mode = 'lines', legendgroup = "2",
                color = ~Product , 
                 colors = trend_pal2)  %>%
      layout(legend = list(orientation = 'h'))         
  }) 
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

enter image description here

...