1
votes

https://plot.ly/r/custom-buttons/

Hello SO! First time posting here. I'm relatively new to R shiny and Plotly. I'm trying to use Plotly to essentially filter the data based upon the "update" button option that is in Plotly. The reference code is at the link above. Below is my code, I'm so close, the buttons will filter the data, but not correctly, so I feel like I'm missing something with the annotations in the args for Plotly.

I appreciate your feedback!

library(shiny)
library(shinydashboard)
library(plotly)
library(RODBC)
library(tidyverse)
library(lubridate)
library(htmlwidgets)
################
# ui
################
    ui <- fluidRow(plotlyOutput("plot", width = '100%', height = '800px'))




################
# Server
################
server <- function(input, output, session) {
  load(file = "/mnt/data/shinyAppsData/ltsang/B2.dat")
    margin <- list(
    l = 150,
    r = 50,
    b = 100,
    t = 100,
    pad = 4
  )

    build_annotations <- list(
      x=B2$DATETIME, 
      y=B2$WL_BUILD)
    release_annotations <- list(
      x=B2$DATETIME, 
      y=B2$WL_RELEASE)
    automation_annotations <- list(
      x=B2$DATETIME, 
      y=B2$AUTOMATION_RCVD)


  output$plot <- renderPlotly({B2 %>% 
      plot_ly(type = 'scatter', mode = 'lines') %>%
      add_trace(x=~DATETIME, y = ~WL_BUILD, source="A", name = ~NODES, line = list(color = ~NODES, width = 4)) %>%
      add_trace(x=~DATETIME, y = ~WL_RELEASE, source="B", name = ~NODES, line = list(color = ~NODES, width = 4, dash = 'dash')) %>%
      add_trace(x=~DATETIME, y = ~AUTOMATION_RCVD, source= "C", name = ~NODES, line = list(color = ~NODES, width = 4, dash = 'dot')) %>%
      layout(autosize = T, title = "NIGHT PRODUCTION", margin=margin,
             xaxis = list(title = "TIME, DATE", tickformat = "%H - %m/%d/%Y (%a)", ticks= "inside", dtick=3600000, rangeslider = list(type = "date"),
             rangeselector = list(
                buttons = list(
                  list(
                    count = 1,
                    label = "1 Day",
                    step = "day",
                    stepmode = "backward"),
                  list(
                    count = 2, 
                    label = "2 Days",
                    step = "day",
                    stepmode = "backward"),
                  list(
                    count = 3, 
                    label = "3 Days",
                    step = "day",
                    stepmode = "backward"),
                  list(step = "all", label = "all")
                )
            )),
            yaxis = list(title = "ACCESSION COUNT"),
            updatemenus = list(
              list(
                x = -0.1, 
                y = 0.8,
                showactive=TRUE,
                active = -1,
                bgcolor = "lightblue",
                type = 'buttons', 
                buttons = list(
                  list(
                    label = "WL_BUILD", 
                    method = "update",
                    args = list(list(visible = c(TRUE,FALSE,FALSE)),
                                list(title = "WORKLIST BUILD", source="A"))),
                                     #annotations = list(build_annotations,release_annotations,automation_annotations )))), 
                  list(
                    label = "WL_RELEASE", 
                    method = "update",
                    args = list(list(visible = c(FALSE,TRUE,FALSE)),
                                list(title = "WORKLIST RELEASE", source="B"))),
                                     #annotations = list(build_annotations,release_annotations,automation_annotations)))), 
                  list(
                    label = "AUTOMATION_RCVD", 
                    method = "update",
                    args = list(list(visible = c(FALSE,FALSE,TRUE)),
                                list(title = "AUTOMATION RECEIVED", source="C"))),
                                     #annotations = list(build_annotations,release_annotations,automation_annotations)))),
                  list(
                    label = "VIEW ALL", 
                    method = "update",
                    args = list(list(visible = c(TRUE,TRUE,TRUE)),
                                list(title = "AUTOMATION RECEIVED & WORKLIST BUILD/RELEASE")))
                                     #annotations = list(release_annotations,build_annotations, automation_annotations))))
                )
              )
            )
      )}
  )
  #observeEvent(event_data("plotly_relayout"), {
  #plotlyProxy("plot", session) %>%
  #plotlyProxyInvoke("relayout")
  #})

}

shinyApp(ui, server, enableBookmarking = "url")


enter image description here

1
You currently have the counts set to 1, 3, and 4 despite being labeled as 1 Day, 2 Days, and 3 Days. Is that how you would like it? - K.Daisey
I will update that, thanks for catching that, that cleaned up my rangeslider but doesn't do anything to the Plotly buttons with "update" method. - ltsang
Can you try adding your first line as a separate add_trace() or add_line()? - K.Daisey
I just did that after doing some more research, I'll update my code to reflect that change, but still doesn't update my graph based upon buttons clicked. I thought plotly would take care of all the "reactive" stuff but doesn't seem to be doing it in this instance. - ltsang

1 Answers

0
votes

We figured it out. Updated code below, lists are the bain of my existence.

server <- function(input, output, session) {
  load(file = "/mnt/data/shinyAppsData/ltsang/B2.dat")
    margin <- list(
    l = 150,
    r = 50,
    b = 100,
    t = 100,
    pad = 4
  )

    chem<-length(c("COBAS7S", "COBAS7S2","COBAS7U","COBAS5S","COBASIA", "COBAS8LV","LIAISON","ARCTECT","CPL CBC","CPL UA","A1C","COAG1","RPR", "sg"))
    release<-length(c("COBAS7S", "COBAS7S2","COBAS7U","COBAS5S","COBASIA", "COBAS8LV","LIAISON","ARCTECT","CPL CBC","CPL UA","A1C","COAG1","RPR"))
    auto<-length(c("Automate3", "Automate5" ,"Automate6","BIM1", "BIM2", "BIM3","MUT2","P612-1", "P612-2","P612-3","P612-4", "P612-5","P612-6", "P612-7", "sg"))


    output$plot <- renderPlotly({B2 %>% 
      plot_ly(type = 'scatter', mode = 'lines') %>%
      add_lines(x=~DATETIME, y = ~WL_BUILD, name = ~NODES, line = list(color = ~NODES, width = 4)) %>%
      add_lines(x=~DATETIME, y = ~WL_RELEASE, name = ~NODES, line = list(color = ~NODES, width = 4, dash = 'dash')) %>%
      add_lines(x=~DATETIME, y = ~AUTOMATION_RCVD, name = ~NODES, line = list(color = ~NODES, width = 4, dash = 'dot')) %>%
      layout(autosize = T, title = "NIGHT PRODUCTION", margin=margin,
             xaxis = list(title = "TIME, DATE", tickformat = "%H - %m/%d/%Y (%a)", ticks= "inside", dtick=3600000, rangeslider = list(type = "date"),
             rangeselector = list(
                buttons = list(
                  list(
                    count = 1,
                    label = "1 Day",
                    step = "day",
                    stepmode = "backward"),
                  list(
                    count = 2, 
                    label = "2 Days",
                    step = "day",
                    stepmode = "backward"),
                  list(
                    count = 3, 
                    label = "3 Days",
                    step = "day",
                    stepmode = "backward"),
                  list(step = "all", label = "all")
                )
            )),
            yaxis = list(title = "ACCESSION COUNT"),
            updatemenus = list(
              list(
                x = -0.1, 
                y = 0.8,
                showactive=TRUE,
                active = -1,
                bgcolor = "lightblue",
                type = 'buttons', 
                buttons = list(
                  list(
                    label = "WL_BUILD", 
                    method = "update",
                    args = list(list(visible = c(rep_len(TRUE, chem), rep_len(FALSE, release), rep_len(FALSE, auto))),
                                list(title = "WORKLIST BUILD", key="A"))),

                  list(
                    label = "WL_RELEASE", 
                    method = "update",
                    args = list(list(visible = c(rep_len(FALSE, chem), rep_len(TRUE, release), rep_len(FALSE, auto))),
                                list(title = "WORKLIST RELEASE", key="B"))),

                  list(
                    label = "AUTOMATION_RCVD", 
                    method = "update",
                    args = list(list(visible = c(rep_len(FALSE, chem), rep_len(FALSE, release), rep_len(TRUE, auto))),
                                list(title = "AUTOMATION RECEIVED", key="C"))),

                  list(
                    label = "VIEW ALL", 
                    method = "update",
                    args = list(list(visible = c(rep_len(TRUE, chem), rep_len(TRUE, release), rep_len(TRUE, auto))),
                                list(title = "AUTOMATION RECEIVED & WORKLIST BUILD/RELEASE")))

                )
              )
            )
      )}
  )
}

shinyApp(ui, server, enableBookmarking = "url")