Index error in for loop

Hello

I'm trying to run this code for ELO rating from this course:

Using the dataset only till week 17, here is the link to the excel file
https://www.mediafire.com/file/0a5v393ki775vw9/sport2.xlsx/file

I also tried to run it with all 22 weeks but could not make it work either

#########################################################

library(dplyr)

data<- read_xlsx("C:/sport2.xlsx")
 
data$PtsW <- as.numeric(data$PtsW)
data$PtsL <- as.numeric(data$PtsL)
data$YdsW <- as.numeric(data$YdsW)
data$YdsL <- as.numeric(data$YdsL)
data$TOW <- as.numeric(data$TOW)
data$TOL <- as.numeric(data$TOL)

rankings <- data_frame()
teams <- data %>% distinct(Winner.tie) %>% select(Winner.tie)
teams
rankings <- bind_rows(rankings,teams)
#print(data)
#class(rankings)
#print(rankings)
rankings

for (i in 2:19) {
  rankings[,i] <- 0
}
colnames(rankings) <- c("Team","Week.0","Week.1","Week.2","Week.3","Week.4","Week.5","Week.6",
                        "Week.7","Week.8","Week.9","Week.10","Week.11","Week.12","Week.13",
                        "Week.14","Week.15","Week.16","Week.17")
rankings$Week.0 <- 1500

# Iterate for each week of play
week.no <- 1
k_factor <- 20.0
week.data <- data[data$Week == week.no,]


for (j in 1:17) {
  week.no <- j
  k_factor <- 20.0
  week.data <- data[data$Week == week.no,]
  for (i in 1:nrow(week.data)) {
    winner <- week.data[i,"Winner.tie"]
 
    loser <- week.data[i,"Loser.tie"]
    old.rank.w <- rankings[rankings$Team == winner,week.no+1]
    old.rank.w <- old.rank.w[[1]]
    old.rank.l <- rankings[rankings$Team == loser,week.no+1]
    old.rank.l <- old.rank.l[[1]]
    
    # Calculate Margin of Victory Multiplier 
    # mv_mult = LN(ABS(PD)+1) * (2.2/((ELOW-ELOL)*.001+2.2))
    pd <- week.data$PtsW[i] - week.data$PtsL[i]
    mv_mult <- 1 #Margin For Victory Multiplier
    mv_mult <- log(pd +1) * (2.2/((old.rank.w - old.rank.l)*.001+2.2))
    #
    
    # Use old ELO Algorithm
    #
    w_w <- 1.0
    w_l <- 0.0
    if (pd == 0) {
      w_w <- 0.5
      w_l <- 0.5
    }
    #
    
    #
    d_ij_w <- old.rank.w - old.rank.l
    d_ij_l <- old.rank.l - old.rank.w
    #
    mu_ij_w <- 1 / (1 + 10 ^ ((-1 * d_ij_w)/400))
    new.rank.w <- round( old.rank.w + (k_factor * mv_mult * (w_w - mu_ij_w)))
    #
    mu_ij_l <- 1 / (1 + 10 ^ ((-1 * d_ij_l)/400))
    new.rank.l <- round( old.rank.l + (k_factor * mv_mult * (w_l - mu_ij_l)))
    #
    print (sprintf("Rank : W = %d L = %d",new.rank.w,new.rank.l))
    rankings[rankings$Team == winner,week.no+2] <- new.rank.w
    rankings[rankings$Team == loser,week.no+2] <- new.rank.l
  } 
  
###################################################################3  
  # if team didn't play, carry forward early ratings
  # not needed for wildcard, division et al
#  for (i in 1:nrow(rankings)) {
#    if (is.na(rankings[i,week.no+2])) {
#      rankings[i,week.no+2] <- rankings[i,week.no+1]
#    }
#    if (rankings[i,week.no+2] < 1) {
#      rankings[i,week.no+2] <- rankings[i,week.no+1]
#    }
#    }
##################################################################

}
# week #1 ranking
rankings %>% select(Team,Week.1) %>% arrange(-Week.1)
# week #17 ranking
rankings %>% select(Team,Week.17) %>% arrange(-Week.17)
#

I get the error
Error in x[[jj]][iseq] <- vjj : replacement has length zero

this error doesnt seem to relate to any part of the final code block you shared... there is no iseq object... no vjj object ? no jj object ?

I did run your code, and found errors, below I paste the minimal changes I produced to eliminate the error and get some output, yet, it seems the approach has a flaw, for any week where a team fails to compete its ranking is not adjusted from 0. You would need to think of a strategy/principle of how to treat the rankings of teams who dont play for a given period of time... and extend your code to cover that case.

Hope this helps you get back on track.


library(tidyverse)
library(readxl)
 data<- read_xlsx("sport2.xlsx")

rankings <- data_frame()
teams <- data %>% distinct(Winner.tie) %>% select(Winner.tie)
teams
rankings <- bind_rows(rankings,teams)
#print(data)
#class(rankings)
#print(rankings)
rankings

for (i in 2:19) {
  rankings[,i] <- 0
}
colnames(rankings) <- c("Team","Week.0","Week.1","Week.2","Week.3","Week.4","Week.5","Week.6",
                        "Week.7","Week.8","Week.9","Week.10","Week.11","Week.12","Week.13",
                        "Week.14","Week.15","Week.16","Week.17")
rankings$Week.0 <- 1500

# Iterate for each week of play
week.no <- 1
k_factor <- 20.0
week.data <- data[data$Week == week.no,]

doranking <- function(max_j,data,rankings){
for (j in 1:max_j) {
  week.no <- j
  k_factor <- 20.0
  week.data <- data[data$Week == week.no,]
  for (i in 1:nrow(week.data)) {
    winner <- week.data[[i,"Winner.tie"]]
    
    loser <- week.data[[i,"Loser.tie"]]
    old.rank.w <- rankings[rankings$Team == winner,week.no+1][[1]]
    old.rank.l <- rankings[rankings$Team == loser,week.no+1][[1]]

    
    # Calculate Margin of Victory Multiplier 
    # mv_mult = LN(ABS(PD)+1) * (2.2/((ELOW-ELOL)*.001+2.2))
    pd <- week.data$PtsW[i] - week.data$PtsL[i]
    #Margin For Victory Multiplier
    mv_mult <- log(pd +1) * (2.2/((old.rank.w - old.rank.l)*.001+2.2))
    #
    
    # Use old ELO Algorithm
    #
    w_w <- 1.0
    w_l <- 0.0
    if (pd == 0) {
      w_w <- 0.5
      w_l <- 0.5
    }
    #
    
    #
    d_ij_w <- old.rank.w - old.rank.l
    d_ij_l <- old.rank.l - old.rank.w
    #
    mu_ij_w <- 1 / (1 + 10 ^ ((-1 * d_ij_w)/400))
    new.rank.w <- round( old.rank.w + (k_factor * mv_mult * (w_w - mu_ij_w)))
    #
    mu_ij_l <- 1 / (1 + 10 ^ ((-1 * d_ij_l)/400))
    new.rank.l <- round( old.rank.l + (k_factor * mv_mult * (w_l - mu_ij_l)))
    #
    print (sprintf("Rank : W = %d L = %d",new.rank.w,new.rank.l))
    rankings[rankings$Team == winner,week.no+2] <- new.rank.w
    rankings[rankings$Team == loser,week.no+2] <- new.rank.l
  } 
  
  ###################################################################3  
  # if team didn't play, carry forward early ratings
  # not needed for wildcard, division et al
  #  for (i in 1:nrow(rankings)) {
  #    if (is.na(rankings[i,week.no+2])) {
  #      rankings[i,week.no+2] <- rankings[i,week.no+1]
  #    }
  #    if (rankings[i,week.no+2] < 1) {
  #      rankings[i,week.no+2] <- rankings[i,week.no+1]
  #    }
  #    }
  ##################################################################
  
}
  rankings
}

rankings2 <- doranking(17,data,rankings)

# week #1 ranking
rankings2 %>% select(Team,Week.1) %>% arrange(-Week.1)
# week #17 ranking
rankings2 %>% select(Team,Week.17) %>% arrange(-Week.17)
#

p.s. wrapping the main code as a function has benefits to me, as I could through on debugonce() to step through the function for debugging etc. in a most convenient way

1 Like

Great!! thanks a lot!!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.