inst/app/server.R

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)
    
  })
}
pmelgren/gameTracker documentation built on Jan. 2, 2020, 4:12 p.m.