r - finding nth max per row of dataframe with logic for ties?

Question

trying to count tournament profit per player. here's what the data looks like:

library(data.table)
df <- data.table('player_1' = c(10, 9, 5, 6, 7),
                 'player_2' = c(12, 9, 7, 6, 5),
                 'player_3' = c(6, 10, 6, 5, 12),
                 'player_4' = c(4, 8, 10, 5, 12))


df
   player_1 player_2 player_3 player_4
1:       10       12        6        4
2:        9        9       10        8
3:        5        7        6       10
4:        6        6        5        5
5:        7        5       12       12
  

each row is a new set of scores per round. So, in round 1 player_2 got first, player_1 got 2nd, player_3 3rd, and player_4 4th, and so on.

1st place wins $20; 2nd place wins $10; 3rd wins $5 and 4th gets nothing. In the event of a tie, the players would split each place together; so, in row 5 player_3 and player_4 each win $15 ($10 plus $20 divided by two). In row 2, player_3 wins $20, and player_2 and player_1 each win $7.50

I want to come up with the profit for each player, but I'm struggling with the logic for 2nd and 3rd place, as well as handling ties.
I used

df[,winning_score := do.call(pmax, .SD)]

to find the highest score for each round, but this fails to identify ties, as well as 2nd and 3rd place. I'm using data.table because it's 100k rows, but dataframe answers are good too. Any help is greatly appreciated, thanks!

question from:https://stackoverflow.com/questions/65913887/finding-nth-max-per-row-of-dataframe-with-logic-for-ties

Answer 1

Using apply rowwise -

prize <- c(20, 10, 5, 0)
t(apply(df, 1, function(x) {
  v1 <- rank(-x, ties.method = 'min')
  v2 <- prize[order(order(-x))]
  v3 <- tapply(v2, v1, mean)
  v3[as.character(v1)]
})) -> result
result


#     [,1] [,2] [,3] [,4]
#[1,] 10.0 20.0  5.0  0.0
#[2,]  7.5  7.5 20.0  0.0
#[3,]  0.0 10.0  5.0 20.0
#[4,] 15.0 15.0  2.5  2.5
#[5,]  5.0  0.0 15.0 15.0

To calculate total prize for the players you can use colSums.

colSums(result)
#[1] 37.5 52.5 47.5 37.5