R Markdown
library(httr)
library(jsonlite)
##
## Pridedamas paketas: 'jsonlite'
## Šis objektas yra užmaskuotas nuo 'package:shiny':
##
## validate
library(magrittr)
library(BAwiR)
## Warning: paketas 'BAwiR' buvo sukurtas pagal R versiją 4.2.3
library(readxl)
library(tidyverse)
## ── Attaching packages
## ───────────────────────────────────────
## tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0 ✔ purrr 1.0.1
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.3.0 ✔ stringr 1.5.0
## ✔ readr 2.1.3 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ tidyr::extract() masks magrittr::extract()
## ✖ dplyr::filter() masks stats::filter()
## ✖ purrr::flatten() masks jsonlite::flatten()
## ✖ dplyr::group_rows() masks kableExtra::group_rows()
## ✖ dplyr::lag() masks stats::lag()
## ✖ purrr::set_names() masks magrittr::set_names()
## ✖ jsonlite::validate() masks shiny::validate()
graztai_pbp <- readRDS("C:/Users/Euronics/Documents/Rokas/Projects/graztai_pbp.rds")
library(data.table)
##
## Pridedamas paketas: 'data.table'
##
## Šie objektai yra užmaskuoti nuo 'package:dplyr':
##
## between, first, last
##
## Šis objektas yra užmaskuotas nuo 'package:purrr':
##
## transpose
library(dplyr)
graztai_pbp<-as.data.table(graztai_pbp)
VG_players<-data.table( player =c(
"D. Pikūnas",
"D. Bučas",
"A. Neifaltas",
"R. Rudžinskas",
#"P. Po?ka",
"D. Šablinskas",
"P. Žala",
#"P. Poguda",
"R. Urbelis",
"M. Gružys",
"T. Jurevičius",
"T. Rėkašius",
"D. Ridikas",
"R. Rimša",
"E. Beržonskis",
"M. Gauba",
"J. Laurinavičius",
"A. Jankūnas",
"K. Bratikas"))
graztai_pbp$previousAction <- as.double(graztai_pbp$previousAction)
assisters <- graztai_pbp[actionType=="assist",] %>% mutate(actionNumber=previousAction) %>% select(game,actionNumber,player) %>% setnames("player","assister")
scorers <- graztai_pbp[actionType %in% c("2pt","3pt","freethrow") & success== 1,] %>% select(game,actionNumber,player) %>% setnames("player","scorer")
assisters_scorers <- left_join(assisters,scorers , by =c("game","actionNumber" )) %>% filter(assister %in% c(VG_players$player))
assists_average <- assisters_scorers %>%
group_by(assister, scorer, game) %>%
summarise(total = n()) %>%
ungroup()
## `summarise()` has grouped output by 'assister', 'scorer'. You can override
## using the `.groups` argument.
per_route <- assists_average %>%
group_by(assister, scorer) %>%
summarise(weight = mean(total)) %>%
ungroup()
## `summarise()` has grouped output by 'assister'. You can override using the
## `.groups` argument.
nodes<-tibble(unique(assisters_scorers$assister))
nodes <- nodes %>% rowid_to_column("id")
colnames(nodes)[2]<-"label"
per_route
## # A tibble: 88 × 3
## assister scorer weight
## <chr> <chr> <dbl>
## 1 A. Jankūnas A. Neifaltas 1
## 2 A. Jankūnas D. Pikūnas 1.33
## 3 A. Jankūnas D. Ridikas 1
## 4 A. Jankūnas D. Šablinskas 1
## 5 A. Jankūnas K. Bratikas 1
## 6 A. Jankūnas M. Gauba 1
## 7 A. Jankūnas M. Gružys 1
## 8 A. Neifaltas A. Jankūnas 1
## 9 A. Neifaltas D. Pikūnas 1
## 10 A. Neifaltas D. Šablinskas 1
## # … with 78 more rows
edges <- per_route %>%
left_join(nodes, by = c("assister" = "label")) %>%
rename(from = id) %>%
left_join(nodes, by = c("scorer" = "label")) %>%
rename(to = id) %>% select(from, to, weight)
edges$to <- as.double(edges$to )
library(visNetwork)
## Warning: paketas 'visNetwork' buvo sukurtas pagal R versiją 4.2.3
library(networkD3)
## Warning: paketas 'networkD3' buvo sukurtas pagal R versiją 4.2.3
edges$smooth <- TRUE # should the edges be curved?
edges <- mutate(edges, width = (exp(weight)))
visNetwork(nodes, edges) %>%
visIgraphLayout(layout = "layout_with_fr") %>%
visEdges(arrows = "middle") %>%
#visEdges(arrows = list(to = list(enabled = TRUE, type = "bar")))%>%
visEdges(smooth = list(enabled = TRUE, type = "diagonalCross")) %>%
visEdges(arrows = list(to = list(enabled = TRUE,
scaleFactor = 2, type = 'arrow')))%>%
visEdges(color = list(hover = "green")) %>%
visInteraction(hover = TRUE) %>%
visEdges(color = list(color = "red", highlight = "yellow"))
#write.csv(nodes, file = "C:/Users/Euronics/Documents/Rokas/Projects/nodes.csv")
ColourScal ='d3.scaleOrdinal() .range(["#910D3D","#8D1B2B","#882511","#832D00","#7D3300","#773900"])'
list_graph <- list()
for ( i in nodes$id) {
i=i-1
edges_d3 <- data.table(mutate(edges, from = from - 1, to = to - 1, width = exp(weight)))[to == i & !is.na(to),] #%>% dplyr::arrange(desc(width))
# Reorder data.table
nodes_d3 <- as.data.frame(mutate(nodes, id = id - 1)) # nodes_d3 <- (left_join(nodes_d3,edges_d3, by=c("id"="from"))) %>% dplyr::arrange(desc(width)) %>% select(id,label)# Reorder data.table
list_graph[[i+1]] <-
sankeyNetwork(Links = edges_d3, Nodes = data.table(nodes_d3), Source = "from", Target = "to", nodePadding=50,
NodeID = "label", Value = "width", colourScale=ColourScal, sinksRight=T,nodeWidth=5, fontSize=13)
# you save it as an html
saveNetwork(list_graph[[i+1]], paste0("C:/Users/Euronics/Documents/Rokas/Projects/ballbook-main/sn",i+1,".html"))
# htmltools::includeHTML(paste0("C:/Users/Euronics/Documents/Rokas/Projects/ballbook-main/sn",i+1,".html"))
# # tags$iframe()
#
# library(webshot)
# library(bookdown)
# # you convert it as png
# webshot(paste0("C:/Users/Euronics/Documents/Rokas/Projects/ballbook-main/sn",i+1,".html"),paste0("C:/Users/Euronics/Documents/Rokas/Projects/ballbook-main/sn",i+1,"png"), vwidth = 200, vheight = 200)
}
## Warning: It looks like Source/Target is not zero-indexed. This is required in
## JavaScript and so your plot may not render.
## Warning: It looks like Source/Target is not zero-indexed. This is required in
## JavaScript and so your plot may not render.
## Warning: It looks like Source/Target is not zero-indexed. This is required in
## JavaScript and so your plot may not render.
library(shiny)
# Define file paths
file_paths <- paste0("file:///C:/Users/Euronics/Documents/Rokas/Projects/ballbook-main/sn", 1:12, ".html")
shinyApp(
ui = fluidPage(
titlePanel("Tabbed HTML Page with Buttons"),
sidebarLayout(
sidebarPanel(
selectInput("tab", "Choose a tab to display:",
choices = c("Tab 1", "Tab 2", "Tab 3"))
),
mainPanel(
tabsetPanel(
tabPanel("Tab 1",
lapply(1:12, function(i) {
actionButton(paste0("open_html_button_", i), paste("Open HTML File", i))
})
),
tabPanel("Tab 2", h2("Content for Tab 2")),
tabPanel("Tab 3", h2("Content for Tab 3"))
)
)
)
),
server = function(input, output) {
observe({
lapply(1:12, function(i) {
observeEvent(input[[paste0("open_html_button_", i)]], {
browseURL(file_paths[i])
})
})
})
}
)
##
## Listening on http://127.0.0.1:3178
