##Problem 1
I am an avid bird hunter. I enjoy being outdoors in the fall and winter, getting some exercise, and spending time with my father. In preparation for deer season, I was perusing the PA game commissions website and stumbled upon some data about bird hunting that I thought would be interesting. I pulled hunter and harvest numbers from this website and built the data set for this exercise, titled “Bird species.csv.”
The corresponding plot shows the trends in Pennsylvania grouse and pheasant hunters and the birds harvested by those hunters since 1990. While our interest in bird hunting has increased, the plot trends show the opposite story for the rest of the bird hunting population. Both the number of hunters and birds harvested have declined in this data set, moving down and to the left on the graph.
The evident conclusion is that the decline in the number of hunters is causing the number of birds harvested to decrease. I added the point values (hunters and birds) as hover text since the point values are not major values like 150,000 or 275,000. I felt it important to provide the reader with those specific values.
One small challenge I encountered was changing the color of the markers. I wanted the colors to be more “hunter-esque,” brown and blaze orange. After researching ways to customize colors in a plotly graph I settled on the method here.
#https://www.pa.gov/agencies/pgc/huntingandtrapping/harvest-survey-and-data/harvest-data-and-maps/estimate-harvest-by-species
#https://www.pa.gov/agencies/pgc/huntingandtrapping/harvest-survey-and-data/harvest-data-and-maps/estimated-number-of-hunters-by-species
#bring data in
birds <-read.csv("Bird species.csv")
bird_colors <- c("#5C4033", "#FF6600")
birds %>%
plot_ly( x = ~Hunters, y = ~Harvested,
hoverinfo = "text",
text = ~paste(Year, "<br> Hunters:", Hunters,
"<br> Harvested:", Harvested)) %>%
add_markers(frame = ~Year,
color = ~Type,
marker = list(size = 10),
colors = bird_colors) %>%
animation_slider(currentvalue = list(font = list(color="white"))) %>%
layout(title = "PA bird hunting trends",
xaxis = list(title ="# of Hunters"),
yaxis = list(title ="# of Birds Harvested"))
##Problem 2
With the recent reporting on the Pittsburgh Pirates spending money on free agents this offseason, I became curious to graphically see how their payroll has differed from the other teams in the NL Central. Additionally, I was curious to see if or how payroll correlated to wins, as we fans believe it does.
The below graph shows a scatterplot of opening day payroll versus win total. The plot confirms some trends we knew like payrolls have increased the past 25 years, some teams more than others. We also see some trends that we think we knew. The Milwaukee Brewers seem to be a well-run franchise. Only once did they have a top two payroll, but they have won the division six times. The Chicago Cubs on the other hand had a top two payroll twenty-four out of the twenty-five years and they also have six division titles. Lastly, I do believe this graph shows that higher payrolls = more wins. There are exceptions where teams with higher payrolls have finished lower in the division than expected, but the Cardinals and Cubs spend and are typically at the top of the division. The Pirates have lower/ the lowest payrolls and typically finish at the bottom of the division. The Reds often end up in the middle and the Brewers yo-yo back and forth between highs and lows.
Along with the number of wins, I added the place of finish as hover text. The place of finish is important here because up until 2013, there was a sixth team in the NL Central, the Houston Astros, and the graph could be misleading. I did not include them in my analysis because I was only interested in how the Pirates compare to “current” NL Central teams. One example year is 2003. The Pirates finished fourth, however on the plot it looks like they finished third.
One challenge in problem 2 was the animation coding. I originally had the “animation_slider” code before the “animation_opts” code and could not get the animation speed to change. It was only after switching their order, that I achieved different transition and frame speeds.
#https://www.baseball-reference.com/teams/PIT/index.shtml#all_franchise_years
#https://legacy.baseballprospectus.com/compensation/cots/national-league-central/pittsburgh-pirates/
#bring data in
NL_cent <-read.csv("NL Cent 02.csv")
team_colors <- c("#0E3386", "#C6011F", "#FFC52F", "black", "red")
NL_cent %>%
plot_ly(x = ~Payroll.Scaled, y = ~W,
hoverinfo = "text",
text = ~paste("Wins:", W, "<br> Finish:", Finish)) %>%
add_markers(frame = ~Year,
ids = ~Team,
color = ~Team,
marker = list(size = 10),
colors = team_colors) %>%
add_text(x = 175, y = 40, text = ~Year, frame = ~Year,
textfont = list(size = 50, color = toRGB("#7BB369"))) %>%
animation_opts(frame = 2000, transition = 1000, redraw = FALSE) %>%
animation_slider(currentvalue = list(font = list(color="white"))) %>%
layout(title = list(text = "NL Central Payroll vs Wins", x = 0, xanchor = "left", xref = "paper"),
xaxis = list(title ="Opening Day Payroll ($millions)", tickvals = list(30, 60, 90, 120, 150, 180, 210)),
yaxis = list(title ="Wins"))