Kami terus menganalisis data bola basket menggunakan R.
Berbeda dengan artikel sebelumnya, yang benar-benar menghibur, grafik yang akan dibangun dalam artikel ini mungkin menarik dari sudut pandang menganalisis permainan tim musim ini.
Dan kami akan membuat grafik rata-rata bergerak untuk tiga jenis peringkat tim NBA: menyerang, defensif, dan net-rating (yaitu perbedaan antara dua yang pertama). Singkatnya tentang mereka. Peringkat menyerang dan bertahan adalah jumlah poin yang dicetak / dilewatkan oleh tim untuk 100 harta. Peringkat NET - ini adalah perbedaan mereka untuk seratus harta. Siapa pun yang tertarik untuk mempelajari lebih lanjut tentang mereka dapat membaca glosarium tentang referensi basket . Ada rumus perhitungan, yang juga saya terapkan menggunakan R, tapi saya belum menerbitkan artikel tentang itu.
Saya juga akan menjelaskan mengapa saya akan membuat grafik moving average. Dalam setiap pertandingan individu, proporsi keacakan terlalu tinggi, indikator melompat dari 70 hingga 150, yang membuat analisis data tidak berguna, dan grafik itu sendiri lebih mirip kardiogram. Jika kita mengambil rata-rata kumulatif, maka kita mendapatkan ekstrem lain: jadwalnya mirip dengan fluktuasi teredam, dan permainan di akhir musim, ketika mereka ditambahkan ke yang sudah diadakan 70-75 pertandingan, praktis tidak mempengaruhi indikator keseluruhan. Secara kasar, mereka "tidak terlihat." Rata-rata bergerak dalam kasus ini adalah jalan keluar dari jalan buntu. Di satu sisi, pengaruh kesempatan berkurang, di sisi lain, tidak ada akumulasi hasil yang berlebihan. Dalam statistik bola basket, mereka biasanya melakukan rata-rata bergerak 10 pertandingan.
Perpustakaan digunakan
library(httr) library(jsonlite) library(tidyverse) library(lubridate) library(zoo) library(ggthemes) library(gganimate)
Mengambil Data Menggunakan API NBA
Terakhir kali, saya mengambil data menggunakan ekstensi NBA Data Retriever . Kali ini saya akan menggunakan NBA API untuk secara langsung memuat data yang diperlukan ke dalam R.
Pertama, kami mencari tahu dari mana mendapatkan data ini. Untuk melakukan ini, buka halaman yang kami butuhkan di stats.nba.com dan buka alat pengembang. Kemudian buka Network -> XHR dan tekan F5. Dalam daftar yang muncul, kami menemukan file dengan nama yang mirip dengan nama halaman. Kami membutuhkannya. Setelah memastikan bahwa Anda telah memilih file yang benar, salin alamatnya di R. Dalam gambar itu terlihat seperti ini.
buka file yang diinginkan
file akan terlihat seperti ini
salin ke alamat R.
Sekarang mari kita mulai bekerja di R Studio . Untuk mendapatkan informasi yang kami butuhkan, kami menggunakan fungsi GET dari paket http . Namun, agar permintaan dieksekusi dengan benar (ini dapat diperiksa oleh fungsi status_code , harus 200), Anda perlu menambahkan header untuk menentukan parameter kerja dari transaksi HTTP
##Adding headers request_headers <- c( "accept-encoding" = "gzip, deflate, sdch", "accept-language" = "en-US,en;q=0.8", "cache-control" = "no-cache", "connection" = "keep-alive", "host" = "stats.nba.com", "pragma" = "no-cache", "upgrade-insecure-requests" = "1", "user-agent" = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_11_2) AppleWebKit/601.3.9 (KHTML, like Gecko) Version/9.0.2 Safari/601.3.9" ) #Getting a response request <- GET(adv_box_team, add_headers(request_headers))
Kami mendapat jawaban seperti ini:
Tetapi sementara data yang kita butuhkan tidak terlihat. Untuk mendapatkannya, pertama-tama kita mengekstrak content permintaan dengan content fungsi ke file json, dan kemudian mengonversinya menjadi daftar dengan fungsi dari paket jsonlite dengan nama pembicaraan fromJSON
boxscore_data <- fromJSON(content(request, as = "text"))
Akibatnya, kami mendapatkan daftar yang sudah berisi semua informasi yang kami butuhkan dan kemudian kami membawanya ke dalam formulir yang diperlukan untuk pekerjaan.
Persiapan data
Untuk melakukan ini, buat tabel data alih-alih daftar, lalu tambahkan tajuk kolom.
#Convert to tibble data and assigning column names table <- tbl_df(data.frame(boxscore_data$resultSets$rowSet[[1]], stringsAsFactors = FALSE)) names(table) <- toupper(boxscore_data$resultSets$headers[[1]])
toupper adalah fungsi yang menggantikan semua karakter dengan huruf besar. Setelah itu, kita akan mendapatkan tabel dengan 2460 baris dan 46 kolom. Pada prinsipnya, Anda dapat bekerja dengan tabel dalam formulir ini, tetapi lebih baik untuk mengecualikan informasi yang tidak perlu, untuk pekerjaan yang lebih nyaman dan cepat.
##Select the columns you want to analyze rating <- table %>% select(TEAM_ID, TEAM_ABBREVIATION, TEAM_NAME, GAME_ID, GAME_DATE, MATCHUP, WL, E_OFF_RATING, E_DEF_RATING, E_NET_RATING)
Jika Anda melihat tabel sumber, Anda dapat melihat dua jenis peringkat yang sama: "normal" dan dengan awalan E. Tanpa masuk ke detail, E-rating memperhitungkan kecepatan permainan, oleh karena itu lebih akurat. Kami mengambilnya.
Selanjutnya, saya ingin menyederhanakan nama-nama peringkat. Mereka perlu dimasukkan ke dalam argumen fungsi dan lebih baik menggunakan notasi yang lebih akrab bagi berbagai pengguna: ORTG, DRTG, NRTG. Di sini Anda bisa "bingung" dengan menulis ekspresi reguler dan mengganti dengan str_replace , tetapi menulisnya masih menyenangkan dan di sini kita bisa melakukannya tanpa mereka dengan sempurna. Kita hanya perlu mengekstrak 3, 7, 9 dan 12 karakter dari nama saat ini, menggabungkannya dan mengganti nama kolom dengan vektor karakter yang dihasilkan. Semua ini dilakukan dengan menggunakan fungsi-fungsi dari paket str_sub : str_sub dan str_c (analog dari paste0 ).
## Renaming columns with E_OFF_RATING on ORTG rating1 <- rating %>% rename_at(vars(starts_with("E_")), list(~str_c(str_sub(., start = 3, end = 3), str_sub(., start = 7, end = 7), str_sub(., start = 9, end = 9), str_sub(., start = 12, end = 12))))
di dalam fungsi paket, dplyr memiliki properti yang sama dengan dt[, lapply(.SD, func), .SDols = col1] dalam paket data.table : aksi diterapkan ke beberapa kolom pada saat yang bersamaan. Di sini kita memilih semua kolom yang namanya dimulai dengan "E_".
Sebagai hasilnya, kami mendapatkan tabel seperti itu, yang dengannya kami akan terus bekerja dengan:
Fungsi rolling_offnet_rating_nba untuk merencanakan dan menghidupkan rata-rata bergerak.
Sekali lagi, seperti yang terakhir kali, mari kita buat fungsi untuk membuat perubahan minimal dalam perhitungan.
Fungsi rolling_offnet_rating_nba seperti ini:
rolling_offnet_rating_nba <- function(table, name, variable, col1 = col1, col2 = col2)
tabel adalah nama tabel data,
name - singkatan dari tim yang grafiknya akan dibuat ("BOS", "LAL", dll.).
variabel - peringkat yang akan dihitung (di sini ada dua opsi, ORTG atau NRTG, untuk peringkat pelindung saya membuat fungsi terpisah)
col1 dan col2 - warna garis pada nilai di atas / di bawah rata-rata.
Sebagian besar fungsi dplyr menggunakan evaluasi non-standar (NSE ). Ini adalah istilah umum yang berarti bahwa penilaian mereka berbeda dari penilaian biasa di R. Ini memungkinkan kami untuk menyederhanakan penulisan kode dan bekerja dengan database SQL, tetapi minusnya adalah bahwa kami tidak dapat mengganti nilai dengan objek setara yang didefinisikan di tempat lain.
Dplyr menggunakan evaluasi Tidy . Oleh karena itu, perlu untuk menggunakan alat khusus (fungsi kutipan, operator !!) untuk menyelesaikan masalah yang dihadapi selama pemrograman. Anda dapat membaca lebih lanjut tentang ini di sini , dan lihat di sini .
Kode berikut mengambil nama argumen fungsi dan menulis ekspresi yang disajikan kepadanya. (Untuk memahami bagaimana enquo dan sejenisnya, berguna untuk mencetak output dari fungsi ini)
##Return the entered value in the function argument in the type quosure quo_rating <- enquo(variable) quo_col1 <- enquo(col1) quo_col2 <- enquo(col2)
Selanjutnya, kami mengubah format data dari beberapa kolom: kami membuat GAME_DATE karakter menjadi kolom dalam format Tanggal, dan kami membuat kolom rating numerik. Karena kita menerapkan fungsi as.numeric ke tiga kolom, kemudian mutate_at digunakan alih-alih mutate . Dan kami mengurutkan semuanya dalam urutan tanggal yang naik.
##Changing the data type of multiple columns test1 <- table %>% mutate(GAME_DATE = as.Date(ymd_hms(GAME_DATE))) %>% mutate_at(vars(ORTG:NRTG), list(~as.numeric)) %>% arrange(GAME_DATE)
Dan kemudian kita menghitung rata-rata bergerak 10 pertandingan dari tim yang kita butuhkan. Untuk melakukan ini, gunakan fungsi rollmeanr dari paket zoo . r pada akhir nama berarti bahwa hasilnya harus lurus. Untuk sembilan pertandingan pertama musim ini, rata-rata bergerak 10 pertandingan sama sekali tidak mungkin untuk dihitung, jadi kami membiarkan bidang ini tidak berubah dengan mengisinya dalam NA menggunakan argumen fill. na.omit menghapus dari tabel baris di mana NA ini terjadi.
##The calculation of the moving average team <- test1 %>% filter(TEAM_ABBREVIATION == "DAL") %>% mutate(RATING = rollmeanr(ORTG, k = 10, fill= NA)) %>% na.omit(test1)
Tabel tim terlihat seperti ini:
Pada prinsipnya, kami telah menerima informasi yang kami butuhkan. Dengan menggunakan dua baris kode, Anda dapat membuat grafik garis. Tetapi garis hitam pada latar belakang putih tidak begitu menarik dari sudut pandang estetika dan informatif. Bagian selanjutnya dari "tubuh fungsi" mengoreksi ini.
Untuk mulai dengan, kami menambahkan data pada nilai rata-rata, 10 dan 21 (kesepuluh dari bawah), serta tanggal 10 pertandingan tim (mis., Yang pertama yang dihitung rata-rata bergeraknya dan yang tersisa di tabel tim setelah menghapus garis dari NA) .
##The average, 10 and 21 ratings in the entire League. average <- league %>% mutate(average = mean(!! quo_rating)) %>% select(average) %>% unique() %>% .$average top10 <- league %>% arrange(desc(!! quo_rating)) %>% select(!! quo_rating) %>% slice(10) top10 <- top10[[1]] bottom10 <- league %>% arrange(desc(!! quo_rating)) %>% select(!! quo_rating) %>% slice(21) bottom10 <- bottom10[[1]] ##Getting the date of the first rollaverage data <- team %>% select(GAME_DATE) %>% arrange(GAME_DATE) data <- data[[1,1]]
Dari fungsi yang sebelumnya tidak digunakan, fungsi slice muncul di sini, yang memilih baris dengan nomor seri mereka.
Selanjutnya, kami memilih 2 warna dan namanya. Data, seperti terakhir kali, table_color dari table_color tabel. Nama akan digunakan dalam judul bagan untuk menjelaskan warna mana yang sesuai dengan nilai di bawah rata-rata, dan mana yang lebih tinggi.
##Getting color and color_name selected color color1 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(!! quo_col1) color1 <- color1[[1]] color2 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(!! quo_col2) color2 <- color2[[1]] name1 <- paste0("name_", quo_name(quo_col1)) name2 <- paste0("name_", quo_name(quo_col2)) name_color1 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(name1) name_color1 <- name_color1[[1]] name_color2 <- table_color %>% filter(TEAM_ABBREVIATION == name) %>% select(name2) name_color2 <- name_color2[[1]]
Argumen fungsi default ke col1 dan col2, ini adalah warna pertama dan kedua dari perintah. Dalam kebanyakan kasus (lebih tepatnya dalam 26), nilai-nilai ini tidak perlu diubah, namun, untuk empat tim, warna berikut harus digunakan dalam palet warna mereka. Di Dallas dan Minnesota, warna pertama dan kedua terlalu mirip, sedangkan di Milwaukee dan Brooklyn mereka tidak terlihat pada latar belakang putih. Baik itu, dan yang lain menyulitkan pembacaan jadwal karena itu layak menggunakan argumen col2 = col3 untuk mereka.
Selanjutnya kita mendapatkan peringkat maksimum untuk tim. Kami akan membutuhkan nilai ini untuk mengatur teks dengan nilai peringkat pada grafik. Saya ingin memperhatikan baris kode terakhir. Kebetulan bahwa fungsi sempurna merencanakan grafik di 89 dari 90 kasus, tetapi ketika membangun peringkat pelindung, Milwaukee memberikan kesalahan. Ternyata nilai nilai maksimum di Milwaukee dicapai dua kali dan ggplot2 secara alami mulai bersumpah bahwa estetika seharusnya, dalam kasus kami, baik 1 atau 73. Oleh karena itu, kami memerlukan nilai peringkat maksimum tunggal.
##The maximum value of the rating max <- team %>% filter(RATING == max(RATING)) %>% select(RATING) max <- max[[1]]
Membangun grafik statis di ggplot2
##Building and save a static chart Sys.setlocale("LC_ALL", "C") gg <- ggplot(team, aes(GAME_DATE, RATING)) + geom_hline(yintercept = c(top10, bottom10), col = c("red", "blue")) + annotate(geom = "text", x = as.Date(data) + 2, y = top10 - 0.2, label = "TOP 10", col = "red") + annotate(geom = "text", x = as.Date(data) + 2, y = bottom10 + 0.2, label = "BOTTOM 10", col = "blue") + geom_line(size = 2, col = if_else(team$RATING > average, color1, color2)) + theme_tufte() + labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling ", quo_name(quo_rating)), subtitle = paste0(paste0(name_color1, " - above average ", quo_name(quo_rating)), "\n", paste0(name_color2, " - below average ", quo_name(quo_rating))), caption = "Source: BBall Index Data & Tools\nTelegram: @NBAatlantic, twitter: @vshufinskiy") theme(plot.title = element_text(size = 12, hjust = 0.5), plot.caption = element_text(size = 10), plot.subtitle = element_text(size = 9)) ggsave(paste0(unique(team$TEAM_NAME), quo_name(quo_rating), ".jpeg"), gg, width = 8, units = "in")
Dari yang baru di sini, penggunaan fungsi if_else untuk mengubah warna garis tergantung pada apakah peringkat rata-rata Liga lebih tinggi atau lebih rendah, serta baris pertama yang mengubah lokal. Ini dilakukan agar singkatan untuk nama bulan di sepanjang sumbu X ditulis dalam bahasa Inggris.
Animasi rata-rata bergerak 10 pertandingan.
Dalam pembuatan animasi, saya menambahkan beberapa lotion yang tidak mungkin pada versi statis. Pertama, tanggal perubahan (mirip dengan bagaimana tahun berubah di artikel terakhir), serta nilai peringkat pada titik waktu tertentu. Itu juga berubah warna tergantung pada apakah itu di atas atau di bawah rata-rata.
##Building animations anim <- gg + theme(plot.title = element_text(hjust = 0.5, size = 25), plot.subtitle = element_text(size = 15), plot.caption = element_text(size = 15), axis.text = element_text(size = 15), axis.title = element_text(size = 18)) + geom_text(aes(x = as.Date(data), y = max + 0.5), label = paste0(quo_name(quo_rating)," ", round(team$RATING, digits = 1)), size = 6, col = if_else(team$RATING > average, color1, color2)) + transition_reveal(GAME_DATE) + labs(title = paste0(team$TEAM_NAME, " 10-Game Rolling ", quo_name(quo_rating)), subtitle = paste0(paste0(name_color1, " - above average ",quo_name(quo_rating)), "\n", paste0(name_color2, " - below average ",quo_name(quo_rating)), "\n", "Date: {frame_along}"), caption = paste0("Source: stats.nba.com\nTelegram: @NBAatlantic, twitter: @vshufinskiy"))
Hasil
Pada grafik, sangat jelas bahwa Dallas merosot di paruh kedua Februari-Maret. Penjelasan untuk ini sangat sederhana: pada titik ini di musim itulah Mavericks bertukar 4 dari 5 pemain dalam lima awal mereka, dan aset masuk utama, Latvian Kristaps Porzingis, tidak bermain selama satu menit karena pecahnya ligamen berhamburan.
Di sini saya tidak akan menyelidiki komponen olahraga, jadi jika ada yang tertarik untuk melihat 89 grafik yang tersisa dari musim 2018-19, maka Anda dipersilakan untuk blog saya di sports.ru , di mana saya berencana untuk menulis artikel dengan ikhtisar yang paling menarik dari mereka atau di Telegram saya saluran tentang NBA, di mana saya akan memposting semuanya.
Repositori GitHub