Как я могу построить x, y очков футболиста в зависимости от времени в R?

Question

Допустим, у меня есть следующие данные:

   Player time    x    y
1       1   69 53.0 43.6
2       1   70 54.0 43.6
3       1   71 55.5 43.6
4       1   72 56.5 44.6
5       1   73 58.7 45.6
6       2   69 32.3 12.7
7       2   70 34.2 14.4
8       2   71 34.6 14.0
9       2   72 35.5 14.4
10      2   73 36.4 14.6

Переменная времени указана в секундах.Я хочу показать в сюжете движение каждого игрока (отдельно) с течением времени.в моей голове есть своего рода анимация, в которой игроки движутся с течением времени.В идеале, я хочу представить это на футбольном поле в качестве следующего шага.Любая помощь о том, как этого добиться?

Answer 1

Используя RStudio, попробуйте это и нажмите play

library(plotly)
d2 <- data.frame(   x=c(0, 0, 16.5, 100, 100,83.5), 
                 xend=c(16.5,16.5, 16.5, 83.5,83.5,83.5),
                    y=rep(c(13.68, 61.32, 13.68),2), 
                 yend=rep(c(13.68,61.32,61.32),2))
p <- ggplot(d, aes(x, y, color=factor(Player))) +
  geom_point(aes(frame = time)) + 
  xlim(0,100)+ylim(0,75)+
  geom_vline(xintercept = c(0,50,100), color="white") + 
  geom_segment(data = d2,aes(x=x, xend=xend, y=y,yend=yend),inherit.aes = F, color="white") +
  geom_point(aes(x=50,y=75/2), size=2, color="white", inherit.aes = F) +
  theme(panel.background = element_rect(fill = "darkgreen"))
ggplotly(p)

Вы можете создать функцию самостоятельно, как уже прокомментировано

my_soccer_field <- function(data, lengthPitch = 100, widthPitch = 75,
                            colPitch = "white", lwd = 0.2){
 require(ggplot2)
 require(plotly)
 # the field proportions
 x_start <- c(0,0, lengthPitch, lengthPitch, 16.5, lengthPitch-16.5,
             0,0,lengthPitch, lengthPitch, 5.5, lengthPitch-5.5,
             -2,-2,lengthPitch+2, lengthPitch+2, -2, lengthPitch+2)
 x_end <- c(16.5, 16.5, lengthPitch-16.5, lengthPitch-16.5, 16.5,lengthPitch-16.5,
           5.5, 5.5, lengthPitch-5.5, lengthPitch-5.5, 5.5,lengthPitch-5.5,
           0, 0, lengthPitch, lengthPitch, -2,lengthPitch+2)
 y_start <- c(rep(c(widthPitch/2 - 20.16, widthPitch/2 + 20.16),3),
             rep(c(widthPitch/2 - 9.16, widthPitch/2 + 9.16),3),
             rep(c(widthPitch/2 - 3.66, widthPitch/2 + 3.66),3))
 y_end <- c(rep(c(widthPitch/2 - 20.16, widthPitch/2 + 20.16),2), widthPitch/2 + 20.16,widthPitch/2 - 20.16,
           rep(c(widthPitch/2 - 9.16, widthPitch/2 + 9.16),2), widthPitch/2 + 9.16,widthPitch/2 - 9.16,
           rep(c(widthPitch/2 - 3.66, widthPitch/2 + 3.66),2), widthPitch/2 + 3.66,widthPitch/2 - 3.66)
 areas <- data.frame(x_start, x_end,y_start,y_end)
 points <- data.frame(x=c(lengthPitch/2, 11, lengthPitch-11),
                     y=widthPitch/2)
# the plot
 p <- ggplot(data) +
    geom_point(aes(x, y, color=factor(Player), frame = time), show.legend = F) + 
    xlim(-4,lengthPitch+4)+ylim(-4,widthPitch+4)+
    geom_rect(aes(xmin = 0, xmax = lengthPitch, 
                ymin = 0, ymax = widthPitch), fill = NA, col = colPitch, 
            lwd = lwd, inherit.aes = F)+
    geom_segment(aes(x = lengthPitch/2, y = 0, xend = lengthPitch/2, yend = widthPitch), col = colPitch,lwd = lwd)+
    geom_segment(data = areas,aes(x=x_start, xend=x_end, y=y_start,yend=y_end),inherit.aes = F, color=colPitch,lwd = lwd)+
    geom_point(data=points, aes(x, y),size=c(2,0.8,0.8), col=colPitch, inherit.aes = F) +
    theme(panel.background = element_rect(fill="#328422"),panel.grid = element_line(color="red"),
        rect = element_blank(), line = element_blank(), 
        axis.title = element_blank(), axis.text = element_blank())
  ggplotly(p)
}

my_soccer_field(d) 

Наконец-то я бы переключился на блестящее приложение.Скопируйте и вставьте весь код в RStudio и нажмите Play.Данные называются d и должны быть предварительно загружены в сеанс.

library(shiny)
require(ggplot2)
# UI definition
ui <- fluidPage(

   # Application title
   titlePanel("My Football Player"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
         selectInput("colPitch", "Color of the pith", selected = "white", choices = colors()),
         numericInput("lengthPitch", "length of the pitch", min = 60, max=120, value = 100),
         numericInput("widthPitch", "width of the pitch", min = 50, max=90, value = 75),
         sliderInput("time","Time",min =min(d$time),max = max(d$time),value = min(d$time),step = 1,animate = T)
      ),

      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("Pitch")
      )
   )
)

# Server definition
server <- function(input, output) {

  areas <- reactive({
     req(input$lengthPitch)
     req(input$widthPitch)
     lengthPitch <- input$lengthPitch
     widthPitch <- input$widthPitch

     x_start <- c(0,0, lengthPitch, lengthPitch, 16.5, lengthPitch-16.5,
                  0,0,lengthPitch, lengthPitch, 5.5, lengthPitch-5.5,
                  -2,-2,lengthPitch+2, lengthPitch+2, -2, lengthPitch+2)
     x_end <- c(16.5, 16.5, lengthPitch-16.5, lengthPitch-16.5, 16.5,lengthPitch-16.5,
                5.5, 5.5, lengthPitch-5.5, lengthPitch-5.5, 5.5,lengthPitch-5.5,
                0, 0, lengthPitch, lengthPitch, -2,lengthPitch+2)
     y_start <- c(rep(c(widthPitch/2 - 20.16, widthPitch/2 + 20.16),3),
                  rep(c(widthPitch/2 - 9.16, widthPitch/2 + 9.16),3),
                  rep(c(widthPitch/2 - 3.66, widthPitch/2 + 3.66),3))
     y_end <- c(rep(c(widthPitch/2 - 20.16, widthPitch/2 + 20.16),2), widthPitch/2 + 20.16,widthPitch/2 - 20.16,
                rep(c(widthPitch/2 - 9.16, widthPitch/2 + 9.16),2), widthPitch/2 + 9.16,widthPitch/2 - 9.16,
                rep(c(widthPitch/2 - 3.66, widthPitch/2 + 3.66),2), widthPitch/2 + 3.66,widthPitch/2 - 3.66)
     data.frame(x_start, x_end,y_start,y_end)
   })

  points <- reactive({ 
    req(input$lengthPitch)
    req(input$widthPitch)
    lengthPitch <- input$lengthPitch
    widthPitch <- input$widthPitch
    data.frame(x=c(lengthPitch/2, 11, lengthPitch-11),
                        y=widthPitch/2)
  })


   output$Pitch <- renderPlot({
     req(input$lengthPitch)
     req(input$widthPitch)
      lengthPitch <- input$lengthPitch
      widthPitch <- input$widthPitch
      lwd <- 0.2

     ggplot(d) +
       geom_point(data = . %>% filter(time ==  input$time), aes(x, y, color=factor(Player)), show.legend = F) + 
       xlim(-4,lengthPitch+4)+ylim(-4,widthPitch+4)+
       geom_rect(aes(xmin = 0, xmax = lengthPitch, 
                     ymin = 0, ymax = widthPitch), fill = NA, col = input$colPitch, 
                 lwd = lwd, inherit.aes = F)+
       geom_segment(aes(x = lengthPitch/2, y = 0, xend = lengthPitch/2, yend = widthPitch), col = input$colPitch,lwd = lwd)+
       geom_segment(data = areas(),aes(x=x_start, xend=x_end, y=y_start,yend=y_end),inherit.aes = F, color=input$colPitch,lwd = lwd)+
       geom_point(data=points(), aes(x, y),size=c(2,0.8,0.8), col=input$colPitch, inherit.aes = F) +
       theme(panel.background = element_rect(fill="#328422"),panel.grid = element_blank(),
             rect = element_blank(), line = element_blank(), 
             axis.title = element_blank(), axis.text = element_blank())
   })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 2

df <- read.table(text="Player time    x    y
1       1   69 53.0 43.6
2       1   70 54.0 43.6
3       1   71 55.5 43.6
4       1   72 56.5 44.6
5       1   73 58.7 45.6
6       2   69 32.3 12.7
7       2   70 34.2 14.4
8       2   71 34.6 14.0
9       2   72 35.5 14.4
10      2   73 36.4 14.6", header = T)

library(ggplot2)

ggplot( data = df, 
        aes( x = x, 
             y = y, 
             group = as.factor(Player), 
             colour = as.factor(Player) )
        ) + 
  geom_point() +
  #set dimensions football-field
  scale_x_continuous( limits = c(0,100), breaks = seq(0,100,10), labels = seq(0,100,10), expand = c(0,0) ) +
  scale_y_continuous( limits = c(0,50), breaks = seq(0,50,by = 10), labels = seq(0,50, by = 10), expand = c(0,0) )