[fix]キックの種類判別を修正

R/make_data.R

+get_referee <- function(rcl) {
+    referee <- rcl |>
+        dplyr::filter(command == "referee") %>%
+        dplyr::select(
+            step,
+            judge=args,
+        ) %>%
+        tidyr::drop_na() %>%
+        distinct(step, .keep_all = TRUE)
+    return(referee)
+}
+
+read_goal <- function(referee, name) {
+    goal <- referee |>
+        dplyr::filter(stringr::str_detect(judge, "goal_[rl]_[0-9]+")) |>
+        dplyr::mutate(
+            side = judge |>
+                stringr::str_remove("goal_") |>
+                stringr::str_extract("[rl]"),
+            score = judge |>
+                stringr::str_remove("goal_[rl]_") |>
+                stringr::str_extract("[0-9]+"),
+        ) |>
+        dplyr::inner_join(name, by = "side") |>
+        dplyr::select(
+            step,
+            judge,
+            side,
+            name,
+            score,
+        ) %>%
+        tidyr::drop_na()
+
+    return(goal)
+}
+
 get_player <- function(rcg, name) {
     output <- rcg |>
         dplyr::inner_join(name, by = "side") |>
-        dplyr::filter(is.na(stime)) |>
         dplyr::select(
             step,
             team = name,
@@ -18,13 +53,32 @@ get_player <- function(rcg, name) {
     return(output)
 }
 
-get_action <- function(rcl, ball, players) {
+get_ball <- function(rcg) {
+    ball <- rcg |>
+        dplyr::select(step, ball_x, ball_y, ball_vx, ball_vy) |>
+        dplyr::distinct(step, .keep_all = TRUE) %>%
+        dplyr::mutate(before_ball_x = lag(ball_x)) %>%
+        dplyr::mutate(before_ball_y = lag(ball_y)) %>%
+        dplyr::mutate(before_bvx = lag(ball_vx)) %>%
+        dplyr::mutate(before_bvy = lag(ball_vy)) %>%
+        dplyr::mutate(next_ball_x = lead(ball_x)) %>%
+        dplyr::mutate(next_ball_y = lead(ball_y)) %>%
+        dplyr::mutate(next_ball_vx = lead(ball_vx)) %>%
+        dplyr::mutate(next_ball_vy = lead(ball_vy)) %>%
+        dplyr::mutate(kick_speed= (ball_vx^2+ball_vy^2)) %>%
+        dplyr::mutate(a_kick_speed= (next_ball_vx^2+next_ball_vy^2)) %>%
+        dplyr::mutate(target_ball_x = (ball_x + next_ball_vx*10)) %>%
+        dplyr::mutate(target_ball_y = (ball_y + next_ball_vy*10))
+
+    return(ball)
+}
+
+
+get_action <- function(rcl,ball,players) {
+    referee <- get_referee(rcl)
     output <- rcl |>
-        dplyr::filter(command == "kick" | command == "tackle") |>
+        dplyr::filter(command == "kick" | command == "tackle" | command == "catch") |>
         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(
@@ -32,107 +86,110 @@ get_action <- function(rcl, ball, players) {
             team,
             unum,
             command,
-            ax = x,
-            ay = y,
         ) |>
+        dplyr::inner_join(players, by = c("step", "team", "unum"))%>%
         dplyr::inner_join(ball, by = "step") %>%
-        dplyr::inner_join(players, by = c("step", "team", "unum")) %>%
-        dplyr::mutate(after_team = lead(team)) %>%
-        dplyr::mutate(a_sameteam = (after_team == team)) %>%
-        dplyr::mutate(tackle_scc = (command == "tackle" & a_sameteam)) %>%
-        dplyr::mutate(a_tackle_scc = lead(tackle_scc)) %>%
-        dplyr::select(-c(after_team, a_sameteam))
+        dplyr::distinct(step,team, .keep_all = TRUE) %>% 
+        dplyr::full_join(referee,by="step") %>% 
+        dplyr::arrange(step) %>%
+        dplyr::mutate(next_judge = lead(judge)) %>%
+        dplyr::filter(command == "kick" | command == "tackle" | command == "catch") %>%
+        dplyr::mutate(a_tackle = (lead(command)=="tackle")) %>%
+        dplyr::mutate(next_team = lead(team)) %>%
+        dplyr::mutate(a_sameteam = (next_team == team)) %>%
+        dplyr::mutate(tackle_scc = (judge == "NULL" & command == "tackle" & a_sameteam)) %>%
+        dplyr::mutate(a_tackle_scc = lead(tackle_scc))
 
     return(output)
 }
 
-get_tackle <- function(action) {
+get_kick_log <- function(action,goal) {
     output <- action %>%
-        dplyr::filter(command == "tackle") %>%
-        dplyr::select(-c(a_tackle_scc, ax, ay))
+        dplyr::filter(command != "tackle") %>%
+        dplyr::mutate(next_catch = (lead(command) == "catch")) %>%
+        dplyr::filter(command == "kick") %>%
+        dplyr::mutate(before_team = lag(team)) %>%
+        dplyr::mutate(before_unum = lag(unum)) %>%
+        dplyr::mutate(next_team = lead(team)) %>%
+        dplyr::mutate(next_unum = lead(unum)) %>%
+        dplyr::mutate(b_sameteam = (before_team == team)) %>%
+        dplyr::mutate(b_sameunum = (before_unum == unum)) %>%
+        dplyr::mutate(a_sameteam = (next_team == team)) %>%
+        dplyr::mutate(a_sameunum = (next_unum == unum))
+
+    output$b_sameteam[1] <- TRUE
+    output$b_sameunum[1] <- FALSE
+    output <- dplyr::full_join(output,goal,by=c("step","judge","side")) %>%
+        dplyr::arrange(step) %>% 
+        dplyr::mutate(next_score = lead(score)) %>% 
+        dplyr::mutate(next_judge = lead(judge)) %>% 
+        dplyr::mutate(is_goal = (!is.na(next_score)&(side==lead(side)))) %>%
+        dplyr::filter(command == "kick") %>%
+        dplyr::mutate(shoot_scc = (judge == "NULL") & is_goal) %>% 
+        dplyr::mutate(dribble_scc = (
+            (judge == "NULL") & (next_judge == "NULL") & a_sameteam & a_sameunum)) %>%
+        dplyr::mutate(pass_scc = (
+            (judge == "NULL") & (next_judge == "NULL") & a_sameteam & !a_sameunum)) %>%
+        dplyr::mutate(shoot = (
+            shoot_scc | 
+            abs(target_ball_x) > 54 & abs(target_ball_y) < 12)) %>% 
+        dplyr::mutate(dribble = (
+            (!shoot)&
+            (!dribble_scc)&
+            (!pass_scc)&
+            (dribble_scc |
+                (!shoot) & (a_tackle_scc)|
+                (!shoot) & sqrt((ball_x - next_ball_x)^2 + (ball_y - next_ball_y)^2) < 1.0 )
+        )) %>%
+        dplyr::mutate(pass = (
+            (pass_scc | (!dribble & !shoot))
+        )) %>%
+        group_by(grc = cumsum(!dribble)) %>%
+        mutate(touch = row_number()) %>%
+        ungroup()
     return(output)
 }
 
-
-
-get_kick_log <- function(action) {
-  output <- action %>%
-    dplyr::filter(command == "kick") %>%
-    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 = (a_sameteam & a_sameunum)) %>%
-    dplyr::mutate(pass = (a_sameteam & !a_sameunum)) %>%
-    group_by(grc = cumsum(!dribble)) %>%
-    mutate(touch = row_number()) %>%
-    ungroup() %>%
-    select(-c(tackle_scc, grc, before_team, before_unum, b_sameteam, b_sameunum, after_team, after_unum, a_sameteam, a_sameunum))
-  return(output)
-}
-
-get_kick <- function(action) {
-    output <- action %>%
+get_kick <- function(kick_log) {
+    output <- action %>% 
         dplyr::filter(command == "kick") %>%
-        dplyr::mutate(after_team = lead(team)) %>%
-        dplyr::mutate(after_unum = lead(unum)) %>%
-        dplyr::mutate(a_sameteam = (after_team == team)) %>%
-        dplyr::mutate(a_sameunum = (after_unum == unum)) %>%
-        select(-c(command, pvx, pvy, body, neck)) %>% 
-        dplyr::mutate(next_ball_x = lead(ball_x)) %>%
-        dplyr::mutate(next_ball_y = lead(ball_y))
-
-
+        select(-c(command, pvx, pvy, body, neck))
     return(output)
 }
 
-get_action_Allplayer <- function(players,action){
-  action <- action  %>% 
-    dplyr::select(step,action_team=team,ball_x,ball_y,pass,dribble)
-  output <- players  %>% 
-    dplyr::inner_join(action,by = "step")
-  return(output)
+get_action_Allplayer <- function(players, action) {
+    action <- action %>%
+        dplyr::select(step, action_team = team, ball_x, ball_y, pass, dribble)
+    output <- players %>%
+        dplyr::inner_join(action, by = "step")
+    return(output)
 }
 
-get_pass_Allplayer <- function(players,pass){
-    pass <- pass  %>% 
-        dplyr::select(step,ax,ay,pass_team=team,ball_x,ball_y,ball_vx,ball_vy,pass_scc)
-    output <- players  %>% 
-        dplyr::inner_join(pass,by = "step")
+get_pass_Allplayer <- function(players, pass) {
+    pass <- pass %>%
+        dplyr::select(step, ax, ay, pass_team = team, ball_x, ball_y, ball_vx, ball_vy, pass_scc)
+    output <- players %>%
+        dplyr::inner_join(pass, by = "step")
     return(output)
 }
 
-get_dribble_Allplayer <- function(players,dribble){
-    dribble <- dribble  %>% 
-        dplyr::select(step,dribble_team=team,ball_x,ball_y,dribble_scc)
-    output <- players  %>% 
-        dplyr::inner_join(dribble,by = "step")
+get_dribble_Allplayer <- function(players, dribble) {
+    dribble <- dribble %>%
+        dplyr::select(step, dribble_team = team, ball_x, ball_y, dribble_scc)
+    output <- players %>%
+        dplyr::inner_join(dribble, by = "step")
     return(output)
 }
 
 get_pass <- function(kick) {
     output <- kick %>%
-        dplyr::mutate(pass_scc = (a_sameteam & !a_sameunum)) %>%
-        dplyr::mutate(pass = ((a_sameteam & !a_sameunum) | (!a_tackle_scc & !a_sameteam))) %>%
         dplyr::filter(pass) %>%
-        distinct(step,.keep_all=TRUE) %>%
-        select(-c(a_tackle_scc,tackle_scc, pass, a_sameteam, a_sameunum, after_team, after_unum))
+        distinct(step, .keep_all = TRUE) %>%
+        select(-c(a_tackle_scc, tackle_scc, pass, a_sameteam, a_sameunum, next_team, next_unum))
 
     return(output)
 }
 
-
-
-
 get_dribble <- function(kick) {
     output <- kick %>%
         dplyr::mutate(dribble = ((!a_sameteam & a_tackle_scc) | (a_sameteam & a_sameunum))) %>%
@@ -141,54 +198,12 @@ get_dribble <- function(kick) {
         mutate(touch = row_number()) %>%
         ungroup() %>%
         dplyr::filter(dribble) %>%
-        select(-c(a_tackle_scc,tackle_scc, dribble, a_sameteam, a_sameunum, after_team, after_unum, dribble, grc))
+        select(-c(a_tackle_scc, tackle_scc, dribble, a_sameteam, a_sameunum, next_team, next_unum, dribble, grc))
 
     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,
-            side,
-            name,
-            score,
-        ) %>%
-        tidyr::drop_na()
-
-    return(goal)
-}
 
 before_goal <- function(kick_log, goal_step, goal_team) {
     playlist <- kick_log %>%
@@ -286,49 +301,49 @@ kick_dist <- function(rcg) {
         dplyr::filter(move_dist != 0 & move_dist < 40)
 }
 
-select_name <- function(data,name){
-    output <- data  %>% 
+select_name <- function(data, name) {
+    output <- data %>%
         dplyr::filter(team %in% name)
     return(output)
 }
 
-get_AttackLine <- function(data){
-    output <- data  %>%
-        dplyr::group_by(step) %>% 
-        filter(px == max(px)) %>% 
+get_AttackLine <- function(pass) {
+    output <- pass %>%
+        dplyr::group_by(step) %>%
+        filter(px == max(px)) %>%
         dplyr::select(
-          step,
-          pass_team,
-          pass_scc,
-          AL=px
-          )
+            step,
+            pass_team,
+            pass_scc,
+            AL = px
+        )
     return(output)
 }
 
-get_DefendLine <- function(data){
-    output <- data  %>%
-        dplyr::group_by(step) %>% 
-        filter(px == min(px)) %>% 
-        dplyr::select(step,DL=px)
+get_DefendLine <- function(pass) {
+    output <- pass %>%
+        dplyr::group_by(step) %>%
+        filter(px == min(px)) %>%
+        dplyr::select(step, DL = px)
     return(output)
 }
 
-get_MedianLine <- function(data){
-    output <- data  %>%
-        dplyr::group_by(step) %>% 
-        dplyr::summarize(ML=median(px)) %>% 
-        dplyr::select(step,ML)
+get_MedianLine <- function(pass) {
+    output <- pass %>%
+        dplyr::group_by(step) %>%
+        dplyr::summarize(ML = median(px)) %>%
+        dplyr::select(step, ML)
     return(output)
 }
 
-get_DynamicPressureLine <- function(data){
-    data <- data  %>% 
+get_DynamicPressureLine <- function(pass) {
+    pass <- pass %>%
         filter(unum != 1)
-    ad <- get_AttackLine(data)
-    dd <- get_DefendLine(data)
-    md <- get_MedianLine(data)
-    output <- dplyr::inner_join(ad,dd,by = "step") %>% 
-              dplyr::inner_join(md,by = "step") %>%
-              distinct(step,.keep_all=TRUE)
+    ad <- get_AttackLine(pass)
+    dd <- get_DefendLine(pass)
+    md <- get_MedianLine(pass)
+    output <- dplyr::inner_join(ad, dd, by = "step") %>%
+        dplyr::inner_join(md, by = "step") %>%
+        distinct(step, .keep_all = TRUE)
     return(output)
-}
\ No newline at end of file
+}

R/read_rcg.R

 #' Read RCG file
-#' 
+#'
 #' @param path RCG file path
 #' @return Parsed tibble of RCG file in \code{path}
-#' @examples 
+#' @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::filter(type == "show") |>
-    dplyr::select(time,stime,players, ball.x, ball.y, ball.vx, ball.vy) |>
-    tidyr::unnest(players) |>
-    dplyr::select(time:capacity, ball.x:ball.vy) |>
-    dplyr::rename(step = time) |>
-    dplyr::rename_with(stringr::str_replace, pattern = "\\.", replacement = "_")
-  
-  return(rcg)
-}
+    rcg <- path |>
+        readr::read_file() |>
+        jsonlite::parse_json(simplifyVector = TRUE, flatten = TRUE) |>
+        tibble::as_tibble() |>
+        dplyr::filter(type == "show") |>
+        dplyr::select(time, stime, players, ball.x, ball.y, ball.vx, ball.vy) |>
+        tidyr::unnest(players) |>
+        dplyr::select(time:capacity, ball.x:ball.vy) |>
+        dplyr::rename(step = time) |>
+        dplyr::rename_with(stringr::str_replace, pattern = "\\.", replacement = "_")
 
-get_ball <- function(rcg) {
-  ball <- rcg |>
-    dplyr::select(step, ball_x, ball_y, ball_vx, ball_vy) |>
-    dplyr::distinct(step,.keep_all = TRUE)
-  
-  return(ball)
+    return(rcg)
 }
\ No newline at end of file