[add]ドリブル、パス、タックルの識別

R/get_kick_point.R

-get_kick_point <- function(log_data) {
-  output <- log_data |> 
+get_kick_point <- function(rcl) {
+  output <- rcl |> 
     dplyr::filter(command=="kick") |>
     dplyr::mutate(
       x = args |> stringr::str_extract("[0-9\\-\\.]+"),
       l1 = args |> stringr::str_remove(x),
       y = l1 |> stringr::str_extract("[0-9\\-\\.]+"),
-
+      unum = as.numeric(unum)
     ) |>
     dplyr::select(
       step,
@@ -18,3 +18,92 @@ get_kick_point <- function(log_data) {
   
   return(output)
 }
+
+read_referee <- function(path_rcl) {
+  referee <- path_rcl |>
+    readr::read_lines() |>
+    tibble::as_tibble() |>
+    dplyr::mutate(
+      step     = value |> stringr::str_extract("\\d+"),
+      command = value |> 
+        stringr::str_extract("referee [a-zA-Z0-9_]*")|> 
+        stringr::str_remove("referee "),
+      step = as.numeric(step),
+    ) |> 
+    dplyr::select(
+      step,
+      command,
+    ) %>% tidyr::drop_na()
+    
+  
+  return(referee)
+}
+
+read_goal <- function(referee,name){
+  goal <- referee |>
+    dplyr::filter(stringr::str_detect(command, "goal_[rl]_[0-9]+")) |>
+    dplyr::mutate(
+      side  = command |> 
+        stringr::str_remove("goal_") |> 
+        stringr::str_extract("[rl]"),
+      score = command |> 
+        stringr::str_remove("goal_[rl]_") |> 
+        stringr::str_extract("[0-9]+") ,
+    ) |>
+    dplyr::inner_join(name,by="side") |>
+    dplyr::select(
+      step,
+      name,
+      score,
+    ) %>% tidyr::drop_na()
+
+  return(goal)
+}
+
+before_goal <- function(kick_log,goal_step,goal_team){
+
+  playlist <- kick_log %>%
+    dplyr::arrange(desc(step)) %>%
+    dplyr::filter(
+      step > goal_step -100,
+      step < goal_step,
+      team == goal_team, 
+    )
+}
+
+get_goal_playlist <- function(kick_log,goal){
+  if(length(goal$step)<1){
+    return(NA)
+  }
+  i <- 1
+  output <- before_goal(kick_log,goal$step[i],goal$name[i])
+  i<- i+1
+  while(i <= length(goal$step)){
+    # print(i)
+    i_list <- before_goal(kick_log,goal$step[i],goal$name[i])
+    output <- output |> bind_rows(i_list)
+    i<- i+1
+  }
+  # for(i in goal$step){
+  #   i_list <- before_goal(kick_log,goal$step[i],goal$name[i])
+  #   output <- output |> bind_rows(i_list)
+  #   print(i)
+  # }
+  return(output)
+}
+
+convert_ball_acg_and_rcl <- function(rcg,rcl){
+  output <- dplyr::inner_join(rcg,rcl,by="step")
+  return(output)
+}
+
+get_dribble_point <- function(log_data){
+  output <- log_data %>% filter(dribble==TRUE,pass==FALSE)
+  return(output)
+}
+
+get_pass_point <- function(log_data){
+  output <- log_data %>% filter(pass==TRUE)
+  return(output)
+}
+

R/make_data.R

+source("~/soccer2D/socceR/R/read_old_rcg.R")
+source("~/soccer2D/socceR/R/read_rcl.R")
+source("~/soccer2D/socceR/R/read_rcg.R")
+
+get_rcl <- function(path_rcl){
+    output <- path_rcl |> read_rcl()
+    return(output)
+}
+
+get_name <- function(path_rcg){
+    team_name <- path_rcg |>
+        stringr::str_extract("[a-zA-Z0-9_-]*.rcg") |> 
+        stringr::str_remove("[0-9]*-") |>
+        stringr::str_remove(".rcl") 
+    l_team <- team_name |>
+        stringr::str_extract("[a-zA-Z0-9_]*-vs-") |>
+        stringr::str_remove("_[0-9]*-vs-")
+    r_team <- path_rcg |>
+        stringr::str_extract("[a-zA-Z0-9_]*.rcg") |>
+        stringr::str_remove("_[0-9]*.rcg")
+    name_table <- tibble::tribble(
+        ~side, ~name,
+        "l", l_team,
+        "r",r_team,
+    )
+
+    return(name_table)
+}
+
+replase_rcg_to_rcl <- function(path_rcg){
+    output <- path_rcg |> stringr::str_replace(pattern=".rcg", replacement=".rcl")
+}
+replase_rcl_to_rcg <- function(path_rcl){
+    output <- path_rcl |> stringr::str_replace(pattern=".rcl", replacement=".rcg")
+}
+
+get_player <- function(rcg,name){
+    output <- rcg |> 
+        dplyr::inner_join(name,by="side") |>
+        dplyr::select(
+            step,
+            team = name,
+            unum,
+            x,
+            y,
+            vx,
+            vy,
+            body,
+            neck,
+        )
+    return(output)
+}
+
+get_kick <- function(rcl,ball){
+    output <- rcl |>
+        get_kick_point() |>
+        convert_ball_rcg_and_rcl(ball)
+
+    output <- output %>% 
+        dplyr::mutate(before_team=lag(team)) %>%
+        dplyr::mutate(before_unum=lag(unum)) %>%
+        dplyr::mutate(after_team=lead(team)) %>%
+        dplyr::mutate(after_unum=lead(unum)) %>%
+        dplyr::mutate(b_sameteam=(before_team==team)) %>% 
+        dplyr::mutate(b_sameunum=(before_unum==unum)) %>%
+        dplyr::mutate(a_sameteam=(after_team==team)) %>% 
+        dplyr::mutate(a_sameunum=(after_unum==unum))
+        
+
+    output$b_sameteam[1] <- TRUE
+    output$b_sameunum[1] <- FALSE
+
+    output <- output %>%
+        dplyr::mutate(dribble=(b_sameteam & b_sameunum)) %>%
+        dplyr::mutate(pass=(a_sameteam & !a_sameunum)) %>%
+        dplyr::mutate(tackle=(!b_sameteam))%>%
+        group_by(grc = cumsum(!dribble)) %>% 
+        mutate(touch = row_number()) %>% 
+        ungroup() %>% 
+        select(-c(grc,before_team,before_unum,b_sameteam,b_sameunum,after_team,after_unum,a_sameteam,a_sameunum))
+    return(output)
+}
+
+kick_dist <- 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)
+}
\ No newline at end of file

R/make_graphics.R

@@ -50,21 +50,100 @@ make_field <- function(input_graph){
 }
 
 make_heatmap <- function(p_data){
-    p <- ggplot(data = p_data, aes(x = as.numeric(x), y = as.numeric(y))) +
+    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))+ 
-    geom_density_2d_filled(alpha = 0.5)
+    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)
 
-# make_kick_point <- function(p_data,input_graph){
-#     log_data <- p_data
+    p <- p |> make_field()
 
-#     p <- input_graph +
-#     geom_point(data = p_data,aes(x = as.numeric(x), y = as.numeric(y)))
+    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)
-# }
+    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))
+            )
+        )
+
+}
\ No newline at end of file

R/read_old_rcg.R

+read_old_rcg_ball <- function(path_rcg){
+    ball_log <- path_rcg |>
+    readr::read_lines() |>
+    tibble::as_tibble() |>
+    dplyr::mutate(
+        step = value |> stringr::str_extract("\\(show ([0-9]*)*")
+                    |> stringr::str_remove("\\(show "),
+        ball = value |> stringr::str_extract("\\(\\(b\\)( [0-9\\-\\.]*)*\\)")
+            |> stringr::str_remove("\\(\\(b\\) ")
+            |> stringr::str_remove("\\)"),
+        ball_x = ball |> stringr::str_extract("[0-9\\-\\.]+"),
+        ball_y = ball |> stringr::str_remove(ball_x)
+            |> stringr::str_extract("[0-9\\-\\.]+"),
+        ball_vx = ball  |> stringr::str_remove(ball_x)
+            |> stringr::str_remove(ball_y)
+            |> stringr::str_extract("[0-9\\-\\.]+"),
+        ball_vy = ball  |> stringr::str_remove(ball_x)
+            |> stringr::str_remove(ball_y)
+            |> stringr::str_remove(ball_vx)
+            |> stringr::str_extract("[0-9\\-\\.]+"),
+        step = as.numeric(step),
+        # ball,
+        ball_x = as.numeric(ball_x),
+        ball_y = as.numeric(ball_y),
+        ball_vx = as.numeric(ball_vx),
+        ball_vy = as.numeric(ball_vy),
+    )|>
+    dplyr::select(
+        step,
+        # ball,
+        ball_x,
+        ball_y,
+        ball_vx,
+        ball_vy,
+    ) %>% tidyr::drop_na()
+    return(ball_log)
+}
+
+read_old_rcg_player <- function(path_rcg){
+    player_log <- path_rcg |>
+    readr::read_lines() |>
+    tibble::as_tibble() |>
+    dplyr::mutate(
+        step = value |> stringr::str_extract("\\(show ([0-9]*)*")
+                    |> stringr::str_remove("\\(show "),
+        players = value |> stringr::str_extract_all("\\(\\([lr] [0-9]*\\) [0-9]* [0-9x]* ([0-9\\-\\.]* )*\\(v h [0-9\\-\\.]*\\) \\(s( [0-9\\-\\.]*)*\\)( \\(f [rl] [0-9\\-\\.]*\\))* \\(c( [0-9\\-\\.]*)*\\)\\)")
+    ) |>
+    tidyr::unnest(players) |>
+    dplyr::mutate(
+        player = players |> stringr::str_extract("\\([rl] [0-9]+\\)"),
+        side = player |> stringr::str_extract("[rl]"),
+        unum = player |> stringr::str_extract("[0-9]+"),
+        params = players |> stringr::str_remove("\\([rl] [0-9]+\\)"),
+
+        type = params|> stringr::str_extract("[0-9\\-\\.x]+"),
+        l1 = params |> stringr::str_remove(type),
+
+        state = l1 |> stringr::str_extract("[0-9\\-\\.x]+"),
+        l2 = l1 |> stringr::str_remove(state),
+
+        x = l2 |> stringr::str_extract("[0-9\\-\\.]+"),
+        l3 = l2 |> stringr::str_remove(x),
+
+        y = l3 |> stringr::str_extract("[0-9\\-\\.]+"),
+        l4 = l3 |> stringr::str_remove(y),
+
+        vx = l4 |> stringr::str_extract("[0-9\\-\\.]+"),
+        l5 = l4 |> stringr::str_remove(vx),
+
+        vy = l5 |> stringr::str_extract("[0-9\\-\\.]+"),
+        l6 = l5 |> stringr::str_remove(vy),
+
+        body = l6 |> stringr::str_extract("[0-9\\-\\.]+"),
+        l7 = l6 |> stringr::str_remove(body),
+
+        neck = l7 |> stringr::str_extract("[0-9\\-\\.]+"),
+        l8 = l7 |> stringr::str_remove(neck),
+
+        step = as.numeric(step),
+        # players,
+        # player,
+        side,
+        unum = unum,
+        # params,
+        # type,
+        # state,
+        x = as.numeric(x),
+        y = as.numeric(y),
+        vx = as.numeric(vx),
+        vy = as.numeric(vy),
+        body = as.numeric(body),
+        neck = as.numeric(neck),
+    ) |>
+    dplyr::select(
+        step,
+        # players,
+        # player,
+        side,
+        unum,
+        # params,
+        # type,
+        # state,
+        x,
+        y,
+        vx,
+        vy,
+        body,
+        neck,
+    ) %>% tidyr::drop_na()
+    return(player_log)
+}
\ No newline at end of file

R/read_rcg.R

-# remove(list = ls());gc()
-# path = "~/socceR/R/test.rcg"
-tag <- c("x","y","vx","vy")
-
-read_rcg_ball <- function(path){
-    ball_log <- path |>
-    readr::read_lines() |>
+#' Read RCG file
+#' 
+#' @param path RCG file path
+#' @return Parsed tibble of RCG file in \code{path}
+#' @examples 
+#' read_rcg("data/20220405162804-HELIOS_base_3-vs-enemy_2.rcg")
+read_rcg <- function(path) {
+  rcg <- path |>
+    readr::read_file() |>
+    jsonlite::parse_json(simplifyVector = TRUE, flatten = TRUE) |>
     tibble::as_tibble() |>
-    dplyr::mutate(
-        step = value |> stringr::str_extract("\\(show ([0-9]*)*")
-                    |> stringr::str_remove("\\(show "),
-        ball = value |> stringr::str_extract("\\(\\(b\\)( [0-9\\-\\.]*)*\\)")
-            |> stringr::str_remove("\\(\\(b\\) ")
-            |> stringr::str_remove("\\)"),
-        x = ball |> stringr::str_extract("[0-9\\-\\.]+"),
-        y = ball |> stringr::str_remove(x)
-            |> stringr::str_extract("[0-9\\-\\.]+"),
-        vx = ball  |> stringr::str_remove(x)
-            |> stringr::str_remove(y)
-            |> stringr::str_extract("[0-9\\-\\.]+"),
-        vy = ball  |> stringr::str_remove(x)
-            |> stringr::str_remove(y)
-            |> stringr::str_remove(vx)
-            |> stringr::str_extract("[0-9\\-\\.]+"),
-    )|>
-    dplyr::select(
-        step,
-        # ball,
-        x,
-        y,
-        vx,
-        vy,
-    ) %>% tidyr::drop_na()
-    return(ball_log)
-}
-
-read_rcg_player <- function(path){
-    player_log <- path |>
-    readr::read_lines() |>
-    tibble::as_tibble() |>
-    dplyr::mutate(
-        step = value |> stringr::str_extract("\\(show ([0-9]*)*")
-                    |> stringr::str_remove("\\(show "),
-        players = value |> stringr::str_extract_all("\\(\\([lr] [0-9]*\\) [0-9]* [0-9x]* ([0-9\\-\\.]* )*\\(v h [0-9\\-\\.]*\\) \\(s( [0-9\\-\\.]*)*\\)( \\(f [rl] [0-9\\-\\.]*\\))* \\(c( [0-9\\-\\.]*)*\\)\\)")
-    ) |>
+    dplyr::filter(type == "show") |>
+    dplyr::select(time, players, ball.x, ball.y, ball.vx, ball.vy) |>
     tidyr::unnest(players) |>
-    dplyr::mutate(
-        player = players |> stringr::str_extract("\\([rl] [0-9]+\\)"),
-        team = player |> stringr::str_extract("[rl]"),
-        unum = player |> stringr::str_extract("[0-9]+"),
-        params = players |> stringr::str_remove("\\([rl] [0-9]+\\)"),
-
-        type = params|> stringr::str_extract("[0-9\\-\\.x]+"),
-        l1 = params |> stringr::str_remove(type),
+    dplyr::select(time:capacity, ball.x:ball.vy) |>
+    dplyr::rename(step = time) |>
+    dplyr::rename_with(stringr::str_replace, pattern = "\\.", replacement = "_")
   
-        state = l1 |> stringr::str_extract("[0-9\\-\\.x]+"),
-        l2 = l1 |> stringr::str_remove(state),
-
-        x = l2 |> stringr::str_extract("[0-9\\-\\.]+"),
-        l3 = l2 |> stringr::str_remove(x),
-
-        y = l3 |> stringr::str_extract("[0-9\\-\\.]+"),
-        l4 = l3 |> stringr::str_remove(y),
-
-        vx = l4 |> stringr::str_extract("[0-9\\-\\.]+"),
-        l5 = l4 |> stringr::str_remove(vx),
-
-        vy = l5 |> stringr::str_extract("[0-9\\-\\.]+"),
-        l6 = l5 |> stringr::str_remove(vy),
+  return(rcg)
+}
 
-        body = l6 |> stringr::str_extract("[0-9\\-\\.]+"),
-        l7 = l6 |> stringr::str_remove(body),
+get_ball <- function(rcg) {
+  ball <- rcg |>
+    dplyr::select(step, ball_x, ball_y, ball_vx, ball_vy) |>
+    dplyr::distinct(step,.keep_all = TRUE)
   
-        neck = l7 |> stringr::str_extract("[0-9\\-\\.]+"),
-        l8 = l7 |> stringr::str_remove(neck),
-    ) |>
-    dplyr::select(
-        step,
-        # players,
-        # player,
-        team,
-        unum,
-        # params,
-        # type,
-        # state,
-        x,
-        y,
-        vx,
-        vy,
-        body,
-        neck,
-    )  %>% tidyr::drop_na()
-    return(player_log)
+  return(ball)
 }
\ No newline at end of file

R/read_rcl.R

+#' Read RCL file
+#' 
+#' @param path RCL file path
+#' @return Parsed tibble of RCL file in \code{path}
+#' @examples 
+#' read_rcg("data/20220405162804-HELIOS_base_3-vs-enemy_2.rcl")
 read_rcl <- function(path) {
   rcl <- path |>
   readr::read_lines() |>
   tibble::as_tibble() |>
   dplyr::mutate(
-    step     = value |> stringr::str_extract("\\d+"),
+    step     = value |> stringr::str_extract("\\d+") |> as.numeric(),
     agent    = value |> stringr::str_extract("\\w+_([0-9]{1,2}|Coach)"),
     team     = agent |> stringr::str_remove("_([0-9]{1,2}|Coach)"),
     unum     = agent |> stringr::str_extract("([0-9]{1,2}|Coach)$"),
@@ -26,7 +32,7 @@ read_rcl <- function(path) {
     unum,
     command,
     args,
-    line = value,
+    # line = value,
   )
   
   return(rcl)