library(shiny)
library(shinyjs)
library(DT)
library(DBI)
# Code that determines the functionality of the app
function(input, output, session) {
# create the output dataframe as a reactive object
dat = reactiveVal(data.frame(time = numeric(0)
,event = character(0)
,beg_team = character(0)
,end_team = character(0)
,loc_x = integer(0)
,loc_y = integer(0)
,comment = character(0)
,stringsAsFactors = FALSE))
last_click = reactiveValues(x = 60, y = 35)
########################
## App output elements
########################
# render a clickable image of a rugby pitch
output$pitch <- renderPlot({
par(mar = c(0,0,0,0))
plot(c(0,120),c(0,70.5),type = "n",xlab = "",ylab = "",axes = FALSE)
rasterImage(pitch_image, 0, -.5, 120, 71)
points(last_click$x,last_click$y,col = teams[[input$team]],pch= 19,cex = 2)
}, height = function() {
session$clientData$output_pitch_width*(70/120)
})
# Load the youtube Javascript API based on the link when the user clicks "load video"
observeEvent(input$videoLoad,{
output$video = renderUI({
video = strsplit(input$link,"?v=")[[1]][2] # get the video info from the link
# script to initiate Youtube Javascript API
HTML(paste0(
'<html>
<body>
<iframe id="existing-iframe"
width="745" height="420"
src="https://www.youtube.com/embed/',video,'?enablejsapi=1"
frameborder="0"
></iframe>
<script type="text/javascript">
var tag = document.createElement(\'script\');
tag.src = \'https://www.youtube.com/iframe_api\';
var firstScriptTag = document.getElementsByTagName(\'script\')[0];
firstScriptTag.parentNode.insertBefore(tag, firstScriptTag);
var player;
function onYouTubeIframeAPIReady() {
player = new YT.Player(\'existing-iframe\');
}
var panelChoice = 0;
var playerTime = 0;
Shiny.setInputValue(\'kickPanel\',0);
Shiny.setInputValue(\'conversionPanel\',0);
</script>
</body>
</html>'
))
})
# once the video player loads, change the names of the possession radio
# buttons to the names of the teams input by the user
updateRadioButtons(session,"team",choiceNames = c(input$home,input$away)
,choiceValues = c(input$home,input$away),inline = TRUE)
})
# output table of the data being collected
output$Main_table = DT::renderDataTable({
tmp=within(dat(),rm("comment"))
if(nrow(dat()) > 0){
tmp[["time"]] = paste0(
'<button style="border:none;padding:0!important;'
,'color:#069;text-decoration:underline;cursor: pointer;" '
,'id = goTo_',1:nrow(dat()),'>',tmp[['time']],'</button>')
tmp[["note"]] = paste0(
'<button type="button" class="btn btn-secondary btn-xs" '
,'style="color:',ifelse(dat()[["comment"]] == "","gray","green"),'" '
,'id=note_',1:nrow(dat()),'>'
,"<span class='glyphicon glyphicon-comment'></span></button>")
tmp[["Delete"]] = paste0(
'<button type="button" class="btn btn-secondary btn-xs delete" '
,'style="color:red;" id=delete_'
,1:nrow(dat()),'>Delete</button>')
}
datatable(tmp, escape=F, style = "bootstrap",class = "table-condensed"
,options = list(dom = 't'))
})
##################
## Click Handlers
##################
# begin recording an event when the pitch is single-clicked
observeEvent(input$click,{
# record time of the youtube video
runjs("if (player.getPlayerState() == 1) {
Shiny.setInputValue('vidTime',player.getCurrentTime());
} else {
Shiny.setInputValue('vidTime',playerTime);
}")
# add a row to the dataframe with x and y locations populated based on click
tmp = rbind(data.frame(time = 0
,event = "SELECT"
,beg_team = input$team
,end_team = input$team
,loc_x = round(input$click$x-10,0)
,loc_y = max(min(round(input$click$y,0),70),0)
,comment = ""
,stringsAsFactors = FALSE)
,dat())
dat(tmp)
if(input$click$y > 0 & input$click$y < 70 & input$kickPanel == 1){
click("receivekick")
runjs("panelChoice = 0; Shiny.setInputValue('kickPanel',0);")
}else if((input$click$y < 0 | input$click$y > 70) & input$kickPanel == 1){
click("intotouch")
runjs("panelChoice = 0; Shiny.setInputValue('kickPanel',0);")
}else if(input$kickPanel == 2){
click("maulends")
runjs("Shiny.setInputValue('kickPanel',0);")
}else if(input$conversionPanel != 1){
runjs("panelChoice = 1;")
}
last_click$x = input$click$x
last_click$y= input$click$y
})
# record a phase when the pitch is double-clicked
observeEvent(input$dblclick,{
runjs("Shiny.setInputValue('vidTime',player.getCurrentTime())")
tmp = rbind(data.frame(time = 0
,event = "Ruck"
,beg_team = input$team
,end_team = input$team
,loc_x = round(input$dblclick$x-10,0)
,loc_y = max(min(round(input$dblclick$y,0),70),0)
,comment = ""
,stringsAsFactors = FALSE)
,dat())
dat(tmp)
runjs("panelChoice = 2;")
last_click$x = input$dblclick$x
last_click$y= input$dblclick$y
})
# change end team any time possesion is changed (manually or automatically)
observeEvent(input$team,{
tmp = dat()
tmp$end_team[min(1,nrow(tmp))] = input$team
dat(tmp)
})
##################################
## Single Click Event Handlers
##################################
observeEvent(input$kickoff,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Kickoff/22"
dat(tmp)
runjs("panelChoice = 5; Shiny.setInputValue('kickPanel',1)")
})
observeEvent(input$receivekick,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Receive Kick"
dat(tmp)
runjs("panelChoice = 0;")
})
observeEvent(input$scrum,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Scrum"
dat(tmp)
runjs("panelChoice = 8;")
})
observeEvent(input$knockon,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Knock On"
dat(tmp)
runjs("panelChoice = 0;")
updateRadioButtons(session,"team"
,selected = ifelse(input$team == input$home
,input$away,input$home))
})
observeEvent(input$lineout,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Lineout"
dat(tmp)
runjs("panelChoice = 7;")
})
observeEvent(input$turnover,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Loose Turnover"
dat(tmp)
runjs("panelChoice = 0;")
updateRadioButtons(session,"team"
,selected = ifelse(input$team == input$home
,input$away,input$home))
})
observeEvent(input$penalty,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Penalty"
dat(tmp)
runjs("panelChoice = 3;")
})
observeEvent(input$try,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Try"
dat(tmp)
runjs("panelChoice = 4;Shiny.setInputValue(\'conversionPanel\',1);")
})
observeEvent(input$restart,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Tap Restart"
dat(tmp)
runjs("panelChoice = 0;")
})
observeEvent(input$kick,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Loose Kick"
dat(tmp)
runjs("panelChoice = 5; Shiny.setInputValue('kickPanel',1)")
})
observeEvent(input$intotouch,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Into Touch"
dat(tmp)
runjs("panelChoice = 0;")
updateRadioButtons(session,"team"
,selected = ifelse(input$team == input$home
,input$away,input$home))
})
observeEvent(input$maul,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Maul"
dat(tmp)
runjs("panelChoice = 6; Shiny.setInputValue('kickPanel',2)")
})
observeEvent(input$maulends,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Maul Ends"
dat(tmp)
runjs("panelChoice = 8;")
})
observeEvent(input$other,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Held Up/Other"
dat(tmp)
runjs("panelChoice = 0;")
})
#################################
## Ruck Result event handlers
#################################
observeEvent(input$setpieceturnover,{
updateRadioButtons(session,"team"
,selected = ifelse(input$team == input$home
,input$away,input$home))
})
observeEvent(input$backs,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = paste(tmp$event[min(1,nrow(tmp))], "-", "Backs Phase")
dat(tmp)
runjs("panelChoice = 0;")
})
observeEvent(input$forwards,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = paste(tmp$event[min(1,nrow(tmp))], "-", "Forwards Phase")
dat(tmp)
runjs("panelChoice = 0;")
})
observeEvent(input$pickandgo,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = paste(tmp$event[min(1,nrow(tmp))], "-", "Pick and Go")
dat(tmp)
runjs("panelChoice = 0;")
})
observeEvent(input$boxkick,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = paste(tmp$event[min(1,nrow(tmp))], "-", "Box Kick")
dat(tmp)
runjs("panelChoice = 5; Shiny.setInputValue('kickPanel',1)")
})
observeEvent(input$ruckpenalty,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = paste(tmp$event[min(1,nrow(tmp))], "-", "Penalty")
dat(tmp)
runjs("panelChoice = 3;")
})
observeEvent(input$maulfromlineout,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = paste(tmp$event[min(1,nrow(tmp))], "-", "Maul")
dat(tmp)
runjs("panelChoice = 6; Shiny.setInputValue('kickPanel',2)")
})
#################################
## Penalty Result event handlers
#################################
observeEvent(input$penaltykick,{
# record time of the youtube video
runjs("Shiny.setInputValue('vidTime',player.getCurrentTime())")
# add a row to the dataframe with x and y locations populated based on click
tmp = rbind(data.frame(time = 0
,event = "Penalty Kick"
,beg_team = input$team
,end_team = input$team
,loc_x = round(last_click$x-10,0)
,loc_y = max(min(round(last_click$y,0),70),0)
,comment = ""
,stringsAsFactors = FALSE)
,dat())
dat(tmp)
runjs("panelChoice = 5; Shiny.setInputValue('kickPanel',1)")
})
observeEvent(input$kickforpoints,{
# record time of the youtube video
runjs("Shiny.setInputValue('vidTime',player.getCurrentTime())")
# add a row to the dataframe with x and y locations populated based on click
tmp = rbind(data.frame(time = 0
,event = "Kick for Points"
,beg_team = input$team
,end_team = input$team
,loc_x = round(last_click$x-10,0)
,loc_y = max(min(round(last_click$y,0),70),0)
,comment = ""
,stringsAsFactors = FALSE)
,dat())
dat(tmp)
runjs("panelChoice = 4;Shiny.setInputValue(\'conversionPanel\',1);")
})
observeEvent(input$scrumfrompen,{
# record time of the youtube video
runjs("Shiny.setInputValue('vidTime',player.getCurrentTime())")
# add a row to the dataframe with x and y locations populated based on click
tmp = rbind(data.frame(time = 0
,event = "Scrum"
,beg_team = input$team
,end_team = input$team
,loc_x = round(last_click$x-10,0)
,loc_y = max(min(round(last_click$y,0),70),0)
,comment = ""
,stringsAsFactors = FALSE)
,dat())
dat(tmp)
runjs("panelChoice = 8;")
})
observeEvent(input$restartfrompen,{
# record time of the youtube video
runjs("Shiny.setInputValue('vidTime',player.getCurrentTime())")
# add a row to the dataframe with x and y locations populated based on click
tmp = rbind(data.frame(time = 0
,event = "Tap Restart"
,beg_team = input$team
,end_team = input$team
,loc_x = round(last_click$x-10,0)
,loc_y = max(min(round(last_click$y,0),70),0)
,comment = ""
,stringsAsFactors = FALSE)
,dat())
dat(tmp)
runjs("panelChoice = 0;")
})
#################################
## Conversion Kick event handlers
#################################
observeEvent(input$madekick,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Made Kick"
dat(tmp)
runjs("panelChoice = 0;Shiny.setInputValue(\'conversionPanel\',0);")
})
observeEvent(input$missedkick,{
tmp = dat()
tmp$event[min(1,nrow(tmp))] = "Missed Kick"
dat(tmp)
runjs("panelChoice = 0;Shiny.setInputValue(\'conversionPanel\',0);")
})
#############################
## Behind-the-scenes Handlers
#############################
# Handlers for all the buttons on the data table
observeEvent(input$lastClick,{
#delete a row if if the delete button is clicked
if(substr(input$lastClickId,1,6) == "delete"){
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
tmp = dat()
tmp = tmp[-row_to_del,]
dat(tmp)
# Seek the player to the given timestamp when the timestamp button is clicked
}else if(substr(input$lastClickId,1,4) == "goTo"){
goto_time = dat()[['time']][as.numeric(gsub("goTo_","",input$lastClickId))] - 1
runjs(paste0('player.seekTo(',goto_time,')'))
# Handle user-added comments (also triggers reactive below)
}else if(substr(input$lastClickId,1,4) == "note"){
runjs("playerTime = player.getCurrentTime();")
runjs("player.pauseVideo();")
rownum = as.numeric(strsplit(input$lastClickId,"_")[[1]][2])
prevcomment = dat()[rownum,"comment"]
runjs(paste0("var rowcomment = prompt('Add a Comment For This Event','",prevcomment,"');
Shiny.setInputValue('lastComment',rowcomment);"))
}
})
# reactive handler for when a comment is added
observeEvent(input$lastComment,{
rownum = as.numeric(strsplit(input$lastClickId,"_")[[1]][2])
tmp = dat()
tmp[rownum,"comment"] = input$lastComment
dat(tmp)
})
# Behind-the-scenes function to update time when an event is recorded
observeEvent(input$vidTime,{
tmp = dat()
tmp$time[min(1,nrow(tmp))] = round(input$vidTime,0)
dat(tmp)
})
# write the data to the database
observeEvent(input$export,{
conn = DBI::dbConnect(odbc::odbc()
,Driver = "ODBC Driver 17 for SQL Server"
,Server = "petrack.cln0jg6hschy.us-east-1.rds.amazonaws.com"
,Database = "Testing"
,UID = "admin"
,PWD = "MRugby1959"
,Port = 1433)
tmp = dat()
# add columns containing the game metadata
tmp$video_link = input$link
tmp$home_team = input$home
tmp$away_team = input$away
tmp$type = input$type
tmp$side = input$side
tmp$location = input$location
tmp$game_date = input$gameDate
tmp$minutes_per_half = input$minutesPerHalf
tmp$upload_date = Sys.Date()
# write the data to the database then close the connection.
if(DBI::dbWriteTable(conn,"ingest",tmp,append = TRUE,row.names = FALSE)){
showNotification("Data Uploaded Successfully",type = "message")
}
DBI::dbDisconnect(conn)
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.