knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "man/figures/README-", out.width = "100%" )
options(repos = c(openvolley = "https://openvolley.r-universe.dev", CRAN = "https://cloud.r-project.org")) install.packages("volleysim") ## or ## install.packages("remotes") ## if needed remotes::install_github("openvolley/volleysim")
The volleysim
package provides functions for simulating sets and matches of volleyball. The simulation model can be parameterized in two ways:
A simple "sideout" parameterization. We simply specify the sideout rate for each team. This can be a constant value (i.e. their average sideout rate) or can be provided as a function, allowing the sideout rate to vary depending on whatever factors you think might be appropriate. (Function-based parameterization is experimental: see help("vs_simulate_set")
for more information.)
A more detailed "phase" parameterization. In this model, we specify the rates for each team for:
serve_ace
(serve ace rate)serve_error
(serve error rate)rec_loss_other
(loss of the point during reception-phase play, excluding reception errors and attack errors --- e.g. errors on reception-phase sets)rec_att_error
(error rate on reception-phase attacks)rec_att_kill
(kill rate on reception-phase attacks)rec_att_replayed
(rate at which reception-phase attacks are replayed by the attacking team for a second attack: either blocked for reattack, deliberately recycled off the block, or dug by the defending team but put back over as a freeball)rec_no_att
(proportion of receptions, excluding reception errors, on which an attack is not made)rec_block
(block kill rate against reception-phase attacks)trans_loss_other
, trans_att_error
, trans_att_kill
, trans_att_replayed
, trans_no_att
, trans_block
- as for the rec_*
parameters, but in transition phase (i.e. everything after the reception-phase attack)rd1 <- function(z) round(z, 1) options(dplyr.summarise.inform = FALSE)
library(volleysim) library(datavolley) library(dplyr) ## read an example file x <- dv_read(dv_example_file()) ## calculate the rates we need to simulate rates <- vs_estimate_rates(x, target_team = "each") vs_simulate_match(rates)
So given the performances of the two teams during that match, we expect that the home team should have won, with 3-0 being the most likely scoreline. Compare this to the actual match result:
summary(x)
Let's say we have two teams with the following season-average parameters:
library(dplyr) rates <- tribble(~team, ~serve_ace, ~serve_error, ~rec_loss_other, ~rec_att_error, ~rec_att_kill, ~rec_att_replayed, ~rec_no_att, ~trans_loss_other, ~trans_att_error, ~trans_att_kill, ~trans_att_replayed, ~trans_no_att, ~rec_block, ~trans_block, "My team", 0.062, 0.156, 0.009, 0.071, 0.499, 0.05, 0.05, 0.018, 0.082, 0.452, 0.05, 0.08, 0.075, 0.079, "Other team", 0.069, 0.190, 0.014, 0.063, 0.523, 0.05, 0.05, 0.021, 0.102, 0.435, 0.05, 0.05, 0.083, 0.109) knitr::kable(rates)
"My team" is due to play "Other team" in our next match. If we assume that both teams play to their season-average parameters, what outcome do we expect?
vs_simulate_match(rates)
Looks like we expect a close match, but My team is most probably going to lose.
Perhaps as the coach of My team there are some adjustments I could make --- in choosing the players in our starting lineup, or in our match tactics. Can simulation help us explore which option might be most beneficial?
Let's say that one of our options is to substitute in a different pass-hitter: Betty, who has a more aggressive serve and attack but who is a weaker passer than our starting pass-hitter Agnes. With Betty in the lineup instead of Agnes, we guesstimate our new team parameters to be:
rates2 <- rates ## increase my team's serve aces and errors by 1% each, and attack kills by 2% rates2[1, c("serve_ace", "serve_error", "rec_att_kill", "trans_att_kill")] <- rates2[1, c("serve_ace", "serve_error", "rec_att_kill", "trans_att_kill")] + c(0.01, 0.01, 0.02, 0.02) ## increase opposition serve aces by 1% rates2[2, c("serve_ace")] <- rates2[2, c("serve_ace")] + 0.01 vs_simulate_match(rates2)
That makes a slight improvement. Our second option is to change our serving tactics: we will serve more aggressively in order to put more pressure on Other team's reception but accepting that we will make more serve errors in doing so:
rates3 <- rates ## increase my team's serve aces by 2% and errors by 5% rates3[1, c("serve_ace", "serve_error")] <- rates3[1, c("serve_ace", "serve_error")] + c(0.02, 0.05) ## decrease opposition reception kills by 5% due to their expected poorer passing rates3[2, c("rec_att_kill")] <- rates3[2, c("rec_att_kill")] - 0.05 vs_simulate_match(rates3)
This looks like it might be a better option (assuming, of course, that we have estimated the changes in rates correctly).
Let's look at another match: the 2020 Austrian Women's Volley Cup played between Hartberg and UVC Graz (the dvw file was downloaded from https://www.volleynet.at/dvdownload/information/f-Damen/ and is bundled with the volleysim package). UVC Graz won the match 3-1:
x <- dv_read(vs_example_file()) summary(x)
Let's see what result we expected given the team's actual performances during the match:
rates <- list(vs_estimate_rates(x, target_team = home_team(x)), vs_estimate_rates(x, target_team = visiting_team(x))) sim_result <- vs_simulate_match(rates = rates) sim_result
The simulations suggest that Hartberg had a r rd1(sim_result$pwin*100)
% chance of winning, with the most likely scoreline being 1-3 --- consistent with the actual result.
Now let's say that the two teams will be playing again soon, and the Hartberg coach thinks that their first-ball attack could be improved by improving their passing. What difference might we expect in the match outcome for an improvement in this area?
First let's get a handle on the relevant performance parameters. "Positive" passes here means passes that were rated as perfect or positive.
## extract the play-by-play data xp <- plays(x) ## identify first-ball attacks fba <- xp %>% dplyr::filter(skill == "Attack" & phase == "Reception") %>% mutate(made_attack = TRUE, fbso = evaluation == "Winning attack") %>% dplyr::select(point_id, team, made_attack, fbso) ## join that back to the full play-by-play data xp <- left_join(xp, fba, by = c("point_id", "team")) %>% mutate(fbso = if_else(is.na(fbso), FALSE, fbso), made_attack = if_else(is.na(made_attack), FALSE, made_attack)) ## and pass quality on each rally pq <- xp %>% dplyr::filter(skill == "Reception") %>% group_by(point_id) %>% dplyr::summarize(pass_quality = case_when(n() == 1 ~ evaluation)) xp <- left_join(xp, pq, by = "point_id") %>% mutate(pass_quality = case_when(grepl("Perfect|Positive", pass_quality) ~ "Positive", grepl("Error", pass_quality) ~ "Error", TRUE ~ "Other")) ## finally summarize the first-ball attacks by pass quality fb_summary <- xp %>% dplyr::filter(skill == "Reception" & team == home_team(x)) %>% group_by(pass_quality) %>% dplyr::summarize(N = n(), `Attack %` = mean(made_attack)*100, `Attack kill %` = mean(fbso[made_attack])*100, `FBSO%` = mean(fbso)*100) fb_summary
Hartberg made r fb_summary$N[fb_summary$pass_quality == "Positive"]
positive passes (r rd1(fb_summary$N[fb_summary$pass_quality == "Positive"]/sum(fb_summary$N)*100)
% positive pass rate). They made an actual attack on r rd1(fb_summary$"Attack %"[fb_summary$pass_quality == "Positive"])
% of those positive passes, with a kill rate of r rd1(fb_summary$"Attack kill %"[fb_summary$pass_quality == "Positive"])
% on those attacks. Their overall first-ball sideout rate on positive passes was r rd1(fb_summary$"FBSO%"[fb_summary$pass_quality == "Positive"])
%.
On other passes (excluding pass errors), Hartberg's first-attack sideout rate was r rd1(fb_summary$"FBSO%"[fb_summary$pass_quality == "Other"])
%, with only r rd1(fb_summary$"Attack %"[fb_summary$pass_quality == "Other"])
% of those passes leading to an attack, and a kill rate of r rd1(fb_summary$"Attack kill %"[fb_summary$pass_quality == "Other"])
% on those attacks.
Let's say that with some focused training, the Hartberg coach thinks that their positive pass rate can be substantially increased, from r rd1(fb_summary$N[fb_summary$pass_quality == "Positive"]/sum(fb_summary$N)*100)
% to 75%. This would change their reception attack kill rate, because more attacks would be made from positive passes. The expected reception attack kill rate would be the weighted average of the kill rates on positive and other passes (where the weights are the relative numbers of positive and other passes).
new_positive_pass_rate <- 0.75 attack_rate_pos <- new_positive_pass_rate * 0.878 attack_rate_other <- (1 - new_positive_pass_rate) * 0.615 new_rec_att_kill <- (attack_rate_pos * 0.419 + ## positive pass rate multiplied by their corresponding kill rate attack_rate_other * 0.188 ## attack rate on other passes * their kill rate ) / (attack_rate_pos + attack_rate_other) new_rec_att_kill
That is, with the hypothesized better passing performance we expect only a modest increase in the overall reception attack kill rate to r rd1(new_rec_att_kill*100)
% (up from r rd1(rates[[1]]$rec_att_kill*100)
%).
Armed with that estimate, we can explore what effect that might have on a re-match:
rates[[1]]$rec_att_kill <- new_rec_att_kill new_sim_result <- vs_simulate_match(rates = rates) new_sim_result
Giving a match win probability of r rd1(new_sim_result$pwin*100)
% (up from r rd1(sim_result$pwin*100)
%).
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.