我正在为分类模型列表编写我的predict
函数,所以每个模型都会投票给一些预测。
我创建了以下函数,但是它非常慢。最里面的for
循环需要花费很多时间才能计算出来。
predict.risemble <- function(.models, .dataset) {
all_levels <- unique(unlist(lapply(.models, function(x) x$levels)))
voting_df <- data.frame(matrix(0, ncol = length(all_levels), nrow = nrow(.dataset)))
colnames(voting_df) <- all_levels
voting_df <- as_tibble(voting_df)
for (model in .models) {
cat(sprintf("Making predictions for model %s\n", model$method))
predictions <- predict(model, .dataset)
cat("Voting ...\n")
for (i in 1:length(predictions)) {
prediction <- as.character(predictions[i])
voting_df[i, prediction] <- voting_df[i, prediction] + model$results$Kappa
if (mod(i, 1000) == 0) {
cat(sprintf("%f%%\n", i / length(predictions) * 100))
}
}
}
return (as.factor(colnames(voting_df)[apply(voting_df, 1, which.max)]))
}
我需要加速最内部的for
循环。
因此,给定预测向量(类factor
),我们可以使用character
将其转换为列名列表(类as.character
)。我们将此向量称为predictions
。
在给定列voting_df
的向量的情况下,我需要为predictions
的每一行添加一些特定的值。
示例:
predictions <- c("a", "a", "a", "b", "c")
> voting_df
# A tibble: 5 x 3
a b c
<dbl> <dbl> <dbl>
1 1 0 0
2 1 0 0
3 1 0 0
4 0 1 0
5 0 0 1
修改
我的predict
函数的最终版本是这样的:
predict.risemble <- function(.models, .dataset) {
all_levels <- unique(unlist(lapply(.models, function(x) x$levels)))
voting_df <- data.frame(matrix(0, ncol = length(all_levels), nrow = nrow(.dataset)))
colnames(voting_df) <- all_levels
voting_df <- as_tibble(voting_df)
voting_df <- voting_df %>% select(noquote(order(colnames(voting_df))))
for (model in .models) {
predictions <- as.character(predict(model, .dataset))
votes <- tibble(prediction = predictions) %>%
mutate(prediction_id = row_number(), value = model$results$Kappa) %>%
spread(prediction, value) %>%
select(-one_of("prediction_id"))
votes[, all_levels[!all_levels %in% names(votes)]] <- NA
votes <- votes %>% select(noquote(order(colnames(votes))))
votes[is.na(votes)] <- 0
voting_df <- voting_df + votes
}
return (as.factor(colnames(voting_df)[apply(voting_df, 1, which.max)]))
}
答案 0 :(得分:1)
我会尝试从您的向量构建一个数据框,然后使用tidyrs传播函数:
library(tidyverse)
tibble(pred =predictions) %>%
mutate(pred_id = row_number(), value =1) %>%
spread(pred, value)
然后可以将NA替换为零。这对您有用吗?