关闭 R 中特定的 modalDialog 闪亮

Mar*_*ark 3 jquery r modal-dialog showmodaldialog shiny

我的应用程序中有一个场景与下面的虚拟应用程序中的情况相匹配。我真正的应用程序所做的是以数据框中可用的每一列的形式显示,checkboxes供用户从中选择要运行的模型。我正在尝试构建的是on ,它显示用户将鼠标悬停在该列中的数据图。目前,我已经完成了所有工作,但仍然存在一个问题:dropdownmenudropdownButtonmodalDialogtriggeredhover

如果用户使用 关闭modalhistogram下拉dialog window按钮的 也会消失。如何只制作plot dialogto close,同时保持 1 全部打开checkboxes

这是一个存在问题的虚拟应用程序:

library(shiny)
library(shinyjs)

shinyApp(


  ui = fluidPage(
    useShinyjs(),

        dropdownButton(label = "CLICK",
                       h5("This is the dropdownbutton window" ),
          checkboxInput("Checker", "Hover for modal dialog"),
          icon = icon("tasks"),
          inputId = "MYDDMbut",
          circle = T, 
          status = "info", 
          tooltip = tooltipOptions(title = "Click to open window"), width = "400px")
  ),

    server =  function(input, output, session) {
    output$distPlot <- renderPlot({
        hist(mtcars$disp)
    })


    onevent('mouseover','Checker',{
      delay(1000, 
            showModal(div(id="ModalDiv", modalDialog(
              inputId = "distPlot",
              title = HTML('<span style="color:#339fff; font-size: 20px; font-weight:bold; font-family:sans-serif ">Current data column<span>
                           <button type = "button" class="close" data-dismiss="modal" ">
                           <span style="color:#339fff; ">x <span>
                           </button> '),
              br(),
              plotOutput("distPlot"),
              br(),
              easyClose = TRUE,
              footer = NULL ))))
      print("2")}, T)
  }
    )
Run Code Online (Sandbox Code Playgroud)

qfa*_*lle 6

我删除了模态上的关闭十字,并在 fetter 上添加了一个“确定”按钮,然后observeEvent在其上放置了一个。

library(shiny)
library(shinyjs)
library(shinyWidgets)

shinyApp(


    ui = fluidPage(
        useShinyjs(),

        dropdownButton(label = "CLICK",
                       h5("This is the dropdownbutton window" ),
                       checkboxInput("Checker", "Hover for modal dialog"),
                       icon = icon("tasks"),
                       inputId = "MYDDMbut",
                       circle = T, 
                       status = "info", 
                       tooltip = tooltipOptions(title = "Click to open window"), width = "400px")
    ),

    server =  function(input, output, session) {
        output$distPlot <- renderPlot({
            hist(mtcars$disp)
        })


        onevent('mouseover','Checker',{
                 showModal(div(id="ModalDiv", modalDialog(
                      inputId = "distPlot",
                      title = HTML('<span style="color:#339fff; font-size: 20px; font-weight:bold; font-family:sans-serif ">Current data column<span>'),
                      br(),
                      plotOutput("distPlot"),
                      footer = tagList(actionButton("close", "OK")) )))
            print("2")}, T)

        observeEvent(input$close, {
            removeModal()
            toggleDropdownButton(inputId = "MYDDMbut")
        })
    }
        )
Run Code Online (Sandbox Code Playgroud)