我试图创建一个闪亮的应用程序,但使用存储在不同脚本中的模块。我在调用模块内要使用的数据时遇到了麻烦。
我有两个应用程序版本--其中一个所有内容都存储在一个单独的Shiny R脚本中,这一点没有问题。然而,当我试图将其拆分为多个部分(服务器和用户界面模块)时,我得到了无法找到数据的错误。
错误:
适用的应用程序:
我的问题是,如何将数据传递到服务器模块,以便执行mean
和median
计算?
不工作的应用程序部件:
- 我的应用程序:**
startDate <- as.Date("2023-01-01")
endDate <- as.Date("2023-06-01")
dates = seq.Date(from = startDate, to = endDate, by = "days")
dates <- rep(dates, each = 10)
propertyPrices <- round(rnorm(length(dates), mean = 100000, sd = 20000), 2)
purchases <- data.frame(collectionDate = dates, price = propertyPrices)
propertyRentals <- round(rnorm(length(dates), mean = 1000, sd = 200), 2)
rentals <- data.frame(collectionDate = dates, price = propertyRentals)
library(shiny)
library(tidyverse)
ui_table_code <- modules::use("ui_code.R")
server_table_code <- modules::use("server_code.R")
ui <- fluidPage(
ui_table_code$ui_controls("dygraph"),
ui_table_code$ui_table("dygraph")
)
server <- function(input, output) {
server_table_code$server_summary("dygraph")
}
shinyApp(ui = ui, server = server)
- 服务器(服务器代码. R):**
modules::import("shiny", "moduleServer", "reactive", "renderTable")
modules::import("dygraphs", "renderDygraph", "dyOptions", "dySeries", "dyAxis", "dygraph")
modules::import("magrittr", "%>%")
modules::import("tibble", "column_to_rownames", "add_column")
modules::import("dplyr", "select", "filter", "bind_rows", "mutate", "ungroup", "summarise", "group_by", "n", "full_join", "case_when", "distinct", "bind_rows", "arrange")
modules::import("zoo", "rollapply")
modules::import("stats", "median")
server_summary <- function(id){
moduleServer(id, function(input, output, session){
comprar_stats = reactive({
purchases %>%
filter(collectionDate > as.Date("2022-09-27")) %>%
filter(price < 1000000) %>%
filter(price > 100000) %>%
group_by(collectionDate) %>%
summarise(
mean_price = mean(price),
mean_price = round(mean_price, 0),
propertiesListed = n(),
median_price = median(price),
median_price = round(median_price, 0)
) %>%
ungroup()
})
mean_median_choice <- reactive({tolower(input$metric2)})
output$myTable = renderTable({
comprar_stats() %>%
select(c("collectionDate", "propertiesListed", contains(mean_median_choice())))
})
}
)
}
- 用户界面(用户界面代码. R)**
modules::import("shiny", "NS", "selectInput", "tableOutput")
modules::import("purrr", "map_chr", "pluck")
modules::import("htmltools", "tagList", "tags")
modules::import("dygraphs", "dygraphOutput")
ui_controls <- function(id) {
ns <- NS(id)
selectInput(
ns("metric2"), "Select Mean or Median",
choices = c("Mean", "Median"),
width = NULL,
selectize = TRUE,
selected = "Mean"
)
}
ui_table <- function(id){
ns <- NS(id)
tags$div(
class = "mytable",
tableOutput(ns("myTable"))
)
}
- 可用的应用程序:**
startDate <- as.Date("2023-01-01")
endDate <- as.Date("2023-06-01")
dates = seq.Date(from = startDate, to = endDate, by = "days")
dates <- rep(dates, each = 10)
propertyPrices <- round(rnorm(length(dates), mean = 100000, sd = 20000), 2)
purchases <- data.frame(collectionDate = dates, price = propertyPrices)
propertyRentals <- round(rnorm(length(dates), mean = 1000, sd = 200), 2)
rentals <- data.frame(collectionDate = dates, price = propertyRentals)
library(shiny)
library(tidyverse)
ui_controls <- function(id) {
ns <- NS(id)
selectInput(
ns("metric2"), "Select Mean or Median",
choices = c("Mean", "Median"),
width = NULL,
selectize = TRUE,
selected = "Mean"
)
}
ui_table <- function(id){
ns <- NS(id)
tags$div(
class = "mytable",
tableOutput(ns("myTable"))
)
}
server_summary <- function(id){
moduleServer(id, function(input, output, session){
comprar_stats = reactive({
purchases %>%
filter(collectionDate > as.Date("2022-09-27")) %>%
filter(price < 1000000) %>%
filter(price > 100000) %>%
group_by(collectionDate) %>%
summarise(
mean_price = mean(price),
mean_price = round(mean_price, 0),
propertiesListed = n(),
median_price = median(price),
median_price = round(median_price, 0)
) %>%
ungroup()
})
mean_median_choice <- reactive({tolower(input$metric2)})
output$myTable = renderTable({
comprar_stats() %>%
select(c("collectionDate", "propertiesListed", contains(mean_median_choice())))
})
}
)
}
ui <- fluidPage(
ui_controls("dygraph"),
ui_table("dygraph")
)
server <- function(input, output) {
server_summary("dygraph")
}
shinyApp(ui = ui, server = server)
1条答案
按热度按时间w6lpcovy1#
第一次使用
modules
包时,一个选项是将全局环境中的数据集作为参数传递。为此,添加
purchases
作为server_code.R
中服务器函数的参数:在主应用代码中,将
purchases
传递给server_summary
: