seaque
seaque

Reputation: 53

Shiny double click zoom plot interaction not working properly

I have a Shiny app that lets users upload a CSV file and observe the dataset. I wanted to make zoom interaction, found this demo app in Shiny website. Now the demo app works perfect when i try it in a new project, but in my project it zooms to inaccurate parts of the plot. Like this:

Now when i double click in the rectangle, it should zoom to 3.0-4.0 Y axis and 5-6 X axis.

But the result is this.

I've looked at my code and i just can't find why it creates inaccurate results. I simply copy pasted the demo app and changed it to fit my project. Plot interaction codes are at the end of each.

server.R

library(shiny)
library(tidyverse)

function(input, output, session) {
  
  dataUpload <- reactive({
    
    inFile <- input$file1
    print(inFile)
    
    if(is.null(inFile))
      return(NULL)
    
    dt_frame = read.csv(inFile$datapath, header=input$header, sep=input$sep)
    
    updateSelectInput(session, "column", choices = names(dt_frame))
    updateSelectInput(session, "column2", choices = names(dt_frame))
    facet_choices <- select(dt_frame, where(is.character))
    updateSelectInput(session, "facet", choices = c(".", names(facet_choices)), selected = ".")
    updateSelectInput(session, "facet2", choices = c(".", names(facet_choices)), selected = ".")
    
    return(dt_frame)
  })
  
  ranges <- reactiveValues(x = NULL, y = NULL)
  ranges2 <- reactiveValues(x = NULL, y = NULL)
  
  output$plot <- renderPlot({
    
    if(is.null(input$file1))
      return(NULL)
    
    dataset <- dataUpload()
    
    if (input$plot == "Histogram") {
      
      p <- ggplot(dataset, aes_string(x = input$column)) +
        geom_histogram() +
        coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)
    }
    
    if (input$plot == "Point") {
      
      p <- ggplot(dataset,aes_string(x = input$column, y = input$column2)) +
        geom_point() +
        coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)
    }
    
    if (input$plot == "Bar") {
      
      p <- ggplot(dataset, aes_string(x = input$column)) +
        geom_bar() +
        coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE) 
    }
    
    if (input$plot == "BoxPlot") {
      
      p <- ggplot(dataset,aes_string(x = input$column, y = input$column2)) +
        geom_boxplot() +
        coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)
    }
    
    if (input$facet != '.')
      p <- p + facet_wrap(input$facet)
    
    if (input$facet2 != '.')
      p <- p + aes_string(fill = input$facet2)
    
    print(p)
  
    })
  
    output$plot_zoom <- renderPlot({
       p_zoom <- p + coord_cartesian(xlim = ranges2$x, ylim = ranges2$y, 
       expand = FALSE)

    print(p_zoom)
    })

    observe({
      brush <- input$plot_brush
      if (!is.null(brush)) {
          ranges2$x <- c(brush$xmin, brush$xmax)
          ranges2$y <- c(brush$ymin, brush$ymax)
      } 
      else {
          ranges2$x <- NULL
          ranges2$y <- NULL
      }
    })
}

ui.R

library(shiny)
library(tidyverse)

dataset <- reactive({
  dataset <- dataUpload()
})

fluidPage(
  
  pageWithSidebar(
    
    headerPanel( "Shiny ile Keşifsel Veri Analizi Uygulaması"),
    
    sidebarPanel(
      
      fileInput('file1', 
                'CSV dosyası seçiniz.',
                accept=c('text/csv')),
      
      checkboxInput('header',
                    'İlk Satır Sütun Adları',
                    TRUE),
      
      radioButtons('sep',
                   'Ayırıcı',
                   c("Virgül"=',',
                     "Tab"='\t', 
                     "Noktalı Virgül"=';')),
      
      tags$hr(),
      
      selectInput("plot",  
                  "Grafik: ",
                  c("Point", "Histogram", "Bar", "BoxPlot")),
      
      uiOutput("slider"),
      
      selectInput("facet",  
                  "Grupla: ",
                  ""),
      
      selectInput("facet2",  
                  "Renklendir: ",
                  ""),
      
      tags$hr(),
      
      selectInput("column", 
                  "X: ",""),
      
      selectInput("column2", 
                  "Y: ","")),
    
      mainPanel( 
        plotOutput("plot",
                 brush = brushOpts(
                   id = "plot_brush",
                   resetOnNew = TRUE)),
        plotOutput("plot_zoom", height = 300)
    )
  )
)

Just realized that because i use reactive ranges that comes from uploaded CSV, my double click ranges was interfering with the ranges of double click. Added ranges2 reactive values so i can get the limits of selected area. To make things easier i decided to output the zoomed plot as another one. But now print(p_zoom) returns as NULL when i select an area on the plot.

Upvotes: 0

Views: 855

Answers (1)

seaque
seaque

Reputation: 53

With the demo app below, i was able to find the problem occurs using print or show function. Just typing p instead of print(p) solved it for me.

PS: Using switch to determine which kind of plot to create based on input also seems to break this zoom function.

library(ggplot2)
library(shiny)

ui <- fluidPage(
  fluidRow(
    column(width = 12, class = "well",
           h4("Brush and double-click to zoom"),
           plotOutput("plot1", height = 300,
                      dblclick = "plot1_dblclick",
                      brush = brushOpts(
                        id = "plot1_brush",
                        resetOnNew = TRUE
                      )
           )
    )
    
  )
)

server <- function(input, output) {
  
  ranges <- reactiveValues(x = NULL, y = NULL)
  
  output$plot1 <- renderPlot({
    p <- ggplot(iris, aes(Sepal.Width, Petal.Length)) +
      geom_point() +
      coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)

    p
  })
  
  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observeEvent(input$plot1_dblclick, {
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)
      
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })
}
shinyApp(ui, server)

Upvotes: 0

Related Questions