0

Hello I have created a shiny app which creates a scatter plot between selected variables. Then when I click on a data point the name of the point is printed in the plot. The problem is that when I update the plot with other variables the printed are not erased. Generally I would like some ideas on how remove the data labels from my plot.

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
library(htmlwidgets)
js <- HTML(
  "Shiny.addCustomMessageHandler('resetValue', function(variableName){
  Shiny.onInputChange(variableName, null);
  }
);"
)
fluidPage(
  tags$head(tags$script(js)),
  # App title ----
  titlePanel(div("CROSS CORRELATION",style = "color:blue")),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(width = 3

    ),
    # Main panel for displaying outputs ----
    mainPanel(

      tabsetPanel(type = "tabs",
                  tabPanel("Table",
                           shiny::dataTableOutput("contents")),
                  tabPanel("Correlation Plot",
                           tags$style(type="text/css", "
           #loadmessage {
                                      position: fixed;
                                      top: 0px;
                                      left: 0px;
                                      width: 100%;
                                      padding: 5px 0px 5px 0px;
                                      text-align: center;
                                      font-weight: bold;
                                      font-size: 100%;
                                      color: #000000;
                                      background-color: #CCFF66;
                                      z-index: 105;
                                      }
                                      "),conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                                                          tags$div("Loading...",id="loadmessage")
                                      ),
                           fluidRow(
                             column(3, uiOutput("lx1")),
                           column(3,uiOutput("lx2"))),
                           hr(),
                           fluidRow(
                             tags$style(type="text/css",
                                        ".shiny-output-error { visibility: hidden; }",
                                        ".shiny-output-error:before { visibility: hidden; }"
                             ),
                           column(3,uiOutput("td")),
                           column(3,uiOutput("an"))
                           ),
                           fluidRow(
                           plotlyOutput("sc"))
      )
      )
  )))
#server.r
 function(input, output,session) {


  output$lx1<-renderUI({
    selectInput("lx1", label = h4("Select 1st Expression Profile"), 
                choices = colnames(mtcars) 
                )
  })
  output$lx2<-renderUI({
    selectInput("lx2", label = h4("Select 2nd Expression Profile"), 
                choices = colnames(mtcars) 
                )
  })


  output$td<-renderUI({
    radioButtons("td", label = h4("Trendline"),
                 choices = list("Add Trendline" = "lm", "Remove Trendline" = ""), 
                 selected = "")
  })


  output$an<-renderUI({

    radioButtons("an", label = h4("Correlation Coefficient"),
                 choices = list("Add Cor.Coef" = cor(subset(mtcars, select=c(input$lx1)),subset(mtcars, select=c(input$lx2))), "Remove Cor.Coef" = ""), 
                 selected = "")
  })  


  # 1. create reactive values
  vals <- reactiveValues()
  # 2. create df to store clicks
  vals$click_all <- data.frame(x = numeric(),
                               y = numeric(),
                               label = character())

  # 3. add points upon plot click
  observeEvent({event_data("plotly_click", source = "select")}, {
    # get clicked point
    click_data <- event_data("plotly_click", source = "select")
    # check if from correct curve
    if(!is.null(click_data) && click_data[["curveNumber"]] == 2) {
      # get data for current point
      label_data <- data.frame(x = click_data[["x"]],
                               y = click_data[["y"]],
                               label = click_data[["key"]],
                               stringsAsFactors = FALSE)
      # add current point to df of all clicks
      vals$click_all <- merge(vals$click_all,
                              label_data, 
                              all = TRUE)
    }
  }) 
 output$sc<-renderPlotly({
   mtcars$model <- row.names(mtcars)
     if(input$td=="lm"){
       p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "model",group = 1))+
         # Change the point options in geom_point
         geom_point(color = "darkblue") +

         # Change the title of the plot (can change axis titles
         # in this option as well and add subtitle)
         labs(title = "Cross Correlation") +
         # Change where the tick marks are
         scale_x_continuous(breaks = seq(0, 35, 5)) +
         scale_y_continuous(breaks = seq(0, 35, 5)) +
         # Change how the text looks for each element
         theme(title = element_text(family = "Calibri", 
                                    size = 10, 
                                    face = "bold"), 
               axis.title = element_text(family = "Calibri Light", 
                                         size = 16, 
                                         face = "bold", 
                                         color = "darkgrey"), 
               axis.text = element_text(family = "Calibri", 
                                        size = 11))+
         theme_bw()+

         annotate("text", x = 5, y = 5, label = as.character(input$an))+
       geom_smooth(aes(group = 1))+
         # 4. add labels for clicked points
         geom_text(data = vals$click_all,
                   aes(x = x, y = y, label = label),
                   inherit.aes = FALSE, nudge_y = -1,5)
     }
   else{
     mtcars$model <- row.names(mtcars)
     p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "model",group = 1))+
       # Change the point options in geom_point
       geom_point(color = "darkblue") +

       # Change the title of the plot (can change axis titles
       # in this option as well and add subtitle)
       labs(title = "Cross Correlation") +
       # Change where the tick marks are
       scale_x_continuous(breaks = seq(0, 35, 5)) +
       scale_y_continuous(breaks = seq(0, 35, 5)) +
       # Change how the text looks for each element
       theme(title = element_text(family = "Calibri", 
                                  size = 10, 
                                  face = "bold"), 
             axis.title = element_text(family = "Calibri Light", 
                                       size = 16, 
                                       face = "bold", 
                                       color = "darkgrey"), 
             axis.text = element_text(family = "Calibri", 
                                      size = 11))+
       theme_bw()+

       annotate("text", x = 5, y = 5, label = as.character(input$an))+
     # 4. add labels for clicked points
     geom_text(data = vals$click_all,
               aes(x = x, y = y, label = label),
               inherit.aes = FALSE, nudge_y = -1,5)
   } 






   ggplotly(p1,source = "select", tooltip = c("key")) %>%
     layout(hoverlabel = list(bgcolor = "white", 
                              font = list(family = "Calibri", 
                                          size = 9, 
                                          color = "black")))

 })
 # 5a. reset plotly click event and vals$click_all upon changing plot inputs
 observeEvent(c(
   input$lx1,
   input$lx2
 ), {
   session$sendCustomMessage("resetValue", ".clientValue-plotly_click-select")
   vals$click_all <- data.frame(x = numeric(),
                                y = numeric(),
                                label = character())
 })






}
firmo23
  • 7,490
  • 2
  • 38
  • 114

1 Answers1

1

1. Reset the plotly event input

First, add this to the ui:

js <- HTML(
    "Shiny.addCustomMessageHandler('resetValue', function(variableName){
        Shiny.onInputChange(variableName, null);
    }
    );"
)

ui <- fluidPage(
        tags$head(tags$script(js)),
        ...
    )

Then, use the message handler in the server:

session$sendCustomMessage("resetValue", ".clientValue-plotly_click-select")

Note, the plotly event data follows this format: '.clientValue-event-source', where event is the type of event (e.g. plotly_click, plotly_hover, etc) and source is specified in the plot where the click event data are coming from.

This method was adapted from this answer. This article is also a useful reference.

2. Reset the reactive dataframe

vals$click_all <- data.frame(x = numeric(),
                                     y = numeric(),
                                     label = character())

3. Use observeEvent to trigger "resets" when plot variables change

observeEvent(c(
        input$column_x,
        input$column_y
    ), {
        session$sendCustomMessage("resetValue", ".clientValue-plotly_click-select")
        vals$click_all <- data.frame(x = numeric(),
                                     y = numeric(),
                                     label = character())
    })

Note: you need to add the session argument to your server function, like this:

server <- function(input, output, session) {
   ...
}

Minimal example

library(shiny)
library(plotly)
library(htmlwidgets)

js <- HTML(
    "Shiny.addCustomMessageHandler('resetValue', function(variableName){
        Shiny.onInputChange(variableName, null);
    }
    );"
)

ui <- fluidPage(
        # 5b. js to reset the plotly click event
        tags$head(tags$script(js)),
        fluidRow(column(width = 3,
                        selectInput("column_x", "X Variable", colnames(mtcars)),
                        selectInput("column_y", "Y Variable", colnames(mtcars))),
                 column(width = 9,
                        plotlyOutput("plot")
                        )
                 )
    )

server <- function(input, output, session) {

    # 1. create reactive values
    vals <- reactiveValues()
    # 2. create df to store clicks
    vals$click_all <- data.frame(x = numeric(),
                                 y = numeric(),
                                 label = character())
    # 3. add points upon plot click
    observeEvent({event_data("plotly_click", source = "select")}, {
        # get clicked point
        click_data <- event_data("plotly_click", source = "select")
        # check if from correct curve
        if(!is.null(click_data) && click_data[["curveNumber"]] == 0) {
            # get data for current point
            label_data <- data.frame(x = click_data[["x"]],
                                     y = click_data[["y"]],
                                     label = click_data[["key"]],
                                     stringsAsFactors = FALSE)
            # add current point to df of all clicks
            vals$click_all <- merge(vals$click_all,
                                    label_data, 
                                    all = TRUE)
        }
    }) 

    output$plot <- renderPlotly({
        mtcars$model <- row.names(mtcars)
        g <- ggplot(mtcars, aes_string(x = input$column_x, 
                                       y = input$column_y, 
                                       key = "model",
                                       group = 1)) +
            geom_point() +
            geom_smooth(aes(group = 1)) +
            # 4. add labels for clicked points
            geom_text(data = vals$click_all,
                      aes(x = x, y = y, label = label),
                      inherit.aes = FALSE, nudge_x = 1.5)
        ggplotly(g, source = "select", tooltip = c("key"))
    })

    # 5a. reset plotly click event and vals$click_all upon changing plot inputs
    observeEvent(c(
        input$column_x,
        input$column_y
    ), {
        session$sendCustomMessage("resetValue", ".clientValue-plotly_click-select")
        vals$click_all <- data.frame(x = numeric(),
                                     y = numeric(),
                                     label = character())
    })

}

shinyApp(ui, server)

enter image description here

Hallie Swan
  • 2,714
  • 1
  • 15
  • 23
  • First of all thanks a lot for your explanation and your answer which seems to be to the right direction! For some reason I cannot apply it on my original app so I edited and put the whole mechanism on it. I am not sure how you activate the two inputs in the server.r file but I suppose this is the issue. – firmo23 Apr 03 '18 at 14:44
  • I use uiOutput() for my two inputs lx1 and lx2 as my actual dataset comes after loading a csv file and gives its variables to the inputs. – firmo23 Apr 04 '18 at 16:53
  • @firmo23 Oh, you add `geom_point` to your plot *before* `geom_smooth` (my answer adds `geom_smooth` first). So in your plotly click event_data, the `curveNumber` for your `geom_point` is 0, not 2. All you have to do is change the `if` statment to: `if(!is.null(click_data) && click_data[["curveNumber"]] == 0)` – Hallie Swan Apr 04 '18 at 18:00
  • great that works! I will accept it. If I want to use exactly the same functionality for another plot in the same app what should I change? – firmo23 Apr 04 '18 at 19:57
  • @firmo23 `source` in ggplotly, event_data, and session$sendCustomMessage. For example, if `source` is "second_plot" then change to `session$sendCustomMessage("resetValue", ".clientValue-plotly_click-second_plot")` – Hallie Swan Apr 04 '18 at 20:03
  • so the ui.r remains exactly the same and I repeat your code with the changes in source which I will name "select2" – firmo23 Apr 04 '18 at 20:20
  • @firmo23 you'll have to change your ui to add the new plot etc, but you don't have to edit the js – Hallie Swan Apr 04 '18 at 20:22
  • great that worked! btw do you know if it is possible to remove the data labels one by one?maybe with a button? – firmo23 Apr 04 '18 at 20:35
  • @firmo23 definitely possible. add an `actionButton` in ui and an `observeEvent` to remove the last row of `vals$click_all` on server. this is similar: https://stackoverflow.com/questions/49190820/create-data-set-from-clicks-in-shiny-ggplot/49203281#49203281 – Hallie Swan Apr 04 '18 at 21:14