0

我一直在尝试使用 R Shiny 模块制作应用程序。这就是模块的样子。

library(shiny)
library(dplyr)
library(tidyr)
library(plotly)
library(shinycssloaders)
library(lubridate)
library(shinyWidgets)


graphModuleUI <- function(id, itemlist) {
  ns <- NS(id)
  
  tagList(
    sidebarLayout(
      sidebarPanel(
        dateRangeInput( ns("daterange"), " Select Date Range",
                        min = min(dat$Date),
                        max = max(dat$Date),
                        start = max(dat$Date) - days(30),
                        end = max(dat$Date)),
        
        pickerInput(ns("location"),"Select Location", 
                    choices= unique(dat$location), 
                    options = list(`actions-box` = TRUE),multiple = T,
                    selected = unique(dat$location)),
        
        selectInput(ns("items"), "Select Items", choices = itemlist,
                    selected = itemlist, multiple= T)
      ),
      
      mainPanel(
        withSpinner(plotlyOutput("plot"))
      )
      
    )

    
  )
}
graphModule <- function(input, output, session, data) {
  

  df <- reactive({
    data%>%
      filter(Date <= input$daterange[2], Date >= input$daterange[1])%>%
      filter(location %in% input$location)%>%
      filter(item %in% input$items)%>%
      group_by(Date)%>%
      summarise(avgprice=mean(price))%>%
      mutate(pricelag=lag(avgprice,1))%>%
      mutate(percent_change=(avgprice-pricelag)/pricelag)

  })
  
  
  output$plot<- renderPlotly({
    df()%>%
      plot_ly(x=~Date, y=~percent_change, type = 'scatter', mode='lines')%>%
      layout(yaxis=list(title="Daily change in %"), 
             title= paste("Daily change in average price of", input$categories ,"items", sep = " "),
             paper_bgcolor='transparent',
             plot_bgcolor='transparent')
  })
}

数据如下

dat<-read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vTiN0zQUwFH4neKMbsxBJOpv0Q_OPZkI5mUZXtf45O9mEM_brIFVGPWoXkoNRrzNSKakOsNXO9bdOwO/pub?output=csv")
dat$shop<-as.factor(dat$shop)
dat$category<-as.factor(dat$category)
dat$location<-as.factor(dat$location)
dat$Date<-ymd(dat$Date)


groceries_data <- filter(dat, category == "Groceries")
eat_out_data <- filter(dat, category == "Eating_Out")
wearables_data <- filter(dat, category == "Wearables")
space_data <- filter(dat, category == "Space")
utilities_data <- filter(dat, category == "Utilities")
transport_data <- filter(dat, category == "Transport")

all_data_items<-unique(dat$item)
groceries_data_items<-unique(groceries_data$item)
eat_out_data_items<-unique(eat_out_data$item)
wearables_data_items<-unique(wearables_data$item)
space_data_items<-unique(space_data$item)
utilities_data_items<-unique(utilities_data$item)
transport_data_items<-unique(transport_data$item)

该应用程序看起来像这样。

ui <- fluidPage(
  titlePanel("PriceTrack"),
  tabsetPanel(id = "Prices", 
              tabPanel("All", graphModuleUI("all", all_data_items)),
              tabPanel("Groceries", graphModuleUI("groceries", groceries_data_items)),
              tabPanel("Eating Out", graphModuleUI("eating_out", eat_out_data_items)),
              tabPanel("Wearables", graphModuleUI("wearables", wearables_data_items)),
              tabPanel("Space", graphModuleUI("space", space_data_items)),
              tabPanel("Utilities", graphModuleUI("utilities", utilities_data_items)),
              tabPanel("Transport", graphModuleUI("transport", transport_data_items))
  )
)
server <- function(input, output, session) {
  callModule(graphModule, "all", dat)
  callModule(graphModule, "groceries", groceries_data)
  callModule(graphModule, "eating_out", eat_out_data)
  callModule(graphModule, "wearables", wearables_data)
  callModule(graphModule, "space", space_data)
  callModule(graphModule, "utilities", utilities_data)
  callModule(graphModule, "transport", transport_data)
}
# Run the application 
shinyApp(ui = ui, server = server)

模块化 UI（输入）工作正常。但情节永远不会从模块化服务器呈现。

我无法理解为什么。它没有显示任何错误。只是，“微调器”旋转无限时间。

谁能帮我解决这个问题？提前致谢。

4

0 回答 0