Problem 1 [20 points]

Create a plotly graph of your choosing that represents at least two variables, one of which must be a categorical variable.

This plot can be a scatter plot, overlayed density plots (graphing variable is continuous, separate densities grouped by categorical variable), etc. choropleth maps could also be on the list…you have to admit they look kinda cool.

You can use any data of your choosing, just reference this.

The graph must include:

  1. customized hover text that is informative to the graphing elements in the plot

  2. separate color to represent groups

  3. labeled axes and appropriate title

Include at least a 1-paragraph discussion about the graph. Discuss what is being plotted and what information is being displayed in the graph. Discuss any information that the reader may gain from hovering the cursor over graphing elements. Discuss any issues/chalenges you had (if any) while making the plot, and you you dealt with or overcame them.

library(plotly)
library(ggplot2)
library(tidyverse)
library(dplyr)
library(nlme)
library(dslabs)

# Create a subset of the data for each diet type
barley <- subset(Milk, Diet == "barley")
barley_lupins <- subset(Milk, Diet == "barley+lupins")
lupins <- subset(Milk, Diet == "lupins")

# Calculate densities of protein for each diet type
d_barley <- density(barley$protein)
d_barley_lupins <- density(barley_lupins$protein)
d_lupins <- density(lupins$protein)

# Use empirical cumulative distribution function to estimate areas under the curve to add to the hover text
d_b_emp <- ecdf(barley$protein)
d_b_l_emp <- ecdf(barley_lupins$protein)
d_l_emp <- ecdf(lupins$protein)

# Create graph
# Shows density of protein by diet type
# Added hover text shows an estimate of the area under the curve

Milk%>%
  plot_ly()%>%
  add_lines(x = d_barley$x, y = d_barley$y, name = "Barley", hoverinfo = "text", text = ~paste("Protein: ", d_barley$x, "<br> Area Under Curve Estimate: ", d_b_emp(d_barley$x)))%>%
  add_lines(x = d_barley_lupins$x, y = d_barley_lupins$y, name = "Barley and Lupins", hoverinfo = "text", text = ~paste("Protein: ", d_barley_lupins$x, "<br> Area Under Curve Estimate: ", d_b_l_emp(d_barley_lupins$x)))%>%
  add_lines(x = d_lupins$x, y = d_lupins$y, name = "Lupins", hoverinfo = "text", text = ~paste("Protein: ", d_lupins$x, "<br> Area Under Curve Estimate: ", d_l_emp(d_lupins$x))) %>%
  layout(title = "Density of Protein Content of Cows, by Diet",
         xaxis = list(title = "Protein Content"),
         yaxis = list(title = "Density"))

This graph shows overlayed density plots for the protein of cow’s milk in the weeks after calving. The data is grouped by diet, which can be either barley, lupins, or barley and lupins. We can see that the distribution for protein content is shifted farthest to the left overall, with the distribution for barley and lupins in the center, and the distribution for barley shifted most to the right. It appears that the three distributions have overall similar variance. I added a hover text label with an estimate for the area under the curve using the ecdf (empirical cumulative distribution function) in base R. I did this because densities are not easily interpretable on their own, and I did not want to draw attention to those values and have them be possibly misinterpreted by a viewer. By adding an estimate for the area under the curve, the viewer can get a grasp on the probability of milk being below a certain level of protein content, broken down by diet type of the cow it came from. As a specific example to highlight the usefulness of this, at a protein content of about 3.56, we can see that cows with diet of barley and those with diet of barley and lupins have densities that about intersect. However, by looking at the estimates of the cumulative density function, we can see that cows with diets of barley have an estimated area under the curve of about 0.54, while the group with a diet of barley and lupins have an estimated area under the curve of about 0.69. So, overall, it is more likely that the cows with diets of barley and lupins have protein content less than about 3.56 units than cows with diets of just barley. An issue I had with this graph was figuring out how to add useful hover text while maintaining accuracy of the densities. I had to make sure that the length of any items that I added as hover text was the same as the length of the densities so that each point had a value. But since this was a density curve, it was not easy to add additional variable information for each point, as it would be in a scatterplot.

Problem 2 [20 points]

Create an animated plotly graph with a data set of your choosing. This can be, but does not have to be a scatter plot. Also, the animation does not have to take place over time. As mentioned in the notes, the frame can be set to a categorical variable. However, the categories the frames cycle through should be organized (if needs be) such that the progression through them shows some pattern.

This graph should include:

  1. Aside from the graphing variable, a separate categorical variable. For example, in our animated scatter plot we color grouped the points by continent.

  2. Appropriate axis labels and a title

  3. Augment the frame label to make it more visible. This can include changing the font size and color to make it stand out more, and/or moving the frame label to a new location in the plotting region. Note, if you do this, make sure it is till clearly visible and does not obstruct the view of your plot.

Include at least a 1-paragraph discussion about the plot. Discuss what you are plotting and what trends can be seen throughout the animation. Discuss any issues, if any, you ran into in making the plot and how you overcame them.

library(modeldata)

taxi %>%
  plot_ly(x = ~distance, color = ~local)%>%
  add_histogram(frame = ~dow, showlegend = TRUE, opacity = 0.95)%>%
  animation_opts(frame = 3000, transition = 1500)%>%
  layout(xaxis = list(title = "Distance (Miles)",color = "black", tickfont = list(size = 18, color = "black"), titlefont = list(size = 16, color = "black")),
         yaxis = list(title = "Frequency",  color = "black", tickfont = list(size = 18, color = "black"), titlefont = list(size = 16, color = "back")), legend = list(title = list(text = "Was trip local?")), 
         title = list(text = "Taxi Trips in Chicago in 2022: Distance and Locality of Trip", font = list(color = "black", size = 17)))%>%
  animation_slider(currentvalue = list(prefix = "Day of Week: ", font = list(color = "blue", size = 20, x = 1.5, y = 1.5)), font = list(color = "black", size = 18))