Trendline cannot be displayed after putting observer in my shiny app

ggplot2

#1

Hello I have shiny app that takes a dataset as input, cleans it from NAs and then makes a plot out of it. The I give user the choice to add a trendline in that plot. This is how my dataset looks like:

gene_symbol Entrez_ID Ensembl_ID     Lex1  Lex2  Lex3  Lex4  Lex5  Lex6  Lex7  Lex8  Lex9 Lex10
   <chr>           <int> <chr>         <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
 1 A1BG             5171 ENSG00000121~     9     1    12     8     9     1    32   126    29    24
 2 A1BG-AS1        52447 ENSG00000268~    30    46    58    94    53    11   125   142    67    67
 3 A1CF             9119 ENSG00000148~     0     0     0     0     0    87     0     0     0     0
 4 A2M             14002 ENSG00000175~   273   520  1387  1549  2064  1101  2508  6420  3269  4475
 5 A2M-AS1         38572 ENSG00000245~     2     2     7    11    14     8    13     6    20    16
 6 A2ML1           11899 ENSG00000166~     0     0     0     0     0     2     0     2     1     0
 7 A2ML1-AS1       44904 ENSG00000256~     0     0     0     0     0     1     0     0     0     0
 8 A2ML1-AS2       45000 ENSG00000256~     0     0     0     0     0     0     0     0     0     0
 9 A2MP1           44659 ENSG00000256~     1     1     4     4     2     1     0     9     1     0
10 A3GALT2         15764 ENSG00000184~     0     0     0     0     0     0     0     0     0     0

This is the working app.

#ui.r
        library(shiny)
        library(ggplot2)
        library(plotly)


    fluidPage(

      # App title ----
      titlePanel(div("CROSS CORRELATION",style = "color:blue")),

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

        # Sidebar panel for inputs ----
        sidebarPanel(

          # Input: Select a file ----
          fileInput("file1", "Input CSV-File",
                    multiple = TRUE,
                    accept = c("text/csv",
                               "text/comma-separated-values,text/plain",
                               ".csv")),

          # Horizontal line ----
          tags$hr(),

          # Input: Checkbox if file has header ----
          checkboxInput("header", "Header", TRUE),

          # Input: Select separator ----
          radioButtons("sep", "Separator",
                       choices = c(Comma = ",",
                                   Semicolon = ";",
                                   Tab = "\t"),
                       selected = ","),


          # Horizontal line ----
          tags$hr(),

          # Input: Select number of rows to display ----
          radioButtons("disp", "Display",
                       choices = c(Head = "head",
                                   All = "all"),
                       selected = "head")





        ),
        # 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) {
  rt<-reactive({
    req(input$file1)

    csvdata <- read.csv(input$file1$datapath,
                        header = input$header
    )
    if(input$disp == "head"){
      head(csvdata)
    } else{
      csvdata
    } 
    csvdata$Lex1=as.numeric(levels(csvdata$Lex1))[csvdata$Lex1]
    csvdata$Lex2=as.numeric(levels(csvdata$Lex2))[csvdata$Lex2]
    csvdata$Lex3=as.numeric(levels(csvdata$Lex3))[csvdata$Lex3]
    csvdata$Lex4=as.numeric(levels(csvdata$Lex4))[csvdata$Lex4]
    csvdata$Lex5=as.numeric(levels(csvdata$Lex5))[csvdata$Lex5]
    csvdata$Lex6=as.numeric(levels(csvdata$Lex6))[csvdata$Lex6]
    csvdata$Lex7=as.numeric(levels(csvdata$Lex7))[csvdata$Lex7]
    csvdata$Lex8=as.numeric(levels(csvdata$Lex8))[csvdata$Lex8]
    csvdata$Lex9=as.numeric(levels(csvdata$Lex9))[csvdata$Lex9]
    csvdata$Lex10=as.numeric(levels(csvdata$Lex10))[csvdata$Lex10]
    csvdata$Lex11=as.numeric(levels(csvdata$Lex11))[csvdata$Lex11]
    csvdata$Lex12=as.numeric(levels(csvdata$Lex12))[csvdata$Lex12]


    capture.output(csvdata[rowSums(is.na(csvdata)) > 0,],file = "Missing_genes.csv")


    row.has.na <- apply(csvdata, 1, function(x){any(is.na(x))})
    csvdata2 <- csvdata[!row.has.na,]

    csvdata2
  }) 

  output$contents <- shiny::renderDataTable({

    rt()
  })


  output$lx1<-renderUI({
    selectInput("lx1", label = h4("Select 1st Expression Profile"), 
                choices = colnames(rt()[,4:15]), 
                selected = "Lex1")
  })
  output$lx2<-renderUI({
    selectInput("lx2", label = h4("Select 2nd Expression Profile"), 
                choices = colnames(rt()[,4:15]), 
                selected = "Lex2")
  })

  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(rt(), select=c(input$lx1)),subset(rt(), select=c(input$lx2))), "Remove Cor.Coef" = ""), 
                 selected = "")
  })  


 output$sc<-renderPlotly({

   p1 <- ggplot(rt(), aes_string(x = input$lx1, y = input$lx2))+
     # 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, 80000, 10000)) +
     scale_y_continuous(breaks = seq(0, 120000, 20000)) +
     # 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()+
     geom_smooth(method = input$td)+
     annotate("text", x = 50000, y = 50000, label = as.character(input$an))

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

 }) 




}

And here is the code that I added in order to make data labels persistent in my plot.

# 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
  observe({
    # get clicked point
    click_data <- event_data("plotly_click", source = "select")
    # 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)
  })
# 4. add labels for clicked points
     geom_text(data = vals$click_all,
               aes(x = x, y = y, label = label),
               inherit.aes = FALSE, nudge_x = 0.25)

This is the new non-functional server.r which provides this issue that prevents the trendline from displaying. I know they are not errors but warnings but they still cause the issue:

Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced
Warning in qt((1 - level)/2, df) : NaNs produced

#server.r
function(input, output) {
  rt<-reactive({
    req(input$file1)

    csvdata <- read.csv(input$file1$datapath,
                        header = input$header
    )
    if(input$disp == "head"){
      head(csvdata)
    } else{
      csvdata
    } 
    csvdata$Lex1=as.numeric(levels(csvdata$Lex1))[csvdata$Lex1]
    csvdata$Lex2=as.numeric(levels(csvdata$Lex2))[csvdata$Lex2]
    csvdata$Lex3=as.numeric(levels(csvdata$Lex3))[csvdata$Lex3]
    csvdata$Lex4=as.numeric(levels(csvdata$Lex4))[csvdata$Lex4]
    csvdata$Lex5=as.numeric(levels(csvdata$Lex5))[csvdata$Lex5]
    csvdata$Lex6=as.numeric(levels(csvdata$Lex6))[csvdata$Lex6]
    csvdata$Lex7=as.numeric(levels(csvdata$Lex7))[csvdata$Lex7]
    csvdata$Lex8=as.numeric(levels(csvdata$Lex8))[csvdata$Lex8]
    csvdata$Lex9=as.numeric(levels(csvdata$Lex9))[csvdata$Lex9]
    csvdata$Lex10=as.numeric(levels(csvdata$Lex10))[csvdata$Lex10]
    csvdata$Lex11=as.numeric(levels(csvdata$Lex11))[csvdata$Lex11]
    csvdata$Lex12=as.numeric(levels(csvdata$Lex12))[csvdata$Lex12]


    capture.output(csvdata[rowSums(is.na(csvdata)) > 0,],file = "Missing_genes.csv")


    row.has.na <- apply(csvdata, 1, function(x){any(is.na(x))})
    csvdata2 <- csvdata[!row.has.na,]

    csvdata2
  }) 

  output$contents <- shiny::renderDataTable({

    rt()
  })


  output$lx1<-renderUI({
    selectInput("lx1", label = h4("Select 1st Expression Profile"), 
                choices = colnames(rt()[,4:15]), 
                selected = "Lex1")
  })
  output$lx2<-renderUI({
    selectInput("lx2", label = h4("Select 2nd Expression Profile"), 
                choices = colnames(rt()[,4:15]), 
                selected = "Lex2")
  })

  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(rt(), select=c(input$lx1)),subset(rt(), 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
  observe({
    # get clicked point
    click_data <- event_data("plotly_click", source = "select")
    # 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({

   p1 <- ggplot(rt(), aes_string(x = input$lx1, y = input$lx2,key = "gene_symbol"))+
     # 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, 80000, 10000)) +
     scale_y_continuous(breaks = seq(0, 120000, 20000)) +
     # 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()+
     geom_smooth(method = input$td)+
     annotate("text", x = 50000, y = 50000, 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_x = 0.25)
   ggplotly(p1,source = "select", tooltip = c("key")) %>%
     layout(hoverlabel = list(bgcolor = "white", 
                              font = list(family = "Calibri", 
                                          size = 9, 
                                          color = "black")))

 }) 




}

I ran this with iris dataset and it works so it is a matter of NAs I think. But as you can see in the beginning of my code I get rid of them. So why do they still cause the problem and prevent trendline from displaying?