Добавление значения в каждую строку фрейма данных с учетом вектора имен столбцов

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

Я бы попытался построить фрейм данных из вашего вектора, а затем использовать функцию распространения тидиров:

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

Тогда, возможно, замените NA на нули. Это работает для вашей цели?