Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Keisuke ANDO
socceR
Commits
023f84b5
Commit
023f84b5
authored
Dec 09, 2022
by
Takumi Amano
💬
Browse files
[fix]キックの種類判別を修正
parent
4452e7e2
Changes
2
Show whitespace changes
Inline
Side-by-side
R/make_data.R
View file @
023f84b5
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
)
{
output
<-
action
%>%
dplyr
::
filter
(
command
==
"tackle"
)
%>%
dplyr
::
select
(
-
c
(
a_tackle_scc
,
ax
,
ay
))
return
(
output
)
}
get_kick_log
<-
function
(
action
)
{
get_kick_log
<-
function
(
action
,
goal
)
{
output
<-
action
%>%
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
(
after
_team
=
lead
(
team
))
%>%
dplyr
::
mutate
(
after
_unum
=
lead
(
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
=
(
after
_team
==
team
))
%>%
dplyr
::
mutate
(
a_sameunum
=
(
after
_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
<-
output
%>%
dplyr
::
mutate
(
dribble
=
(
a_sameteam
&
a_sameunum
))
%>%
dplyr
::
mutate
(
pass
=
(
a_sameteam
&
!
a_sameunum
))
%>%
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
()
%>%
select
(
-
c
(
tackle_scc
,
grc
,
before_team
,
before_unum
,
b_sameteam
,
b_sameunum
,
after_team
,
after_unum
,
a_sameteam
,
a_sameunum
))
ungroup
()
return
(
output
)
}
get_kick
<-
function
(
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
){
get_action_Allplayer
<-
function
(
players
,
action
)
{
action
<-
action
%>%
dplyr
::
select
(
step
,
action_team
=
team
,
ball_x
,
ball_y
,
pass
,
dribble
)
dplyr
::
select
(
step
,
action_team
=
team
,
ball_x
,
ball_y
,
pass
,
dribble
)
output
<-
players
%>%
dplyr
::
inner_join
(
action
,
by
=
"step"
)
dplyr
::
inner_join
(
action
,
by
=
"step"
)
return
(
output
)
}
get_pass_Allplayer
<-
function
(
players
,
pass
){
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
)
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"
)
dplyr
::
inner_join
(
pass
,
by
=
"step"
)
return
(
output
)
}
get_dribble_Allplayer
<-
function
(
players
,
dribble
){
get_dribble_Allplayer
<-
function
(
players
,
dribble
)
{
dribble
<-
dribble
%>%
dplyr
::
select
(
step
,
dribble_team
=
team
,
ball_x
,
ball_y
,
dribble_scc
)
dplyr
::
select
(
step
,
dribble_team
=
team
,
ball_x
,
ball_y
,
dribble_scc
)
output
<-
players
%>%
dplyr
::
inner_join
(
dribble
,
by
=
"step"
)
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
){
select_name
<-
function
(
data
,
name
)
{
output
<-
data
%>%
dplyr
::
filter
(
team
%in%
name
)
return
(
output
)
}
get_AttackLine
<-
function
(
data
)
{
output
<-
data
%>%
get_AttackLine
<-
function
(
pass
)
{
output
<-
pass
%>%
dplyr
::
group_by
(
step
)
%>%
filter
(
px
==
max
(
px
))
%>%
dplyr
::
select
(
step
,
pass_team
,
pass_scc
,
AL
=
px
AL
=
px
)
return
(
output
)
}
get_DefendLine
<-
function
(
data
)
{
output
<-
data
%>%
get_DefendLine
<-
function
(
pass
)
{
output
<-
pass
%>%
dplyr
::
group_by
(
step
)
%>%
filter
(
px
==
min
(
px
))
%>%
dplyr
::
select
(
step
,
DL
=
px
)
dplyr
::
select
(
step
,
DL
=
px
)
return
(
output
)
}
get_MedianLine
<-
function
(
data
)
{
output
<-
data
%>%
get_MedianLine
<-
function
(
pass
)
{
output
<-
pass
%>%
dplyr
::
group_by
(
step
)
%>%
dplyr
::
summarize
(
ML
=
median
(
px
))
%>%
dplyr
::
select
(
step
,
ML
)
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
)
}
R/read_rcg.R
100644 → 100755
View file @
023f84b5
...
...
@@ -10,7 +10,7 @@ read_rcg <- function(path) {
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
)
|>
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
)
|>
...
...
@@ -18,11 +18,3 @@ read_rcg <- function(path) {
return
(
rcg
)
}
\ No newline at end of file
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
)
}
\ No newline at end of file
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment