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

Question

我正在运行一些闪亮的应用程序。然而，有些包含可能引起公众兴趣的图形。因此，我正在 Infogram 中寻找类似于下图的解决方案，但可以从 Poltly 的 ( plotly) 工具栏编辑图表，尤其是颜色。这是 Infogram 的玩具示例。

是否可以通过编辑 Plotly 在 Shiny R 中做类似的事情？在工具栏中添加一个小的绘图配置按钮是理想的选择。如果没有，您是否知道有类似的软件包可以实现此目的？

“顶部”将是：

请注意工具栏上的配置按钮（齿轮）设计。这本身并不存在。

一个 R 代码示例

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

Answer 1

看来您对 SO 并不陌生，但我确实想指出这对解决我的代码问题没有帮助。这更像是为我做这件事，这很可能就是为什么到目前为止你还没有得到答复。

你试过什么了？什么有效？什么没有？您提到了 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()在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)