用用户选择的交互式颜色制作一个绘图R

Question

我有一些正在运行的闪亮应用程序。然而，有些包含可能引起公众兴趣的图形。因此，我正在从 Infogram 寻找类似于下图的解决方案，可以在 Web 环境中编辑图表的颜色以供以后下载。

是否可以在 Shiny R 中做类似的事情？作为 Plotly，也许在工具栏上添加一个小绘图配置按钮？ 如果 Plotly 不可行，你知道有类似的包可以实现这一点吗？

“顶部”是：

R 代码示例

library(plotly)
fig <- plot_ly(midwest, x = ~percollege, color = ~state, type = "box")
fig

Answer 1

您似乎并不陌生，但我确实想指出这不是一个“帮助我的代码”问题。这更像是“为我做这件事”，这很可能就是到目前为止您还没有得到答复的原因。 到目前为止您尝试过什么？什么有效？什么没有？您提到了 Shiny，但没有任何内容表明您试图与 Shiny 合作来实现这一目标。 好吧，我的肥皂盒塌了。

这是实现这一目标的众多方法中的一种。在我的回答结束时，我将一次性提供解释中提供的所有代码（更容易复制+粘贴）。

我使用了五个库，并从默认的 Plotly 颜色开始。

library(shiny)
library(shinydashboard)
library(colourpicker)
library(tidyverse)
library(plotly)

# starting plot with default colors from Plotly
defCol <- c('#1f77b4', '#ff7f0e', '#2ca02c', '#d62728', '#9467bd', '#8c564b', 
            '#e377c2', '#7f7f7f', '#bcbd22', '#17becf')

接下来，我编写了一个 UDF 来为箱线图中的每个标签创建颜色选择/选择器。代码中的注释应该使这一点不言自明。但是，如果您对此或答案的任何部分有任何疑问，请告诉我。 （我知道我的意思......这并不意味着其他人也这样做。）

输入值，或者正如我在代码功能名称中提到的那样，是您将在图例中看到的名称。它是您分配给 

color

中的

plot_ly()

的任何列的唯一值的向量。在这个答案中，它是

unique(midwest$state)

。

colInput <- function(vecFeats) { # vecFeats = vector of feature names for colors
  pickers <- invisible(lapply(1:length(vecFeats), function(k) {
    colourInput(inputId = paste0("col", k),           # names used in plot_ly()
                label = vecFeats[k],                  # color sel label for user
                value = defCol[k],    # initial color == this should match initial plot
                showColour = "background"  # to user, only show the color itself after select
    )
    }))
pickers
}

我创建了一个接下来具有绘图标签的对象，因为它会被重复使用。请注意我关于排序和使用字符字段与因子（或有序）字段的评论。

# used multiple times-- the data color names
dcn <- sort(unique(midwest$state))  # not a factor, alphabetize to match plot
#-- Plotly will alphabetize if not factor --

接下来是闪亮的用户界面和服务器。在 UI 中，我在

colInput()

 的调用中调用了 UDF 

sidebar

。我将绘图渲染输出

plotlyOutput

添加到

body

。在服务器中，我仅使用

input$col

+ 颜色数字来调用绘图渲染。这是侧边栏中用户输入的交互。初始颜色是 UDF 中建立的颜色 (

value = defCol[k]

)。

ui <- shinydashboardPlus::dashboardPage(      # create aesthetics
  header = dashboardHeader(title = "Header"),
  sidebar = dashboardSidebar(                 # create mask for user interaction
      collapsed = F,
      title = "Choose colors for the plot.",  # sidebar title
      .list = colInput(dcn)                   # use data color names, call UDF
      ),
  body = dashboardBody(title = "Body", plotlyOutput("plt"))
)

server <- function (input, output, session) {
  # using same data for color selects and plot
  output$plt <- renderPlotly({                      # send plot to ui
    plot_ly(midwest, x = ~percollege, color = ~state, 
            # connect colors to color picker in sidebar dynamically
            colors = paste0("input$col", 1:length(dcn)) %>%   # use data color names
              map(., function(i) {eval(parse(text = i))}) %>% # convert strings to obj
              unlist() %>% setNames(dcn),           # make named list for Plotly
            type = "box")
  })
}

shinyApp(ui, server)

以上所有代码。

library(shiny)
library(shinydashboard)
library(colourpicker)
library(tidyverse)
library(plotly)

# starting plot with default colors from Plotly
defCol <- c('#1f77b4', '#ff7f0e', '#2ca02c', '#d62728', '#9467bd', '#8c564b', 
            '#e377c2', '#7f7f7f', '#bcbd22', '#17becf')

# create color selectors for plot, using plot data
colInput <- function(vecFeats) { # vecFeats = vector of feature names for colors
  pickers <- invisible(lapply(1:length(vecFeats), function(k) {
    colourInput(inputId = paste0("col", k),           # names used in plot_ly()
                label = vecFeats[k],                  # color sel label for user
                value = defCol[k],    # initial color == this should match initial plot
                showColour = "background"  # to user, only show the color itself after select
    )
    }))
pickers
}

# used multiple times-- the data color names
dcn <- sort(unique(midwest$state))  # not a factor, alphabetize to match plot
#-- Plotly will alphabetize if not factor --

ui <- shinydashboardPlus::dashboardPage(      # create aesthetics
  header = dashboardHeader(title = "Header"),
  sidebar = dashboardSidebar(                 # create mask for user interaction
      collapsed = F,
      title = "Choose colors for the plot.",  # sidebar title
      .list = colInput(dcn)                   # use data color names, call UDF
      ),
  body = dashboardBody(title = "Body", plotlyOutput("plt"))
)

server <- function (input, output, session) {
  # using same data for color selects and plot
  output$plt <- renderPlotly({                      # send plot to ui
    plot_ly(midwest, x = ~percollege, color = ~state, 
            # connect colors to color picker in sidebar dynamically
            colors = paste0("input$col", 1:length(dcn)) %>%   # use data color names
              map(., function(i) {eval(parse(text = i))}) %>% # convert strings to obj
              unlist() %>% setNames(dcn),           # make named list for Plotly
            type = "box")
  })
}
shinyApp(ui, server)