Очень наивный трюк. Я добавил место для продукта во втором столбце. Это делает разные расцветки. Спасибо за воспроизводимый пример.
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)