-
Notifications
You must be signed in to change notification settings - Fork 1
/
dashboard_main.Rmd
155 lines (121 loc) · 5.73 KB
/
dashboard_main.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
---
title: "Hero Stats Dashboard"
author: "Dorio"
date: "March 25, 2019"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
---
```{r setup, include=FALSE}
library(knitr)
library(flexdashboard)
library(jsonlite)
library(data.table)
library(dplyr)
library(tidyr)
library(stringr)
library(stringi)
library(crosstalk)
library(scales)
library(plotly)
root = "https://api.overwatchleague.com"
node = "player"
expand = "stats"
path = paste(paste(root,node,sep = "/"),
ifelse(is.null(expand), NULL,paste0("expand=",expand)),sep="?")
#flatJSON <- fromJSON(path,simplifyDataFrame=T,flatten=T)
#write_json(flatJSON,paste0("player_hero_stats_","2019-03-25",".json"))
flatJSON<-read_json(paste0("player_hero_stats_","2019-03-25",".json"),simplifyDataFrame=T,flatten=T)
tableJSON <- data.table(flatJSON)
### Trasfer dataset to flat and long file #############
get_heroes_stats <- function(x){
if(!is.null(x)) unnest(x,stats) %>% select(-id) %>%
spread(key=name1,value=value,fill=NA)
}
merge_player_info <- function(id){
vars = c("id","name","homeLocation","familyName","givenName","nationality","teams",
"attributes.role","stats.tournament_type","stats.season_id")
get_heroes_stats(tableJSON)
}
tableJSON$row <- 1:nrow(tableJSON)
table_hero <- tableJSON[,rbindlist(stats.heroes, fill = T, id = "row")
][,`:=`(player_name=tableJSON$name[row],hero_row =.I)]
# Get hero stats table
table_hero_stats <- table_hero[,rbindlist(stats, fill = T, id = "hero_row")
][,`:=`(id=NULL,
stats_10m = ifelse(str_detect(name,"_1m"),value*10,value))][]
### Get team info table
table_team <- tableJSON[,rbindlist(teams, fill = T, id = "row")][,player_name:=tableJSON$name[row]]
### Get player name plus hero stats long file
setnames(table_hero,"name","hero_name")
setkey(table_hero,hero_row)
setkey(table_hero_stats,hero_row)
table1 <- table_hero_stats[table_hero,]
### Get hero player info file, uid by player_name
vars <- c("id","player_name","homeLocation","familyName","givenName","nationality","teams",
"attributes.role","stats.tournament_type","stats.season_id")
table2 <- tableJSON[,c("player_name"):=name][,vars,with=F]
### Merge to get player info and hero info long file
setkey(table2,player_name)
setkey(table1,player_name)
table3 <- table1[table2,]
### Merge with team table to get player info, team info, and hero stats long file
table_stats_by_player_hero <- table3[table_team[,.(player_name,team.id,team.name,team.primaryColor,team.abbreviatedName)],]
### Prepare barchart dataset #############
### Default parameters
played_heroes = unique(na.omit(table_stats_by_player_hero$hero_name))
suppor_heroes = c("brigitte","moira","zenyatta","ana","lucio","mercy")
stats_vars = str_subset(unique(table_stats_by_player_hero$name),"_per_1m")
play_time_min = 3600 #seconds
### Plot barchart #############
library(plotly)
library(ggplot2)
library(data.table)
#scale_x_continuous()
hero = "reinhardt"
### filter minimum play time
setkey(table_stats_by_player_hero,player_name,hero_name)
filter_stats <- table_stats_by_player_hero[
table_stats_by_player_hero[name=="time_played_total" & stats_10m>play_time_min, player_name,keyby=.(player_name,hero_name)],
][name %in% stats_vars,]
### calculate player rank for barchart sorting, by stats name
filter_stats <- filter_stats[,rank:=paste(name,sprintf("%03i", frankv(stats_10m,order=-1,ties.method = "first"))),by=name]
setorder(filter_stats,name,rank)
### set up color parameters
table_team_color <- unique(filter_stats[,c("team.abbreviatedName","team.primaryColor")])
color_str <- paste0("#",table_team_color$team.primaryColor)
names(color_str) <-table_team_color$team.abbreviatedName
#ytitle <- stri_trans_totitle(gsub("_"," ",str_remove(stats_var,"_avg_per_1m")))
filter_stats_plot<- filter_stats[,c("id","player_name","team.abbreviatedName","hero_name","rank","name","stats_10m")]
filter_stats_plot$Stats_name_formatted <- paste0(stri_trans_totitle(gsub("_"," ",str_remove(filter_stats_plot$name,"_avg_per_1m"))),"/10 Min")
names(filter_stats_plot) <- c("ID","Player","Team","Hero","Rank","Stats_name","Value","Stats_name_formatted")
#filter_stats_plot_wide <- dcast(filter_stats_plot,formula=ID+Player+Team+Hero~Stats_name_formatted,
# value.var="Value",fun.aggregat=F)
```
```{r render subpages, include=FALSE}
# Get all unique product groups for the subpages
played_heroes_list <- filter_stats[,.N,by=hero_name][N>6,hero_name]
tank_heroes<- played_heroes_list[played_heroes_list %in% c("winston","reinhardt","wreckingball","zarya","dva","roadhog","orisa")]
healer_heroes<- played_heroes_list[played_heroes_list %in% c("ana","lucio","zenyatta","mercy","brigitte","moira")]
dps_heroes <- played_heroes_list[!played_heroes_list %in% c(tank_heroes,healer_heroes)]
# Create variable which stores all subpages outputs
out = NULL
# Set knitr options to allow duplicate labels (needed for the subpages)
options(knitr.duplicate.label = 'allow')
# Create temporary environment which we use for knitting subpages.RMD
subpage_env <- new.env()
for (hr in played_heroes_list) {
# Filter data for product group
sub <- SharedData$new(filter_stats_plot[Hero==hr,],~Player,group="hero_stats_subset")
# Assign filtered data and product group to subpage_env
assign("subpage_data", sub, subpage_env)
assign("tank_heroes", tank_heroes, subpage_env)
assign("healer_heroes", healer_heroes, subpage_env)
assign("dps_heroes", dps_heroes, subpage_env)
assign("heroes", hr, subpage_env)
# Knit subpage.RMD using the subpage_env and add result to out vector
out = c(out, knitr::knit_child('dashboard_sub.RMD', envir = subpage_env))
}
```
`r paste(knitr::knit_child(text = out), collapse = '')`