Question

我正在为分类模型列表编写我的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)]))
}

Answer 1

我会尝试从您的向量构建一个数据框，然后使用tidyrs传播函数：

library(tidyverse)
tibble(pred =predictions) %>%
mutate(pred_id = row_number(), value =1) %>%
spread(pred, value)

然后可以将NA替换为零。这对您有用吗？

给定列名称的向量，将值添加到数据帧的每一行

1 个答案: