Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 202041

manipulating glue-generated title on my gganimate

$
0
0

I have created a basketball animation using gganimate, as seen below. You can get the full animation on my blog post (Look at animation under "Paul Pierce Isolation").

NBA Animation

Now, there is one problem with this: once the seconds reach single digits, it shows only one digit (7). Its doing what its told to do, but I want it to display (07) so that it closely matches a NBA broadcast.

Example NBA Broadcast

I'm thinking of using transformers from the glue package, but I'm not sure how I'd do that.

Here is my code:

# Function to grab jersey numbers
grab_jersey <- function(player_id) {

  swish_url <- paste0("https://www.swishanalytics.com/nba/players/player?id=", player_id)

  swish <- read_html(swish_url)

  result <- swish %>% 
    html_node(".mobile-hide") %>%
    html_text() %>% 
    # Extract out numeric
    parse_number()

  result
}



## Read in dataset
e.dat_test <- read_csv("https://raw.githubusercontent.com/howardbaek/nba-animation/master/test_df.csv")

# Replace _ent with jersey numbers
a1_ent_jersey <- e.dat_test %>% 
  pull(a1_ent) %>%
  first() %>% 
  grab_jersey()

a2_ent_jersey <- e.dat_test %>% 
  pull(a2_ent) %>%
  first() %>% 
  grab_jersey()

a3_ent_jersey <- e.dat_test %>% 
  pull(a3_ent) %>%
  first() %>% 
  grab_jersey()

a4_ent_jersey <- e.dat_test %>% 
  pull(a4_ent) %>%
  first() %>% 
  grab_jersey()

a5_ent_jersey <- e.dat_test %>% 
  pull(a5_ent) %>%
  first() %>% 
  grab_jersey()

h1_ent_jersey <- e.dat_test %>% 
  pull(h1_ent) %>%
  first() %>% 
  grab_jersey()

h2_ent_jersey <- e.dat_test %>% 
  pull(h2_ent) %>%
  first() %>% 
  grab_jersey()

h3_ent_jersey <- e.dat_test %>% 
  pull(h3_ent) %>%
  first() %>% 
  grab_jersey()

h4_ent_jersey <- e.dat_test %>% 
  pull(h4_ent) %>%
  first() %>% 
  grab_jersey()

h5_ent_jersey <- e.dat_test %>% 
  pull(h5_ent) %>%
  first() %>% 
  grab_jersey()

# Mutate jersey number columns
e.dat_test <- e.dat_test %>% 
  mutate(a1_ent_jersey = a1_ent_jersey,
         a2_ent_jersey = a2_ent_jersey,
         a3_ent_jersey = a3_ent_jersey,
         a4_ent_jersey = a4_ent_jersey,
         a5_ent_jersey = a5_ent_jersey,
         h1_ent_jersey = h1_ent_jersey,
         h2_ent_jersey = h2_ent_jersey,
         h3_ent_jersey = h3_ent_jersey,
         h4_ent_jersey = h4_ent_jersey,
         h5_ent_jersey = h5_ent_jersey) %>% 
  mutate(quarter_processed = case_when(
    quarter == 1 ~ "1ST",
    quarter == 2 ~ "2ND",
    quarter == 3 ~ "3RD",
    quarter == 4 ~ "4TH",
    TRUE ~ "NA"
  )) %>% 
  mutate(game_clock_minutes = game_clock %/% 60) %>% 
  mutate(game_clock_seconds = game_clock %% 60)


possid_quarter <- e.dat_test %>% 
  pull(quarter_processed) %>% 
  first()


# Save animation as object
anim <- fullcourt() +
  # Home Players + Jersey Numbers
  geom_point(data = e.dat_test, aes(x = h1_x, y = h1_y, group = possID), size = 6, color = "lightskyblue1") +  
  geom_text(data = e.dat_test, aes(x = h1_x, y = h1_y, group = possID, label = h1_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = h2_x, y = h2_y, group = possID), size = 6, color = "lightskyblue1") +  
  geom_text(data = e.dat_test, aes(x = h2_x, y = h2_y, group = possID, label = h2_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = h3_x, y = h3_y, group = possID), size = 6, color = "lightskyblue1") +  
  geom_text(data = e.dat_test, aes(x = h3_x, y = h3_y, group = possID, label = h3_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = h4_x, y = h4_y, group = possID), size = 6, color = "lightskyblue1") +  
  geom_text(data = e.dat_test, aes(x = h4_x, y = h4_y, group = possID, label = h4_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = h5_x, y = h5_y, group = possID), size = 6, color = "lightskyblue1") + 
  geom_text(data = e.dat_test, aes(x = h5_x, y = h5_y, group = possID, label = h5_ent_jersey), color = 'black', alpha = 0.3) + 

  # Away Players
  geom_point(data = e.dat_test, aes(x = a1_x, y = a1_y, group = possID), size = 6, color = "salmon1") +  
  geom_text(data = e.dat_test, aes(x = a1_x, y = a1_y, group = possID, label = a1_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = a2_x, y = a2_y, group = possID), size = 6, color = "salmon1") +  
  geom_text(data = e.dat_test, aes(x = a2_x, y = a2_y, group = possID, label = a2_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = a3_x, y = a3_y, group = possID), size = 6, color = "salmon1") +  
  geom_text(data = e.dat_test, aes(x = a3_x, y = a3_y, group = possID, label = a3_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = a4_x, y = a4_y, group = possID), size = 6, color = "salmon1") +  
  geom_text(data = e.dat_test, aes(x = a4_x, y = a4_y, group = possID, label = a4_ent_jersey), color = 'black', alpha = 0.3) + 

  geom_point(data = e.dat_test, aes(x = a5_x, y = a5_y, group = possID), size = 6, color = "salmon1") +  
  geom_text(data = e.dat_test, aes(x = a5_x, y = a5_y, group = possID, label = a5_ent_jersey), color = 'black', alpha = 0.3) + 

  # Ball
  geom_point(data = e.dat_test, aes(x = x, y = y, group = possID), size = 3, color = "gold") +

  transition_time(time = -game_clock) +
  ggtitle(paste0(possid_quarter, "",  "{-frame_time %/% 60}", ":", "{round(-frame_time %% 60, 0)}")) +
  theme(plot.title = element_text(hjust = 0.5))


anim




Viewing all articles
Browse latest Browse all 202041

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>