R Plotly, dynamically add annotation on click event on dynamic added plotly graphs

Dear all,

I'm programming an shiny app on which user add or remove plots pushing actions buttons
On these dynamically added plot I want allow user to add and edit an annotation when he clicks on the graph

My problem when I click on the plot (a plotly graph) it displays an annotation (I cannot yet edit it..) on the clicked graph but also on the others graphs ...

For adding annotation texte zone I would like to do in my shiny app something like
(next step I will need to edit it)

Here below is a commented reprex of what I'm trying to do

I hope someone could solved my problem. I have been stuck for two weeks on this ...

Kind regards



library(shinycssloaders) # for spinner while data / plot loads 


#data definition
X <- c(1,2,3,4,5,6,7,8,9,10)
data <- data.frame(X,Y,Z)

#UI part
ui <- fluidPage(
                mainPanel(# Add button UI to add graph dynamically
                          actionButton("add_graphe",  label = '+'),
                          # Add button UI to deletecgraph dynamically
                          actionButton("supp_graphe",  label = '-'),
                          # Hold the graph from InsertUI created in the server part
                          div(id = 'placeholder')

#Server part
server <- function(input, output) {
  # Create a reactive value which contain the number of graphs actually plotted
  nbre <- reactiveVal(0)
  # Create a reactive which will contains informations about the clicked plot
  states<-reactiveValues(source=c(), value =c(), changed=c())
  # Create a reactive function which concatenate the number of graph with a string. Used further to give an incremental id to the new plot or other widget (ex.selectizeinput)
  Id <- reactive({
                               paste0(id, nbre())
  # Triggered when we push the "Add_graph" button
  observeEvent(input$add_graphe, {
    #increase nbre() value
    #Insert an UI element
              selector = '#placeholder',
              #The block representing the UI element (several elements inside, PlotlyOUput, seletizeInput x2)
              ui = div(id = Id()('ui'), style = "display:inline-block;width:49%",   #Insertion en ligne des elements
                        selectizeInput(Id()('select_X'), 'Axe X', names(data)),
                        selectizeInput(Id()('select_Y'), 'Axe Y', names(data),multiple=T, options = list('plugins' = list('remove_button'),'create' = TRUE,'persist' = FALSE))
    # Let's collect information id about the created graph
    states$source <- c(states$source,Id()('graph'))
    states$value <- c(states$value,nbre())
    states$changed = rep(FALSE,length(states$source))
  # Triggered when we push the "supp_graph" button
  observeEvent(input$supp_graphe, {
      #Remove the ui corresponding to plot id to delete
               selector = paste0('#',Id()('ui'))  #
      #Decrease nbre() value 
  # Triggered when nbre() change (so when we increase or decrease nbre() following an action on add or supp button)
  observeEvent(nbre(), {
                        id <- Id()('graph')
                        selectionX <- Id()('select_X')
                        selectionY <- Id()('select_Y')
    x_clicked = 0
    y_clicked = 0
    output[[id]] <- renderPlotly({
      #Check that both selectize input are not null
      if(is.null(input[[selectionX]]) || is.null(input[[selectionY]])){return()}
      #if not null get the selected values
      x_var <- input[[selectionX]]
      y_var <- input[[selectionY]]
      # Perform adaptation to the dataframe to allow multiplot
      data_to_plot <- select(data, y_var)
      data_to_plot <- gather(data_to_plot,variable,value)
      data_to_plot <-data.frame(data[names(data)==x_var],data_to_plot)

      # The for loop is dedicated to identify which plot has been clicked comparing even_data() information to the graphs ids 
      # It also allows to know which x and y point has been clicked in order to position the future annotation on this clicked point
      for(src in states$source)
        if( !is.null(event_data("plotly_click", source = src) ) )
          x_clicked = event_data("plotly_click", source = src)$x
          y_clicked = event_data("plotly_click", source = src)$y
          value <- event_data("plotly_click", source = src)[[2]]
          if(states$value[states$source==src]!=value )
            states$value[states$source==src] <- value
            states$changed[states$source==src] <- TRUE
        print(paste(states$source[states$changed==T], 'has changed'))
        states$changed <- rep(FALSE,length(states$source))
      # Perform ggplot function
      p<-ggplot(data_to_plot, aes(x=get(names(data_to_plot[1])), y = value, colour = variable)) + geom_line() + theme_linedraw()
      #Add plotly functionalities
      q<- ggplotly(p, source = id, dynamicTicks = TRUE) %>%
                                                                  editable = F,
                                                                  scrollZoom = T,
                                                                  displaylogo = F
                                                            #Add a new annotation near the clicked point 
                                                            add_annotations(x= x_clicked, y = y_clicked, text = "enter",clicktoshow = FALSE)%>%

  }, ignoreInit = FALSE)

shinyApp(ui = ui, server = server)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.