我正在创建嵌套的for循环，以基于类别明智地预测数据。在我的数据中，类别列是年龄，性别，州和地区。 我必须根据上述类别进行销售预测，例如年龄包含男性，女性和未定义的子类别。其余子类别也必须这样做。 在嵌套的for循环中，我将根据类别对数据进行分组，并将每个类别的子集数据一一应用到我的预测函数中。这样做时，我的整个程序需要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
我将类别列动态传递为categorical_columns。 分类列包含categorical_columns <-c（年龄，性别，州，地区） input_amt_column为“金额” input_date_column为“ order_date” input_key_column为“ cust_id”
我的自动Arima模型功能
get_autoarima_model <- function(value,period,start_date,freq)
{
value <- round(value)
tsdata <- ts(value, start = start_date, freq = freq )
if (length(tsdata) >= 7) {
ts_data <-tsclean(tsdata)
adf_test <- adf.test(ts_data)
if((adf_test$p.value<0.05)==TRUE)
{
model <- auto.arima(ts_data)
fcast<-forecast(model,level=c(95),h=period)
fc <- data.frame(fcast)
}else {
adf.test(diff(diff(log(ts_data))))
model <- auto.arima(ts_data)
fcast<-forecast(model,level=c(95),h=period)
fc <- data.frame(fcast)
}
}else {
fc <- NULL
}
return(fc)
}
答案 0 :(得分：1)
您可以将age设为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)