174
281
19
| This Week's Predictions | |||||
|---|---|---|---|---|---|
| Week 22 | |||||
| Game | Prediction | Winner | Correct | Correct Votes | Correct Percent |
| 1 | Cincinnati Bengals | Los Angeles Rams | No | 6 | 0.3158 |
| Individual Results | |||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Week 22 | |||||||||||||||||||||||||||
| Name | Weekly # Correct | Percent | Weeks Picked | Season Percent | Adj Season Percent | Season Trend | |||||||||||||||||||||
| Week 1 | Week 2 | Week 3 | Week 4 | Week 5 | Week 6 | Week 7 | Week 8 | Week 9 | Week 10 | Week 11 | Week 12 | Week 13 | Week 14 | Week 15 | Week 16 | Week 17 | Week 18 | Week 19 | Week 20 | Week 21 | Week 22 | ||||||
| Frank Czerniakowski | 8 | 12 | 13 | 11 | 14 | 10 | 8 | 8 | 8 | 7 | 10 | 10 | 9 | 12 | 11 | 12 | 13 | 9 | 5 | 3 | 1 | 1 | 1 | 22 | 0.6940 | 0.6940 | |
| Matthew Rogers | 9 | 10 | 11 | 8 | 14 | 9 | 10 | NA | 7 | 6 | 11 | 7 | 8 | 10 | 9 | 10 | 14 | 9 | 6 | 2 | 0 | 1 | 1 | 21 | 0.6404 | 0.6113 | |
| Welvin Lucero | 8 | 9 | 10 | NA | 12 | 9 | NA | 9 | 9 | 7 | 10 | NA | 9 | 11 | NA | NA | NA | 8 | 4 | 0 | 1 | 1 | 1 | 16 | 0.6126 | 0.4455 | |
| Gabriel Costa | 8 | 8 | 10 | 8 | 11 | 11 | 9 | 6 | 5 | 7 | 9 | 11 | 10 | 10 | 8 | 10 | 12 | NA | 4 | 2 | 1 | 1 | 1 | 21 | 0.6075 | 0.5799 | |
| Blake Schwartz | 10 | 6 | 8 | 6 | 11 | 9 | 9 | 9 | 7 | 5 | 9 | 6 | 9 | 9 | 10 | 11 | 12 | 10 | 5 | 1 | 1 | 1 | 1 | 22 | 0.5836 | 0.5836 | |
| Eric Swenson | 9 | 8 | 7 | 7 | 11 | 10 | 9 | 7 | 6 | 7 | 8 | 9 | 7 | 8 | 9 | 10 | 13 | 7 | 5 | 1 | 1 | 1 | 1 | 22 | 0.5694 | 0.5694 | |
| Ira Crofford | 7 | 11 | 12 | 9 | 12 | 10 | 10 | 9 | 8 | 7 | 10 | 7 | 9 | 10 | 9 | 12 | 11 | 10 | 4 | 1 | 1 | 0 | 0 | 22 | 0.6370 | 0.6370 | |
| Jeremy Reynolds | 8 | 11 | 9 | 10 | 13 | 10 | 9 | 9 | 7 | 7 | 11 | 7 | 8 | 11 | 10 | 9 | 12 | 8 | 5 | 2 | 1 | 0 | 0 | 22 | 0.6299 | 0.6299 | |
| Michael Prokos | 9 | 13 | 11 | NA | 12 | 8 | 9 | 7 | 8 | 7 | 8 | 8 | 9 | 11 | 10 | 10 | 11 | 9 | 4 | 1 | 1 | 0 | 0 | 21 | 0.6264 | 0.5979 | |
| Daniel Baller | 8 | 9 | 12 | 9 | 12 | 9 | 9 | 9 | 10 | 5 | 8 | 6 | 9 | 10 | 10 | 10 | 12 | 8 | 5 | 1 | 1 | 0 | 0 | 22 | 0.6121 | 0.6121 | |
| Jonathan Roginski | 6 | 10 | 10 | 11 | 13 | 9 | 10 | 7 | 7 | 6 | 10 | 10 | 9 | 9 | 10 | 11 | NA | 8 | 4 | 2 | 0 | 0 | 0 | 21 | 0.6113 | 0.5835 | |
| Leslie Jones | 15 | 9 | 10 | 10 | 7 | 9 | 9 | 10 | 8 | NA | 6 | NA | 6 | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 0 | 12 | 0.6111 | 0.3333 | |
| William Freiberg | 10 | 10 | 9 | 10 | 13 | 9 | 9 | 9 | 8 | 6 | 9 | 8 | 9 | 10 | 9 | NA | NA | 8 | 5 | 0 | 1 | 0 | 0 | 20 | 0.6104 | 0.5549 | |
| Patrick Mugg | 7 | 8 | 11 | 7 | 9 | 10 | 8 | 9 | 5 | 6 | 8 | 7 | 9 | 8 | 11 | NA | 13 | 9 | 5 | 2 | NA | 0 | 0 | 20 | 0.5779 | 0.5254 | |
| Cherri Gound | 10 | 6 | 10 | 9 | 11 | 9 | 10 | 7 | 6 | 6 | 7 | 6 | 9 | 10 | 11 | NA | 10 | 8 | 4 | 1 | 2 | 0 | 0 | 21 | 0.5736 | 0.5475 | |
| Josephine Cammack | 9 | 9 | 6 | 8 | 12 | 8 | 9 | 8 | 4 | 6 | 6 | 8 | 9 | 9 | 9 | 10 | 13 | 8 | 4 | 1 | 1 | 0 | 0 | 22 | 0.5587 | 0.5587 | |
| Kevin Cummiskey | 9 | 8 | 10 | NA | 10 | 9 | NA | 8 | 6 | NA | NA | 5 | 9 | 10 | 7 | NA | 10 | 9 | 5 | 0 | 0 | 0 | 0 | 17 | 0.5502 | 0.4252 | |
| Margaret Grogan | 6 | 10 | 10 | 9 | 10 | 7 | 7 | 9 | 9 | 8 | 7 | 5 | 9 | 8 | 10 | 6 | 6 | 8 | 4 | 1 | 2 | 0 | 0 | 22 | 0.5374 | 0.5374 | |
| Tina Hartley | 8 | 8 | 8 | 6 | 9 | 8 | 7 | 8 | 4 | 5 | 6 | 9 | 9 | 9 | 7 | 12 | NA | 6 | 4 | 1 | 2 | 0 | 0 | 21 | 0.5132 | 0.4899 | |
| Nicholas Reisweber | 11 | 10 | 9 | 7 | 10 | 9 | 10 | 9 | NA | 5 | 10 | 9 | 9 | 8 | 7 | NA | NA | NA | NA | NA | NA | NA | 0 | 14 | 0.5971 | 0.3800 | |
| Shane Clark | 5 | 11 | 7 | NA | 12 | 11 | 8 | 8 | NA | 7 | 9 | 7 | 9 | 9 | 9 | 12 | 11 | 7 | 5 | 1 | 1 | NA | 0 | 19 | 0.5960 | 0.5147 | |
| John Kearby | 8 | 10 | 12 | 10 | 11 | 8 | NA | 8 | 8 | 5 | 9 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 10 | 0.5933 | 0.2697 | |
| James Starling | 7 | 11 | 9 | 10 | 11 | 9 | 6 | 9 | 6 | 5 | 8 | 9 | 7 | 11 | 9 | 10 | 11 | 9 | NA | NA | NA | NA | 0 | 18 | 0.5858 | 0.4793 | |
| Evangeline Reynolds | 8 | 8 | NA | 11 | 11 | 6 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 9 | NA | NA | NA | NA | 0 | 6 | 0.5699 | 0.1554 | |
| Margaret Wieczorek | 8 | 10 | 9 | 9 | 11 | 8 | 9 | 8 | 5 | 5 | 7 | NA | 8 | 7 | 10 | NA | NA | NA | NA | NA | NA | NA | 0 | 14 | 0.5561 | 0.3539 | |
| Alexander Withenbury | 9 | 8 | 6 | 11 | 4 | 5 | 3 | 5 | 8 | 5 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 10 | 0.4384 | 0.1993 | |
177
283
12
| This Week's MA376 Predictions | |||||
|---|---|---|---|---|---|
| Week 22 | |||||
| Game | Prediction | Winner | Correct | Correct Votes | Correct Percent |
| 1 | Cincinnati Bengals | Los Angeles Rams | No | 3 | 0.25 |
| MA376 Individual Results | |||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Week 22 | |||||||||||||||||||||||||||
| Name | Weekly # Correct | Percent | Weeks Picked | Season Percent | Adj Season Percent | Season Trend | |||||||||||||||||||||
| Week 1 | Week 2 | Week 3 | Week 4 | Week 5 | Week 6 | Week 7 | Week 8 | Week 9 | Week 10 | Week 11 | Week 12 | Week 13 | Week 14 | Week 15 | Week 16 | Week 17 | Week 18 | Week 19 | Week 20 | Week 21 | Week 22 | ||||||
| Sammy Whipple | 8 | 11 | 10 | NA | 10 | 11 | 10 | 9 | 7 | 5 | 11 | NA | 9 | 9 | 13 | 13 | 13 | 8 | 5 | 2 | 1 | 1 | 1 | 20 | 0.6640 | 0.6036 | |
| Ryan Santoro | 12 | 11 | 12 | 11 | NA | 9 | 9 | 10 | 6 | 7 | 10 | 8 | 10 | 8 | 8 | 13 | 13 | 8 | 4 | 1 | 0 | 1 | 1 | 21 | 0.6453 | 0.6160 | |
| Tyler Vratny | 9 | 8 | 9 | NA | 11 | 5 | NA | 7 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 4 | 2 | 1 | 1 | 9 | 0.5714 | 0.2338 | |
| Cameron Jones | NA | 12 | 13 | 9 | 12 | 8 | 9 | 9 | 6 | 6 | 8 | 11 | 9 | 10 | NA | 11 | 14 | 9 | 4 | 2 | 1 | 0 | 0 | 20 | 0.6546 | 0.5951 | |
| Elijah Dabkowski | NA | 10 | 10 | 8 | 11 | 8 | 11 | 9 | 9 | 8 | 10 | 9 | 9 | 9 | 10 | 9 | 11 | 10 | 3 | 3 | 1 | 0 | 0 | 21 | 0.6340 | 0.6052 | |
| Tyler Guetzke | NA | 9 | 9 | 10 | 13 | 9 | 10 | 7 | 6 | 5 | 9 | 10 | 9 | 9 | 12 | NA | NA | NA | 5 | 1 | 1 | 0 | 0 | 18 | 0.6175 | 0.5052 | |
| Christopher Terry | 8 | 9 | 11 | NA | 10 | 10 | 10 | NA | NA | 4 | NA | NA | NA | 9 | 9 | NA | NA | NA | NA | NA | NA | 0 | 0 | 10 | 0.6015 | 0.2734 | |
| Jack Perreault | 9 | 8 | 10 | 11 | 11 | 9 | 8 | 9 | 6 | 7 | 10 | NA | 8 | NA | 9 | 10 | NA | NA | NA | 2 | NA | 0 | 0 | 16 | 0.5991 | 0.4357 | |
| Bethany Carter | 9 | 9 | 7 | 7 | 11 | 9 | 7 | 10 | 7 | 7 | 7 | 10 | 8 | 10 | 7 | 9 | 12 | 10 | 5 | 0 | 1 | 0 | 0 | 22 | 0.5765 | 0.5765 | |
| Caroline Swenson | 9 | 9 | 9 | 8 | 10 | 9 | 9 | 7 | 6 | NA | 9 | 9 | 9 | 8 | 9 | 9 | NA | 8 | NA | 1 | 1 | 0 | 0 | 19 | 0.5673 | 0.4899 | |
| Anders Grau | 6 | 9 | 10 | 8 | 11 | 7 | NA | 8 | 7 | 5 | 8 | 10 | 8 | 9 | 9 | NA | NA | NA | NA | 1 | 2 | 0 | 0 | 17 | 0.5463 | 0.4221 | |
| Samuel Deruse | NA | 8 | 8 | NA | 11 | 6 | 9 | NA | NA | NA | 8 | NA | 7 | 6 | NA | NA | NA | 8 | 3 | NA | NA | 0 | 0 | 11 | 0.5362 | 0.2681 | |
| Ryan Smith | NA | 12 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 1 | 0.8000 | 0.0364 | |
| Stanley Liu | NA | 13 | 11 | 10 | 10 | 10 | NA | NA | NA | 7 | NA | NA | NA | NA | 12 | NA | NA | NA | NA | 3 | 1 | NA | 0 | 9 | 0.6814 | 0.2788 | |
| Maurice Bellan | NA | 9 | NA | 12 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 2 | 0.6774 | 0.0616 | |
| John White | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 9 | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 1 | 0.6429 | 0.0292 | |
| Isaiah Smith | 12 | NA | 10 | 5 | NA | 10 | 9 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 5 | 0.6301 | 0.1432 | |
| Mitchell Miller | 10 | 8 | 10 | 9 | 11 | 9 | 10 | 8 | 7 | 6 | 8 | 10 | 9 | 10 | 7 | 11 | NA | NA | 5 | NA | NA | NA | 0 | 17 | 0.6116 | 0.4726 | |
| Chloe Zendt | 6 | 8 | 11 | 12 | 12 | 9 | 7 | 9 | 7 | 6 | 10 | 7 | 9 | 8 | 12 | NA | NA | NA | NA | NA | NA | NA | 0 | 15 | 0.6045 | 0.4122 | |
| Kiersten Eggers | 10 | 9 | 8 | 9 | 13 | 8 | 10 | 8 | 7 | 6 | 7 | 9 | 10 | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 13 | 0.6000 | 0.3545 | |
| Bennett Smith | 8 | 10 | 9 | 10 | 9 | 8 | 10 | NA | 8 | 6 | 8 | NA | NA | NA | NA | NA | NA | NA | 5 | NA | NA | NA | 0 | 11 | 0.5948 | 0.2974 | |
| Robert Warren | 10 | 8 | 10 | 10 | 11 | 9 | 7 | 8 | 5 | 7 | 10 | 8 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 12 | 0.5852 | 0.3192 | |
| Colin Day | 7 | 10 | 12 | 10 | 9 | 9 | 9 | NA | 8 | 6 | 9 | 4 | 10 | 9 | 8 | NA | NA | NA | NA | NA | NA | NA | 0 | 14 | 0.5825 | 0.3707 | |
| Gregg Puttkammer | 6 | 10 | 10 | 11 | 12 | 8 | 7 | 10 | 6 | 6 | 9 | 6 | NA | 9 | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 13 | 0.5789 | 0.3421 | |
| Henry Janeway | 7 | 9 | NA | 10 | NA | 6 | 9 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 5 | 0.5694 | 0.1294 | |
| Seth Benson | 5 | 10 | 13 | 9 | 9 | 7 | 8 | NA | NA | 6 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 8 | 0.5678 | 0.2065 | |
| Erika Hartel | 9 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 1 | 0.5625 | 0.0256 | |
| Aaron Bonner | NA | NA | 11 | 7 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 2 | 0.5625 | 0.0511 | |
| Alechandra Terenas | NA | 8 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 1 | 0.5333 | 0.0242 | |
| Oscar Morales | 11 | NA | 4 | NA | 8 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 0 | 3 | 0.4792 | 0.0653 | |
| Nicole Sacchinelli | NA | 4 | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA | 2 | NA | NA | 0 | 2 | 0.3158 | 0.0287 | |
176
284
31
| This Week's Combined Cadet and Instructor Predictions | |||||
|---|---|---|---|---|---|
| Week 22 | |||||
| Game | Prediction | Winner | Correct | Correct Votes | Correct Percent |
| 1 | Cincinnati Bengals | Los Angeles Rams | No | 9 | 0.2903 |
260
164
| This Week's Matched Cadet and Instructor Predictions | ||
|---|---|---|
| Week 22 | ||
| Game | Prediction | Correct |
| 1 | Cincinnati Bengals | No |
---
title: "2021 NFL Moneyline Picks"
output:
flexdashboard::flex_dashboard:
theme:
version: 4
bootswatch: solar
orientation: rows
vertical_layout: fill
social: ["menu"]
source_code: embed
navbar:
- { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer" }
---
```{r setup, include=FALSE}
# source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")
thematic::thematic_rmd(font = "auto")
```
```{r Reading in our picks files, include=FALSE}
current_week = 22 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2021 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2021 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2021 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2021 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2021 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2021 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2021 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2021 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2021 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2021 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2021 NFL Week 11.csv")
week_12 = read_csv("./CSV_Data_Files/2021 NFL Week 12.csv")
week_13 = read_csv("./CSV_Data_Files/2021 NFL Week 13.csv")
week_14 = read_csv("./CSV_Data_Files/2021 NFL Week 14.csv")
week_15 = read_csv("./CSV_Data_Files/2021 NFL Week 15.csv")
week_16 = read_csv("./CSV_Data_Files/2021 NFL Week 16.csv")
week_17 = read_csv("./CSV_Data_Files/2021 NFL Week 17.csv")
week_18 = read_csv("./CSV_Data_Files/2021 NFL Week 18.csv")
week_19 = read_csv("./CSV_Data_Files/2021 NFL Wild Card.csv")
week_20 = read_csv("./CSV_Data_Files/2021 NFL Divisional Round.csv")
week_21 = read_csv("./CSV_Data_Files/2021 NFL Conference Round.csv")
week_22 = read_csv("./CSV_Data_Files/2021 NFL Super Bowl.csv")
cadet_wk1 = read_csv("./CSV_Data_Files/2021 NFL Week 1 MA376.csv")
cadet_wk2 = read_csv("./CSV_Data_Files/2021 NFL Week 2 MA376.csv")
cadet_wk3 = read_csv("./CSV_Data_Files/2021 NFL Week 3 MA376.csv")
cadet_wk4 = read_csv("./CSV_Data_Files/2021 NFL Week 4 MA376.csv")
cadet_wk5 = read_csv("./CSV_Data_Files/2021 NFL Week 5 MA376.csv")
cadet_wk6 = read_csv("./CSV_Data_Files/2021 NFL Week 6 MA376.csv")
cadet_wk7 = read_csv("./CSV_Data_Files/2021 NFL Week 7 MA376.csv")
cadet_wk8 = read_csv("./CSV_Data_Files/2021 NFL Week 8 MA376.csv")
cadet_wk9 = read_csv("./CSV_Data_Files/2021 NFL Week 9 MA376.csv")
cadet_wk10 = read_csv("./CSV_Data_Files/2021 NFL Week 10 MA376.csv")
cadet_wk11 = read_csv("./CSV_Data_Files/2021 NFL Week 11 MA376.csv")
cadet_wk12 = read_csv("./CSV_Data_Files/2021 NFL Week 12 MA376.csv")
cadet_wk13 = read_csv("./CSV_Data_Files/2021 NFL Week 13 MA376.csv")
cadet_wk14 = read_csv("./CSV_Data_Files/2021 NFL Week 14 MA376.csv")
cadet_wk15 = read_csv("./CSV_Data_Files/2021 NFL Week 15 MA376.csv")
cadet_wk16 = read_csv("./CSV_Data_Files/2021 NFL Week 16 MA376.csv")
cadet_wk17 = read_csv("./CSV_Data_Files/2021 NFL Week 17 MA376.csv")
cadet_wk18 = read_csv("./CSV_Data_Files/2021 NFL Week 18 MA376.csv")
cadet_wk19 = read_csv("./CSV_Data_Files/2021 NFL Wild Card MA376.csv")
cadet_wk20 = read_csv("./CSV_Data_Files/2021 NFL Divisional Round MA376.csv")
cadet_wk21 = read_csv("./CSV_Data_Files/2021 NFL Conference Round MA376.csv")
cadet_wk22 = read_csv("./CSV_Data_Files/2021 NFL Super Bowl MA376.csv")
#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv"))
#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>%
mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))
#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>%
mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>%
mutate(Percent = round(Percent,4))
#Reading in the moneyline odds for each team and cleaning the team names
odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))
####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7,
week_8, week_9, week_10, week_11, week_12, week_13, week_14,
week_15, week_16, week_17, week_18, week_19, week_20,
week_21, week_22) #add in the additional weeks
cdt.picks = list(cadet_wk1, cadet_wk2, cadet_wk3, cadet_wk4, cadet_wk5,
cadet_wk6, cadet_wk7, cadet_wk8, cadet_wk9, cadet_wk10, cadet_wk11,
cadet_wk12, cadet_wk13, cadet_wk14, cadet_wk15, cadet_wk16,
cadet_wk17, cadet_wk18, cadet_wk19, cadet_wk20,
cadet_wk21, cadet_wk22) #add in the additional weeks
odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7,
odds_wk8, odds_wk9, odds_wk10, odds_wk11, odds_wk12, odds_wk13,
odds_wk14, odds_wk15, odds_wk16, odds_wk17, odds_wk18, odds_wk19,
odds_wk20, odds_wk21, odds_wk22) #add in the additional weeks
####################END OF UPDATE##############################
weeks = as.list(seq(1:current_week)) #creating a list of each week number
```
```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
cl_odds = odds_cleaning(odds)
#Cleaning scores data
Scores = cleaning2(Scores)
#creating a list of winners for each week
winners = map(weeks, weekly_winners)
#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])
#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```
```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)
#Creating the prediction table.
pred_table = map(games, pred_table_fn)
#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)
#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```
```{r Displaying Group Results, echo=FALSE}
#Displaying the group results
inst_group_table = results[[length(results)]] %>% gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Predictions"),
subtitle = md(glue("Week {length(results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
)) %>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage
#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)
#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)
#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)
##### Remove this line before next season
weekly_group_correct_picks[[22]]=0
#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)
#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)
#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))
#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))
#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```
```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>%
rename(`Win Percentage` = ".") %>%
add_column(Week = unlist(weeks))
```
```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>%
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
geom_point()+
geom_path(aes(x = Week))+
#geom_text(aes(label=`Win Percentage`),hjust=.5, vjust=-1.5)+
ylim(c(0, 1)) +
xlab("NFL Week") +
ylab("Correct Percentage")+
ggtitle("Weekly Group Correct Percentage")+
theme_classic()+
theme(plot.title = element_text(hjust = 0.5, size = 18))
```
```{r instructor beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)
#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)
#Creating a list of how many cbs experts picked each week.
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```
```{r instructor beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)
#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)
#Creating a list of how many cbs experts picked each week.
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```
```{r instructor beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)
#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)
#Creating a list of how many cbs experts picked each week.
espn_experts_total = map(espn_weekly_percent, experts_tot)
```
```{r instructor beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)
#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)
#Creating a list of how many cbs experts picked each week.
espn_experts_season_total = map(espn_season_percent, experts_tot)
```
```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)
p = inst.picks[[21]]
#Combining each week into one dataframe and calculating percentage Correct for this week.
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>%
mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4))
#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))
#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
for(j in 1:length(a)){
help[j] = ifelse(is.na(a[i,j])==T,0,1)
tot_week[i] = sum(help)
}
}
#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
for(j in 1:length(a)){
help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
tot_picks[i] = sum(help)
}
}
#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
tot_correct[i] = sum(a[i,], na.rm = T)
}
#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
add_column(tot_correct)%>%
add_column(tot_picks)%>%
mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
select(-tot_correct, -tot_picks) %>%
arrange(desc(Percent), desc(`Season Percent`)) %>%
mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```
```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")
weekly_indiv_percent_plot = weekly_indiv_percent %>%
pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>%
mutate(Week = as.factor(Week))
levels = NULL
for(i in 1:length(weeks)){
levels[i] = glue("Week {i}")
}
weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
mutate(Week = factor(Week, levels))
```
```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
plot_object =
ggplot(data = df,
aes(x = as.factor(Week), y=Percent, group = 1))+
geom_path(size = 7)+
scale_y_continuous(limits = c(0,1))+
theme_void()+
theme(legend.position = "none")
return(plot_object)
}
sparklines =
weekly_indiv_percent_plot %>%
group_by(Name) %>%
nest() %>%
mutate(plot = map2(Name, data, plot_group)) %>%
select(-data)
indiv_disp_2 = indiv_disp %>%
inner_join(sparklines, by = "Name") %>%
mutate(`Season Trend` = NA)
```
```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("Individual Results"),
subtitle = md(glue("Week {length(weeks)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Percent),
rows = Percent<.5
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Percent),
rows = Percent>.5
)) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(`Season Percent`),
rows = `Season Percent`<.5
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(`Season Percent`),
rows = `Season Percent`>.5
))%>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(`Adj Season Percent`),
rows = `Adj Season Percent`<.5
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(`Adj Season Percent`),
rows = `Adj Season Percent`>.5
)) %>%
tab_options(
container.width = pct(100),
data_row.padding = px(1),
container.height = "100%"
) %>%
tab_spanner(
label = "Weekly # Correct",
columns = starts_with(c("Week "))
) %>%
text_transform(
locations = cells_body(c(`Season Trend`)),
fn = function(x){
map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
}) %>%
cols_hide(c(plot))
indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```
```{r instructor formattable, echo=FALSE}
improvement_formatter <-
formatter("span",
style = x ~ formattable::style(
font.weight = "bold",
color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
x ~ icontext(ifelse(x == max(x), "star", ""), x))
indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))
indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3,
align = c("l", rep("c", NROW(indiv_disp_3)-1)),
list(`Season Percent` = color_bar("#FA614B"),
`Season Percent`= improvement_formatter,
`Adj Season Percent`= improvement_formatter)))
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```
```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.
inst_indiv_plots = weekly_indiv_percent_plot %>%
ggplot(aes(x = factor(Week), y = Percent, color = Name))+
geom_point()+
geom_path(aes(x = as.factor(Week), y = Percent, color = Name,
group = Name))+
geom_text_repel(aes(label=round(Percent,3)),hjust=0.5, vjust=2, size = 3)+
ylim(c(0, 1)) +
labs(x = "NFL Week",
y = "Correct Percentage",
title = "Weekly Individual Correct Percentage")+
facet_wrap(~Name)+
theme_classic()+
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 18),
axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```
```{r Cadet Group Predictions, include=FALSE}
### Cadet Group Predictions
#Creating the list of everyones predictions each week.
c_games = map(cdt.picks, games_fn)
#Creating the prediction table.
c_pred_table = map(c_games, pred_table_fn)
#Adding who won to the predictions
c_with_winners = map2(c_pred_table, winners, adding_winners)
#Creating results for each week.
c_results = map2(c_with_winners,weekly_number_of_games, c_results_fn)
```
```{r Printing Cadet Group Prediction Table, echo=FALSE}
#Displaying the group results
c_group_table = c_results[[length(c_results)]] %>%
gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's MA376 Predictions"),
subtitle = md(glue("Week {length(results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
))%>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r Cadet Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage
#how many games correct, incorrect, and not picked each week
c_weekly_group_correct = map(c_results, weekly_group_correct_fn)
#how many games were picked each week
c_weekly_games_picked = map2(c_weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)
#Calculating the number of correct picks for each week
c_weekly_group_correct_picks = map(c_weekly_group_correct, weekly_group_correct_picks_fn)
######### Remove this line before next season.
c_weekly_group_correct_picks[[22]]=0
#Calculating weekly win percentage
c_weekly_win_percentage = map2(c_weekly_group_correct_picks, c_weekly_games_picked, weekly_win_percentage_fn)
#Calculating season win percentage
c_season_win_percentage = round(sum(unlist(c_weekly_group_correct_picks))/sum(unlist(c_weekly_games_picked)),4)
#Calculating number of games picked this season
c_season_games = sum(unlist(c_weekly_games_picked))
#calculating season wins
c_season_wins = sum(unlist(c_weekly_group_correct_picks))
#calculating the number of people who picked this week
c_Total = dim(cdt.picks[[length(weeks)]])[1]
```
```{r Data for MA376 group results, include=FALSE}
#Previous Weeks
c_group_season_for_plotting = unlist(c_weekly_win_percentage) %>% as.data.frame() %>%
rename(`Win Percentage` = ".") %>%
add_column(Week = unlist(weeks))
```
```{r Plotting MA376 group results, echo=FALSE}
c_group_plot = c_group_season_for_plotting %>%
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
geom_point()+
geom_path(aes(x = Week))+
#geom_text(aes(label=`Win Percentage`),hjust=.5, vjust=-1.5)+
ylim(c(0, 1)) +
labs(x = "NFL Week",
y = "Correct Percentage",
title = "Weekly MA376 Group Correct Percentage",
caption = glue::glue("Best week is Week {c_group_season_for_plotting$Week[which(c_group_season_for_plotting$`Win Percentage`==max(c_group_season_for_plotting$`Win Percentage`))]}"))+
theme_classic()+
theme(plot.title = element_text(hjust = 0.5, size = 18))
```
```{r Cadet beating cbs week, include=FALSE}
#Creating a list of how many cbs experts the cadets beat each week.
c_cbs_experts_beat = map2(cbs_weekly_percent, c_weekly_win_percentage, experts_beat)
```
```{r cadet beating cbs season, include=FALSE}
#Creating a list of how many cbs experts the cadets beat for the season.
c_cbs_experts_beat_season = map2(cbs_season_percent, c_season_win_percentage, experts_beat)
```
```{r Cadet beating ESPN, include=FALSE}
#Creating a list of how many cbs experts the cadets beat each week.
c_espn_experts_beat = map2(espn_weekly_percent, c_weekly_win_percentage, experts_beat)
```
```{r cadet beating ESPN season, include=FALSE}
#Creating a list of how many cbs experts the cadets beat for the season.
c_espn_experts_beat_season = map2(espn_season_percent, c_season_win_percentage, experts_beat)
```
```{r cdt individual results, include=FALSE}
#Creating a list of individual results for each week.
c_weekly_indiv = pmap(list(cdt.picks, winners, weeks), indiv_weekly_pred)
#Combining each week into one dataframe and calculating percentage Correct for this week.
c_full_season = c_weekly_indiv %>% reduce(full_join, by = "Name") %>%
mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4))
#Creating a dataframe with only the weekly picks
c_a = c_full_season %>% select(starts_with("Week"))
#Creating a vector of how many weeks each person picked over the season
c_tot_week = NULL
c_help = NULL
for (i in 1:dim(c_a)[1]){
for(j in 1:length(c_a)){
c_help[j] = ifelse(is.na(c_a[i,j])==T,0,1)
c_tot_week[i] = sum(c_help)
}
}
#Creating a vector of how many games each person picked over the season
c_tot_picks= NULL
c_help = NULL
for (i in 1:dim(c_a)[1]){
for(j in 1:length(c_a)){
c_help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(c_a[i,j])==T,0,1)
c_tot_picks[i] = sum(c_help)
}
}
#Creatign a vector of how many games each person picked correct over the season
c_tot_correct = NULL
c_help = NULL
for (i in 1:dim(c_a)[1]){
c_tot_correct[i] = sum(c_a[i,], na.rm = T)
}
#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
c_indiv_disp = c_full_season %>%
add_column(`Weeks Picked` = c_tot_week) %>%
add_column(c_tot_correct)%>%
add_column(c_tot_picks)%>%
mutate(`Season Percent` = round(c_tot_correct/c_tot_picks,4))%>%
mutate(`Adj Season Percent` = round(`Season Percent`*(c_tot_week/length(c_a)),4)) %>%
select(-c_tot_correct, -c_tot_picks) %>%
arrange(desc(Percent), desc(`Season Percent`)) %>%
mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```
```{r cdt individual percentages, include=FALSE}
#Calculating individual percentages for each week.
c_weekly_indiv_percent = map2(c_weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")
c_weekly_indiv_percent_plot = c_weekly_indiv_percent %>%
pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent") %>%
mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
c_weekly_indiv_percent_plot = c_weekly_indiv_percent_plot %>%
mutate(Week = factor(Week, levels))
```
```{r cadet sparklines, include=FALSE}
#adding sparklines
c_sparklines =
c_weekly_indiv_percent_plot %>%
group_by(Name) %>%
nest() %>%
mutate(plot = map2(Name, data, plot_group)) %>%
select(-data)
c_indiv_disp_2 = c_indiv_disp %>%
inner_join(c_sparklines, by = "Name") %>%
mutate(`Season Trend` = NA)
```
```{r Printing Individual Cdt Table, echo=FALSE}
# Printing the individual Table
c_indiv_table = c_indiv_disp_2 %>%
gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("MA376 Individual Results"),
subtitle = md(glue("Week {length(weeks)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Percent),
rows = Percent<.5
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Percent),
rows = Percent>.5
)) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(`Season Percent`),
rows = `Season Percent`<.5
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(`Season Percent`),
rows = `Season Percent`>.5
))%>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(`Adj Season Percent`),
rows = `Adj Season Percent`<.5
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(`Adj Season Percent`),
rows = `Adj Season Percent`>.5
))%>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)%>%
tab_spanner(
label = "Weekly # Correct",
columns = starts_with(c("Week "))
)%>%
text_transform(
locations = cells_body(c(`Season Trend`)),
fn = function(x){
map(c_indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
}) %>%
cols_hide(c(plot))
c_indiv_winners = c_indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
c_indiv_season = c_indiv_disp_2 %>%
filter(`Season Percent` == max(`Season Percent`)) %>%
select(Name) %>%
pull() %>%
paste(collapse = ", ")
c_indiv_season_adj = c_indiv_disp_2 %>%
filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>%
select(Name) %>%
pull() %>%
paste(collapse = ", ")
```
```{r Plotting individual Cdt results over the season2, echo=FALSE}
#Creating the individual plot.
c_indiv_plot = c_weekly_indiv_percent_plot %>%
ggplot(aes(x = as.factor(Week), y = Percent, color = Name))+
geom_point()+
geom_line(aes(x = as.factor(Week), y = Percent, color = Name,
group = Name))+
geom_text_repel(aes(label=round(Percent,4)),hjust=.5, vjust=2, size = 3)+
#geom_text(aes(label=Percent),hjust=.5, vjust=-1.5)+
ylim(c(0, 1)) +
labs(x = "NFL Week",
y = "Correct Percentage",
title = "Weekly MA376 Individual Correct Percentage")+
theme_classic()+
facet_wrap(~Name)+
# scale_x_discrete(guide = guide_axis(n.dodge = 2))+
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5, size = 18),
axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```
```{r Combined Cadet and Instructor Predictions, include=FALSE}
#Combining inst and cadet picks
comb_picks = map2(inst.picks, cdt.picks, comb_picks_fn)
#Creating the list of Combined predictions each week.
comb_games = map(comb_picks, games_fn)
#Creating the Combined prediction table.
comb_pred_table = map(comb_games, pred_table_fn)
#Adding who won to the predictions
comb_with_winners = map2(comb_pred_table, winners, adding_winners)
#Creating Combined results for each week.
comb_results = map2(comb_with_winners,weekly_number_of_games, comb_results_fn)
```
```{r Printing Combined Prediction Results, echo=FALSE}
#Displaying the Combined results
comb_table = comb_results[[length(comb_results)]] %>%
gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Combined Cadet and Instructor Predictions"),
subtitle = md(glue("Week {length(results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
))%>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r Combined Results over season, include=FALSE}
#how many games correct, incorrect, and not picked each week
comb_weekly_group_correct = map(comb_results, weekly_group_correct_fn)
#how many games were picked each week
comb_weekly_games_picked = map2(comb_weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)
#Calculating the number of correct picks for each week
comb_weekly_group_correct_picks = map(comb_weekly_group_correct, weekly_group_correct_picks_fn)
####### Remove this line before next season
comb_weekly_group_correct_picks[[22]]=0
#Calculating weekly win percentage
comb_weekly_win_percentage = map2(comb_weekly_group_correct_picks, comb_weekly_games_picked, weekly_win_percentage_fn)
#Calculating season win percentage
comb_season_win_percentage = round(sum(unlist(comb_weekly_group_correct_picks))/sum(unlist(comb_weekly_games_picked)),4)
#Calculating number of games picked this season
comb_season_games = sum(unlist(comb_weekly_games_picked))
#calculating season wins
comb_season_wins = sum(unlist(comb_weekly_group_correct_picks))
# #calculating combined weekly win percentage
# comb_weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)
#calculating the number of people who picked this week
comb_Total = dim(comb_picks[[length(comb_picks)]])[1]
comb_season_for_plotting = unlist(comb_weekly_win_percentage) %>% as.data.frame() %>%
rename(`Win Percentage` = ".") %>%
add_column(Week = unlist(weeks))
```
```{r Plotting the Combined group results, echo=FALSE}
comb_plot = comb_season_for_plotting %>%
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
geom_point()+
geom_path(aes(x = Week))+
#geom_text(aes(label=`Win Percentage`),hjust=.5, vjust=-1.5)+
ylim(c(0, 1)) +
labs(x = "NFL Week",
y = "Correct Percentage",
title = "Weekly Combined Correct Percentage",
caption = glue::glue("Best week is Week {comb_season_for_plotting$Week[which(comb_season_for_plotting$`Win Percentage`==max(comb_season_for_plotting$`Win Percentage`))]}"))+
theme_classic()+
theme(plot.title = element_text(hjust = 0.5, size = 18))
```
```{r Combined beating cbs, include=FALSE}
#Creating a list of how many cbs experts our combined picks beat each week.
comb_cbs_experts_beat = map2(cbs_weekly_percent, comb_weekly_win_percentage, experts_beat)
```
```{r combined beating cbs season, include=FALSE}
#Creating a list of how many cbs experts our combined picks beat for the season.
comb_cbs_experts_beat_season = map2(cbs_season_percent, comb_season_win_percentage, experts_beat)
```
```{r Combined beating ESPN, include=FALSE}
#Creating a list of how many cbs experts we beat each week.
comb_espn_experts_beat = map2(espn_weekly_percent, comb_weekly_win_percentage, experts_beat)
```
```{r combined beating ESPN season, include=FALSE}
#Creating a list of how many cbs experts our combined picks beat for the season.
comb_espn_experts_beat_season = map2(espn_season_percent, comb_season_win_percentage, experts_beat)
```
```{r matched picks, include=FALSE}
#Finding where inst and Cadet predictions match
matched = map2(results, c_results, matched_fn)
```
```{r Printing matched results, echo=FALSE}
matched_table = matched[[length(matched)]] %>%
gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Matched Cadet and Instructor Predictions"),
subtitle = md(glue("Week {length(results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
))%>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r include=FALSE}
matched_per = map(matched, matched_percent_fn) %>% unlist() %>% as.data.frame()
##### Remove this line before next year
matched_per[22,1] = 0
matched_season_percent_for_plotting = matched_per %>%
mutate(`Win Percentage` = matched_per[,1]) %>%
select(`Win Percentage`) %>%
add_column(Week = unlist(weeks))
```
```{r Plotting matched percent, echo=FALSE}
matched_plot = matched_season_percent_for_plotting %>%
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
geom_point()+
geom_path(aes(x = Week))+
#geom_text(aes(label=`Win Percentage`),hjust=.5, vjust=-1.5)+
ylim(c(0, 1)) +
labs(x = "NFL Week",
y = "Correct Percentage",
title = "Weekly Matched Correct Percentage",
caption = glue::glue("Best week is Week {comb_season_for_plotting$Week[which(comb_season_for_plotting$`Win Percentage`==max(comb_season_for_plotting$`Win Percentage`))]}"))+
theme_classic()+
theme(plot.title = element_text(hjust = 0.5, size = 18))
```
```{r Matched Results over season, include=FALSE}
#how many games correct, incorrect, and not picked each week
matched_weekly_group_correct = map(matched, weekly_group_correct_fn)
#how many games were picked each week
matched_weekly_games_picked = map2(matched_weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)
#Calculating the number of correct picks for each week
matched_weekly_group_correct_picks = map(matched_weekly_group_correct, weekly_group_correct_picks_fn)
#Calculating weekly win percentage
matched_weekly_win_percentage = map2(matched_weekly_group_correct_picks, matched_weekly_games_picked, weekly_win_percentage_fn)
#Calculating season win percentage
matched_season_win_percentage = round(sum(unlist(matched_weekly_group_correct_picks))/sum(unlist(matched_weekly_games_picked)),4)
#Calculating number of games picked this season
matched_season_games = sum(unlist(matched_weekly_games_picked))
#calculating season wins
matched_season_wins = sum(unlist(matched_weekly_group_correct_picks))
```
```{r Calculting instructor winnings based on moneyline odds}
#adding the odds and winnings to the results table
odds_results = map2(weeks, results, weekly_odds)
#Creating a list of total winnings for each week
weekly_winnings = map(odds_results, weekly_money)
#total amount we have won/lost this season
season_money = weekly_winnings %>%
unlist() %>%
as.data.frame() %>%
rename("Weekly Winnings" = 1) %>%
mutate("Season Winnings" = cumsum(`Weekly Winnings`))
```
```{r Creating instructor winnings table, echo=FALSE}
#Displaying the group moneyline results
inst_group_odds_table = odds_results[[length(odds_results)]] %>% gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Winnings"),
subtitle = md(glue("Week {length(odds_results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "red"),
locations = cells_body(
columns = c(Winnings),
rows = Winnings < 0
)) %>%
grand_summary_rows(
columns = c(Winnings),
fns = list(
Total = ~sum(.)),
missing_text = "",
formatter = fmt_currency
) %>%
# tab_style(
# style = cell_text(color = "red"),
# locations = cells_grand_summary(
# columns = c(Winnings),
# rows = 0 > `Total`
# )) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
)) %>%
fmt_currency(
columns = c(Winnings),
currency = "USD"
) %>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r Instructor winnings plot}
group_moneyline_plot_data = group_season_for_plotting %>%
add_column(season_money) %>%
select(-`Win Percentage`)
group_moneyline_plot = group_moneyline_plot_data %>%
ggplot(aes(x = as.factor(Week),
y = `Season Winnings`,
fill = `Season Winnings` < 0))+
geom_bar(stat = "identity")+
scale_fill_manual(values = c("#be0032", "#006400"))+
new_scale("fill")+
geom_point(aes(x = as.factor(Week), y = `Weekly Winnings`,
fill = `Weekly Winnings` < 0),
size = 3, shape = 21, color = "black", stroke=2)+
geom_path(aes(x = as.factor(Week), y = `Weekly Winnings`))+
scale_fill_manual(values = c("#be0032", "#006400"))+
labs(x = "NFL Week", y = "Winnings", title = "Instructor weekly and season winnings",
subtitle = "Bars represent season cumulative gains and losses. \nPoints represent Weekly gains and losses.")+
geom_hline(aes(yintercept = 0))+
theme_classic()+
theme(legend.position = "none",
plot.title = element_text(hjust = .5, size = 18),
plot.subtitle = element_markdown(hjust = .5, size = 10))
this_weeks_inst_money = group_moneyline_plot_data %>%
filter(Week==current_week) %>%
select(`Weekly Winnings`) %>%
pull() %>%
scales::dollar()
this_seasons_inst_money = group_moneyline_plot_data %>%
filter(Week==current_week) %>%
select(`Season Winnings`) %>%
pull() %>%
scales::dollar()
```
```{r Calculting cadet winnings based on moneyline odds}
#adding the odds and winnings to the results table
c_odds_results = map2(weeks, c_results, weekly_odds)
#Creating a list of total winnings for each week
c_weekly_winnings = map(c_odds_results, weekly_money)
#total amount we have won/lost this season
c_season_money = c_weekly_winnings %>%
unlist() %>%
as.data.frame() %>%
rename("Weekly Winnings" = 1) %>%
mutate("Season Winnings" = cumsum(`Weekly Winnings`))
```
```{r Creating cadet winnings table, echo=FALSE}
#Displaying the group moneyline results
c_group_odds_table = c_odds_results[[length(c_odds_results)]] %>% gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Cadet Winnings"),
subtitle = md(glue("Week {length(c_odds_results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "red"),
locations = cells_body(
columns = c(Winnings),
rows = Winnings < 0
)) %>%
grand_summary_rows(
columns = c(Winnings),
fns = list(
Total = ~sum(.)),
missing_text = "",
formatter = fmt_currency
) %>%
# tab_style(
# style = cell_text(color = "red"),
# locations = cells_grand_summary(
# columns = c(Winnings),
# rows = 0 > `Total`
# )) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
)) %>%
fmt_currency(
columns = c(Winnings),
currency = "USD"
) %>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r Cadet winnings plot}
c_group_moneyline_plot_data = c_group_season_for_plotting %>%
add_column(c_season_money) %>%
select(-`Win Percentage`)
c_group_moneyline_plot = c_group_moneyline_plot_data %>%
ggplot(aes(x = as.factor(Week),
y = `Season Winnings`,
fill = `Season Winnings` < 0))+
geom_bar(stat = "identity")+
scale_fill_manual(values = c("#be0032", "#006400"))+
new_scale("fill")+
geom_point(aes(x = as.factor(Week), y = `Weekly Winnings`,
fill = `Weekly Winnings` > 0),
size = 3, shape = 21, color = "black", stroke=2)+
geom_path(aes(x = as.factor(Week), y = `Weekly Winnings`))+
scale_fill_manual(values = c("#be0032", "#006400"))+
labs(x = "NFL Week", y = "Winnings", title = "Cadet weekly and season winnings",
subtitle = "Bars represent season cumulative gains and losses. \nPoints represent Weekly gains and losses.")+
geom_hline(aes(yintercept = 0))+
theme_classic()+
theme(legend.position = "none",
plot.title = element_text(hjust = .5, size = 18),
plot.subtitle = element_markdown(hjust = .5, size = 10))
this_weeks_cadet_money = c_group_moneyline_plot_data %>%
filter(Week==current_week) %>%
select(`Weekly Winnings`) %>%
pull() %>%
scales::dollar()
this_seasons_cadet_money = c_group_moneyline_plot_data %>%
filter(Week==current_week) %>%
select(`Season Winnings`) %>%
pull() %>%
scales::dollar()
```
```{r Calculting combined winnings based on moneyline odds}
#adding the odds and winnings to the results table
comb_odds_results = map2(weeks, comb_results, weekly_odds)
#Creating a list of total winnings for each week
comb_weekly_winnings = map(comb_odds_results, weekly_money)
#total amount we have won/lost this season
comb_season_money = comb_weekly_winnings %>%
unlist() %>%
as.data.frame() %>%
rename("Weekly Winnings" = 1) %>%
mutate("Season Winnings" = cumsum(`Weekly Winnings`))
```
```{r Creating combined winnings table, echo=FALSE}
#Displaying the group moneyline results
comb_group_odds_table = comb_odds_results[[length(comb_odds_results)]] %>% gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Combined Picks Winnings"),
subtitle = md(glue("Week {length(comb_odds_results)}"))
) %>%
tab_style(
style = cell_text(color = "red", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="No"
)) %>%
tab_style(
style = cell_text(color = "red"),
locations = cells_body(
columns = c(Winnings),
rows = Winnings < 0
)) %>%
grand_summary_rows(
columns = c(Winnings),
fns = list(
Total = ~sum(.)),
missing_text = "",
formatter = fmt_currency
) %>%
# tab_style(
# style = cell_text(color = "red"),
# locations = cells_grand_summary(
# columns = c(Winnings),
# rows = 0 > `Total`
# )) %>%
tab_style(
style = cell_text(color = "green", weight = "bold"),
locations = cells_body(
columns = c(Correct),
rows = Correct =="Yes"
)) %>%
fmt_currency(
columns = c(Winnings),
currency = "USD"
) %>%
tab_options(
data_row.padding = px(3),
container.height = "100%"
)
```
```{r combined winnings plot}
comb_group_moneyline_plot_data = comb_season_for_plotting %>%
add_column(comb_season_money) %>%
select(-`Win Percentage`)
comb_moneyline_plot = comb_group_moneyline_plot_data %>%
ggplot(aes(x = as.factor(Week),
y = `Season Winnings`,
fill = `Season Winnings` > 0))+
geom_bar(stat = "identity")+
scale_fill_manual(values = c("#be0032", "#006400"))+
new_scale("fill")+
geom_point(aes(x = as.factor(Week), y = `Weekly Winnings`,
fill = `Weekly Winnings` > 0),
size = 3, shape = 21, color = "black", stroke=2)+
geom_path(aes(x = as.factor(Week), y = `Weekly Winnings`))+
scale_fill_manual(values = c("#be0032", "#006400"))+
labs(x = "NFL Week", y = "Winnings", title = "Combined picks weekly and season winnings",
subtitle = "Bars represent season cumulative gains and losses. \nPoints represent Weekly gains and losses.")+
geom_hline(aes(yintercept = 0))+
theme_classic()+
theme(legend.position = "none",
plot.title = element_text(hjust = .5, size = 18),
plot.subtitle = element_markdown(hjust = .5, size = 10))
this_weeks_comb_money = comb_group_moneyline_plot_data %>%
filter(Week==current_week) %>%
select(`Weekly Winnings`) %>%
pull() %>%
scales::dollar()
this_seasons_comb_money = comb_group_moneyline_plot_data %>%
filter(Week==current_week) %>%
select(`Season Winnings`) %>%
pull() %>%
scales::dollar()
```
```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
cdt.data = map2(cdt.picks, weeks, disp_data) %>% bind_rows()
```
```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
cadet_538 = map(c_results, five38) %>% unlist() %>% sum()
comb_538 = map(comb_results, five38) %>% unlist() %>% sum()
```
```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week
#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)
#Creating the prediction table.
pred_table = map(games, pred_table_fn)
#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>%
rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>%
gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Predictions"),
subtitle = md(glue("Week {length(weeks)}"))
) %>%
tab_options(
data_row.padding = px(3)
)
#Creating the list of cadet group predictions each week.
c_games = map(cdt.picks, games_fn)
#Creating the prediction table.
c_pred_table = map(c_games, pred_table_fn)
#Printing table of Cadet predictions
c_pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>%
rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>%
gt() %>%
cols_align(
align = "center") %>%
tab_header(
title = md("This Week's Cadet Predictions"),
subtitle = md(glue("Week {length(weeks)}"))
) %>%
tab_options(
data_row.padding = px(3)
)
```
Instructor Group Predictions {data-navmenu="Instructor Results"}
==========================================================================
Sidebar {.sidebar}
-------------------------------------
#### CBS Sports
This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.
For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
#### ESPN
We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.
Row
--------------------------------------
### Win percentage for the week
```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = weekly_win_percentage[[length(weekly_win_percentage)]],icon = "fa-user-plus",caption = "Win percentage for the week.",color = "green")
```
### Season Win Percentage
```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = season_win_percentage,icon = "fa-user-plus",caption = "Season win percentage.",color = "green")
```
### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```
### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```
### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```
Row
--------------------------------------
###
```{r}
inst_group_table
```
###
```{r}
ggplotly(inst_group_season_plot) %>%
layout(title = list(y = .93, xref = "plot"),
margin = list(t = 40))
```
Instructor Individual Predictions {data-navmenu="Instructor Results"}
==========================================================================
Sidebar {.sidebar}
-------------------------------------
#### Best Picks of the Week.
`r indiv_winners`
#### Best Season Correct Percentage
`r indiv_season`
#### Best Adjusted Season Correct Percentage
`r indiv_season_adj`
* Adjusted season percentage accounts for the number of weeks picked.
row {.tabset}
--------------------------------------
### Individual Table
```{r}
indiv_table
```
### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```
Cadet Group Predictions {data-navmenu="Cadet Results"}
==========================================================================
Sidebar {.sidebar}
-------------------------------------
#### CBS Sports
This week we beat or tied `r c_cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.
For the season we are currently beating or tied with `r c_cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
#### ESPN
We also beat or tied `r c_espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
For the season we are currently beating or tied with `r c_espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.
Row
--------------------------------------
### Win percentage for the week
```{r}
cadet_rate <- c_weekly_win_percentage[[length(c_weekly_win_percentage)]]*100
gauge(cadet_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = c_weekly_win_percentage[[length(c_weekly_win_percentage)]],icon = "fa-user-plus",caption = "Win percentage for the week.",color = "green")
```
### Season Win Percent
```{r}
cadet_season <- c_season_win_percentage*100
gauge(cadet_season, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = c_season_win_percentage,icon = "fa-user-plus",caption = "Season win percentage.",color = "green")
```
### Games Correct
```{r}
valueBox(value = c_season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```
### Games Picked
```{r}
valueBox(value = c_season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```
### Predictions
```{r}
valueBox(value = c_Total,icon = "fa-users",caption = "Predictions this week")
```
Row
--------------------------------------
###
```{r}
c_group_table
```
###
```{r}
ggplotly(c_group_plot) %>%
layout(title = list(y = .93, xref = "plot"),
margin = list(t = 40))
```
Cadet Individual Predictions {data-navmenu="Cadet Results"}
==========================================================================
Sidebar {.sidebar}
-------------------------------------
#### Best Picks of the Week.
`r c_indiv_winners`
#### Best Season Correct Percentage
`r c_indiv_season`
#### Best Adjusted Season Correct Percentage
`r c_indiv_season_adj`
* Adjusted season percentage accounts for the number of weeks picked.
Column {.tabset}
--------------------------------------
### Cadet Individual Table
```{r}
c_indiv_table
```
### Cadet Individual Plots
```{r, out.width="100%", out.height="100%"}
ggplotly(c_indiv_plot)
```
Combined Predictions
==========================================================================
Sidebar {.sidebar}
-------------------------------------
#### CBS Sports
This week our combined predictions beat or tied `r comb_cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.
For the season we are currently beating or tied with `r comb_cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
#### ESPN
Our combined predictions also beat or tied `r comb_espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
For the season our combined predictions are currently beating or tied with `r comb_espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.
Row
--------------------------------------
### Win percentage for the week
```{r}
comb_rate <- comb_weekly_win_percentage[[length(comb_weekly_win_percentage)]]*100
gauge(comb_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = comb_weekly_win_percentage[[length(comb_weekly_win_percentage)]],icon = "fa-user-plus",caption = "Win percentage for the week.",color = "green")
```
### Season Win Percent
```{r}
comb_season <- comb_season_win_percentage*100
gauge(comb_season, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = comb_season_win_percentage,icon = "fa-user-plus",caption = "Season win percentage.",color = "green")
```
### Games Correct
```{r}
valueBox(value = comb_season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```
### Games Picked
```{r}
valueBox(value = comb_season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```
### Number of Predictions
```{r}
valueBox(value = comb_Total,icon = "fa-users",caption = "Predictions this week")
```
Row
--------------------------------------
###
```{r}
comb_table
```
###
```{r}
ggplotly(comb_plot) %>%
layout(title = list(y = .93, xref = "plot"),
margin = list(t = 40))
```
Matched Predictions
==========================================================================
Row
--------------------------------------
### Win percentage for the week
```{r}
matched_rate <- matched_weekly_win_percentage[[length(matched_weekly_win_percentage)]]*100
gauge(matched_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = matched_weekly_win_percentage[[length(matched_weekly_win_percentage)]],icon = "fa-user-plus",caption = "Win percentage for the week.",color = "green")
```
### Season Win Percent
```{r}
matched_season <- matched_season_win_percentage*100
gauge(matched_season, min = 0, max = 100, symbol = '%', gaugeSectors(
success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```
```{r}
#valueBox(value = matched_season_win_percentage,icon = "fa-user-plus",caption = "Season win percentage.",color = "green")
```
### Games Picked
```{r}
valueBox(value = matched_season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```
### Season Games Correct
```{r}
valueBox(value = matched_season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```
Row
--------------------------------------
###
```{r}
matched_table
```
###
```{r}
ggplotly(matched_plot) %>%
layout(title = list(y = .93, xref = "plot"),
margin = list(t = 40))
```
Instructor Data {data-navmenu="Instructor Results"}
==========================================================================
```{r}
datatable(
inst.data, extensions = 'Buttons', options = list(
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
)
)
```
Cadet Data {data-navmenu="Cadet Results"}
==========================================================================
```{r}
datatable(
cdt.data, extensions = 'Buttons', options = list(
dom = 'Blfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
)
)
```