Загрузка файлов в блестящее приложение и позволяет пользователю фильтровать данные для конкретных наблюдений - PullRequest
Новая
       6

Загрузка файлов в блестящее приложение и позволяет пользователю фильтровать данные для конкретных наблюдений

0 голосов
/ 29 ноября 2018

Как создать динамический фильтр для пользователя для поднабора данных, загруженных в его приложение Riny?

Динамический фильтр будет меняться на основе предыдущего фильтра в том смысле, что, например, после выбора региона следующие фильтры будут обновляться по мере необходимости и отображать только дополнительные параметры для фильтрации на основе региона (ов).) выбрано.Любая помощь будет принята с благодарностью.

Набор данных временного ряда будет выглядеть примерно так: 

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

1 Ответ

0 голосов
/ 04 декабря 2018

Мне удалось решить проблему.Спасибо за отзыв о моем первом вопросе о переполнении стека.Обязательно учту эти предложения в следующий раз, когда я отправлю вопрос.Любые вопросы по поводу кода ниже, не стесняйтесь оставлять комментарии.

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)
}
...