#r #ggplot2 #gganimate
#r #ggplot2 #gganimate
Вопрос:
Я пытаюсь анимировать движение игроков и баскетбол в одной игре NBA. В NBA игровые часы начинаются с 12 минут и уменьшаются до 11:59 минут, 11:58, 11: 57 минут и т.д. Следовательно, набор данных об одном владении имеет game_clock
переменную, которая начинается с 718.80 секунд (11.98 минут). Вот что я сделал до сих пор:
gganimate
код:
first_poss_so <- read_csv("https://raw.githubusercontent.com/jasonbaik94/stackoverflow-data/master/first_poss_so.csv")
fullcourt()
geom_point(data = first_poss_so, aes(x = h1_x, y = h1_y, group = possID), size=3, color = "blue")
geom_point(data = first_poss_so, aes(x = h2_x, y = h2_y, group = possID), size=3, color = "blue")
geom_point(data = first_poss_so, aes(x = h3_x, y = h3_y, group = possID), size=3, color = "blue")
geom_point(data = first_poss_so, aes(x = h4_x, y = h4_y, group = possID), size=3, color = "blue")
geom_point(data = first_poss_so, aes(x = h5_x, y = h5_y, group = possID), size=3, color = "blue")
geom_point(data = first_poss_so, aes(x = a1_x, y = a1_y, group = possID), size=3, color = "red")
geom_point(data = first_poss_so, aes(x = a2_x, y = a2_y, group = possID), size=3, color = "red")
geom_point(data = first_poss_so, aes(x = a3_x, y = a3_y, group = possID), size=3, color = "red")
geom_point(data = first_poss_so, aes(x = a4_x, y = a4_y, group = possID), size=3, color = "red")
geom_point(data = first_poss_so, aes(x = a5_x, y = a5_y, group = possID), size=3, color = "red")
geom_point(data = first_poss_so, aes(x = x, y = y, group = possID), size=3, color = "gold")
transition_time(time = game_clock)
Вот full_court()
library(ggplot2)
fullcourt <- function () {
palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
"#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
#Generate Data for the 3 point line
# Define the circle; add a point at the center if the 'pie slice' if the shape is to be filled
circleFun <- function(center=c(0,5.25), diameter=20.9, npoints=20000, start=0, end=1, filled=TRUE){
tt <- seq(start*pi, end*pi, length.out=npoints)
df <- data.frame(
y = center[1] diameter / 2 * cos(tt),
x = center[2] diameter / 2 * sin(tt)
)
return(df)
}
halfCircle <- circleFun(c(0, 5.25), 20.9*2, start=0, end=1, filled=FALSE)
ggplot(data=data.frame(y=1,x=1),aes(x,y))
###halfcourt line:
geom_path(data=data.frame(x=c(47,47),y=c(0,50)))
###outside boy:
geom_path(data=data.frame(y=c(0,0,50,50,0),x=c(0,94,94,0,0)))
###solid FT semicircle above FT line:
geom_path(data=data.frame(y=c((-6000:(-1)/1000) 25,(1:6000/1000) 25),x=c(19 sqrt(6^2-c(-6000:(-1)/1000,1:6000/1000)^2))),aes(y=y,x=x))
geom_path(data=data.frame(y=c((-6000:(-1)/1000) 25,(1:6000/1000) 25),x=c(75 sqrt(6^2-c(-6000:(-1)/1000,1:6000/1000)^2))),aes(y=y,x=x))
###dashed FT semicircle below FT line:
geom_path(data=data.frame(y=c((-6000:(-1)/1000) 25,(1:6000/1000) 25),x=c(19-sqrt(6^2-c(-6000:(-1)/1000,1:6000/1000)^2))),aes(y=y,x=x),linetype='dashed')
geom_path(data=data.frame(y=c((-6000:(-1)/1000) 25,(1:6000/1000) 25),x=c(75-sqrt(6^2-c(-6000:(-1)/1000,1:6000/1000)^2))),aes(y=y,x=x),linetype='dashed')
###kex:
geom_path(data=data.frame(y=c(17,17,33,33,17),x=c(0,19,19,0,0)))
geom_path(data=data.frame(y=c(17,17,33,33,17),x=c(94,75,75,94,94)))
###boy inside the kex:
geom_path(data=data.frame(y=c(19,19,31,31,19),x=c(0,19,19,0,0)))
geom_path(data=data.frame(y=c(19,19,31,31,19),x=c(94,75,75,94,94)))
###restricted area semicircle:
geom_path(data=data.frame(y=c((-4000:(-1)/1000) 25,(1:4000/1000) 25),x=c(5.25 sqrt(4^2-c(-4000:(-1)/1000,1:4000/1000)^2))),aes(y=y,x=x))
geom_path(data=data.frame(y=c((-4000:(-1)/1000) 25,(1:4000/1000) 25),x=c(88.75-sqrt(4^2-c(-4000:(-1)/1000,1:4000/1000)^2))),aes(y=y,x=x))
###halfcourt semicircle:
geom_path(data=data.frame(y=c((-6000:(-1)/1000) 25,(1:6000/1000) 25),x=c(47-sqrt(6^2-c(-6000:(-1)/1000,1:6000/1000)^2))),aes(y=y,x=x))
geom_path(data=data.frame(y=c((-6000:(-1)/1000) 25,(1:6000/1000) 25),x=c(47 sqrt(6^2-c(-6000:(-1)/1000,1:6000/1000)^2))),aes(y=y,x=x))
###rim:
geom_path(data=data.frame(y=c((-750:(-1)/1000) 25,(1:750/1000) 25,(750:1/1000) 25,(-1:-750/1000) 25),x=c(c(5.25 sqrt(0.75^2-c(-750:(-1)/1000,1:750/1000)^2)),c(5.25-sqrt(0.75^2-c(750:1/1000,-1:-750/1000)^2)))),aes(y=y,x=x))
geom_path(data=data.frame(y=c((-750:(-1)/1000) 25,(1:750/1000) 25,(750:1/1000) 25,(-1:-750/1000) 25),x=c(c(88.75 sqrt(0.75^2-c(-750:(-1)/1000,1:750/1000)^2)),c(88.75-sqrt(0.75^2-c(750:1/1000,-1:-750/1000)^2)))),aes(y=y,x=x))
###backboard:
geom_path(data=data.frame(y=c(22,28),x=c(4,4)),lineend='butt')
geom_path(data=data.frame(y=c(22,28),x=c(90,90)),lineend='butt')
###three-point line:
# geom_path(data=data.frame(y=c(-21,-21,-21000:(-1)/1000,1:21000/1000,21,21),x=c(0,169/12,5.25 sqrt(23.75^2-c(-21000:(-1)/1000,1:21000/1000)^2),169/12,0)),aes(y=y,x=x))
###fiy aspect ratio to 1:1
geom_path(data=halfCircle,aes(x=x,y=y 25))
###Complete the three-point line
geom_path(data=data.frame(y=c(4.1,4.1,45.9,45.9),x=c(5.25,0,0,5.25)))
geom_path(data=halfCircle,aes(x=94-x,y=y 25))
geom_path(data=data.frame(y=c(4.1,4.1,45.9,45.9),x=c(88.75,94,94,88.75)))
coord_fixed()
###Clean up the Court
theme_bw() theme(panel.grid=element_blank(), legend.title=element_blank(), panel.border=element_blank(),axis.text=element_blank(),axis.ticks=element_blank(),axis.title=element_blank(),legend.position="top")}
Проблема с моим gganimate
кодом заключается в том, что transition_time
воспроизведение воспроизводится в обратном направлении … потому что game_clock
начинается примерно с 12 минут и уменьшается. Конечно, я могу вычесть 12 минут из game_clock, но это помешало бы мне использовать game_clock
в качестве разумного обозначения: ggtitle("Game Clock: {frame_time}")
В принципе, как я могу заставить transition_time
отображать время в порядке убывания? (Начинается с 12 минут и заканчивается через 0 минут)
Ответ №1:
(На практике я не загружаю внешние связанные данные, о которых я не знаю, поэтому я собираюсь ответить подходом, использующим стандартные данные.)
Это должно быть возможно сделать, изменив знак в вашей переменной transition_time и снова изменив знак в вашем названии, вот так:
library(gapminder)
library(gganimate)
library(dplyr)
a <- gapminder %>%
ggplot(aes(gdpPercap, lifeExp, color = continent, group = country))
geom_point()
transition_time(-year)
labs(title = "Year: {-frame_time}")
animate(a, nframes = 50, duration = 5)
Комментарии:
1. Спасибо, что указали на это в отношении моих данных. Я отредактировал процесс импорта данных, чтобы сделать его более безопасным.
2. В любом случае, решение должно быть применимо, если вы используете »
transition_time(time = -game_clock)
, а затем также измените знак в своем названии.3. Да, это работает чудесно. Из любопытства, как вы узнали об этом трюке?
4. У меня было предчувствие, что это сработает, сродни использованию
arrange(-numeric_variable)
в качестве ярлыка дляarrange(desc(numeric_variable))
indplyr
.