--- title: "WSF 2017" author: "Evans School Team" date: "December 14, 2018" output: html_document: default --- ```{r Setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) library(tidyverse) library(dplyr) library(readr) library(pander) library(sjPlot) library(ggplot2) ``` ## Fauntleroy Tollbooth Redemptions, 2017 This is data collected between Monday, June 19 - Monday, October 2 by WSF. There are 716 observations in the raw data set. Observations were only taken during the weekdays and over the afternoon hours (~2-7pm). Weekdays not accounted for in the data include: Friday, June 23 Tuesday, July 4 (Independence Day) Thursday, July 27 Wednesday, August 9 Wednesday, August 23 Friday, August 25 Friday, September 1 Monday, September 4 (Labor Day) Wednesday, September 6 Thursday, September 7 Entire week of September 11-15 Monday, September 25 ###Visualizing the data This document depicts observations made by WSF in the summer sailing schedule of 2017. Notes on any adjustment or refining of the raw data are included in the code chunks leading with a #. ```{r Download v3 data} # version 3 is an edited version of the raw data, edited in excel in the following ways: # -- assigns finite number to textual number information in estimated spaces leftover (e.g. 50 represents 50+, and 40 represents the only range reported, 40-50) [6 total observations] # -- adds additional variable for "late" boats (10+ minutes after scheduled departure or identified as late by WSF data collector) # -- adds additional variable for two-boat schedule (where indicated by WSF data collector) v3.fauntleroy.tollbooth.2017 <- read_csv("C:/Users/xxxxx/Downloads/Fauntleroy_Tollbooth_Redemptions_v3.csv") # to use this code, you must edit the directory above to match the location on your computer. ``` ```{r Glimpse v3 data} glimpse(v3.fauntleroy.tollbooth.2017) View(v3.fauntleroy.tollbooth.2017) ``` A number of observations recorded non-numeric data points for the estimated # of spaces leftover, such as "n/a," or "no line," or "no traffic." These observations were removed because they cannot be interpreted quantitatively. ```{r Fixing Errata} # create function to help filter out vectors `%!in%` <- Negate(`%in%`) # filter out observations that have non-numeric values for estimated # of spaces leftover clean.tollbooth.v3 <- v3.fauntleroy.tollbooth.2017 %>% filter(spaces %!in% c("n/a","no traffic","no line","No line","no Vashon traffic")) # filter out two-boat observations (19 observations) clean.tollbooth.v3 <- clean.tollbooth.v3 %>% filter(`two-boat`==FALSE) %>% # remove miscellaneous columns from data set select(-c(X10,Notes)) # make estimated spaces as numeric clean.tollbooth.v3$spaces <- as.numeric(clean.tollbooth.v3$spaces) ``` There are 629 observations as a result of filtering out these observations. ```{r Glimpse clean data} View(clean.tollbooth.v3) ``` ## Graphing the Results ### Observed Available Spaces Remaining on Vessels Leaving Fauntleroy ```{r Figure 14, echo=FALSE} clean.tollbooth.v3 %>% ggplot(aes(x=date, y=spaces, group=late,color=late)) + geom_point() + scale_color_manual(name="Actual Departure", values = c("TRUE"="firebrick3", "FALSE"="grey50"), label = c("On-time", "Late")) + ylab("Estimated available spaces on boat") + xlab("Observation Day") + theme_bw() + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank()) + facet_wrap(~ time) ``` ### Boxplots - Observed Available Spaces Remaining on Vessels Leaving Fauntleroye ```{r Figure 11, echo=FALSE} times %>% ggplot(aes(y=spaces,fill=destination, alpha=late)) + geom_boxplot() + scale_alpha_manual(name="Actual Departure", values = c("TRUE"="0.25", "FALSE"="1"), labels = c("On-time", "Late")) + scale_fill_manual(name="Destination", values = c("*VO"="purple", "SO"="royalblue2", "VO"="orangered", "Both"="chartreuse4")) + xlab("On-time v. Late Departures") + ylab("Estimated available spaces on boat") + facet_wrap(~ time) + theme_bw() + theme(axis.text.x = element_blank(), axis.ticks = element_blank()) ``` ### Fullness of Boats Departing Fauntleroy by Boat Position ```{r Figure 15, echo=FALSE} clean.tollbooth.v3 %>% ggplot(aes(x=full, fill=late)) + geom_bar(position = position_dodge()) + scale_fill_manual(name="Actual Departure", values = c("TRUE"="firebrick3", "FALSE"="lightgrey"), labels = c("On-time", "Late")) + ylab("Frequency") + xlab("Partially Full (left bar-cluster) v. Full Boat (right bar-cluster)") + facet_wrap(~ vessel) + theme_bw() + theme(axis.text.x = element_blank(), axis.ticks = element_blank()) ``` ##Fullness of Boats Departing Fauntleroy by Departure Time ```{r Figure 10, echo=FALSE} clean.tollbooth.v3 %>% ggplot(aes(x=full, fill=destination, alpha=late)) + geom_bar(position = position_dodge()) + scale_alpha_manual(name="Actual Departure", values = c("TRUE"="0.5", "FALSE"="1"), labels = c("On-time", "Late")) + scale_fill_manual(name="Destination", values = c("*VO"="purple", "SO"="royalblue2", "VO"="orangered", "Both"="chartreuse4")) + ylab("Frequency") + xlab("Partially Full (left bar-cluster) v. Full Boat (right bar-cluster)") + facet_wrap(~ time) + theme_bw() + theme(axis.text.x = element_blank(), axis.ticks = element_blank()) ```