Question

所以我偶然发现了这篇文章，基本上显示了闪亮的https://www.blog.cultureofinsight.com/2018/01/reproducible-shiny-app-development-with-modules/#disqus_thread

中可重现的应用程序开发的基础。

我对这种方法非常着迷，并想将其应用于自己的应用程序，但是其数据取决于服务器UI输入，因此是在应用程序的服务器部分中创建的。

这是文章的应用代码：

powershell -NoProfile -Command "if (choco prometheus-wmi-exporter | Select-String '1 packages found.') { echo 'prometheus-wmi-exporter is already installed, skipping.' } else { c:/programdata/chocolatey/bin/choco.exe install --force -y prometheus-wmi-exporter.install }"

这是UI模块功能：

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

    # sample data
    demographics <- tibble(
      category = c(rep("Gender", 2), rep("Age", 7), rep("Social", 5)),
      demographic = c("Male", "Female", "15-24", "25-34", "35-44", "45-54", "55-64", "65-74", "75+", LETTERS[1:5]),
      percent = c(48.706585, 51.293415, 18.676534, 21.136115, 19.066600, 18.326197, 10.709079, 7.270722, 
                  4.814752, 8.143243, 33.772399, 34.756400, 15.035762, 8.292197)
    )

    # source modules
    source("modules.R")

    ui <- dashboardPage(
      dashboardHeader(title = "Shiny Modules"),
      dashboardSidebar(disable = TRUE),
      dashboardBody(
        fluidRow(

          map(unique(demographics$category), ~ chartTableBoxUI(id = .x))

         ) 

      )
    )

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

      map(unique(demographics$category), ~ callModule(chartTableBox, id = .x, data = demographics, dem_group = .x))

    }

    shinyApp(ui, server)

这是服务器模块功能：

        chartTableBoxUI <- function(id, div_width = "col-xs-12 col-sm-6 col-md-4") {

      ns <- NS(id)

      div(class = div_width,
             tabBox(width = 12, title = id,
                    tabPanel(icon("bar-chart"),
                             highchartOutput(ns("chart") )
                    ),
                    tabPanel(icon("table"),
                             DT::dataTableOutput(ns("table"))
                    )
             )
      )


}

我目前正在努力用反应式版本“ demographics（）”替换“地图”功能中的数据（在本例中为数据框“人口统计”），该版本已根据服务器用户界面输入事先进行了处理（例如，一个liderInput等）。这就是我假设要修改服务器代码的方式，相应地修改了UI部分中的map函数的“人口统计信息”：

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

  module_data <- reactive({
    data %>% filter(category == dem_group)
  })

  output$chart <- renderHighchart({

    hchart(module_data(), "column", hcaes(x = demographic, y = percent)) %>%
      hc_xAxis(title = list(text = "")) %>% 
      hc_yAxis(title = list(text = ""), labels = list(format = "{value}%")) %>%  
      hc_tooltip(valueDecimals = 1, valueSuffix = " %")

  })

  output$table <- renderDataTable({

    dt_data <- module_data() %>% 
      select(demographic, percent) %>% 
      mutate(percent = (percent / 100))

    DT::datatable(dt_data, style = "bootstrap", class = "display", 
                  options=list(scrollX=TRUE, dom = 't')) %>% 
      formatPercentage('percent', 0)

  })

}

不幸的是，这种方法并不成功。有人知道如何解决此问题吗？非常感谢您的支持。

闪亮模块-使用反应数据

0 个答案: