javascript - Shiny 模块和 renderUI 传递 javascript 代码

Question

我一直在尝试让我的 renderUI 代码响应 @Stéphane Laurent 共享的 slick.js 实现。

基本上我有创建表的模块。我希望用户选择要显示的表格数量。但我希望这些表格可以滚动并且彼此分层

这是可以在您的计算机上运行的可重现示例

chartTableBoxUI <- function(id) {

  ns <- NS(id)


  div(
    tags$div(DTOutput(ns("chart"))),
    tags$div(DTOutput(ns("table")))

  )



}

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

  ns <- session$ns

  vals <- reactiveValues()

  observeEvent(input$chart_rows_selected,{

    vals$sel<- (input$chart_rows_selected)


  })

  output$chart <- renderDT({
    DT::datatable(
      mtcars,options = list(
        dom='t', pageLength = 5)

    )
  })

  output$table <- renderDT({


    DT::datatable(
      mtcars[vals$sel, 1:3],options = list(dom='t')
    )




  })

}

library(shiny)
library(shinydashboard)
library(tidyverse)
library(highcharter)
library(DT)
library(shinyjs)

ui <- fluidPage(

  fluidRow(
    tags$head(
      tags$link(rel="stylesheet", type="text/css",
                href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick-theme.css"),
      tags$link(rel="stylesheet", type="text/css",
                href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.css"),
      tags$script(type="text/javascript", 
                  src="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.js"),
      tags$script(HTML(
        "$(document).ready(function(){
        $('#tables').slick({
        arrows: true,
        dots:true
        });
        });")),
    tags$style(HTML(
      "#tables .slick-prev {
      position:absolute;
      top:65px; 
      left:-100px;
      }
      #tables .slick-next {
      position:absolute;
      top:95px; 
      left:-100px;
      }
      .slick-prev:before, .slick-next:before { 
      color:red !important;
      }
      .content {
      margin: auto;
      padding: 20px;
      width: 80%;
      }"))
  ),



  sliderInput("dr", "Num of tables:",
              min = 0, max = 12,
              value = 2),
  uiOutput("tabs")
  #verbatimTextOutput("dr2")





    )

    )





server <- function(input, output, session) {
  for(i in 1:5)
    callModule(chartTableBox,i)

  output$tabs <- renderUI({
     num_tables<- input$dr


    tags$div(class="content",
             tags$div(id="tables",
                      lapply(1:num_tables,chartTableBoxUI)



             ))


  })





}

shinyApp(ui, server)

Answer 1

这是一个带有 MutationObserver 的解决方案。它观察容器中是否有变化，然后应用slick()。

chartTableBoxUI <- function(id) {

  ns <- NS(id)
  div(
    h2(id),
    tags$div(DTOutput(ns("chart"))),
    tags$div(DTOutput(ns("table")))
  )

}

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

  ns <- session$ns

  vals <- reactiveValues()

  observeEvent(input$chart_rows_selected, {
    vals$sel<- input$chart_rows_selected
  }, ignoreNULL = FALSE)

  output$chart <- renderDT({
    datatable(
      mtcars, options = list(dom='t', pageLength = 5), class = "compact stripe"
    )
  })

  output$table <- renderDT({
    datatable(
      mtcars[vals$sel, 1:3], options = list(dom='t'), class = "compact stripe"
    )
  })

}

library(shiny)
library(DT)
library(shinyjs)

js <- "
$(document).ready(function(){
    var container = document.getElementById('tabs');
    // create an observer instance
    var observer = new MutationObserver(function(mutations) {
      setTimeout(function(){
        $('#tables').slick({
          arrows: true,
          dots: true
        });
      }, 0);
    });
    // observe 
    observer.observe(container, {subtree: false, childList: true});
});
"
ui <- fluidPage(

  fluidRow(
    tags$head(
      tags$link(rel="stylesheet", type="text/css",
                href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick-theme.css"),
      tags$link(rel="stylesheet", type="text/css",
                href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.css"),
      tags$script(type="text/javascript", 
                  src="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.js"),
      tags$script(HTML(js)),
      tags$style(HTML(
        "#tables .slick-prev {
      position:absolute;
      top:65px; 
      left:-100px;
      }
      #tables .slick-next {
      position:absolute;
      top:95px; 
      left:-100px;
      }
      .slick-prev:before, .slick-next:before { 
      color:red !important;
      }
      .content {
      margin: auto;
      padding: 20px;
      width: 80%;
      }"))
    ),

    sliderInput("dr", "Num of tables:", min = 0, max = 12, value = 2),
    div(style = "margin-top: -60px"),
    uiOutput("tabs")

  )

)

server <- function(input, output, session) {
  for(i in 1:12)
    callModule(chartTableBox, paste0("Table",i))

  output$tabs <- renderUI({
    num_tables <- input$dr
    tags$div(class="content",
             tags$div(id="tables",
                      lapply(paste0("Table",1:num_tables), chartTableBoxUI)
             ))
  })

}

shinyApp(ui, server)