make_graphics.R

DEFAULT_MAX_PLAYER <- 11
DEFAULT_PITCH_LENGTH <- 105.0
DEFAULT_PITCH_WIDTH <- 70.0
DEFAULT_PITCH_MARGIN <- 5.0
DEFAULT_CENTER_CIRCLE_R <- 9.15
DEFAULT_PENALTY_AREA_LENGTH <- 16.5
DEFAULT_PENALTY_AREA_WIDTH <- 40.32
DEFAULT_PENALTY_CIRCLE_R <- 9.15
DEFAULT_PENALTY_SPOT_DIST <- 11.0
DEFAULT_GOAL_AREA_LENGTH <- 5.5
DEFAULT_GOAL_AREA_WIDTH <- 18.32
DEFAULT_GOAL_DEPTH <- 2.44
# DEFAULT_CORNER_ARC_R <- 1.0
half_p_l <- DEFAULT_PITCH_LENGTH/2
half_p_w <- DEFAULT_PITCH_WIDTH/2
penalty_x <- half_p_l - DEFAULT_PENALTY_AREA_LENGTH
penalty_y <- DEFAULT_PENALTY_AREA_WIDTH/2
goal_x <- half_p_l - DEFAULT_GOAL_AREA_LENGTH
goal_y <- DEFAULT_GOAL_AREA_WIDTH/2



make_field <- function(input_graph){
    p <- input_graph +
    
    geom_hline(yintercept = 0, linetype = "solid")+
    geom_vline(xintercept = 0, linetype = "solid")+
    geom_linerange(aes(x=half_p_l, y=NULL, ymin=-half_p_w, ymax=half_p_w))+
    geom_linerange(aes(x=-half_p_l, y=NULL, ymin=-half_p_w, ymax=half_p_w))+
    geom_linerange(aes(x=NULL, y=half_p_w, xmin=-half_p_l, xmax=half_p_l))+
    geom_linerange(aes(x=NULL, y=-half_p_w, xmin=-half_p_l, xmax=half_p_l))+

    geom_point(size=0.1) +
    geom_linerange(aes(x=penalty_x, y=NULL, ymin=-penalty_y, ymax=penalty_y))+
    geom_linerange(aes(x=-penalty_x, y=NULL, ymin=-penalty_y, ymax=penalty_y))+
    geom_linerange(aes(x=NULL, y=penalty_y, xmin=penalty_x, xmax=half_p_l))+
    geom_linerange(aes(x=NULL, y=-penalty_y, xmin=penalty_x, xmax=half_p_l))+
    geom_linerange(aes(x=NULL, y=penalty_y, xmax=-penalty_x, xmin=-half_p_l))+
    geom_linerange(aes(x=NULL, y=-penalty_y, xmax=-penalty_x, xmin=-half_p_l))+

    geom_linerange(aes(x=goal_x, y=NULL, ymin=-goal_y, ymax=goal_y))+
    geom_linerange(aes(x=-goal_x, y=NULL, ymin=-goal_y, ymax=goal_y))+
    geom_linerange(aes(x=NULL, y=goal_y, xmax=goal_x, xmin=half_p_l))+
    geom_linerange(aes(x=NULL, y=-goal_y, xmax=goal_x, xmin=half_p_l))+
    geom_linerange(aes(x=NULL, y=goal_y, xmin=-goal_x, xmax=-half_p_l))+
    geom_linerange(aes(x=NULL, y=-goal_y, xmin=-goal_x, xmax=-half_p_l))+

    ggforce::geom_circle(aes(x0 = 0, y0 = 0, r = DEFAULT_CENTER_CIRCLE_R),inherit.aes = FALSE)
    return(p)
}

make_heatmap <- function(p_data){
    p <- ggplot(data = p_data, aes(x = x, y = y )) +
    ggplot2::coord_fixed(xlim=c(-half_p_l,half_p_l),ylim =c(-half_p_w,half_p_w))+ 
    theme(text = element_text(size = 24)) +
    geom_density_2d_filled(alpha = 0.7) +
    labs(x = "x軸", y = "y軸",fill = "プレー割合") + 
    theme_minimal(base_size = 6)

    p <- p |> make_field()

    return(p)
}
make_heatmap_ball <- function(p_data){
    p <- ggplot(data = p_data, aes(x = ball_x, y = ball_y )) +
    ggplot2::coord_fixed(xlim=c(-half_p_l,half_p_l),ylim =c(-half_p_w,half_p_w))+ 
    theme(text = element_text(size = 24)) +
    geom_density_2d_filled(alpha = 0.7) +
    labs(x = "x軸", y = "y軸",fill = "プレー割合") + 
    theme_minimal(base_size = 6)

    p <- p |> make_field()

    return(p)
}
make_kick_point <- function(p_data,input_graph){
    p <- input_graph +
    geom_point(data = p_data,colour = "red",size = 0.5,aes(x = as.numeric(ball_x), y = as.numeric(ball_y)))

    return(p)
}

make_pass_point <- function(p_data,input_graph){
    p <- input_graph +
    geom_point(data = p_data,colour = "bule",size = 0.5,aes(x = as.numeric(ball_x), y = as.numeric(ball_y)))

    return(p)
}

make_dribble_point <- function(p_data,input_graph){
    p <- input_graph +
    geom_point(data = p_data,colour = "green",size = 0.5,aes(x = as.numeric(ball_x), y = as.numeric(ball_y)))

    return(p)
}

make_tackle_point <- function(p_data,input_graph){
    p <- input_graph +
    geom_point(data = p_data,colour = "",size = 0.5,aes(x = as.numeric(ball_x), y = as.numeric(ball_y)))

    return(p)
}

make_ball_area <- function(rcg){
    ball_path <- rcg |>
        dplyr::group_nest(step, ball_x, ball_y) |>
        dplyr::mutate(move_dist_x = ball_x - dplyr::lag(ball_x),
                        move_dist_y = ball_y - dplyr::lag(ball_y),
                        move_dist   = sqrt(move_dist_x^2 + move_dist_y^2),
                        move_dist   = dplyr::if_else(is.na(move_dist), 0, move_dist)
        ) |>
        dplyr::filter(move_dist != 0 & move_dist < 40)

    output <- ball_path |>
        plotly::plot_ly(showlegend = FALSE) |>
        plotly::add_markers(
            data       = ball_path,
            x          = ~ball_x,
            y          = ~ball_y,
            z          = ~move_dist,
            marker     = list(color        = ~move_dist,
                            size         = 3,
                            colorscale   = "Viridis",
                            opacity      = 0.8,
                            showscale  = FALSE)
        ) |>
        plotly::add_paths(
            data       = ball_path |>
            dplyr::select(step, ball_x, ball_y, move_dist) |>
            dplyr::mutate(base = 0) |>
            tidyr::pivot_longer(c(move_dist, base)) |>
            dplyr::group_by(step),
            x          = ~ball_x,
            y          = ~ball_y,
            z          = ~value,
            color      = ~value
        ) |>
        plotly::hide_colorbar() |>
        plotly::layout(
            scene = list(
                xaxis  = list(title = "ボールのX座標"),
                yaxis  = list(title = "ボールのY座標"),
                zaxis  = list(title = "ボールの飛距離"),
                camera = list(eye    = list(x = 0.8, y = -1.8, z =  0.8),
                                center = list(x = 0.0, y =  0.0, z = -0.2))
            )
        )

}