CODEWITHSUNDEEP
rshinyplotly
Dustin Knight
Dustin Knight

Reputation: 350

Conditionally color a single bar in Plotly with R Shiny

Consider the following shiny app:

UI

library(shiny)
library(plotly)
ui <- fluidPage(
  titlePanel("Random Number Generator"),
    mainPanel(
      plotlyOutput("random_numbers")
      )
)

SERVER

server <- function(input, output) {
  df <- reactive({
    runif(100)
  })

  output$random_numbers <- renderPlotly({
    plot_ly() %>%  
      add_trace(y = sort(df()),
                type = 'bar',
                name = 'Random Numbers',
                marker = list(color = 'green')) %>%
      add_trace(y = mean(df()),
                type = 'bar',
                name = 'Mean',
                marker = list(color = 'orange'))
    })
}

The output looks like this:

sample graph

QUESTION

Is there a way I can display the mean on the same trace in the same order as the other runif(100) so that I can keep the ascending order AND keep the average a different color? I want it to look like the following graph:

what it should look like

Upvotes: 3

Views: 1338

Answers (1)

Tonio Liebrand
Tonio Liebrand

Reputation: 17689

There is an argument x you can use. To that one you can pass the value of the index that is closest to the sorted array. In your case: x = which.min(abs(sort(df()) - mean(df()))).

The full app: 

library(shiny)
library(plotly)
ui <- fluidPage(
  titlePanel("Random Number Generator"),
  mainPanel(
    plotlyOutput("random_numbers")
  )
)

server <- function(input, output) {
  df <- reactive({
    runif(100)
  })

  output$random_numbers <- renderPlotly({
    plot_ly() %>%  
      add_trace(
        x = 1:100,
        y = sort(df()),
                type = 'bar',
                name = 'Random Numbers',
                marker = list(color = 'green')) %>%
      add_trace(
        x = which.min(abs(sort(df()) - mean(df()))),
        y = mean(df()),
                type = 'bar',
                name = 'Mean',
                marker = list(color = 'orange'))
  })
}


runApp(shinyApp(ui, server), launch.browser = TRUE)

Edit: The more code intensive but correct solution can be found below.

  output$random_numbers <- renderPlotly({
    full.seq <- 1:(length(df()) + 1)
    mean.idx <- which.min(abs(sort(df()) - mean(df())))
    if((sort(df()) - mean(df()))[mean.idx] < 0) mean.idx <- mean.idx + 1 
    rand.seq <- full.seq[-mean.idx]

    plot_ly() %>%  
      add_trace(
        x = rand.seq,
        y = sort(df()),
        type = 'bar',
        name = 'Random Numbers',
        marker = list(color = 'green')) %>%
      add_trace(
        x = mean.idx,
        y = mean(df()),
        type = 'bar',
        name = 'Mean',
        marker = list(color = 'orange'))
  })

Upvotes: 1

Related Questions