Модальный диалог не работает в блестящих модулях - PullRequest
Новая
       17

Модальный диалог не работает в блестящих модулях

0 голосов
/ 18 апреля 2020

Я не мог понять, что случилось с modal, все работало нормально, если я распечатал event_data без modal, но когда я добавил modal к module, я просто увидел окно выскочил без каких-либо значений, я пробовал так много способов, иногда это выдает неверные данные.

Переменные данных практически одинаковы, я думаю, что все пошло не так, модал не понимал, какие данные в пространстве имен

Может кто-нибудь помочь мне?

Спасибо 

library(shiny)
library(plotly)
library(shinyBS)
library(DT)

#================

tabPanelUI <- function(id, name_main) {
  ns <- NS(id)
  tabPanel(
       title = name_main,
       fluidRow(column = 6,offset = 2,
             plotlyOutput(ns("distPlot")),
             DT::dataTableOutput(ns("sub_event")),br(),br(),br(),
             DT::dataTableOutput(ns("table_out"))
       )
    )
}

#=============

tabPanelServer <- function(input, output, session, data) {

  ns <- session$ns
  dt <- reactive(data)

  # Plot
  output$distPlot <- renderPlotly({
    data_plot <- dt()
    plot_ly(data_plot, x = ~age, color = ~country,customdata = ~country, colors = "Accent", source = "subset") %>% add_histogram()
  })


  # This is event for plotly click 
  output$sub_event <- renderDataTable({
    data_plot <- dt()
    event.data <- event_data("plotly_click", source = "subset")
    if(is.null(event.data) == T) return (NULL)
    return(data_plot[data_plot$age %in% event.data$x & data_plot$country %in% event.data$customdata,])
  })


  # Print out data
  output$table_out <- renderDataTable({
         dt()
  })

 #===============================================
# Everything is wrong here
  # This is modal for plotly click
  output$sub_event1 <- renderDataTable({
    data_plot <- dt()
    event.data <- event_data("plotly_click", source = "subset")
    if(is.null(event.data) == T) return (NULL)
    return(data_plot[data_plot$age %in% event.data$x & data_plot$country %in% event.data$customdata,])
  })

  observeEvent(event_data("plotly_click", source = "subset"),{
    showModal(modalDialog(DT::dataTableOutput(session$ns("sub_event1"))))
  })

  # Another try

  # output$sub_event2 <- renderDataTable({
  #   data_plot <- dt()
  #   event.data <- event_data("plotly_click", source = "subset")
  #   if(is.null(event.data) == T) return (NULL)
  #   return(data_plot[data_plot$age %in% event.data$x & data_plot$country %in% event.data$customdata,])
  # })
  # 
  #   dataModal <- function(id) {
  #      ns <- NS(id)
  #     modalDialog(
  #       DT::dataTableOutput(ns("sub_event2"))
  #     )
  #   }
  # 
  # observeEvent(event_data("plotly_click", source = "subset"),{
  #   ns <- session$ns
  #   showModal(dataModal(ns))
  # })
  }
#============================
# Data
dt1 <- data.frame(id = c(1:10), 
                  age = c(rep("<5 years", 3), rep(">= 5 and < 10 years", 2), rep(">= 10 years",5)),
                  country = c(rep("US", 5), rep("UK", 5)))
dt2 <- data.frame(id = c(1:18), 
                  age = c(rep("<20 years", 14), rep(">= 20 and < 50 years", 2), rep(">= 50 years",2)),
                  country = c(rep("US", 5), rep("UK", 5), rep("Canada",8)))
dt3 <- data.frame(id = c(1:14), 
                  age = c(rep("<5 years", 3), rep(">= 5 and < 10 years", 2), rep(">= 10 and < 20 years",5), rep(">= 20 years",4)),
                  country = c(rep("US", 5), rep("UK", 5),rep("RU", 4)))

#=============================
ui <- shinyUI(
  navbarPage(
    id = "mainNav",
    fluid = TRUE,
    collapsible = TRUE,
    title = "testing",

    navbarMenu(
      title = "Tab 1",
      icon = icon("table"),
      tabPanelUI(id = "tab1_sub1", "Tab 1 Sub 1"),
      tabPanelUI(id = "tab1_sub2", "Tab 1 Sub 2")

    ), 

    navbarMenu(
      title = "Tab 2",
      icon = icon("table"),
      tabPanelUI(id = "tab2", "Tab 2")
    )
  )
)
server <- shinyServer(function(input, output,session){


  callModule(module = tabPanelServer, id = "tab1_sub1",dt1)
  callModule(module = tabPanelServer, id = "tab1_sub2",dt2)
  callModule(module = tabPanelServer, id = "tab2",dt3)
  session$onSessionEnded(stopApp)
})

shinyApp(ui, server)
...