Вложено для цикла, занимающего много времени для выполнения в R - PullRequest
Новая
       5

Вложено для цикла, занимающего много времени для выполнения в R

0 голосов
/ 19 сентября 2018

Я создаю вложенный цикл для прогнозирования данных на основе категорий.В моих данных категориальными столбцами являются возраст, пол, штат и регион.Я должен сделать прогноз продаж на основе вышеуказанной категории, например, возраст содержит мужской, женский, неопределенной подкатегории.То же самое нужно сделать для остальных подкатегорий.В моем вложенном цикле я делю данные на основе категории и применяю эти данные по одному для каждой категории в моей функции прогноза.При этом вся моя программа заняла 7 минут.Мне нужно оптимизировать этот код.Я также попытался использовать функцию lapply, но проблема в том, что я не могу применить данные, которые я установил с помощью lapply, потому что он выдает выходные данные в виде последовательности массивов.Поэтому я получаю ошибку измерения при извлечении определенного столбца в одной категории.

Мой код для вложенного цикла, 

forecasted_category <- list()

  for( i in 1:length(categorical_columns))
  {
    if(categorical_columns[i] %in% names(data)==TRUE){
      categorical_df_name <- paste(categorical_columns[i],"_df",sep="")

      forecasted_by_categories <- list()
      for(j in 1:length(unique(data[,categorical_columns[i]]))){
        categorical_data <- (subset(data,data[,categorical_columns[i]] == unique(data[,categorical_columns[i]])[j]))

        if (forecast_by == "sales"){
          agg_day <- aggregate(categorical_data[,input_amt_column]~categorical_data[,input_date_column],categorical_data,sum)
          names(agg_day) = c(input_date_column, input_amt_column)
          forecast_input_column <- agg_day[,input_amt_column]
        } else if (forecast_by == "customers") {
          agg_day <- aggregate(categorical_data[,input_key_column]~categorical_data[,input_date_column],categorical_data,length)
          names(agg_day) = c(input_date_column, input_key_column)
          forecast_input_column <- agg_day[,input_key_column]
        } else if (forecast_by == "average_sales") {
          agg_day <-aggregate(categorical_data[,input_amt_column]~categorical_data[,input_date_column],categorical_data,mean)
          names(agg_day) = c(input_date_column, input_amt_column)
          forecast_input_column <- agg_day[,input_amt_column]
        }

        min_day <- min(agg_day[,input_date_column])
        max_day <- max(agg_day[,input_date_column])

        get_autoarima_model <- get_autoarima_model(forecast_input_column,period,min_day,freq)
        if (is.null(get_autoarima_model)) {
          category_forecast <- NULL
        }else {
          forecasted_date <- seq(as.Date(max_day)+1, by = "day", length.out = period)
          forecasted_date <- as.data.frame(forecasted_date)
          label <- sprintf("D-%s",seq(1:period))

          if (forecast_by == "customers") {
            category_forecast <- cbind.data.frame(forecasted_date=forecasted_date,label=label,value=round(get_autoarima_model$Point.Forecast))
          }else {
            category_forecast <- cbind.data.frame(forecasted_date=forecasted_date,label=label,value=get_autoarima_model$Point.Forecast)
          }

        }

        forecasted_by_categories[[j]] <- list(sub_category=unique(categorical_data[,categorical_columns[i]]),category_forecast=category_forecast)
      }
    }
    category <- list(category_name=categorical_columns[i])
    category_name <- as.data.frame(category)
    forecasted_category[[i]] <- list(categories=category_name,forecasted_by_categories=forecasted_by_categories)
  }

Пожалуйста, дайте мне знать, если мой запрос не понятен.

Мои образцы данных 

cust_id order_date  amount quantity discount cost_price age gender state    region
1        1 2014-10-27  215.53        9        3    172.424  57      M    TN   MidWest
3        3 2009-09-10  154.71        4        6    123.768  85      M     FL      west
4        4 2014-02-19  520.17        6        0    416.136  55      M     OH NorthEast
5        5 2008-11-25  228.80       10        1    183.040  52      F    AR      west
6        6 2015-07-06  293.35        5        6    234.680  57      M    CO   MidWest
8        8 2014-11-05  537.96        9        5    430.368  53      M    MN      west
9        8 2011-05-28  316.21        4        2    252.968  53      M    MN      west
10       9 2010-03-01 1113.32       10        2    890.656  78      F    OR      west
11       9 2010-09-23  313.98        6        0    251.184  78      F    OR      west
12      10 2010-04-01  135.88        6        0    108.704  43      M    NY      west

Я передаю свои категориальные столбцы динамически, как категориальные столбцы.Столбец категорий содержит столбцы категорий <- c (возраст, пол, штат, регион)

1 Ответ

0 голосов
/ 19 сентября 2018

Вы можете сделать age a factor и использовать вложенный lapply() подход: 

data$age <- factor(data$age)

list_of_subsets <- lapply(data[c("age", "gender", "state", "region")], function(x){
  lapply(levels(x), function(y){
    subset(data, x == y)
  })
})

Чтобы динамически выбирать категориальные столбцы, измените data[c("age", "gender", "state", "region")] на data[sapply(data, is.factor)].

НОВЫЙ КОД:

Вот подход lapply к вашему циклу прогнозирования:

Сначала определите функцию FOO: 

FOO <- function(var, data){
  if(var %in% names(data)){
    lapply(unique(data[, var]), function(y){
      categorical_data <- subset(data, data[, var] == y)
      if (forecast_by == "sales"){
        agg_day <- aggregate(categorical_data[,input_amt_column]~categorical_data[,input_date_column],categorical_data,sum)
        names(agg_day) = c(input_date_column, input_amt_column)
        forecast_input_column <- agg_day[,input_amt_column]
      } else if (forecast_by == "customers") {
        agg_day <- aggregate(categorical_data[,input_key_column]~categorical_data[,input_date_column],categorical_data,length)
        names(agg_day) = c(input_date_column, input_key_column)
        forecast_input_column <- agg_day[,input_key_column]
      } else if (forecast_by == "average_sales") {
        agg_day <-aggregate(categorical_data[,input_amt_column]~categorical_data[,input_date_column],categorical_data,mean)
        names(agg_day) = c(input_date_column, input_amt_column)
        forecast_input_column <- agg_day[,input_amt_column]
      }

      min_day <- min(agg_day[,input_date_column])
      max_day <- max(agg_day[,input_date_column])

      autoarima_model <- get_autoarima_model(forecast_input_column,period,min_day,freq)
      if (is.null(autoarima_model)) {
        category_forecast <- NULL
      }else {
        forecasted_date <- seq(as.Date(max_day)+1, by = "day", length.out = period)
        forecasted_date <- as.data.frame(forecasted_date)
        label <- sprintf("D-%s",seq(1:period))

        if (forecast_by == "customers") {
          category_forecast <- cbind.data.frame(forecasted_date=forecasted_date,label=label,value=round(autoarima_model$Point.Forecast))
        }else {
          category_forecast <- cbind.data.frame(forecasted_date=forecasted_date,label=label,value=autoarima_model$Point.Forecast)
        }

      }
      temp <- list(sub_category = y,
                   category_forecast = category_forecast)
      return(temp)
    })
  } else {
    temp <- "Column not in data!"
  }
}

Теперь переберите вектор имен столбцов с помощью lapply: 

forecasted_category <- lapply(categorical_columns, FOO, data = data)
...