Pertama, beberapa informasi latar belakang. Nama saya Vladislav dan kenalan saya dengan R terjadi pada Agustus tahun lalu. Saya memutuskan untuk belajar bahasa pemrograman karena sifat terapannya. Sejak kecil, saya suka menyimpan statistik olahraga. Dengan bertambahnya usia, hobi ini berubah menjadi keinginan untuk entah bagaimana menganalisis angka-angka ini dan, berdasarkan analisis data, memberikan, jika mungkin, pikiran cerdas. Masalahnya adalah bahwa dalam beberapa tahun terakhir, olahraga telah tersapu oleh gelombang data, puluhan perusahaan bersaing di antara mereka sendiri, mencoba untuk menghitung, menggambarkan, dan mendorong ke neuron setiap tindakan pemain sepak bola, pemain bola basket, pemain baseball di lapangan. Dan Excel tidak cocok untuk analisis. Jadi saya memutuskan untuk belajar R sehingga analisis yang paling sederhana tidak akan memakan waktu setengah hari. Sudah dalam perjalanan studi, minat dalam pemrograman seperti itu telah ditambahkan, tetapi ini sudah lirik.
Saya ingin segera memperhatikan bahwa banyak dari apa yang akan saya tulis di masa depan sudah ada di simpsons ada di Habr dalam artikel Kami membuat histogram animasi menggunakan R. Artikel ini, pada gilirannya, adalah terjemahan dari artikel Buat Trending Animated Bar Charts menggunakan R dari Medium. Oleh karena itu, agar berbeda dari artikel di atas, saya akan mencoba untuk lebih lengkap menggambarkan apa yang saya lakukan, serta momen-momen yang tidak ada dalam artikel asli. Sebagai contoh, untuk mengisi kolom, saya menggunakan warna dari perintah NBA, bukan palet ggplot2
standar, tetapi dalam data yang memproses paket data.table
, bukan dplyr
. Saya telah melakukan semua pekerjaan ini sebagai fungsi, jadi sekarang cukup menulis nama tim dan tahun-tahun di mana Anda perlu menghitung jumlah kemenangan.
Data
Untuk membangun jadwal, saya menggunakan data tentang jumlah kemenangan untuk masing-masing dari 30 tim NBA dalam 15 musim terakhir. Mereka dikumpulkan dari stats.nba.com menggunakan ekstensi NBA Data Retriever , yang, melalui penggunaan NBA API, menghasilkan file csv dengan statistik yang diperlukan. Berikut ini rincian lengkap dari proyek saya di Github .
Perpustakaan digunakan
library(data.table) library(tidyverse) library(gganimate)
Untuk pemrosesan data, saya menggunakan data.table
(hanya karena saya telah memenuhi paket ini sebelumnya). Saya juga mengunduh satu set paket yang tidyverse
, dan bukan ggplot2
terpisah sehingga tidak perlu khawatir, jika selama analisis beberapa ide muncul yang memerlukan pemuatan tambahan paket dari set ini. Dalam kasus khusus ini, ggplot2
dapat ditiadakan, paket set lainnya tidak terlibat. Nah, gganimate
membuat grafik bergerak.
Bekerja dengan data
Pertama, Anda perlu mengatur data. Pada dasarnya, untuk membuat grafik, kita membutuhkan 2 dari 79 kolom tabel dengan data mentah. Anda dapat memilih kolom yang diperlukan terlebih dahulu, Anda dapat mengganti beberapa nilai terlebih dahulu. Saya pergi ke jalan kedua.
Tabel di data.table
memiliki bentuk dt[i, j, by]
, di mana oleh "bertanggung jawab" untuk pengelompokan elemen. Saya akan mengelompokkan berdasarkan kolom TeamName. Dan ada halangan. Kolom ini menampilkan nama-nama tim: Lakers, Celtics, Heat, dll. Tetapi selama periode yang ditinjau (dari musim 2004/05) beberapa tim mengubah nama mereka: New Orleans Hornets menjadi New Orleans Pelicans, Charlotte Bobcats mengembalikan nama historis Charlotte Hornets, dan Seattle Supersonics menjadi Oklahoma City Thunder. Ini dapat menyebabkan kebingungan. Konversi berikut membantu menghindari ini:
table1 <- table[TeamCity == "New Orleans" & TeamName == "Hornets", TeamName := "Pelicans"][ TeamCity == "New Orleans/Oklahoma City" & TeamName == "Hornets", TeamName := "Pelicans"][ TeamName == "Bobcats", TeamName := "Hornets"][ TeamName == "SuperSonics", TeamName := "Thunder"]
Untuk periode ini, perubahannya minimal, tetapi jika Anda mengembangkannya, akan sangat sulit untuk dikelompokkan berdasarkan TeamName dan Anda harus menggunakan kolom yang lebih dapat diandalkan. Dalam data ini, ini adalah TeamID.
Untuk memulai, kami menyingkirkan informasi "ekstra", hanya menyisakan kolom yang kami perlukan untuk bekerja:
table1 <- table1[ , .(TeamName, WINS)]
Dalam data.table
the. () Membangun menggantikan fungsi list
. Opsi yang lebih "klasik" untuk memilih kolom adalah table1 <- table1[, c("TeamName", "WINS")]
. Setelah itu, tabel mengambil bentuk berikut:
Untuk animasi untuk setiap musim secara terpisah, ini sudah cukup, tetapi untuk menghitung jumlah total kemenangan untuk periode yang dipilih, Anda perlu menghitung total kemenangan kumulatif.
table1 <- table1[, CumWins := cumsum(WINS), by = "TeamName"]
Menggunakan fungsi cumsum
kita mendapatkan angka yang kita butuhkan. Menggunakan: = bukannya = memungkinkan Anda menambahkan kolom baru ke tabel; Saya tidak menimpanya dengan kolom CumWins yang sama. by = "TeamName"
mengelompokkan data berdasarkan nama tim dan jumlah kumulatif by = "TeamName"
untuk masing-masing dari 30 tim secara terpisah.
Selanjutnya, saya menambahkan kolom dengan tahun ketika setiap musim dimulai. Musim NBA berlangsung dari Oktober hingga Mei, sehingga jatuh ke dalam dua tahun kalender. Dalam penunjukan musim, tahun dimulainya, mis. Musim: 2018 pada grafik adalah musim 2018/19 pada kenyataannya.
Tabel asli memiliki data ini. Kolom SeasonID menunjukkan angka dalam bentuk 2 (tahun dimulainya musim), misalnya, 22004. Anda dapat menghapus dua yang pertama menggunakan paket stringr
atau fungsi R dasar, tetapi saya menggunakan cara yang sedikit berbeda. Ternyata saya pertama kali menggunakan kolom ini untuk menunjukkan musim yang diperlukan, lalu hapus dan buat kolom dengan tanggal lagi. Tindakan ekstra.
Saya melakukannya sebagai berikut:
table1 <- table1[,year := rep(seq(2004, 2018), each = length(unique(table1$TeamName)))]
Saya โberuntungโ bahwa untuk periode waktu yang dipilih jumlah tim di NBA tidak berubah, jadi saya hanya mengulangi angka dari 2004 hingga 2018 sebanyak 30 kali. Sekali lagi, jika Anda mencatat dalam sejarah, maka metode ini akan merepotkan karena fakta bahwa jumlah tim di setiap musim akan berbeda, sehingga lebih baik menggunakan opsi dengan menghapus kolom SeasonID.
Kemudian tambahkan kolom cumrank.
table1 <- table1[, cumrank := frank(-CumWins, ties.method = "random"), by = "year"]
Ini mewakili peringkat tim di setiap musim dengan jumlah kemenangan dan akan digunakan sebagai nilai dari sumbu X. frank
yang lebih cepat. data.table
analog dari rank
dasar, minus berarti peringkat dalam urutan menurun (ini juga dapat dilakukan dengan menggunakan argumen decreasing = TRUE
. apa urutan tim dengan jumlah kemenangan yang sama akan pergi, oleh karena itu ties.method = "random"
. ties.method = "random"
Nah, semua ini dikelompokkan dalam satu tahun.
Dan konversi tabel terakhir adalah menambahkan kolom value_rel
.
table1 <- table1[, value_rel := CumWins/CumWins[cumrank==1], by = "year"]
Kolom ini mempertimbangkan rasio jumlah kemenangan masing-masing tim dengan indikator tertinggi untuk tahun tersebut. Untuk tim terbaik, indikator ini adalah 1, sisanya kurang, tergantung pada keberhasilan musim.
Setelah semua penambahan, tabel memiliki bentuk berikut:
Hanya satu tim yang disajikan dalam tabel untuk menggambarkan kumulativeness. Semua tindakan ini dilakukan, seperti dalam perubahan nama, dengan rangkai tanda kurung
table1 <- table1[ ,.(TeamName, WINS)][ , CumWins := cumsum(WINS), by = "TeamName"][ ,year := rep(seq(2004, 2018), each = length(unique(table1$TeamName)))][ , cumrank := frank(-CumWins, ties.method = "random"), by = "year"][ , value_rel := CumWins/CumWins[cumrank==1], by = "year"]
Ubah isian kolom dari standar ke warna tim.
Anda dapat langsung melanjutkan ke pembuatan grafik, tetapi menurut saya ada satu poin penting: warna kolom dalam grafik. Anda dapat meninggalkan palet ggplot2
standar, tetapi ini adalah opsi yang buruk. Pertama, menurut saya dia jelek. Dan kedua, sulit untuk menemukan tim di grafik. Untuk penggemar NBA, setiap tim dikaitkan dengan warna tertentu: Boston adalah hijau, Chicago adalah merah, Sacramento adalah ungu, dll. Oleh karena itu, menggunakan warna perintah di kolom isian membantu mengidentifikasinya dengan lebih cepat, meskipun terdapat banyak warna biru dan merah.
Untuk melakukan ini, buat table_color
table dengan nama perintah dan warna utamanya. Warna diambil dari teamcolorcodes.com .
Dengan tabel warna, Anda perlu melakukan satu manipulasi lagi. Karena ketika merencanakan faktor digunakan, maka urutan tim berubah. Yang pertama dalam daftar adalah Philadelphia 76, sebagai satu-satunya pemilik nama "digital", dan kemudian sesuai dengan alfabet. Jadi kita perlu mengatur warna dalam urutan yang sama, dan kemudian mengekstrak vektor yang mengandungnya dari tabel. Saya melakukannya sebagai berikut:
table_color <- table_color[order(TeamName)] cols <- table_color[, "TEAM_color"]
Merencanakan
Kami benar-benar membangun hanya satu bagan, yang berisi semua 450 (15 musim * 30 tim) indikator kemenangan, dan kemudian "membaginya" dengan variabel yang diperlukan (dalam kasus kami, berdasarkan tahun) menggunakan fungsi dari paket gganimate
.
gg <- ggplot(table1, aes(cumrank, group = TeamName, fill = as.factor(TeamName), color = as.factor(TeamName))) + geom_tile(aes(y = CumWins/2, height = CumWins, width = 0.7), color = NA, alpha = 0.8)
Pertama, kita membuat grafik menggunakan fungsi ggplot
. Dalam argumen aes
, tentukan bagaimana variabel dari tabel akan ditampilkan pada grafik. Kami mengelompokkannya berdasarkan Nama Tim, fill
, dan color
akan bertanggung jawab atas warna kolom.
Kolom sejati menyebutnya tidak sepenuhnya benar. Menggunakan geom_tile
kami "membagi" data pada bagan menjadi empat persegi panjang. Berikut adalah contoh bagan jenis ini:

Dapat dilihat bagaimana grafik "dibagi" menjadi kotak (mereka diperoleh dari persegi panjang menggunakan layer coord_equal()
), tiga di setiap kolom. Namun berkat width
argumen kurang dari satu, ubin kami mengambil bentuk kolom.
geom_text(aes(y = 0, label = paste(TeamName, " ")), vjust = 0.2, hjust = 1, size = 6) + geom_text(aes(y = CumWins, label = paste0(" ",round(CumWins))), hjust = 0, size = 7) + coord_flip(clip = "off", expand = FALSE) + scale_fill_manual(values = cols) + scale_color_manual(values = cols) + scale_y_continuous(labels = scales::comma) + scale_x_reverse() + guides(color = FALSE, fill = FALSE) +
Selanjutnya, saya menambahkan dua tanda tangan menggunakan geom_text
: nama tim dan jumlah kemenangan. coord_flip
menukar sumbu, scale_fill_manual
dan scale_color_manual
mengubah warna kolom, scale_x_reverse
"memperluas" sumbu X. Perhatikan bahwa kami mengambil warna dari vektor cols
dibuat sebelumnya.
Lapisan theme
menentukan opsi untuk menyesuaikan tampilan grafik. Di sini ditunjukkan bagaimana tajuk dan label sumbu harus ditampilkan (sama sekali tidak apa yang element_blank
katakan pada kita di sisi kanan kesetaraan). Kami menghapus legenda, latar belakang, bingkai, garis-garis kisi di sepanjang sumbu Y. plot.title
argumen plot.title
, plot.subtitle
, plot.caption
, kami menetapkan opsi tampilan untuk judul, subtitle, dan tanda tangan bagan. Untuk detail lebih lanjut tentang arti semua parameter, lihat gglot2
theme(axis.line=element_blank(), axis.text.x=element_blank(), axis.text.y=element_blank(), axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), legend.position="none", panel.background=element_blank(), panel.border=element_blank(), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), panel.grid.major.x = element_line( size=.1, color="grey" ), panel.grid.minor.x = element_line( size=.1, color="grey" ), plot.title=element_text(size=25, hjust=0.5, face="bold", colour="black", vjust=-1), plot.subtitle = element_text(size = 15), plot.caption =element_text(size=15, hjust=0.5, color="black"), plot.background=element_blank(), plot.margin = margin(2,2, 2, 4, "cm"))
Buat animasi
Saya tidak akan berkutat menggunakan fungsi transition_states
, bagian ini identik dengan publikasi saya sebelumnya tentang Habrรฉ. Adapun labs
itu menciptakan judul, subtitle dan tanda tangan dari bagan. Menggunakan {closest_state}
memungkinkan Anda menampilkan setiap tahun tertentu pada bagan, kolom yang saat ini kami lihat.
anim <- gg + transition_states(year, transition_length = 4, state_length = 1) + view_follow(fixed_x = TRUE) + labs(title = "Cumulative Wins by teams in seasons", subtitle = "Season: {closest_state}", caption = "Telegram: @NBAatlantic, Twitter: @vshufiskiy\n Data sourse: stats.nba.com")
nba_cumulative_wins
berfungsi untuk membuat grafik.
Fungsi penulisan menyederhanakan dan mempercepat proses mendapatkan hasil jika Anda perlu menggunakan kode lebih dari sekali. Biasanya, fungsi dalam R memiliki bentuk berikut:
_ <- function( ) { _ }
Pertama, Anda perlu memahami parameter apa yang ingin Anda ubah menggunakan fungsi, argumennya akan tergantung pada ini. Argumen pertama adalah nama tabel data yang sedang diinput. Ini memungkinkan Anda untuk mengganti nama jika keinginan seperti itu muncul, sementara tidak mengubah apa pun dalam fungsi itu sendiri. Saya juga ingin sejumlah perintah ditampilkan di grafik: dari satu (yang tidak ada gunanya) hingga 30 (tidak ada lagi). Saya juga ingin dapat mempertimbangkan periode waktu dalam 15 tahun yang saya miliki datanya. Semua ini diimplementasikan dalam bentuk fungsi ini:
nba_cumulative_wins <- function(table, elements, first_season, last_season){ ... }
di mana table
adalah nama tabel dengan data input,
elements
- nama-nama tim yang harus ditampilkan pada grafik
first_season
- musim pertama yang ditampilkan pada grafik
last_season
- musim terakhir untuk ditampilkan pada grafik.
Jika argumen tersebut sangat sering digunakan dengan nilai tertentu, maka Anda dapat mengaturnya secara default. Kemudian, jika dihilangkan di antara argumen fungsi, maka nilai ini akan diganti. Misalnya, jika Anda mendaftar
nba_cumulative_wins <- function(table, elements, first_season, last_season = 2018)
maka jadwal akan dibangun hingga musim 2018/19, kecuali dinyatakan sebaliknya.
Bekerja dengan elements
argumen, first_season
, last_season
Menggunakan argumen elements
, kita dapat menentukan nama tim yang ingin kita lihat pada tabel. Ini sangat nyaman ketika ada 2 atau 3 tim seperti itu, tetapi jika kita ingin menampilkan seluruh liga kita harus menulis elements = c()
dan nama semua 30 tim dalam tanda kurung.
Jadi saya memutuskan untuk "membagi" nilai input untuk argumen elements
ke dalam beberapa grup.
Fungsi nba_cumulative_wins
dapat membuat grafik untuk masing-masing tim, divisi, konferensi, atau NBA secara keseluruhan. Untuk ini, saya menggunakan konstruksi berikut:
select_teams <- unique(table1$TeamName) select_div <- unique(table1$Division) select_conf <- unique(table1$Conference) select_nba <- "NBA" table1 <- if(elements %in% select_teams){ table1[TeamName %in% elements] } else if (elements %in% select_div){ table1[Division %in% elements] } else if(elements %in% select_conf){ table1[Conference %in% elements] } else if(elements == "NBA"){ table1 } else { NULL }
select_
vektor simbolis berisi nama-nama dari semua 30 tim, 6 divisi, 2 konferensi dan NBA, dan fungsi unique
hanya menyisakan satu nama unik, bukan 15 (dengan jumlah tahun dalam data).
Kemudian, dengan menggunakan if...else
, argumen elements
dimasukkan diverifikasi milik salah satu kelas ( %in%
digunakan untuk menentukan apakah elemen tersebut milik vektor), dan tabel data dimodifikasi sesuai. Sekarang, jika saya ingin melihat hasil tim bermain di Divisi Barat Daya sebagai gantinya
elements = c("Mavericks", "Spurs", "Rockets", "Grillies", "Pelicans")
cukup masukkan
elements = "Southwest"
, yang jauh lebih cepat dan lebih nyaman.
Karena kemungkinan memilih musim, pekerjaan dengan tanggal juga berubah. Pada awalnya, baris ditambahkan:
table1 <- table1[SeasonID >= as.numeric(paste(2, first_season, sep = "")) & SeasonID <= as.numeric(paste(2, last_season, sep = ""))]
Jadi saya tinggalkan tabel hanya baris-baris yang termasuk dalam interval waktu pilihan kami. Kode untuk membuat kolom year
juga berubah. Sekarang terlihat seperti ini:
table1 <- table1[ ,year := rep(seq(first_season, last_season), each = length(unique(table1$TeamName)))]
Sehubungan dengan pengelompokan elemen, prosedur untuk mendapatkan warna yang diinginkan rumit. Faktanya adalah bahwa dalam tabel table_color
hanya nama-nama perintah. Karena itu, kita perlu "mengerahkan" kontraksi kita kembali. Untuk melakukan ini, gunakan konstruksi if...else
lagi.
elements1 <- if (elements == "NBA"){ c("Hawks", "Celtics", "Nets", "Hornets", "Bulls", "Cavaliers", "Mavericks", "Nuggets", "Pistons", "Warriors", "Rockets", "Pacers", "Clippers", "Lakers", "Grizzlies", "Heat", "Bucks", "Timberwolves", "Pelicans", "Knicks", "Thunder", "Magic", "76ers", "Suns", "Trail Blazers","Kings", "Spurs", "Raptors", "Jazz", "Wizards") } else if (elements == "West") { c("Mavericks","Nuggets", "Warriors", "Rockets", "Clippers", "Lakers", "Grizzlies","Timberwolves", "Pelicans", "Thunder", "Suns", "Trail Blazers","Kings", "Spurs", "Jazz") } else if (elements == "East") { c("Hawks", "Celtics", "Nets", "Hornets", "Bulls", "Cavaliers","Pistons", "Pacers", "Heat", "Bucks", "Knicks", "Magic", "76ers", "Raptors", "Wizards") } else if (elements == "Pacific") { c("Warriors", "Clippers", "Lakers", "Suns", "Kings") } else if (elements == "Southeast") { c("Magic", "Hornets", "Heat", "Hawks", "Wizards") } else if (elements == "Southwest") { c("Mavericks", "Grizzlies", "Pelicans", "Rockets", "Spurs") } else if (elements == "Central") { c("Bucks", "Pacers", "Pistons", "Bulls", "Cavaliers") } else if (elements == "Atlantic") { c("Knicks", "Nets", "Celtics", "Raptors", "76ers") } else if (elements == "Northwest") { c("Nuggets", "Trail Blazers", "Jazz", "Thunder", "Suns") } else { elements }
Selanjutnya, buat tabel dengan nama-nama perintah yang kita butuhkan, hubungkan tabel ini ke table_color
menggunakan fungsi inner_join
dari paket dplyr
. inner_join
hanya menyertakan kasus yang cocok di kedua tabel.
table_elements1 <- data.table(TeamName = elements1) table_color <- table_color[order(TeamName)] inner_table_color <- inner_join(table_color, table_elements1) cols <- inner_table_color[, "TEAM_color"]
Fungsi ini mengubah ejaan judul dan subtitle. Mereka mengambil tampilan ini:
anim <- gg + transition_states(year, transition_length = 4, state_length = 1) + view_follow(fixed_x = TRUE) + labs(title = paste("Cumulative Wins by teams in seasons", first_season, "-", last_season, sep = " "), subtitle = paste(if (elements %in% select_div ){ paste(elements, "Division", sep = " ") } else if (elements %in% select_conf ){ paste("Conference", elements, sep = " ") }, "Season: {closest_state}", sep = " "), caption = "Telegram: @NBAatlantic, Twitter: @vshufiskiy\nData sourse: stats.nba.com")
Rendering
Selanjutnya, semua ini divisualisasikan.
animate(anim, nframes = (last_season - first_season + 1) * (length(unique(table1$TeamName)) + 20), fps = 20, width = 1200, height = 1000, renderer = gifski_renderer(paste(elements[1], "cumwins.gif", sep = "_")))
Saya memilih angka dalam nframes
secara empiris, sehingga tergantung pada jumlah perintah yang dipilih, kecepatan bertambah / berkurang.
Grafik

Saya harap posting saya menarik. Kode proyek Github .
Jika Anda tertarik pada komponen olahraga dari visualisasi ini, Anda dapat mengunjungi blog saya di sports.ru "Di kedua sisi Atlantik"