Как можно избежать использования цикла foor, когда требуются дополнительные параметры?

Question

Я изучаю R и написал некоторый код, который производит желаемые выходные данные, но использует циклы, на которые я хотел бы ответить с помощью некоторого типа функции apply.

У меня есть фрейм данных, results, в котором хранятся результаты матчей двух игроков.

Player1   Player2   Result
Alice     Bob       Win
Charlie   Dennis    Win
Elena     Frank     Loss
...

И еще, scores, в котором хранится общий счет каждого игрока.

Player    Score
Alice     1200
Charlie   1200
Frank     1200
Bob       800
Dennis    800
Elena     800
...

Способ подсчета очковвычисляются с использованием функции, которая получает один результат, текущие оценки и возвращает новый фрейм данных с новыми оценками.

updateScores <- function(result, scores) {
  [ Code that calculates new scores based on a single result ]
  return(scores)
}

Теперь проблема заключается в том, что я хочу просмотреть результаты иобновить таблицу результатов.Это просто для цикла for:

for(i in 1:nrow(results)) {
  scores <- updateScores(results[i, ], scores)
}

Но я изо всех сил пытаюсь понять, как я могу сделать это с помощью apply, mapply или любым другим функциональным способом, который позволяет избежать цикла.Это потому, что переменная scores должна быть передана в updateScores и обновляться при каждой итерации.(В Лиспе я бы использовал функцию reduce, но в R Reduce() работает не так.)

Answer 1

Аналогично Oliver, но без циклов, но адаптировано к существующей структуре данных.

Пример данных

results <- read.table(text="
Player1   Player2   Result
Alice     Bob       Win
Charlie   Dennis    Win
Elena     Frank     Loss
June      Rashida   Tie", header=TRUE, stringsAsFactors=FALSE)

scores <- read.table(text="
Player    Score
Alice     1200
Charlie   1200
Frank     1200
Bob       800
Dennis    800
Elena     800
June      900
Rashida   1100", header=TRUE, stringsAsFactors=FALSE)

Функции

# expected score
exps <- function(ra, rb) {
    d <- (rb - ra)/400
    1/(1 + 10^d)
}

# update ratings
updrmulti <- function(ra, rb, score, k=16) {
    if (NCOL(ra) == 3) {
        rb <- ra[,2]
        score <- ra[,3]
        ra <- ra[,1]
    }
    ea <- exps(ra, rb)
    eb <- 1 - ea
    sa <- score
    sb <- 1 - sa
    cbind(ra=ra + k*(sa - ea), rb=rb + k*(sb - eb))
}

Реализация

# set Player names as rownames. Makes look-up easier
rownames(scores) <- scores$Player

# copy results data.frame
r2 <- results

# recode results to numeric
r2$Result <- (match(r2$Result, c("Loss", "Tie", "Win"))-1)/2

# replace Player names with their respective ratings
r2[,1:2] <- scores[as.matrix(r2[,1:2]), 2]

# pass new ratings+score data.frame to ratings-update function
r2u <- updrmulti(r2)

# cast updated ratings to new data.frame and give appropriate rownames
scores.new <- data.frame(Score=c(r2u))
rownames(scores.new) <- as.matrix(results[,1:2])

# order rows by rownames of original data.frame
scores.new[rownames(scores),, drop=FALSE]
#             Score
# Alice   1201.4545
# Charlie 1201.4545
# Frank   1201.4545
# Bob      798.5455
# Dennis   798.5455
# Elena    798.5455
# June     904.1560
# Rashida 1095.8440

Answer 2

Из комментариев мы узнали, что основной проблемой вопроса является вычисление Эло оценок .Без большого количества информации, я ожидаю, что проблема заключается в оптимизации кода для скорости.

Вместо использования функции apply над for loop можно добиться значительного улучшения скорости, сначала преобразовав рейтинги в структуры player 1 vs player 2 и преобразовав код для использования векторизованных вычислений.Возьмите пример реализации ниже:

Probability <- function(R1, R2)
    1 / (1 + 10^((R1 - R2)/400))
EloRating <- function(R1, R2, K, d){
    P1 <- Probability(R2, R1)
    P2 <- Probability(R1, R2)
    index <- d == 1 #Which matches did Player 1 win?
    #Use that d is 0 and 1's, and !d is 1 and 0's (reverse of d)
    R1 <- R1 + K * (d  - P1) 
    R2 <- R2 + K * (!d  - P1) 
    #output updated ratings
    return(list(Rating1 = R1, Rating2 = R2))
}

Обратите внимание на отсутствие функций for loop и apply, таких как sapply.

Этот фрагмент кода высоко оптимизирован, поскольку Probability может принимать любые 2 вектора и возвращать вектор одинаковой длины, используя только встроенные функции R, которые сами реализованы в оптимизированном * 1018.* или Fortran код.

Сама функция EloRating также очень оптимизирована.Сначала мы рассчитываем вероятность (при предположении нормальности, я догадываюсь?) Выигрыша любого из игроков.Далее я предполагаю, что задан входной вектор d побед, для которого d[i]==1 указывает на то, что игрок 1 выиграл матч против игрока 2, а любой другой результат является обратным.

Мне нравится, когда выигрыш игрока 1 помечен как 1, а выигрыш игрока 2 помечен как 0, поэтому я использую d==1, чтобы убедиться, что d содержит только 1 (TRUE) и 0 * 1030.*.

Когда я убедился в этом, я могу злоупотреблять тем, что логический вектор можно инвертировать, используя !d, изменяя, какие элементы равны 1, а какие - 0.Таким образом, я могу выполнить все изменения рейтинга одновременно, используя только 2 строки кода.

Для небольшого тестирования скорости, давайте запустим микробенчмарк для 1000 наблюдаемых совпадений

set.seed(1)
n <- 1000
R1 <- rnorm(n, 1000, 50)
R2 <- rnorm(n, 1000, 50)
wins <- sample(1:2, n, replace = TRUE)
microbenchmark::microbenchmark(EloRating(R1, R2, 40, wins), times = 1e3)
#output
Unit: microseconds
                        expr     min     lq     mean  median      uq    max neval
 EloRating(R1, R2, 40, wins) 289.983 291.87 305.2853 293.381 309.239 626.03  1000

Обратите внимание на среднее времясоставляет 2.93 * 1e-6 секунд на итерацию для 1000 игроков.

Отказ от ответственности

Я просто конвертировал код из GeeksforGeeks , не задумываясь о его правильности.Я не несу ответственности за любые ошибки в коде, и я предлагаю проверить известные результаты перед его использованием.