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()対応させることはできますか(1 つの色ではなく --> 私の場合は黒です)

  3. Choose color text inの代わりに、変数 (この場合は X1、X2、および X3)colourInput(paste("col", i, sep="_"), "Choose colour:",の対応する名前 (から選択された変数) が欲しいです。selectizeInput

  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. colorInput() のデフォルトの色をデフォルトのカラー パレットに対応させることはできますか (1 つの色ではなく --> 私の場合は黒です)

もちろん、できます。

まず、ggplot が使用する離散変数のデフォルトの色を知る必要があります。これらの色を生成するにはgg_color_hueこの素敵な議論にある関数を使用します。gg_fill_hueggplot の規則に従うように名前を変更しました。

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.Choose color text in colorInput(paste("col", i, sep="_"), "Choose color:" の代わりに、変数の対応する名前 (selectizeInput から選択された変数) が欲しいです (inこの場合、X1、X2、および X3)

上記のコードでも同様に実行されます-単純な貼り付け。


ここで、生成されるウィジェットの数が動的であるために発生する非常に重要な問題を見てみましょう。一意に従ってボックスの色を設定する必要colorInputがあり、それらの入力が 1、2、または 10 ある場合もあります。

この問題にアプローチする非常に優れた方法は、これらのウィジェットに通常どのようにアクセスするかを指定する要素を含む文字ベクトルを作成することだと思います。以下の例では、このベクトルは次のようになりますc("input$X1", "input$X2", ...)

次に、非標準の評価 ( evalparse) を使用して、これらの入力を評価して、選択した色のベクトルを取得し、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クライアント側で を定義した後、ID="reset"を更新するオブザーバーを作成しますcolorInput

私たちの目標は、利用可能なウィジェットupdateColourInputごとに適切なパラメーター化を使用してリストを返すことです。colourInput

選択したすべてのレベル/変数で変数を定義し、適切な数のデフォルト色を生成します。あいまいさを避けるために、ベクトルを再度並べ替えます。

次に and を使用lapplyして、リストとして指定された指定されたパラメーターで関数do.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 に答える