闪亮的双击缩放绘图交互无法正常工作

Posted 2023-02-14

【中文标题】闪亮的双击缩放绘图交互无法正常工作

【英文标题】：Shiny double click zoom plot interaction not working properly

【发布时间】：2022-01-20 06:08:51

【问题描述】：

我有一个 Shiny 应用程序，可让用户上传 CSV 文件并观察数据集。我想做缩放交互，在 Shiny 网站上找到了这个demo app。现在，当我在新项目中尝试演示应用程序时，它可以完美运行，但在我的项目中，它会放大到不准确的部分情节。像这样：

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.

我查看了我的代码，但我找不到它为什么会产生不准确的结果。我只是复制粘贴了演示应用程序并将其更改为适合我的项目。情节交互代码在每个末尾。

服务器.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)
    )
  )
)

刚刚意识到因为我使用来自上传的 CSV 的反应范围，我的双击范围干扰了双击的范围。添加了 range2 反应值，因此我可以获得所选区域的限制。为了让事情变得更容易，我决定将缩放后的图输出为另一个图。但是现在 print(p_zoom) 当我在绘图上选择一个区域时返回为 NULL。

【参考方案1】：

使用下面的演示应用程序，我能够使用打印或显示功能找到问题。只需输入 p 而不是 print(p) 即可解决。

PS：使用 switch 根据输入来确定要创建哪种绘图似乎也破坏了这个缩放功能。

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)