R/shiny_update.R

In RandalMorris/AnalyticsFootball: Fantasy Data from Various Data Sources

#' Update Shiny App
#'
#' @export
#'

Shiny_App_Update <- function() {
  Data_Update(2021,"Season",0,"average",".")

}

#' Update Shiny App Projs
#'
#' @export
#'

Shiny_Proj_Update_App <- function(user) {
  load(file = "./data/ProjectionData.rdata", envir=.GlobalEnv)
  usecase <<- user
  Team_Setup(usecase)
  projection_data()
  assign(paste0(usecase), my_projections)
  #zip_format(usecase,vartype,varseason)
  save(Fred, Steven, NarFFL, FTA, file = paste0("./data/ProjectionData.rdata"))


}

Data_Update_App <- function(season = 2021,
                        vartype = c("Season", "Weekly"),
                        varweek = 0,
                        gtype = c("average","weighted"), wkdir){
  setwd(wkdir)
  varseason <<- season
  vartype <<- vartype
  varweek <<- varweek
  gtype <<- gtype
  player_table <<- ffanalytics::ff_player_data

  data_scrape() # Uncomment this
  cat("",sep = "\n")
  save(QB,RB,WR,TE,K,DST, file = "./data/Raw_Data.rdata")

}

data_scrape_App <- function(){

  #########Scraping Data Sources#########
  {message("Scraping Data Sources")

    my_scrape <<- scrape_data(src= c("CBS", "FantasyPros", "FantasySharks", "FFToday", "NumberFire","NFL", "RTSports", "Walterfootball"),
                              pos = c("QB","RB","WR","TE","K","DST"))
    #scrape_nfl()

    #my_scrape[["QB"]] <- as_tibble(plyr::rbind.fill(my_scrape[["QB"]],NFL_DATA[["QB"]]))
    #my_scrape[["RB"]] <- as_tibble(plyr::rbind.fill(my_scrape[["RB"]],NFL_DATA[["RB"]]))
    #my_scrape[["WR"]] <- as_tibble(plyr::rbind.fill(my_scrape[["WR"]],NFL_DATA[["WR"]]))
    #my_scrape[["TE"]] <- as_tibble(plyr::rbind.fill(my_scrape[["TE"]],NFL_DATA[["TE"]]))
    #my_scrape[["K"]] <- as_tibble(plyr::rbind.fill(my_scrape[["K"]],NFL_DATA[["K"]]))
    #my_scrape[["DST"]] <- as_tibble(plyr::rbind.fill(my_scrape[["DST"]],NFL_DATA[["DST"]]))

    scrape_espn()
    my_scrape[["QB"]] <- as_tibble(plyr::rbind.fill(my_scrape[["QB"]],ESPN_DATA[["QB"]]))
    my_scrape[["RB"]] <- as_tibble(plyr::rbind.fill(my_scrape[["RB"]],ESPN_DATA[["RB"]]))
    my_scrape[["WR"]] <- as_tibble(plyr::rbind.fill(my_scrape[["WR"]],ESPN_DATA[["WR"]]))
    my_scrape[["TE"]] <- as_tibble(plyr::rbind.fill(my_scrape[["TE"]],ESPN_DATA[["TE"]]))
    my_scrape[["K"]] <- as_tibble(plyr::rbind.fill(my_scrape[["K"]],ESPN_DATA[["K"]]))
    my_scrape[["DST"]] <- as_tibble(plyr::rbind.fill(my_scrape[["DST"]],ESPN_DATA[["DST"]]))
    cat("",sep = "\n")

  }

  #########Fix data#########
  player_table1 <<- httr::GET("https://api.myfantasyleague.com/2021/export?TYPE=players&L=&APIKEY=&DETAILS=1&SINCE=&PLAYERS=&JSON=1") %>%
    httr::content() %>% `[[`("players") %>% `[[`("player") %>%
    purrr::map(tibble::as_tibble) %>%
    dplyr::bind_rows() %>%
    tidyr::extract(name, c("last_name", "first_name"), "(.+),\\s(.+)") %>%
    mutate_all(funs(gsub("(?![.-])[[:punct:]]", "", ., perl = T))) %>%
    dplyr::mutate(name = paste0(first_name," ",last_name)) %>%
    dplyr::select(id,name)

  for (p in list("QB","RB","WR","TE","K")) {
    for (j in 1:length(my_scrape[[p]][["id"]])){
      if (is.na(my_scrape[[p]][["id"]][[j]])) {
        my_scrape[[p]][["id"]][[j]] <- as.character(player_table1[match(my_scrape[[p]][["player"]][[j]], player_table1$name),1])
      }
    }
  }
  load_date <- format(Sys.time(), "%a %b %d %Y %I:%M %p")
  write.table(paste0("Data Updated as of ", load_date),paste0("./www/load_date.txt"),row.names=FALSE,sep="\t", quote = FALSE, col.names = FALSE)

  rm(j,p,load_date)

  #########Data Export#########
  message("Starting Data Export")

  #Extract Postion Data for further analtysis
  #Clean and normaize data
  DataQB <- rbind(my_scrape[["QB"]]) %>% add_player_info() #QB Data
  DataRB <- rbind(my_scrape[["RB"]]) %>% add_player_info() #RB Data
  DataWR <- rbind(my_scrape[["WR"]]) %>% add_player_info() #WR Data
  DataTE <- rbind(my_scrape[["TE"]]) %>% add_player_info() #TE Data
  DataK <- rbind(my_scrape[["K"]]) %>% add_player_info() #K Data
  DataDST <- rbind(my_scrape[["DST"]]) %>% add_player_info()#DST Data


  DataQB$first_name <- paste(DataQB$first_name, DataQB$last_name)
  DataRB$first_name <- paste(DataRB$first_name, DataRB$last_name)
  DataWR$first_name <- paste(DataWR$first_name, DataWR$last_name)
  DataTE$first_name <- paste(DataTE$first_name, DataTE$last_name)
  DataK$first_name <- paste(DataK$first_name, DataK$last_name)
  DataDST$first_name <- paste(DataDST$first_name, DataDST$last_name)


  drops <<- c("last_name","src_id","player","team.y","number", "position.y",
              "tm","chg","player.1","pos","site_ci_low","site_ci_high", "ranks_ovr","bye","ranks_pos","z","note","status_game_opp",
              "z1","forecast","owner","games","fantasy_percent_owned",
              "rankings_proj","rankings_actual","passing_pick_six","opp","pass_rate",
              "displayname","esbid","gsisplayerid","site_season_pts", "site_pts","misc_fppg")
  keeps <<- c("id", "first_name", "position","position.x", "team.x", "age", "exp", "data_src",
              "pass_att", "pass_comp", "pass_inc", "pass_int", "pass_tds", "pass_yds",
              "rush_att", "rush_yds", "rush_tds",
              "rec", "rec_tgt", "rec_yds", "rec_tds", "reg_tds",
              "ret_yds", "ret_tds", "fumbles_lost", "fumbles_total", "punt_ret_yds", "kick_ret_yds", "two_pts")


  DataQB <- DataQB[ , (names(DataQB) %notin% drops)] %>% mutate_all(funs(ifelse(is.na(.), 0, .)))
  DataRB <- DataRB[ , (names(DataRB) %notin% drops)] %>% mutate_all(funs(ifelse(is.na(.), 0, .)))
  DataWR <- DataWR[ , (names(DataWR) %notin% drops)] %>% mutate_all(funs(ifelse(is.na(.), 0, .)))
  DataTE <- DataTE[ , (names(DataTE) %notin% drops)] %>% mutate_all(funs(ifelse(is.na(.), 0, .)))
  DataK <- DataK[ , (names(DataK) %notin% drops)] %>% mutate_all(funs(ifelse(is.na(.), 0, .)))
  DataDST <- DataDST[ , (names(DataDST) %notin% drops)] %>% mutate_all(funs(ifelse(is.na(.), 0, .)))

  names(DataQB)[2:4] <- c("name","team","position")
  names(DataRB)[2:4] <- c("name","team","position")
  names(DataWR)[2:4] <- c("name","team","position")
  names(DataTE)[2:4] <- c("name","team","position")
  names(DataK)[2:4] <- c("name","team","position")
  names(DataDST)[2:4] <- c("name","team","position")
  #Column Corrections

  DataQB <<- DataQB %>% add_column(pass_ypa = 0,pass_ypc =0, .before = "pass_tds") %>% dplyr::group_by(name,data_src) %>%
    mutate(rush_avg   = case_when(rush_att > 0 ~ round((rush_yds/rush_att),2), rush_att < 1 ~ 0, FALSE ~ 0),
           pass_yds_g = case_when(pass_comp > 0 ~ round((pass_yds/16),2), pass_comp < 1 ~ 0, FALSE ~ 0),
           pass_ypa   = case_when(pass_att > 0 ~ round((pass_yds/pass_att),2), pass_att < 1 ~ 0, FALSE ~ 0),
           pass_ypc   = case_when(pass_comp > 0 ~ round((pass_yds/pass_comp),2), pass_comp < 1 ~ 0, FALSE ~ 0),
           rush_tds   = case_when(rush_tds > 0 ~ rush_tds, rush_tds < 1 ~ rec_tds, FALSE ~ 0),
    ) %>% ungroup() %>% select(-rec_tds)

  DataRB <<- DataRB %>% add_column(rush_ypc = 0, rush_yds_g = 0, .before = "rush_tds") %>% dplyr::group_by(name,data_src) %>%
    mutate(rush_avg   = case_when(rush_att > 0 ~ round((rush_yds/rush_att),2), rush_att < 1 ~ 0, FALSE ~ 0),
           rush_yds_g = case_when(rush_att > 0 ~ round((rush_yds/16),2), rush_att < 1 ~ 0, FALSE ~ 0),
           rush_ypc   = case_when(rush_att > 0 ~ round((rush_yds/rush_att),2), rush_att < 1 ~ 0, FALSE ~ 0),
           rec_avg    = case_when(rec > 0 ~ round((rec_yds/rec),2), rec < 1 ~ 0, FALSE ~ 0),
           rec_yds_g  = case_when(rec > 0 ~ round((rec_yds/16),2), rec_yds < 1 ~ 0, FALSE ~ 0),
    ) %>% ungroup()

  DataWR <<- DataWR %>% add_column(rush_ypc = 0, rush_yds_g = 0, .before = "rush_tds") %>% dplyr::group_by(name,data_src) %>%
    mutate(rush_avg   = case_when(rush_att > 0 ~ round((rush_yds/rush_att),2), rush_att < 1 ~ 0, FALSE ~ 0),
           rush_yds_g = case_when(rush_att > 0 ~ round((rush_yds/16),2), rush_att < 1 ~ 0, FALSE ~ 0),
           rush_ypc   = case_when(rush_att > 0 ~ round((rush_yds/rush_att),2), rush_att < 1 ~ 0, FALSE ~ 0),
           rec_avg    = case_when(rec > 0 ~ round((rec_yds/rec),2), rec < 1 ~ 0, FALSE ~ 0),
           rec_yds_g  = case_when(rec > 0 ~ round((rec_yds/16),2), rec_yds < 1 ~ 0, FALSE ~ 0),
    ) %>% ungroup()

  DataTE <<- DataTE %>% dplyr::group_by(name,data_src) %>%
    mutate(rec_avg    = case_when(rec > 0 ~ round((rec_yds/rec),2), rec < 1 ~ 0, FALSE ~ 0),
           rec_yds_g  = case_when(rec > 0 ~ round((rec_yds/16),2), rec_yds < 1 ~ 0, FALSE ~ 0),
    ) %>% ungroup()

  DataAllOff <<- plyr::rbind.fill(DataQB,DataRB,DataWR,DataTE,DataDST) # Create table for all offense

  QB <<- as.data.frame(DataQB)
  RB <<- as.data.frame(DataRB)
  WR <<- as.data.frame(DataWR)
  TE <<- as.data.frame(DataTE)
  K <<- as.data.frame(DataK)
  DST <<- as.data.frame(DataDST)

}

projection_data_App <- function(){
  #Create projections based on league data
  #Add Player Data and Rankings
  src_weights <<- c(CBS = 0.344, FFToday = 0.379, NumberFire = 0.322,FantasyFootballNerd = 0.327,
                    FantasyPros = 0.500, FantasySharks = 0.327,RTSports= 0.330, Walterfootball = 0.281)
  vor_baseline <<- c(QB = 18, RB = 55, WR = 63, TE = 23, K = 8, DST = 5)
  PointsSum <<- CalculatePointsTotal()

    my_projections <<- projections_table(my_scrape, scoring_rules = scoring_rules[[paste0(usecase)]], vor_baseline= vor_baseline, src_weights = src_weights) %>%
    add_ecr() %>% add_risk() %>% add_player_info() %>% filter(avg_type == gtype) %>%
    unite("first_name", first_name:last_name,sep = " ") %>% rename(name = first_name) %>%
    select(-c(age,exp, pos,avg_type, V1)) %>%
    dplyr::mutate_at(c(5,7:10), round, 0) %>% dplyr::mutate_at(c(12,14,16,21), round, 2) %>%
    dplyr::arrange(position,pos_rank) %>%
    left_join(PointsSum, by = "id") %>%
    mutate_if(is.numeric, ~replace(., is.na(.), 0))

  Query_Week_Avg = Player_Week_Query(DataSet = pbp_agg_week, Position = "*", NameFilter = "*",
                                     SeasonStart = 2018, SeasonFinish = 2020,
                                     WeekStart = 1, WeekFinish = 17,
                                     GroupFilter = "WeekAvg")

  Query_Week = Player_Week_Query(DataSet = pbp_agg_week, Position = "*", NameFilter = "*",
                                 SeasonStart = 2018, SeasonFinish = 2020,
                                 WeekStart = 1, WeekFinish = 17,
                                 GroupFilter = "ByWeek")

  Query_Season_Avg = Player_Season_Query(DataSet = pbp_agg_season, Position = "*", NameFilter = "*",
                                         SeasonStart = 2018, SeasonFinish = 2020,
                                         GroupFilter = "SeasonAvg")

  Query_Season = Player_Season_Query(DataSet = pbp_agg_season, Position = "*", NameFilter = "*",
                                     SeasonStart = 2018, SeasonFinish = 2020,
                                     GroupFilter = "BySeason")

  DataAllOff <<- plyr::rbind.fill(DataQB,DataRB,DataWR,DataTE,DataDST) # Create table for all offense

  #Load Historical Data
  #Save file
  dataout <<- split(my_projections[-c(3)],my_projections$position)
  wb <<- createWorkbook()
  addWorksheet(wb, "All Proj");writeData(wb, "All Proj", my_projections)
  addWorksheet(wb, "QB Proj");writeData(wb, "QB Proj", dataout$QB)
  addWorksheet(wb, "RB Proj");writeData(wb, "RB Proj", dataout$RB)
  addWorksheet(wb, "WR Proj");writeData(wb, "WR Proj", dataout$WR)
  addWorksheet(wb, "TE Proj");writeData(wb, "TE Proj", dataout$TE)
  addWorksheet(wb, "K Proj");writeData(wb, "K Proj", dataout$K)
  addWorksheet(wb, "DST Proj");writeData(wb, "DST Proj", dataout$DST)
  addWorksheet(wb, "Raw Proj Data");writeData(wb, "Raw Proj Data", DataAllOff)
  addWorksheet(wb, "Team Rec Share Proj Data");writeData(wb, "Team Rec Share Proj Data", teamData)
  addWorksheet(wb, "Rec Share Proj");writeData(wb, "Rec Share Proj", teamRecShare_act)
  addWorksheet(wb, "Fantasy Points Season Agg");writeData(wb, "Fantasy Points Season Agg", Query_Season)
  addWorksheet(wb, "Fantasy Points Season Avg");writeData(wb, "Fantasy Points Season Avg", Query_Season_Avg)
  addWorksheet(wb, "Fantasy Points Week Agg");writeData(wb, "Fantasy Points Week Agg", Query_Week)
  addWorksheet(wb, "Fantasy Points Week Avg");writeData(wb, "Fantasy Points Week Avg", Query_Week_Avg)
  addWorksheet(wb, "Raw Season Stat Agg");writeData(wb, "Raw Season Stat Agg", pbp_agg_season)
  addWorksheet(wb, "Raw Season Stat Avg");writeData(wb, "Raw Season Stat Avg", pbp_avg_season)
  addWorksheet(wb, "Raw Week Stat Agg");writeData(wb, "Raw Week Stat Agg", pbp_agg_week)
  addWorksheet(wb, "Raw Week Stat Avg");writeData(wb, "Raw Week Stat Avg", pbp_avg_week)

  saveWorkbook(wb, file = paste0("/Data/","/fantasyproj ",usecase,".xlsx"), overwrite = TRUE)

  #Run ECR Func
  ECR_Data_App()

  #Run Graphs Function
  Graphs_App()

  my_projections <<- my_projections %>% mutate_if(is.numeric, round, digits=2) %>% arrange(position, pos_rank)
}

#'Create ECR data from Fantasy Pros data
#' @export
#'
ECR_Data_App <- function(){
  Positions <- c("QB", "RB", "WR", "TE", "K", "DST")
  ECR = lapply(seq_len(length(Positions)), function(i,scoring) {

    scoring <- scoring_rules[[paste0(usecase)]][["rec"]][["rec"]]
    if(scoring == 1){scoring="PPR"} else if(scoring == .5){scoring="HALF"} else if(scoring == 0){scoring="STD"}

    if ( Positions[i] == "QB" || Positions[i] == "TE" || Positions[i] == "K" || Positions[i] == "DST" ) {
      rankvar <- 32; xvar1=10;xvar2=33;yvar1=25;yvar2=13;seqvar=rankvar+5 } else {
        rankvar = 75;xvar1=25;xvar2=65;yvar1=60;yvar2=25;seqvar=rankvar+5 }

    fp_draft_rankings(Positions[i], type="both",scoring) %>%
      filter(ecr_rank <= rankvar) %>%
      ggplot(aes(x = ecr_rank, y = adp_rank, colour = factor(ecr_tier), label = player)) +
      geom_abline(slope = 1,intercept = 0,linetype = 2,color = "grey") +
      geom_errorbarh( aes(xmin = ecr_rank_avg - ecr_rank_std, xmax = ecr_rank_avg + ecr_rank_std), height = 0, alpha = 0.6, size = 0.9, show.legend = FALSE) +
      geom_point(size = 1.5) + scale_x_reverse(breaks = c(1, seq(10,seqvar, 10))) +
      scale_y_reverse(breaks = c(1, seq(10,seqvar, 10))) +
      ggsci::scale_color_npg() +
      #hrbrthemes::theme_ipsum_rc(base_size = 10, axis_title_size = 9, plot_title_size = 14 ) +
      labs(title = paste0(Positions[i]," Expert Consensus Rank vs Average Draft Position"), colour  = "Tier", x = "Expert Consensus Rank",
           y = "Average Draft Position",caption = "Data: fantasypros.com") +
      geom_text(aes(x = ecr_rank_avg + ecr_rank_std), size = 2, nudge_x = -3.5, show.legend = FALSE,fontface = "bold") +
      geom_text(aes(x = xvar1, y = yvar1), label = "Under\nDrafted", color = "light grey", size = 8, fontface = "italic") +
      geom_text(aes(x = xvar2, y = yvar2), label = "Over\nDrafted", color = "light grey", size = 8, fontface = "italic") +
      theme(legend.position = "bottom",plot.title = element_text(hjust = 0.5)) +
      guides(colour = guide_legend(nrow = 1))

    ggsave(paste0("./www/",usecase,"/",Positions[i]," ECR.png"),
           height = 8, width = 10, dpi = 320)
  })

}

#'Create Graphs for user
#' @export
#'
Graphs_App <- function(){


  graph_func_App(pos="QB", pos_txt="Quarter Back", rlim = 32, xlim=100)
  graph_func_App(pos="RB", pos_txt="Running Back", rlim = 75, xlim=125)
  graph_func_App(pos="WR", pos_txt="Wide Receiver", rlim = 75, xlim=100)
  graph_func_App(pos="TE", pos_txt="Tight End", rlim = 40, xlim=75)
  graph_func_App(pos="K", pos_txt="Kicker", rlim = 32, xlim=50)
  graph_func_App(pos="DST", pos_txt="Defense", rlim = 32, xlim=50)


  #projection points density plot
  rankprojs <<- data.table(my_projections) %>%
    filter(position %in% c("QB", "RB", "WR", "TE") & points > 0) %>%
    arrange(position)

  densityData <<- data.frame(rankprojs$points, rankprojs$position)
  names(densityData) <- c("pointDensity", "sourceDensity")

  ggplot(densityData, aes(x=rankprojs$points, group=rankprojs$position, fill = rankprojs$position)) +
    geom_density(adjust=1.5, alpha=.4) +
    ylab("Density") + xlab("Player's Projected Points") +
    labs(title = paste(varseason," Density Plot of Projected Points ",usecase, " ",date(), sep="")) +
    theme(
      #plot.background = element_blank()
      plot.title = element_text(hjust = 0.5),
      #panel.grid.major.x = element_blank(),
      #panel.grid.minor.y = element_blank(),
      panel.border=element_rect(color="grey",fill=NA),
      #panel.background = element_blank(),
      legend.position = c(.95, .95),
      legend.justification = c("right", "top"),
      legend.key = element_rect(color="grey",fill=NA),
      legend.background = element_rect(color="grey",fill=NA),
      legend.box.background = element_rect(color="black", size=.75, fill= NA),
      legend.box.just = "right",
      legend.margin = margin(6, 6, 6, 6)
    ) +
    coord_cartesian(xlim=c(0,round(max(densityData$pointDensity),0)))
  ggsave(paste0("./www/",usecase,"/Density.png", sep=""),
         width = 1000/72, height = 1000/72, units = "in")
}

#'Base Graph Set
#' @export
#'
graph_func_App <- function(pos, pos_txt, rlim, xlim){

  ffproj <<- data.table(my_projections) %>%
    filter(position == pos & !is.na(floor)) %>%
    arrange(desc(points)) %>%
    slice_head(n = rlim)

  ggplot(ffproj, aes(x=points, y=pos_rank, color=factor(tier))) +
    geom_errorbarh(aes(xmin=floor,xmax=ceiling), height=1) +
    geom_point(size=6,color="white")+
    geom_point(aes(x=Total_Points), size =2, shape=1, color = "black") +
    geom_text(aes(x=points,label=round(points,0)),check_overlap = T,size=4) +
    geom_text(aes(x=ceiling, label=paste(pos_rank, " | ",name," | ",risk, " | ", Total_Points,sep = ""),
                  hjust=-.1,lineheight=5),check_overlap = T, size=4)+
    geom_text(aes(x=25, y= 0, label=paste("Average Risk = ",
                                          round(mean(risk,na.rm = TRUE),2),sep = "")),color="black") +
    theme(
      #plot.background = element_blank()
      plot.title = element_text(hjust = 0.5)
      ,plot.subtitle=element_text(hjust=0.5)
      ,panel.grid.major.x = element_line()
      ,panel.border=element_rect(color="grey",fill=NA)
      ,panel.background = element_blank()
      ,legend.position = "none") +
    scale_y_reverse(breaks=seq(0,rlim,1)) +
    scale_x_continuous(breaks=seq(0,max(ffproj$ceiling)+xlim,50)) +
    ylab("Average Rank") + xlab("Median FPTS Projection") +
    labs(title = paste(varseason, "Season", pos_txt, "Projections", usecase, date()),
         subtitle=paste("Mean Projection | Rank | Player | Risk | 3 Year Avg Points", sep = ""),
         caption = paste0("Black Circle = 3 Year Avg Points")) +
    coord_cartesian(xlim=c(0,(max(ffproj$ceiling)+xlim)))
  ggsave(paste0("./www/",usecase,"/",pos_txt,".png"),
         device = "png",width = 14, height = 11,dpi = 320, scale = 1, units = "in")


}