Set environment
env <- c("tidyverse","lubridate")
lapply(env, library, character.only = 1)# DOWNLOAD THE CSV FILE FROM THE ACTION CENTER SITE AND IMPORT IT HERE.
stPeteData <- read_csv("C:/Users/ericl/Downloads/St._Petersburg_Action_Center_Data.csv")Abstract - The dataset is from the St. Petersburg [FL] Action Center which can be found at: https://stat.stpete.org/Improving-Liviability/St-Petersburg-Action-Center-Data/qdms-3kn3.
“This dataset is updated daily and contains a log of citizen requests to the Mayor’s Action Center dating back to June 2014. These records describe requests for assistance with City services or reported problems, such as potholes, graffiti, broken sidewalks, storm drain issues, traffic signal/sign problems, special pick-up of dumped items, codes violations, etc.”
This analysis uses the file that was downloaded on 10 December 2020. There are a number of ways to analyze this rich ‘144244 x 24’ dataset including potential options for spatial, imagery, and text analysis. This brief analysis will consider a multi-year comparison (ANOVA) for the issue labelled “Codes Compliance.” It is one of 31 issues that the Action Center tracks and it is also to most common one for St. Petersburg.
At least for the issue of “Codes Compliance”, the center is doing quite well.
Exploratory Data Analysis
A quick look of the dataset.
glimpse( stPeteData )## Rows: 144,244
## Columns: 24
## $ `Ticket ID` <dbl> 7671116, 7671133, 7671319, 6153974,...
## $ `Issue Type` <chr> "Tree Trimming/Removal", "Sanitatio...
## $ `Secondary Issue Type` <chr> "P&R Tree Trim", "Sanitation Depart...
## $ `Issue Description` <chr> "Please do a raise up at this locat...
## $ `Street Address` <chr> "1601 24th St S Saint Petersburg, F...
## $ City <chr> "St. Petersburg", "St. Petersburg",...
## $ State <chr> "Florida", "Florida", "Florida", "F...
## $ `ZIP Code` <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA,...
## $ `Neighborhood / District` <chr> "St. Petersburg / No Neighborhood",...
## $ `Ticket Created Date/Time` <chr> "04/15/2020 08:54:43 AM", "04/15/20...
## $ `Ticket Last Updated Date/Time` <chr> "04/16/2020 02:12:42 PM", "04/17/20...
## $ `Ticket Closed Date/Time` <chr> NA, NA, "04/15/2020 10:12:02 AM", N...
## $ `Ticket Status` <chr> "Acknowledged", "Acknowledged", "Ar...
## $ Image <chr> "https://seeclickfix.com/assets/cat...
## $ lat <dbl> 27.75470, 27.75872, 27.76710, 27.79...
## $ lng <dbl> -82.66515, -82.64097, -82.69117, -8...
## $ Location <chr> "(27.754704, -82.6651485)", "(27.75...
## $ SeeClickFix <chr> "https://en.seeclickfix.com/issues/...
## $ `hours to acknowledge` <dbl> 0.1, 0.4, NA, 759.5, 30.9, 19.4, 12...
## $ `Days open` <dbl> NA, NA, 0.1, NA, NA, NA, 172.7, NA,...
## $ `Day created` <chr> "Wed", "Wed", "Wed", "Sun", "Sun", ...
## $ `Day acknowledged` <chr> "Wed", "Wed", NA, "Thu", "Mon", "Mo...
## $ `Day updated` <chr> "Thu", "Fri", "Wed", "Mon", "Mon", ...
## $ `Day closed` <chr> NA, NA, "Wed", NA, NA, NA, "Fri", N...One of the variables being tracked is Issue Type. Let’s see how many unique values there are, what they are, and how many of each - also sorted.
stPeteData %>%
group_by( `Issue Type` ) %>%
summarise( Count = n(), .groups = 'drop' ) %>%
arrange( desc(Count) )## # A tibble: 31 x 2
## `Issue Type` Count
## <chr> <int>
## 1 Codes Compliance 39036
## 2 Sanitation Department 24002
## 3 Traffic Issue 17035
## 4 Tree Trimming/Removal 15789
## 5 Other 10573
## 6 Pothole / Road Surface Issue 9578
## 7 Sidewalk/Curb Repair 5352
## 8 Stormwater Issue 4573
## 9 City Park Maintenance 3300
## 10 Alley Blading/Smoothing 3102
## # ... with 21 more rowsAnother variable being tracked is Days open. It would be interesting to consider it as a performance metric for the action center. Let’s look at just Codes Compliance. Lots of data points so, we have to summarise a little: by averaging the ticket resolution time for each day. So, if on one particular day, 28 tickets were opened, what is the average time before all 28 tickets were closed?
eda1 <- stPeteData %>%
filter( `Issue Type` == "Codes Compliance" ) %>%
filter( !(is.na(`Days open`)) ) %>%
mutate( Ticket_Created = as_date ( mdy_hms(`Ticket Created Date/Time`) ) ) %>%
group_by( Ticket_Created ) %>%
summarise( Days_Open = mean(`Days open`), .groups = 'drop' )
ggplot( eda1, aes(x=Ticket_Created, y=Days_Open) ) +
geom_jitter(shape=1,size=1) +
geom_smooth(method="lm", se=0, aes(colour="lm") ) +
geom_smooth(method="loess", se=0, aes(colour="loess") ) +
labs(title = "Codes Compliance",
subtitle = "Average duration of open tickets") +
theme( axis.title.y = element_text(angle = 0, vjust=0.5) )
A clear downtrend for open ticket duration Also,…looks quite flat in 2020 let’s zoom in a bit starting mid 2019.
eda2 <- eda1 %>%
filter( Ticket_Created >= as_date( "2019-06-15" ) )
ggplot( eda2, aes(x=Ticket_Created, y=Days_Open) ) +
geom_jitter(shape=1,size=1) +
geom_smooth(method="lm", se=0, aes(colour="lm") ) +
geom_smooth(method="loess", se=0, aes(colour="loess") ) +
labs(title = "Codes Compliance",
subtitle = "Average duration of open tickets") +
theme( axis.title.y = element_text(angle = 0, vjust=0.5) )
Okay, we see that most likely COVID had quite an impact on the center’s response to at least Codes Compliance tickets. Regardless, the center’s average daily response time for “Codes Compliance” tickets was already on a decline starting at least around early 2016.
Could this be due to a decrease in ticket submission?
eda3 <- stPeteData %>%
filter( `Issue Type` == "Codes Compliance" ) %>%
select( `Ticket Created Date/Time` ) %>%
mutate( Ticket_Created = as_date ( mdy_hms(`Ticket Created Date/Time`) ) ) %>%
group_by( Ticket_Created ) %>%
summarise( Daily_Count = n(), .groups = 'drop' )
ggplot( eda3, aes(x=Ticket_Created, y=Daily_Count) ) +
geom_jitter(shape=1,size=1) +
geom_smooth(method="lm", se=0, aes(colour="lm") ) +
geom_smooth(method="loess", se=0, aes(colour="loess") ) +
labs(title = "Codes Compliance",
subtitle = "Daily tickets") +
theme( axis.title.y = element_text(angle = 0, vjust=0.5) )
Doesn’t appear to be. Here we see that “lm” and “loess” both show an increasing trend.
Note: one curiosity here is how the center is currently classifying/handling tickets. We saw that COVID probably affected the open ticket status but the number of tickets isn’t diminishing. Difficult to address from a distance, so we’ll just proceed for now.
It appears that the action center is doing quite well. It seems to be improving its response time to “Codes Compliance” tickets (downtrend) even as the number of tickets increase (uptrend).
But is it significant?
Hypothesis testing
We’ll conduct an ANOVA test which is meant to determine whether there is a statistically significant difference among groups. In this case we’ll group by years. Other grouping can be considered such as per quarter but then the number of groupings and subsequent comparisons may become too large.
Again, let’s group by year and look at the resulting boxplots.
eda4 <- eda3 %>%
mutate( Year = year(Ticket_Created) )
ggplot( eda4, aes(x=as.factor(Year), y=Daily_Count)) +
geom_boxplot() +
labs(title = "Codes Compliance",
subtitle = "Daily tickets") +
theme( axis.title.y = element_text(angle = 0, vjust=0.5) )
Like the daily plots of tickets, the yearly boxplots capture the uptrend.
Let’s develop the hypothesis.
The null hypothesis - \(H_{0}\) : there is no difference among the years.
The alternate hypothesis - \(H_{a}\) : there is a difference among the years.
The ANOVA test:
aovOut <- aov( Daily_Count ~ as.factor(Year) , data = eda4 )
summary( aovOut )## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(Year) 6 35128 5855 74.61 <2e-16 ***
## Residuals 2337 183376 78
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1aovOut## Call:
## aov(formula = Daily_Count ~ as.factor(Year), data = eda4)
##
## Terms:
## as.factor(Year) Residuals
## Sum of Squares 35128.4 183376.3
## Deg. of Freedom 6 2337
##
## Residual standard error: 8.858134
## Estimated effects may be unbalancedWe see that the F-value for the effect of “Year” is not near 1 and the P-value is less than our considered significance level of 0.05. Thus, a significant difference exists among the years and the null hypothesis can be rejected.
However, the ANOVA simply establishes that differences exist, it does not indicate which combination of years are significantly different. A Tukey Honestly Significant Difference (HSD) can compare the years, two at a time, to test the significance of the mean differences.
The Tukey HSD test has a default confidence level of 0.95.
tt <- TukeyHSD( aovOut )
print( tt , digits=11 )## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Daily_Count ~ as.factor(Year), data = eda4)
##
## $`as.factor(Year)`
## diff lwr upr p adj
## 2015-2014 5.46934562612 3.0740574164923 7.8646338358 0.00000000042
## 2016-2014 9.69019171992 7.2970456457646 12.0833377941 0.00000000000
## 2017-2014 11.63003714455 9.2325850752871 14.0274892138 0.00000000000
## 2018-2014 12.26637257178 9.8721581247464 14.6605870188 0.00000000000
## 2019-2014 12.52938627041 10.1351718233766 14.9236007174 0.00000000000
## 2020-2014 13.71171702284 11.2949458057833 16.1284882399 0.00000000000
## 2016-2015 4.22084609380 2.2859098269522 6.1557823606 0.00000000309
## 2017-2015 6.16069151843 4.2204320901756 8.1009509467 0.00000000000
## 2018-2015 6.79702694566 4.8607694620328 8.7332844293 0.00000000000
## 2019-2015 7.06004064429 5.1237831606631 8.9962981279 0.00000000000
## 2020-2015 8.24237139672 6.2782906091470 10.2064521843 0.00000000000
## 2017-2016 1.93984542463 0.0022311250418 3.8774597242 0.04951432928
## 2018-2016 2.57618085186 0.6425739714572 4.5097877323 0.00168204847
## 2019-2016 2.83919455049 0.9055876700875 4.7728014309 0.00030809968
## 2020-2016 4.02152530292 2.0600575195618 5.9829930863 0.00000003523
## 2018-2017 0.63633542723 -1.3025982642879 2.5752691187 0.96069136873
## 2019-2017 0.89934912586 -1.0395845656577 2.8382828174 0.81852118835
## 2020-2017 2.08167987829 0.1149607429495 4.0483990136 0.02990894349
## 2019-2018 0.26301369863 -1.6719153062897 2.1979427036 0.99967861154
## 2020-2018 1.44534445106 -0.5174266897742 3.4081155919 0.31065781960
## 2020-2019 1.18233075243 -0.7804403884045 3.1451018933 0.56345039870plot( tt )
The chart is more intuitive. It shows that most horizontal lines do not cross the dashed vertical “0”. Those horizontal lines indicate statistically significant two-year combinations. For example, the top line (2016-2015) shows significance while the bottom line (2020-2019) does not.
The chart also shows that the center may have reached a plateau starting around 2017. This could be due to the physical realities and limitations of being able to respond to issues like “Codes Compliance”.
The ANOVA test shows that 10 of the 15 combinations are statistically significant at a significance level of 0.05.
So what?
Considering just the “Codes Compliance” issue and the context of COVID - since 2014, the St. Petersburg [FL] Action Center seems to have improved its “Codes Compliance” ticket resolution time while simultaneously having had a mostly significant and meaningful increase in “Codes Compliance” tickets being submitted.
GitHub
Related file(s) can be found at Git Me
No comments:
Post a Comment