Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

182

Games Picked

283

Number of predictions

58

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Kansas City Chiefs Kansas City Chiefs Yes 37 0.6379

Individual Predictions

row

Individual Table

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
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 1 1 5 0.6825 0.1551
Justin Crick 11 11 11 13 8 11 4 11 11 8 9 12 9 8 11 9 11 9 3 3 0 1 1 22 0.6502 0.6502
George Sweet 9 11 10 12 7 10 10 NA 11 8 10 13 9 8 8 8 11 9 4 3 1 1 1 21 0.6479 0.6185
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 NA 13 9 6 11 NA 13 9 4 3 0 1 1 18 0.6368 0.5210
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 7 NA 8 NA 11 10 13 12 NA NA NA 1 1 13 0.6298 0.3722
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 8 12 8 8 11 11 11 11 3 3 1 1 1 22 0.6290 0.6290
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 10 11 8 8 11 9 14 11 4 3 1 1 1 21 0.6208 0.5926
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 11 13 8 5 12 10 12 9 4 3 1 1 1 21 0.6194 0.5912
David Plate 8 NA 8 9 8 10 5 9 11 8 9 12 NA 7 13 NA 11 9 4 4 1 1 1 19 0.6176 0.5334
John Plaster 8 12 8 10 NA NA 6 9 7 10 9 7 8 8 10 10 12 13 3 3 2 1 1 20 0.6142 0.5584
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 10 10 8 9 9 9 11 8 5 2 1 1 1 22 0.6113 0.6113
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 10 NA 8 3 12 10 11 9 3 4 1 1 1 21 0.6105 0.5828
James Tierney 9 10 NA 10 10 12 7 10 8 9 9 10 8 8 7 11 8 10 4 2 1 1 1 21 0.6097 0.5820
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 9 12 8 6 10 8 14 7 3 3 2 1 1 21 0.6097 0.5820
Brian Patterson 10 10 8 11 7 11 5 10 10 8 11 12 7 6 9 8 13 10 2 3 0 1 1 22 0.6078 0.6078
Wayne Schofield 12 9 7 NA 8 NA 5 10 7 NA 10 NA 8 8 12 NA NA 12 3 2 1 1 1 16 0.6053 0.4402
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 9 12 5 NA NA NA 10 10 2 4 1 1 1 18 0.6045 0.4946
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 7 12 8 5 9 10 NA 9 3 3 2 1 1 21 0.6030 0.5756
Eric Hahn 9 13 7 9 8 10 6 9 10 6 11 12 9 6 10 8 12 10 2 2 0 1 1 22 0.6007 0.6007
James Small 8 8 13 9 8 10 8 10 12 6 10 9 5 7 9 8 11 11 3 2 2 1 1 22 0.6007 0.6007
Paul Presti 9 10 12 9 8 9 5 8 NA 9 9 NA 8 10 11 9 NA 8 3 3 0 1 1 19 0.5949 0.5138
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 10 10 8 5 12 NA 9 10 3 1 0 1 1 21 0.5880 0.5613
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 8 12 6 5 11 10 8 9 2 3 1 1 1 22 0.5866 0.5866
Daniel Baller 6 12 11 9 8 9 3 10 8 9 10 9 8 9 9 9 9 10 4 3 0 1 1 22 0.5866 0.5866
Daniel Major 8 13 6 7 8 11 7 11 NA NA 9 NA 7 NA NA NA NA 7 5 3 0 1 1 15 0.5852 0.3990
Shawn Carden 9 12 6 9 8 9 5 10 9 8 9 12 7 6 10 11 10 7 3 4 0 1 1 22 0.5830 0.5830
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 8 11 9 5 9 8 7 10 3 3 2 1 1 22 0.5795 0.5795
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 11 NA 8 5 11 NA NA 9 3 4 0 1 1 18 0.5753 0.4707
Steven Webster 8 8 6 8 9 8 6 10 10 8 10 NA 7 6 12 NA NA NA NA 4 1 1 1 17 0.5728 0.4426
Kristen White 7 13 8 11 6 7 7 10 8 6 10 7 8 7 8 NA 13 8 2 2 0 1 1 21 0.5581 0.5327
Trevor Macgavin 6 10 8 NA 6 7 4 NA 6 6 9 13 7 9 8 9 10 12 5 3 1 1 1 20 0.5578 0.5071
Robert Lynch 9 9 6 10 10 6 4 9 10 5 9 8 7 6 12 10 11 8 4 NA 0 1 1 21 0.5520 0.5269
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 10 8 5 6 11 6 12 6 3 4 1 1 1 19 0.5462 0.4717
Derrick Elam 6 9 11 10 10 7 NA 5 7 7 6 NA 7 9 NA 12 NA 11 2 1 0 1 1 18 0.5450 0.4459
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 NA 9 6 5 9 10 NA 8 NA 2 1 1 1 19 0.5385 0.4651
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 9 9 NA 9 7 8 8 9 4 3 1 1 1 18 0.5312 0.4346
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 9 NA 5 6 11 8 9 7 3 3 1 1 1 21 0.4869 0.4648
William Schouviller 10 9 11 10 8 9 NA 13 10 9 9 10 10 6 11 10 12 10 3 3 1 0 0 21 0.6444 0.6151
Jason Schattel 7 10 9 11 9 10 3 13 12 9 10 12 9 6 10 11 NA 11 3 3 1 0 0 21 0.6330 0.6042
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 8 NA 10 NA 10 9 NA 9 NA NA 1 0 0 17 0.6327 0.4889
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 9 11 10 6 11 9 13 10 2 3 1 0 0 22 0.6254 0.6254
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 10 12 NA 6 8 10 10 9 4 3 0 0 0 19 0.6240 0.5389
Montee Brown 7 NA NA 9 9 11 6 12 11 8 10 12 8 6 11 10 10 9 2 4 1 0 0 20 0.6166 0.5605
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 NA NA 8 8 13 11 NA 10 4 NA NA 0 0 17 0.6104 0.4717
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 10 10 9 6 13 NA NA 10 1 3 1 0 0 19 0.6085 0.5255
Michael Moss 10 NA 11 13 7 9 4 10 9 8 9 10 8 5 10 11 10 NA 2 3 1 0 0 20 0.5976 0.5433
Amy Asberry 8 9 10 9 9 8 5 10 6 9 7 10 9 7 12 11 12 10 3 3 NA 0 0 21 0.5943 0.5673
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 8 NA 10 9 8 8 NA 9 3 2 0 0 0 20 0.5936 0.5396
Paul Shim 10 9 10 11 7 9 4 10 10 8 11 10 8 8 9 8 11 8 2 3 1 0 0 22 0.5901 0.5901
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 10 NA 9 5 10 9 10 13 2 2 1 0 0 21 0.5880 0.5613
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 7 NA 7 7 9 11 10 NA 1 2 0 0 0 20 0.5817 0.5288
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 8 8 NA 6 9 8 12 9 3 4 0 0 0 21 0.5741 0.5480
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 8 10 10 10 9 9 NA 8 NA NA 0 0 0 17 0.5727 0.4425
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 10 11 8 6 9 9 NA 9 3 3 0 0 0 21 0.5655 0.5398
George Mancini 7 12 10 10 9 10 6 NA 7 9 9 11 5 7 NA 10 7 6 1 3 0 0 0 20 0.5538 0.5035
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 9 9 6 8 9 7 NA 8 3 4 2 0 0 19 0.5401 0.4665
Thomas Mccoy 8 10 9 7 8 9 7 11 7 7 NA 10 5 8 NA 9 9 8 3 1 0 0 0 20 0.5375 0.4886
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 9 NA NA NA NA 8 NA 8 NA NA NA 0 0 9 0.5254 0.2149
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 10 12 9 NA NA 9 NA 12 4 4 1 NA 0 14 0.6854 0.4362
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 6 0.6522 0.1779
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 9 13 NA NA NA NA NA NA NA 3 NA NA 0 11 0.6513 0.3256
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 10 10 7 6 12 10 NA 12 3 NA NA NA 0 18 0.6308 0.5161
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 8 9 6 NA NA NA NA NA NA NA NA NA 0 12 0.6307 0.3440
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 1 0.6250 0.0284
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 9 NA 9 8 9 10 NA 9 5 3 1 NA 0 18 0.6229 0.5096
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 9 12 NA 6 10 NA 11 NA 4 NA NA NA 0 15 0.6186 0.4218
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 8 10 6 8 12 9 10 8 NA 3 NA NA 0 13 0.6129 0.3622
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 10 NA 8 6 NA 11 NA NA 2 3 0 NA 0 16 0.6108 0.4442
Donald Park 8 12 7 9 NA NA 6 10 11 NA 9 NA NA NA NA NA NA NA NA NA NA NA 0 8 0.6050 0.2200
Yiming Hu 9 10 8 12 7 9 6 9 10 8 10 NA 7 6 9 9 12 10 NA NA 2 NA 0 18 0.5977 0.4890
Terry Hardison 10 10 9 11 7 9 4 11 9 10 9 11 8 7 11 8 11 7 3 3 0 NA 0 21 0.5957 0.5686
Pamela Augustine 11 13 6 9 6 9 5 10 9 NA 10 11 8 6 11 9 NA NA NA 4 0 NA 0 17 0.5957 0.4603
James Blejski 8 11 10 14 NA 9 7 12 7 6 9 9 9 6 7 9 NA NA NA NA NA NA 0 15 0.5938 0.4049
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 9 12 8 6 11 10 NA 9 3 NA 0 NA 0 18 0.5870 0.4803
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 8 11 9 5 10 10 11 9 3 1 0 NA 0 20 0.5858 0.5325
Robert Gelo 6 9 10 10 9 11 5 11 6 9 9 10 8 6 11 NA NA NA 3 NA NA NA 0 16 0.5833 0.4242
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 9 NA NA NA NA NA NA NA NA NA NA NA 0 8 0.5812 0.2113
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 8 NA 6 NA NA 10 NA 9 3 NA NA NA 0 13 0.5806 0.3431
Steven Curtis NA NA 11 7 8 10 6 7 8 7 7 11 7 8 11 11 NA NA 4 2 1 NA 0 17 0.5780 0.4466
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 7 0.5769 0.1836
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 7 8 9 7 10 NA 11 7 3 NA NA NA 0 18 0.5731 0.4689
Kevin Green 9 12 9 9 8 9 7 NA NA 6 10 11 4 7 6 8 13 9 3 NA NA NA 0 17 0.5691 0.4398
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 7 11 5 7 11 11 NA 9 3 NA 0 NA 0 18 0.5650 0.4623
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 3 0.5625 0.0767
Jason James 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
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 11 NA NA NA NA NA 0 3 0.5625 0.0767
Michael Beck 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
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 8 NA 9 5 10 NA 10 NA 2 NA 1 NA 0 14 0.5615 0.3573
Min Choi 6 7 9 11 7 10 5 13 7 5 NA NA NA NA NA NA NA NA 4 4 0 NA 0 13 0.5500 0.3250
Justin Thrift 9 8 9 8 9 7 5 11 7 6 10 NA 7 9 8 10 NA 8 2 3 1 NA 0 19 0.5480 0.4733
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 7 9 8 8 NA NA NA NA NA NA NA NA 0 13 0.5474 0.3235
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 7 0.5385 0.1713
Rodney Cathcart NA NA NA NA NA NA NA NA NA NA NA NA 7 NA NA NA NA NA NA NA NA NA 0 1 0.5385 0.0245
Craig Webster NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 8 NA NA NA NA 0 1 0.5000 0.0227
Edward Ford 6 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 2 0.4375 0.0398

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 22
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Stephen Woolwine 2 14 0.6854 0.4362
2 Michael Edmunds 1 5 0.6825 0.1551
3 Kevin O'NEILL 0 6 0.6522 0.1779
4 Shelly Bailey 2 11 0.6513 0.3256
5 Justin Crick 1 22 0.6502 0.6502
6 George Sweet 3 21 0.6479 0.6185
7 William Schouviller 2 21 0.6444 0.6151
8 Ramar Williams 2 18 0.6368 0.5210
9 Jason Schattel 1 21 0.6330 0.6042
10 Chris Papageorge 1 17 0.6327 0.4889
11 Ryan Wiggins 0 18 0.6308 0.5161
12 Sarah Sweet 0 12 0.6307 0.3440
13 Daniel Halse 1 13 0.6298 0.3722
14 Cheryl Brown 1 22 0.6290 0.6290
15 Anthony Bloss 2 22 0.6254 0.6254
16 Carlos Caceres 0 1 0.6250 0.0284
17 Antonio Mitchell 1 19 0.6240 0.5389
18 Gabriel Quinones 1 18 0.6229 0.5096
19 Stephen Bush 2 21 0.6208 0.5926
20 Patrick Tynan 3 21 0.6194 0.5912
21 Bradley Hobson 0 15 0.6186 0.4218
22 David Plate 3 19 0.6176 0.5334
23 Montee Brown 1 20 0.6166 0.5605
24 John Plaster 3 20 0.6142 0.5584
25 Keithon Corpening 0 13 0.6129 0.3622
26 Ryan Cvik 2 22 0.6113 0.6113
27 Vincent Scannelli 0 16 0.6108 0.4442
28 PABLO BURGOSRAMOS 3 21 0.6105 0.5828
29 Shaun Dahl 2 17 0.6104 0.4717
30 James Tierney 3 21 0.6097 0.5820
30 Karen Coleman 5 21 0.6097 0.5820
32 Cody Koerwitz 1 19 0.6085 0.5255
33 Brian Patterson 2 22 0.6078 0.6078
34 Wayne Schofield 2 16 0.6053 0.4402
35 Donald Park 0 8 0.6050 0.2200
36 Matthew Schultz 2 18 0.6045 0.4946
37 Aubrey Conn 2 21 0.6030 0.5756
38 Eric Hahn 3 22 0.6007 0.6007
38 James Small 3 22 0.6007 0.6007
40 Yiming Hu 1 18 0.5977 0.4890
41 Michael Moss 0 20 0.5976 0.5433
42 Pamela Augustine 2 17 0.5957 0.4603
42 Terry Hardison 0 21 0.5957 0.5686
44 Paul Presti 2 19 0.5949 0.5138
45 Amy Asberry 0 21 0.5943 0.5673
46 James Blejski 1 15 0.5938 0.4049
47 MICHAEL BRANSON 1 20 0.5936 0.5396
48 Paul Shim 1 22 0.5901 0.5901
49 Bunnaro Sun 1 21 0.5880 0.5613
49 Jonathon Leslein 1 21 0.5880 0.5613
51 Earl Dixon 0 18 0.5870 0.4803
52 Brian Hollmann 3 22 0.5866 0.5866
52 Daniel Baller 1 22 0.5866 0.5866
54 Walter Archambo 0 20 0.5858 0.5325
55 Daniel Major 3 15 0.5852 0.3990
56 Robert Gelo 0 16 0.5833 0.4242
57 Shawn Carden 2 22 0.5830 0.5830
58 Ronald Schmidt 1 20 0.5817 0.5288
59 William Sherman 0 8 0.5812 0.2113
60 Charlene Redmer 0 13 0.5806 0.3431
61 Anthony Brinson 3 22 0.5795 0.5795
62 Steven Curtis 0 17 0.5780 0.4466
63 Rahmatullah Sharifi 0 7 0.5769 0.1836
64 Thomas Brenstuhl 3 18 0.5753 0.4707
65 Kevin Kehoe 1 21 0.5741 0.5480
66 Manuel Vargas 0 18 0.5731 0.4689
67 Steven Webster 2 17 0.5728 0.4426
68 Brandon Parks 2 17 0.5727 0.4425
69 Kevin Green 0 17 0.5691 0.4398
70 Daniel Kuehl 0 21 0.5655 0.5398
71 Khalil Ibrahim 0 18 0.5650 0.4623
72 Jamal Willis 0 3 0.5625 0.0767
72 Jason James 0 1 0.5625 0.0256
72 Michael Beck 0 1 0.5625 0.0256
72 TYREE BUNDY 0 3 0.5625 0.0767
76 Gregory Flint 0 14 0.5615 0.3573
77 Kristen White 2 21 0.5581 0.5327
78 Trevor Macgavin 3 20 0.5578 0.5071
79 George Mancini 0 20 0.5538 0.5035
80 Robert Lynch 2 21 0.5520 0.5269
81 Min Choi 2 13 0.5500 0.3250
82 Justin Thrift 0 19 0.5480 0.4733
83 Alexander Santillan 0 13 0.5474 0.3235
84 Rafael Torres 2 19 0.5462 0.4717
85 Derrick Elam 3 18 0.5450 0.4459
86 Robert Martin 2 19 0.5401 0.4665
87 Cherylynn Vidal 1 19 0.5385 0.4651
87 Derrick Zantt 0 7 0.5385 0.1713
87 Rodney Cathcart 0 1 0.5385 0.0245
90 Thomas Mccoy 0 20 0.5375 0.4886
91 Melissa Printup 2 18 0.5312 0.4346
92 David Spielman 0 9 0.5254 0.2149
93 Craig Webster 0 1 0.5000 0.0227
94 Ryan Shipley 1 21 0.4869 0.4648
95 Edward Ford 0 2 0.4375 0.0398

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 22
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 1 22 0.6502 0.6502
2 Cheryl Brown 1 22 0.6290 0.6290
3 Anthony Bloss 2 22 0.6254 0.6254
4 George Sweet 3 21 0.6479 0.6185
5 William Schouviller 2 21 0.6444 0.6151
6 Ryan Cvik 2 22 0.6113 0.6113
7 Brian Patterson 2 22 0.6078 0.6078
8 Jason Schattel 1 21 0.6330 0.6042
9 Eric Hahn 3 22 0.6007 0.6007
9 James Small 3 22 0.6007 0.6007
11 Stephen Bush 2 21 0.6208 0.5926
12 Patrick Tynan 3 21 0.6194 0.5912
13 Paul Shim 1 22 0.5901 0.5901
14 Brian Hollmann 3 22 0.5866 0.5866
14 Daniel Baller 1 22 0.5866 0.5866
16 Shawn Carden 2 22 0.5830 0.5830
17 PABLO BURGOSRAMOS 3 21 0.6105 0.5828
18 James Tierney 3 21 0.6097 0.5820
18 Karen Coleman 5 21 0.6097 0.5820
20 Anthony Brinson 3 22 0.5795 0.5795
21 Aubrey Conn 2 21 0.6030 0.5756
22 Terry Hardison 0 21 0.5957 0.5686
23 Amy Asberry 0 21 0.5943 0.5673
24 Bunnaro Sun 1 21 0.5880 0.5613
24 Jonathon Leslein 1 21 0.5880 0.5613
26 Montee Brown 1 20 0.6166 0.5605
27 John Plaster 3 20 0.6142 0.5584
28 Kevin Kehoe 1 21 0.5741 0.5480
29 Michael Moss 0 20 0.5976 0.5433
30 Daniel Kuehl 0 21 0.5655 0.5398
31 MICHAEL BRANSON 1 20 0.5936 0.5396
32 Antonio Mitchell 1 19 0.6240 0.5389
33 David Plate 3 19 0.6176 0.5334
34 Kristen White 2 21 0.5581 0.5327
35 Walter Archambo 0 20 0.5858 0.5325
36 Ronald Schmidt 1 20 0.5817 0.5288
37 Robert Lynch 2 21 0.5520 0.5269
38 Cody Koerwitz 1 19 0.6085 0.5255
39 Ramar Williams 2 18 0.6368 0.5210
40 Ryan Wiggins 0 18 0.6308 0.5161
41 Paul Presti 2 19 0.5949 0.5138
42 Gabriel Quinones 1 18 0.6229 0.5096
43 Trevor Macgavin 3 20 0.5578 0.5071
44 George Mancini 0 20 0.5538 0.5035
45 Matthew Schultz 2 18 0.6045 0.4946
46 Yiming Hu 1 18 0.5977 0.4890
47 Chris Papageorge 1 17 0.6327 0.4889
48 Thomas Mccoy 0 20 0.5375 0.4886
49 Earl Dixon 0 18 0.5870 0.4803
50 Justin Thrift 0 19 0.5480 0.4733
51 Rafael Torres 2 19 0.5462 0.4717
51 Shaun Dahl 2 17 0.6104 0.4717
53 Thomas Brenstuhl 3 18 0.5753 0.4707
54 Manuel Vargas 0 18 0.5731 0.4689
55 Robert Martin 2 19 0.5401 0.4665
56 Cherylynn Vidal 1 19 0.5385 0.4651
57 Ryan Shipley 1 21 0.4869 0.4648
58 Khalil Ibrahim 0 18 0.5650 0.4623
59 Pamela Augustine 2 17 0.5957 0.4603
60 Steven Curtis 0 17 0.5780 0.4466
61 Derrick Elam 3 18 0.5450 0.4459
62 Vincent Scannelli 0 16 0.6108 0.4442
63 Steven Webster 2 17 0.5728 0.4426
64 Brandon Parks 2 17 0.5727 0.4425
65 Wayne Schofield 2 16 0.6053 0.4402
66 Kevin Green 0 17 0.5691 0.4398
67 Stephen Woolwine 2 14 0.6854 0.4362
68 Melissa Printup 2 18 0.5312 0.4346
69 Robert Gelo 0 16 0.5833 0.4242
70 Bradley Hobson 0 15 0.6186 0.4218
71 James Blejski 1 15 0.5938 0.4049
72 Daniel Major 3 15 0.5852 0.3990
73 Daniel Halse 1 13 0.6298 0.3722
74 Keithon Corpening 0 13 0.6129 0.3622
75 Gregory Flint 0 14 0.5615 0.3573
76 Sarah Sweet 0 12 0.6307 0.3440
77 Charlene Redmer 0 13 0.5806 0.3431
78 Shelly Bailey 2 11 0.6513 0.3256
79 Min Choi 2 13 0.5500 0.3250
80 Alexander Santillan 0 13 0.5474 0.3235
81 Donald Park 0 8 0.6050 0.2200
82 David Spielman 0 9 0.5254 0.2149
83 William Sherman 0 8 0.5812 0.2113
84 Rahmatullah Sharifi 0 7 0.5769 0.1836
85 Kevin O'NEILL 0 6 0.6522 0.1779
86 Derrick Zantt 0 7 0.5385 0.1713
87 Michael Edmunds 1 5 0.6825 0.1551
88 Jamal Willis 0 3 0.5625 0.0767
88 TYREE BUNDY 0 3 0.5625 0.0767
90 Edward Ford 0 2 0.4375 0.0398
91 Carlos Caceres 0 1 0.6250 0.0284
92 Jason James 0 1 0.5625 0.0256
92 Michael Beck 0 1 0.5625 0.0256
94 Rodney Cathcart 0 1 0.5385 0.0245
95 Craig Webster 0 1 0.5000 0.0227

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    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/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.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))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#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
# 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) #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[[21]]=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))+
  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 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 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 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 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)

#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 Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  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(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  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(columns = c(plot))
```


```{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))+
  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 data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(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)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

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.
 
 </font>


#### ESPN

<font size="4">

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.

</font>

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)
))
```

### 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)
))
```

### 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))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{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") )
  )
)
```