, поэтому я наткнулся на эту статью, которая в основном показывает основы воспроизводимой разработки приложений в блестящем: https://www.blog.cultureofinsight.com/2018/01/reproducible-shiny-app-development-with-modules/#disqus_thread
Я был довольно очарован этим подходом и хочу применить его для собственного приложения, однако,с данными, которые зависят от нескольких входов пользовательского интерфейса и, таким образом, создаются в серверной части приложения.
Это код приложения статьи:
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"))
)
)
)
}
И это функция модуля сервера:
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)
})
}
В настоящее время я пытаюсь заменить данные в функциях «карта», в данном случае это «демография» фрейма данных, на реактивную версию «демография ()», которой манипулируют на основе нескольких входов пользовательского интерфейса.заранее (например, с помощью sliderInput и т. д.).Вот как я предполагал адаптировать серверный код, «демография» функции карты в разделе пользовательского интерфейса была соответствующим образом адаптирована:
server (input, output) {
# previous code
demographics <- reactive ({ ... some manipulations .... })
# new mapping function
map(unique(demographics()$category), ~ chartTableBoxUI(id = .x))
}
К сожалению, этот подход не был успешным.Кто-нибудь знает, как решить эту проблему?Я высоко ценю вашу поддержку.