fork download
copy 
  1. f_score_prob_matches <- function( missinggames, matchday30, foot_model, max_goals = 10, N, limit ){
  2.  
  3.   all_final_tables <- data.frame(stringsAsFactors = FALSE)
  4.   clubs <- matchday30$club_name
  5.  
  6.   conv <- numeric()
  7.   for(i in 1:N){
  8.     Goals_team_away <- 0
  9.     Goals_team_home <- 0
  10.     matchday30 <- 
  11.     for (m in seq_along(missinggames$club_name_home)){
  12.   score_prob <- simulate_score_prob(foot_model = foot_model,
  13.                                     homeTeam = missinggames$club_name_home[m],
  14.                                     awayTeam = missinggames$club_name_away[m],
  15.                                     max_goals = max_goals)
  16.  
  17.     score <- base::sample(x = score_prob, size = 1, prob = score_prob)
  18.  
  19.     Goals_team_home[m] <- which(score_prob == score, arr.ind = T)[1]
  20.  
  21.     Goals_team_away[m] <- which(score_prob == score, arr.ind = T)[2]
  22.     }
  23.  
  24.     missinggames <- missinggames %>% mutate(Goals_team_home = Goals_team_home,
  25.                             Goals_team_away = Goals_team_away,
  26.                             Goal_diff_home = Goals_team_home - Goals_team_away,
  27.                             Goal_diff_away = Goals_team_away - Goals_team_home)
  28.  
  29.      missinggames <-  map_df(1:nrow(missinggames), ~if(missinggames$Goals_team_home[.x] > missinggames$Goals_team_away[.x])
  30.        mutate(missinggames[.x,], points_team_home =  3, points_team_away = 0) else if
  31.        (missinggames$Goals_team_home[.x] == missinggames$Goals_team_away[.x])
  32.            mutate(missinggames[.x,], points_team_home =  1, points_team_away = 1) else
  33.              mutate(missinggames[.x,], points_team_home =  0, points_team_away = 3)
  34.        )
  35.  
  36.     final_points <- map(unique(matchday30$club_name), ~ missinggames %>%
  37.                           filter(club_name_home == .x ) %>%
  38.                           select(points_team_home) %>%
  39.                           sum()+ missinggames %>% 
  40.                           filter(club_name_away == .x ) %>%
  41.                           select(points_team_away) %>% 
  42.                           sum()) %>%
  43.       unlist %>%
  44.       mutate(matchday30, points_new =  .) %>%
  45.       mutate(points = points + points_new) %>% select(points)
  46.  
  47.     final_goal_diff <- map(unique(matchday30$club_name), ~ missinggames %>%
  48.             filter(club_name_home == .x ) %>%
  49.             select(Goal_diff_home) %>%
  50.             sum()+ missinggames %>% 
  51.             filter(club_name_away == .x ) %>%
  52.             select(Goal_diff_away) %>% 
  53.             sum()) %>%
  54.       unlist %>%
  55.       mutate(matchday30, goal_diff_new =  .) %>%
  56.       mutate(goal_diff = goal_diff + goal_diff_new ) %>%
  57.       select(goal_diff)
  58.  
  59.     final_table <- matchday30 %>%
  60.       select(club_name) %>%
  61.       mutate(points = final_points$points,
  62.              goal_diff = final_goal_diff$goal_diff) %>%
  63.       arrange(desc(points), desc(goal_diff)) %>%
  64.       mutate(rank = 1:16)%>%
  65.       select(rank, everything())
  66.  
  67.     all_final_tables <- bind_rows(all_final_tables,final_table)
  68.     average_table <- aggregate(
  69.       all_final_tables[1:(length(clubs)*(i-1)),-1],
  70.       by = list(all_final_tables$club_name[1:(length(clubs)*(i-1))]),
  71.       FUN = "mean"
  72.     )
  73.       average_table2 <- aggregate(
  74.         all_final_tables[,-1],
  75.         by = list(all_final_tables$club_name),
  76.         FUN = "mean"
  77.       )
  78.       conv_speed <- sum(abs(average_table$score-average_table2$score))
  79.       conv <- c(conv, conv_speed)
  80.       if(i %% 10 == 0){
  81.         message("convergence speed: ", round(conv_speed, 3), " run ", i, " out of ", N)
  82.       }
  83.       if(conv_speed < limit){
  84.         message("converged!")
  85.         break
  86.       }
  87.   }
  88.   if(conv_speed < limit){
  89.     conv_plot <- qplot(x=1:length(conv), y=conv, geom = "jitter",
  90.                        main = paste0("converged to below ", limit, 
  91.                                      " after ", length(conv), " runs"))
  92.   } else {
  93.     conv_plot <- qplot(x=1:length(conv), y=conv, geom = "jitter",
  94.                        main = paste0("didn't converge below ", limit, 
  95.                                      " after ", N, " runs"))
  96.   }
  97.   return(list(all_final_tables, conv_plot))
  98. }
Success #stdin #stdout 0.24s 39208KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/Z2pVQp
language:
R (R 3.5.2)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!