闪亮的模块和 renderUI 传递 javascript 代码

Posted 2023-03-24

【中文标题】闪亮的模块和 renderUI 传递 javascript 代码

【英文标题】：Shiny modules and renderUI passing javascript code

【发布时间】：2019-02-24 19:05:57

【问题描述】：

我一直在尝试让我的 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)

【问题讨论】：

你的意思是幻灯片不工作？

【参考方案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)