4

我确实需要一些帮助作为帖子：闪亮服务器中的动态颜色输入不能完全回答我的问题。

我想在我闪亮的应用程序中选择动态颜色（填充）。我准备了一个示例代码：

library(shiny)
library(shinyjs)
library(reshape2)
library(ggplot2)

dat <- data.frame(matrix(rnorm(60, 2, 3), ncol=3))
dat <- melt(dat)

runApp(shinyApp(
  ui = fluidPage(
    selectizeInput("select","Select:", choices=as.list(levels(dat$variable)), selected="X1",multiple =TRUE),
    uiOutput('myPanel'),
    plotOutput("plot"),
    downloadButton('downloadplot',label='Download Plot')
  ),
  server = function(input, output, session) {
    cols <- reactive({
      lapply(seq_along(unique(input$select)), function(i) {
        colourInput(paste("col", i, sep="_"), "Choose colour:", "black")        
      })
    })

    output$myPanel <- renderUI({cols()})

    cols2 <- reactive({        
      if (is.null(input$col_1)) {
        cols <- rep("#000000", length(input$select))
      } else {
        cols <- unlist(colors())
      }
      cols})

    testplot <- function(){
      dat <- dat[dat$variable %in% input$select, ]
      ggplot(dat, aes(x=variable,y=value, fill=cols2()[1])) + geom_boxplot()}

    output$plot <- renderPlot({testplot()})

    output$downloadplot <- downloadHandler(
      filename ="plot.pdf",
      content = function(file) {
        pdf(file, width=12, height=6.3)
        print(testplot())
        dev.off()
      })
  }
))

我希望用户选择箱线图的填充颜色。颜色小部件的数量将根据 中所选变量的数量出现selectizeInput("select"...。到目前为止，一切都运行良好，但是更进一步，我无法弄清楚如何将这种颜色应用于 ggplot 等......

以下是我的问题：

  1. 我如何正确地将填充颜色连接到 ggplot

  2. 我可以使默认颜色colourInput()对应于默认调色板（不是一种颜色->在我的情况下是黑色）

  3. 而不是选择颜色文本，colourInput(paste("col", i, sep="_"), "Choose colour:",我希望拥有selectizeInput变量（在本例中为 X1、X2 和 X3）的相应名称（从 中选择变量）

  4. 我也想有一个可以重置所有选择颜色的按钮

提前谢谢大家，我希望这可以解决

干杯

4

1 回答 1

8

这些都是非常好的和具体的问题，我很高兴，希望能回答它们:)

  1. 我如何正确地将填充颜色连接到 ggplot

在这种情况下，我认为最好的方法是根据variable（这是反应性的）填充框并添加一个新层scale_fill_manual，您可以在其中为不同的框指定自定义颜色。颜色的数量显然必须等于 的级别数variable。这可能是最好的方法，因为您将始终拥有正确的图例。

ggplot(dat, aes(x = variable, y = value, fill = variable)) + 
          geom_boxplot() +
          scale_fill_manual(values = cols)
  1. 我可以使 colourInput() 的默认颜色对应于默认调色板（不是一种颜色 - >在我的情况下是黑色）

当然，你可以做到。

首先，您需要知道 ggplot 使用的离散变量的默认颜色。为了生成这些颜色，我们将使用这个很好的讨论gg_color_hue中的一个函数。我已将其名称更改为遵循 ggplot 约定。gg_fill_hue

我们可以renderUI在我们首先指定所选级别/变量的地方编码所有内容。为了消除由于动态（并且可能以不同的顺序）生成的小部件而导致的明确性，我们对级别/变量的名称进行排序。

然后我们生成适当数量的默认颜色gg_fil_hue并将它们分配给适当的小部件。

为了使事情变得更容易，我们将IDs这些小部件更改为col+ "varname"，由input$select 

output$myPanel <- renderUI({ 
      lev <- sort(unique(input$select)) # sorting so that "things" are unambigious
      cols <- gg_fill_hue(length(lev))

      # New IDs "colX1" so that it partly coincide with input$select...
      lapply(seq_along(lev), function(i) {
        colourInput(inputId = paste0("col", lev[i]),
                    label = paste0("Choose colour for ", lev[i]), 
                    value = cols[i]
        )        
      })
    })

3.而不是在 colourInput(paste("col", i, sep="_"), "Choose colour:" 中选择颜色文本，我希望有变量的相应名称（从 selectizeInput 中选择变量）（在本例 X1、X2 和 X3)

它也在上面的代码中完成 - 简单的粘贴。

现在，让我们看一下由于生成的小部件的动态数量而出现的一个非常重要的问题。我们必须根据唯一性设置框的颜色，colorInput这些输入可能有 1,2 甚至 10 个。

我相信解决这个问题的一个非常好的方法是创建一个字符向量，其中包含指定我们通常如何访问这些小部件的元素。在下面的示例中，此向量如下所示c("input$X1", "input$X2", ...)：

然后使用非标准评估 ( eval, parse) 我们可以评估这些输入以获得具有选定颜色的向量，然后将其传递给scale_fill_manual层。

为了防止选择之间可能出现的错误，我们将使用函数“req”来确保带有颜色的向量的长度与所选级别/变量的长度相同。

output$plot <- renderPlot({
        cols <- paste0("c(", paste0("input$col", sort(input$select), collapse = ", "), ")")
        # print(cols)
        cols <- eval(parse(text = cols))
        # print(cols)

        # To prevent errors
        req(length(cols) == length(input$select))

        dat <- dat[dat$variable %in% input$select, ]
        ggplot(dat, aes(x = variable, y = value, fill = variable)) + 
          geom_boxplot() +
          scale_fill_manual(values = cols)

    })
  1. 我也想有一个可以重置所有选择颜色的按钮

actionButton在客户端用 an定义后，ID="reset"我们创建一个将更新colorInputs 的观察者。

我们的目标是为每个可用的小部件返回一个带有updateColourInput适当参数化的列表colourInput。

我们用所有选择的级别/变量定义一个变量，并生成适当数量的默认颜色。我们再次对向量进行排序以避免歧义。

然后我们使用lapplyanddo.call调用updateColourInput带有指定参数的函数，这些参数以列表形式给出。

observeEvent(input$reset, {
      # Problem: dynamic number of widgets
      # - lapply, do.call

      lev <- sort(unique(input$select))
      cols <- gg_fill_hue(length(lev))

      lapply(seq_along(lev), function(i) {
              do.call(what = "updateColourInput",
                      args = list(
                        session = session,
                        inputId = paste0("col", lev[i]),
                        value = cols[i]
                      )
              )
      })
    })

完整示例：

library(shiny)
library(shinyjs)
library(reshape2)
library(ggplot2)

dat <- data.frame(matrix(rnorm(60, 2, 3), ncol=3))
dat <- melt(dat)

# Function that produces default gg-colours is taken from this discussion:
# https://stackoverflow.com/questions/8197559/emulate-ggplot2-default-color-palette
gg_fill_hue <- function(n) {
  hues = seq(15, 375, length = n + 1)
  hcl(h = hues, l = 65, c = 100)[1:n]
}

runApp(shinyApp(
  ui = fluidPage(
    selectizeInput("select", "Select:", 
                   choices = as.list(levels(dat$variable)), 
                   selected = "X1", 
                   multiple = TRUE), 
    uiOutput('myPanel'),
    plotOutput("plot"),
    downloadButton('downloadplot', label = 'Download Plot'),
    actionButton("reset", "Default colours", icon = icon("undo"))
  ),
  server = function(input, output, session) {

    output$myPanel <- renderUI({ 
      lev <- sort(unique(input$select)) # sorting so that "things" are unambigious
      cols <- gg_fill_hue(length(lev))

      # New IDs "colX1" so that it partly coincide with input$select...
      lapply(seq_along(lev), function(i) {
        colourInput(inputId = paste0("col", lev[i]),
                    label = paste0("Choose colour for ", lev[i]), 
                    value = cols[i]
        )        
      })
    })


    output$plot <- renderPlot({
      cols <- paste0("c(", paste0("input$col", sort(input$select), collapse = ", "), ")")
      # print(cols)
      cols <- eval(parse(text = cols))
      # print(cols)

      # To prevent errors
      req(length(cols) == length(input$select))

      dat <- dat[dat$variable %in% input$select, ]
      ggplot(dat, aes(x = variable, y = value, fill = variable)) + 
        geom_boxplot() +
        scale_fill_manual(values = cols)

    })


    observeEvent(input$reset, {
      # Problem: dynamic number of widgets
      # - lapply, do.call

      lev <- sort(unique(input$select))
      cols <- gg_fill_hue(length(lev))

      lapply(seq_along(lev), function(i) {
        do.call(what = "updateColourInput",
                args = list(
                  session = session,
                  inputId = paste0("col", lev[i]),
                  value = cols[i]
                )
        )
      })
    })




    output$downloadplot <- downloadHandler(
      filename = "plot.pdf",
      content = function(file) {
        pdf(file, width = 12, height = 6.3)
        print(testplot())
        dev.off()
      })
  }
))
于 2016-08-08T12:45:50.660 回答