多个ggiraph图选择可更新Shiny中的数据表，反之亦然

问题描述

我对ggiraph图和Datatable之间的交互性感到麻烦。我可以从数据表中选择行以选择ggiraph图中的点，但是，当我在ggiraph图中选择多个点时，表行将变为未选中状态。此外，如果我从表中选择连续的行，则会选择该图，但是如果我跳过数据表中的行，则该行以及该图可能会被取消选择。

我希望能够从表格中选择任何行或在ggiraph图上选择任何点，并选择另一个。

感谢您提供的任何帮助！

library(ggiraph)
library(ggplot2)
library(tidyverse)
library(htmltools)
library(DT)
library(shinyBS)
library(shinydashboard)

theme_set(theme_minimal())

data <- mtcars
## Default app would select ggiraph plot and search table 
ui <- fluidPage(fluidRow(column(
  width = 12,h4("click a point,the data table will be selected...")
)),fluidRow(column(
  width = 12,girafeOutput(outputId = "fixedplot")
)),DT::dataTableOutput(outputId = "table1")
)))

server <- function(input,output,session) {
  
  output$fixedplot <- renderGirafe({
    data$label <- gsub(pattern = "'"," ",row.names(data))
    
    gg <- ggplot(data = data,mapping = aes(
                   x = wt,y = mpg,tooltip = label,data_id = label,# onclick = onclick
                 )) +
      geom_point_interactive()
    
    plotIT <- girafe(code = print (gg),options = list(opts_selection(type = "multiple",only_shiny = FALSE,css = "fill:red;stroke:white;stroke-width:1px;")))
    return(plotIT)
  })
  
  # create a proxy where we can update datatable
  proxy <- DT::dataTableProxy("table1")
  
  output$table1 <- DT::renderDT({
    # car_data <- data[,1:7]
    DT::datatable(data,escape = FALSE,rownames = TRUE,selection = "multiple",options = list(
                    pageLength = 11,info = FALSE,lengthMenu = list(c(11,-1),c("11","All")),columnDefs = list(list(type = 'natural',targets = 'all')),dom = 'Bfrtip',buttons = list(list(
                      extend = "copy",text = "copY",title = "Table Export"
                    ))
                  ))
  })
  
  tblVal <- reactiveValues(table1_rows_selected = NULL)
  v <- reactiveValues(fixedplot_selected = NULL)
  
  observeEvent(input$fixedplot_selected,ignoreNULL = FALSE,{
    v$fixedplot_selected <- which(rownames(data) == input$fixedplot_selected)
    proxy %>% selectRows(v$fixedplot_selected)
    
  }
  )
  
  observeEvent(input$table1_rows_selected,{
    tblVal$table1_rows_selected <- data[input$table1_rows_selected,]
    plotSelection <- rownames(data[input$table1_rows_selected,]) # which dots to select on fixedplot
    session$sendCustomMessage(type = 'fixedplot_set',message = plotSelection) # pass message to fixedplot to select
  })
}

shinyApp(ui = ui,server = server)

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

dt ggiraph shiny