R语言 将数据从“全局”数据传递到Shiny模块

avwztpqn  于 2023-03-05  发布在  其他
关注(0)|答案(1)|浏览(198)

我试图创建一个闪亮的应用程序,但使用存储在不同脚本中的模块。我在调用模块内要使用的数据时遇到了麻烦。
我有两个应用程序版本--其中一个所有内容都存储在一个单独的Shiny R脚本中,这一点没有问题。然而,当我试图将其拆分为多个部分(服务器和用户界面模块)时,我得到了无法找到数据的错误。
错误:

适用的应用程序:

我的问题是,如何将数据传递到服务器模块,以便执行meanmedian计算?
不工作的应用程序部件:

    • 我的应用程序:**
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)
w6lpcovy

w6lpcovy1#

第一次使用modules包时,一个选项是将全局环境中的数据集作为参数传递。
为此,添加purchases作为server_code.R中服务器函数的参数:

server_summary <- function(id, purchases){
  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())))
    })
  }
  )
}

在主应用代码中,将purchases传递给server_summary

server <- function(input, output) {
  server_table_code$server_summary("dygraph", purchases)
}

相关问题