首页 > 解决方案 > 将文件上传到闪亮的应用程序并允许用户过滤特定观察的数据

问题描述

如何为用户创建一个动态过滤器来对上传到他们的 R 闪亮应用程序的数据进行子集化?

动态过滤器将根据先前的过滤器发生变化,例如,一旦选择了区域,后续过滤器将根据需要更新,并且仅显示更多选项以根据所选区域进行过滤。任何帮助将不胜感激。

时间序列数据集如下所示:

Date    |    Region    |    Market    |    Product    |    SKU    |   Demand
01/01/18      Asia           Japan             A            1111         100

标签: rshinyshiny-reactivity

解决方案


我设法解决了这个问题。感谢您对我的第一个堆栈溢出问题的反馈。下次我发布问题时肯定会记住这些建议。有关以下代码的任何问题,请随时发表评论。

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

### READ IN CSV FILE BASED ON SELECTION ###
mySeries_raw <- reactive({
    inFile <- input$i_file

    if (is.null(inFile)){return(NULL)}
    df <- read.csv(inFile$datapath,
                   header = T,
                   strip.white=T,
                   stringsAsFactors=F,
                   fill=T)

# Rename columns
df %>% setnames(old = c("SDATE", "LEVEL0", "LEVEL3", "LEVEL5", "LEVEL6", "SDATA4"),
                new = c("Date", "SKU", "Product", "Market", "Region", "Ship_AC"))

# Convert Date variable from chr to Date
df$Date <- as.Date(df$Date, format = "%d-%b-%y")

# Convert any remaining character variables to factors
df[sapply(df, is.character)] <- lapply(df[sapply(df, is.character)], as.factor)

# Drop observations containing observations from regions 177899, 234601, 236273, 250900, 29437 and filter observations that exceed current date
df <- df %>%
  filter(!Region %in% c("177899", "234601", "236273", "250900", "29437"),
         Date < as.Date(Sys.Date() %m-% months(1)), # Remove data that exceeds the current month 
         !is.na(Region),
         !is.na(Market))

# Remove "-" and replace with "_" as the "-" causes error later on
df$SKU <- gsub('-', '_', df$SKU)

return(df)

})

### BUILD DATAFRAME ###
# Create Select option for all regions available in the data
output$region <- renderUI({
data <- mySeries_raw()

if(is.null(data)){return(NULL)}

selectInput(inputId = "region",
            label = "Select Region",
            choice = unique(data$Region),
            multiple = TRUE)
})

# Filter the raw data based on regions selected
region_df <- reactive({
data <- mySeries_raw()

if(is.null(data)){return(NULL)}

data %>% 
  filter(Region %in% input$region)

 })

# Create select option for all markets available in the regions selected in previous filter
output$market <- renderUI({
data <- region_df()

if(is.null(data)){return(NULL)}

selectInput(inputId = "market",
            label = "Select Market",
            choice = unique(data$Market),
            multiple = TRUE)
})

# Filter the previous dataset of selected regions based on markets selected
market_df <- reactive({
data <- region_df()

if(is.null(data)){return(NULL)}

data %>% 
  filter(Market %in% input$market)
})

# Create select option for all products available in the markets selected in previous filter
output$product <- renderUI({
data <- market_df()

if(is.null(data)){return(NULL)}

selectInput(inputId = "product",
            label = "Select Product",
            choice = unique(data$Product),
            multiple = TRUE)
})

# Filter the previous dataset of selected markets based on products selected
product_df <- reactive({
data <- market_df()

if(is.null(data)){return(NULL)}

data %>% 
  filter(Product %in% input$product)
})

# Create select options for all SKUs in the products selected in previous filter
output$sku <- renderUI({
data <- product_df()

if(is.null(data)){return(NULL)}

selectInput(inputId = "sku",
            label = "Select SKU",
            choice = unique(data$SKU),
            multiple = TRUE)
})

# Filter the previous dataset of selected products based on SKUs chosen and build the dataframe based on the action button "Build Dataset"
final_df <- eventReactive(input$build, {
data <- product_df()

if(is.null(data)){return(NULL)}

# Drop the Product column
data <- data[, -which(names(data) %in% c("Product"))]

subset_data <- data %>% 
  filter(SKU %in% input$sku)

# Gather, unite and spread variables to include one column for the demand of each SKU in each Market for all Regions 
subset_data <- subset_data %>% 
  my.spread(key = c("Region", "Market", "SKU"), value = c("Ship_AC")) %>% 
  pad(interval = "month") # pad() function from padr library thats adds missing dates to time series data

# Add index to each row 
subset_data$id <- 1:nrow(subset_data)
subset_data <- subset_data

return(subset_data)
})

# Render the final filtered dataset
output$subset_df <- renderDataTable({
final_df()[, -which(names(final_df()) %in% c("id"))] # Drop id column to prevent from rendering. I used DT::renderDataTable to output the final dataframe
})
}

# Function to Gather, unite and spread 
my.spread <- function(df, key, value) {
# quote key
keyq <- rlang::enquo(key)
# break value vector into quotes
valueq <- rlang::enquo(value)
s <- rlang::quos(!!valueq)
df %>% gather(variable, value, !!!s) %>%
unite(temp, !!keyq, variable) %>%
spread(temp, value)
}

推荐阅读