Есть ли способ отобразить отфильтрованную таблицу данных в модальном окне в R блестящий, используя ggiraph и onclick? - PullRequest
Новая
       29

Есть ли способ отобразить отфильтрованную таблицу данных в модальном окне в R блестящий, используя ggiraph и onclick?

0 голосов
/ 28 февраля 2020

Я хотел бы иметь интерактивный график с использованием ggiraph, в котором мой onclick запускает модальное окно, представляющее собой всплывающее окно, отображающее информацию, относящуюся к отдельной точке данных, по которой я щелкнул.

вот мой код ниже. Я не могу заставить модальное всплывающее окно работать должным образом. Я могу получить всплывающее модальное всплывающее окно, но оно пустое. Однако я могу заставить таблицу фильтровать себя, используя приведенный здесь пример.

https://davidgohel.github.io/ggiraph/articles/offcran/shiny.html

'run_girafe_example ("DT")'

Я хотел бы, чтобы эта отфильтрованная таблица была представлена ​​во всплывающем модальном окне. Возможно с данными, транспонированными и представленными в более хорошем формате. Но если я смогу получить данные, которые будут представлены в Модале, я смогу выяснить, как их представить позже. Мне просто нужно выяснить, как заставить модал показывать таблицу отфильтрованных данных в первую очередь!

любая помощь будет принята с благодарностью:) 

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

theme_set(theme_minimal())

data <- mtcars

ui <- fluidPage(

  fluidRow(
    column(width=12,
           h4("click a point, the data table will be filtered...")
    )
  ),

  fluidRow(
    column(width=12,
           ggiraphOutput("fixedplot")
    )
  )
  ,

  fluidRow(
    column(width=12,
           includeScript(path = "set_search_val.js"),
           DT::dataTableOutput("modaltable")
    )
    )
)

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

  output$fixedplot <-renderGirafe({
    data$label <- gsub(pattern = "'", " ", row.names(data) )
    data$onclick <- paste0("set_search_val(\"", data$label, "\");")

    gg <- ggplot(data = data,
                 mapping = aes(x=wt, y=mpg,
                               tooltip = label,
                               data_id = label, 
                               onclick = onclick 
                               ) 
                 ) +
      geom_point_interactive()

    girafe(code = print (gg), 
           options = list(
             opts_selection(type = "single")
             )
           )
    })

  observeEvent(input$fixedplot_selected,{
    showModal(modalDialog(
      tags$caption("Table"),
      tableOutput("modaltable")
    ))
  }
  )

  output$modaltable <- DT::renderDataTable({
    car_data <- data[,1:7]
    DT::datatable(car_data, escape = FALSE)
  })
}

shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 28 февраля 2020

Вам нужно позвонить DT::renderDataTable внутри modalDialog позвонить: 

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

theme_set(theme_minimal())

data <- mtcars

ui <- fluidPage(

  fluidRow(
    column(width=12,
           h4("click a point, the data table will be filtered...")
    )
  ),

  fluidRow(
    column(width=12,
           ggiraphOutput("fixedplot")
    )
  )
  ,

  fluidRow(
    column(width=12,
           includeScript(path = "set_search_val.js"),
           DT::dataTableOutput("modaltable")
    )
  )
)

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

  output$fixedplot <-renderGirafe({
    data$label <- gsub(pattern = "'", " ", row.names(data) )
    data$onclick <- paste0("set_search_val(\"", data$label, "\");")

    gg <- ggplot(data = data,
                 mapping = aes(x=wt, y=mpg,
                               tooltip = label,
                               data_id = label, 
                               onclick = onclick 
                 ) 
    ) +
      geom_point_interactive()

    girafe(code = print (gg), 
           options = list(
             opts_selection(type = "single")
           )
    )
  })

  observeEvent(input$fixedplot_selected,{
    showModal(modalDialog(
      tags$caption("Table"),
      DT::renderDataTable({
        car_data <- data[,1:7]
        DT::datatable(car_data, escape = FALSE)
      })
    ))
  }
  )

  output$modaltable <- DT::renderDataTable({
    car_data <- data[,1:7]
    DT::datatable(car_data, escape = FALSE)
  })
}

shinyApp(ui = ui, server = server)
...