Streetcaster Sidewalk Audits

Bring in the SW audit file from the BARI shared Google Drive and take a look at it. This should be the Sidewalk Audit conducted in… what year?

sw_pts <- st_read(dsn = "~/Google Drive/BARI Research Team Data Library/StreetCaster/Sidewalk Conditions T1/",layer="Sidewalk Centroids")

Reading layer `Sidewalk Centroids' from data source `/Users/justin/Google Drive/BARI Research Team Data Library/StreetCaster/Sidewalk Conditions T1' using driver `ESRI Shapefile'
Simple feature collection with 27388 features and 28 fields
geometry type:  POINT
dimension:      XY
bbox:           xmin: 741131.2 ymin: 2909796 xmax: 801864.4 ymax: 2969943
epsg (SRID):    NA
proj4string:    +proj=lcc +lat_1=41.71666666666667 +lat_2=42.68333333333333 +lat_0=41 +lon_0=-71.5 +x_0=199999.9999999999 +y_0=750000 +datum=NAD83 +units=us-ft +no_defs

sw_pts <- st_read(dsn = "~/Google Drive/BARI Research Team Data Library/StreetCaster/Sidewalk Conditions T1/",layer="Sidewalk Centroids")

Reading layer `Sidewalk Centroids' from data source `/Users/justin/Google Drive/BARI Research Team Data Library/StreetCaster/Sidewalk Conditions T1' using driver `ESRI Shapefile'
Simple feature collection with 27388 features and 28 fields
geometry type:  POINT
dimension:      XY
bbox:           xmin: 741131.2 ymin: 2909796 xmax: 801864.4 ymax: 2969943
epsg (SRID):    NA
proj4string:    +proj=lcc +lat_1=41.71666666666667 +lat_2=42.68333333333333 +lat_0=41 +lon_0=-71.5 +x_0=199999.9999999999 +y_0=750000 +datum=NAD83 +units=us-ft +no_defs

sw_poly <- st_read(dsn = "~/Google Drive/BARI Research Team Data Library/StreetCaster/Sidewalk Conditions T1/",layer="SWK_ANALYSIS")

Reading layer `SWK_ANALYSIS' from data source `/Users/justin/Google Drive/BARI Research Team Data Library/StreetCaster/Sidewalk Conditions T1' using driver `ESRI Shapefile'
Simple feature collection with 27388 features and 27 fields
geometry type:  MULTIPOLYGON
dimension:      XY
bbox:           xmin: 741058.7 ymin: 2909733 xmax: 801961.7 ymax: 2969955
epsg (SRID):    NA
proj4string:    +proj=lcc +lat_1=41.71666666666667 +lat_2=42.68333333333333 +lat_0=41 +lon_0=-71.5 +x_0=199999.9999999999 +y_0=750000 +datum=NAD83 +units=us-ft +no_defs

Basic summary stats:

summary(sw_pts$TIMESTAMP)

           2/2/2012           3/26/2012          11/18/2011           3/27/2012 2009-08-05 10:20:04           1/16/2012 
                214                 144                 143                 136                 129                 123 
          2/14/2012            2/6/2012          11/15/2011            2/9/2012          12/16/2011          12/31/2011 
                117                 115                 112                 108                 107                 106 
           2/7/2012          11/21/2011          12/12/2011           2/23/2012            1/3/2012            1/9/2012 
                105                 103                  99                  98                  95                  95 
           2/1/2012           12/6/2011           1/24/2012          12/13/2011           1/18/2012          11/28/2011 
                 93                  92                  90                  89                  88                  88 
          2/13/2012            2/8/2012           1/25/2012           12/8/2011           12/9/2011          11/29/2011 
                 88                  88                  85                  85                  84                  82 
          12/1/2011            1/5/2012          12/15/2011           1/26/2012           2/15/2012           2/24/2012 
                 80                  78                  78                  76                  75                  74 
         11/22/2011            1/6/2012          12/14/2011           2/21/2012          11/30/2011           1/19/2012 
                 73                  72                  71                  71                  69                  68 
          1/31/2012           1/27/2012          11/23/2011           1/30/2012          11/16/2011           12/7/2011 
                 66                  65                  65                  57                  56                  55 
         11/17/2011           2/22/2012 2011-12-05 16:09:00            2/3/2012 2012-01-09 14:39:29 2009-11-20 14:26:02 
                 54                  52                  33                  31                  29                  23 
2012-02-29 10:29:09 2012-01-09 12:15:19           12/2/2011 2012-01-13 15:06:08 2010-03-10 12:06:45 2011-10-24 15:18:40 
                 23                  22                  21                  19                  18                  18 
2010-06-16 11:50:03 2011-12-05 16:47:10 2012-01-23 10:57:42 2011-12-05 16:48:23 2012-02-29 10:27:13 2011-07-25 11:48:10 
                 16                  16                  16                  15                  15                  14 
2011-08-29 11:21:35 2011-10-24 15:15:45 2012-02-29 10:37:03 2010-03-10 15:23:10 2010-06-16 11:43:44 2011-05-05 14:03:15 
                 14                  14                  14                  13                  13                  13 
2011-05-05 14:04:02 2012-02-29 10:32:33 2011-10-24 15:17:45 2012-01-09 14:00:13 2012-02-28 07:50:13 2012-02-29 10:36:30 
                 13                  13                  12                  12                  12                  12 
2010-02-23 10:22:11 2010-03-10 16:04:42 2010-06-18 12:57:31 2011-08-01 09:57:05 2012-01-03 12:16:36 2012-01-09 10:04:34 
                 11                  11                  11                  11                  11                  11 
2012-01-23 11:28:56 2012-02-29 10:32:01 2012-05-19 15:18:01 2010-03-10 15:36:40 2011-04-11 16:42:58 2011-11-16 15:20:42 
                 11                  11                  11                  10                  10                  10 
2011-12-05 11:58:05 2012-01-09 10:23:32 2012-02-22 11:39:59 2009-12-04 08:57:15 2011-04-25 11:53:19 2012-01-03 15:41:12 
                 10                  10                  10                   9                   9                   9 
2012-01-11 14:02:05 2012-02-13 09:06:34 2012-02-29 10:38:25             (Other) 
                  9                   9                   9               22135 

sw_pts$date2 <- parse_date_time(x = as.character(sw_pts$TIMESTAMP),
                            orders=c("mdY","Ymd HMS"), truncated = 3)
summary(sw_pts$date2) # goes from 2008 through 2012

                 Min.               1st Qu.                Median                  Mean               3rd Qu. 
"2008-12-04 12:59:15" "2011-06-03 08:27:06" "2011-12-16 12:57:41" "2011-09-02 00:27:31" "2012-02-10 08:48:37" 
                 Max. 
"2012-05-31 14:22:01" 

# pdf("figures/audit1_timeline.pdf",height=4,width=10)
hist(sw_pts$date2,breaks = "months",main="Timeline of Audit 1",xlab="Date of Assessment") # mostly in the early part of 2012.

# dev.off()
(dateplot1 <- ggplot(sw_pts) + 
      geom_histogram(aes(x=date2)) + 
      scale_x_datetime("Date of Assessment",date_minor_breaks="months",date_labels="%b %Y") + 
      theme_bw())

rr ggsave(dateplot1,file=/timeline1.pdf)

Saving 7 x 7 in image

So, it looks like this is the quality of the sidewalks

Okay, time to bring in the SCI report from T2:

summary(sw_pts_t2)

     SWK_ID         MATERIAL       SWK_WIDTH                DISTRICT        SWK_AREA         PARENT               SEG_ID     
 24478  :   13   CC     :19494   6      :4434   SOUTH DORCHESTER: 3017   1135   :   20   WASHI1 :  285   TLBRO1_14828:   14  
 17868  :    6   BR     : 1266   6.5    :3768   NORTH DORCHESTER: 2666   1210   :   19   CENTR6 :  239   DOONE1_122  :    6  
 17836  :    5   BC     :  897   7      :2206   WEST ROXBURY    : 2537   1163   :   18   DORCH1 :  196   SHAWM2_7336 :    6  
 372    :    5   CB     :  526   7.5    :1634   DOWNTOWN        : 2055   1334   :   18   RIVER1 :  162   SUMME9_1224 :    6  
 10342  :    4   UNK    :  303   0      :1454   ALLSTON/BRIGHTON: 2041   1452   :   18   WASHI5 :  127   WESTV1_0    :    6  
 (Other):23297   (Other):  177   (Other):9839   (Other)         :11014   (Other):23237   (Other):22321   (Other)     :23292  
 NA's   :   21   NA's   :  688   NA's   :  16   NA's            :   21   NA's   :   21   NA's   :   21   NA's        :   21  
    SIDE           CG_ID           Rpr_Yr          New_SCI         Recon_Date                  geometry    
 LEFT :11563   24258  :   13   Min.   :   0.0   Min.   :  0.00   Min.   :2010-05-05   POINT        :23351  
 RIGHT:11766   17759  :    6   1st Qu.:   0.0   1st Qu.: 45.00   1st Qu.:2014-04-16   epsg:NA      :    0  
 NA's :   22   17728  :    5   Median :   0.0   Median : 73.00   Median :2015-08-10   +proj=lcc ...:    0  
               10277  :    4   Mean   : 262.1   Mean   : 65.48   Mean   :2015-03-21                        
               18301  :    4   3rd Qu.:   0.0   3rd Qu.: 91.00   3rd Qu.:2016-07-21                        
               (Other):22901   Max.   :2016.0   Max.   :100.00   Max.   :2016-11-18                        
               NA's   :  418                                     NA's   :23094                             

Basic descriptives:

summary(sw_poly_t2$SWK_ID) # 5-digit ID numbers, but not unique?

  24478   17868   17836     372   10342   17286   17289   18411   22898   23153   23614   24230    9830   11012   11206 
     13       6       5       5       4       4       4       4       4       4       4       4       4       3       3 
  17839   17855   17861   17959   18460   19071   19135   19233   19682   21372   21443   21746   21846   22041   22116 
      3       3       3       3       3       3       3       3       3       3       3       3       3       3       3 
  22145   22170   22181   22221   22600   23144   23645   24159   24395   24446   24487   24488   24633    5271    5505 
      3       3       3       3       3       3       3       3       3       3       3       3       3       3       3 
  10861   11202   11280   11611   11697   11731   11736   12181   12434   13964   15753   16593   16740   16741   16744 
      2       2       2       2       2       2       2       2       2       2       2       2       2       2       2 
  16748   16821   16890   16957   16968   17018   17090   17142   17496   17834   17835   17860   17968    1829   18401 
      2       2       2       2       2       2       2       2       2       2       2       2       2       2       2 
  18404   18405   18534   18555   18605   18836   18948   19007    1937   20553   20666   21204   21209   21368   21447 
      2       2       2       2       2       2       2       2       2       2       2       2       2       2       2 
  21702   21887   21892   21897   21934   21937   22043   22099 (Other)    NA's 
      2       2       2       2       2       2       2       2   23063      21 

summary(sw_poly_t2$New_SCI) # 0-100 Sidewalk Condition Index

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   0.00   45.00   73.00   65.48   91.00  100.00 

Spatial visuals

Plot SCI:

New data:

Trying to match up geographies across two audits:

So no, those don’t match up. That’s a pain.

Check if the sidewalk segments match up from T1 to T2 at all

st_crs(sw_poly); st_crs(sw_poly_t2)

Coordinate Reference System:
  No EPSG code
  proj4string: "+proj=lcc +lat_1=41.71666666666667 +lat_2=42.68333333333333 +lat_0=41 +lon_0=-71.5 +x_0=199999.9999999999 +y_0=750000 +datum=NAD83 +units=us-ft +no_defs"
Coordinate Reference System:
  No EPSG code
  proj4string: "+proj=lcc +lat_1=41.71666666666667 +lat_2=42.68333333333333 +lat_0=41 +lon_0=-71.5 +x_0=199999.9999999999 +y_0=750000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=us-ft +no_defs"

Let’s look at some subsets to see how to match them spatially

Matching sidewalks segments across waves of audits

trying with centroid points:

rr

sw_pts_t2 <- st_transform(sw_pts_t2,st_crs(sw_pts)) # distmat <- st_distance(sw_pts,sw_pts_t2) # in ft (US) # closest <- apply(distmat,1,function(x){which(x==min(x))}) # closest_dist <- apply(distmat,1,min) # distance in feet # closest[10875] # plot(st_geometry(sw_poly_t2[c(13584,22947),_SCI])) # these are duplicates, that’s why! # closest[10875] <- 13584 # manual fix # matchtable <- tibble(index_t1 = 1:length(unlist(closest)), # closest_index = unlist(closest), # closest_dist = closest_dist, # SWK_ID_t1 = sw_pts\(SWK_ID) # matchtable\)SWK_ID_t2 <- sw_pts_t2\(SWK_ID[matchtable\)closest_index] # summary(matchtable\(closest_dist) # plot(st_geometry(sw_poly %>% filter(SWK_ID %in% matchtable\)SWK_ID_t1[8]))) # these should be overlapping # plot(st_geometry(sw_poly_t2 %>% filter(SWK_ID %in% matchtable$SWK_ID_t2[8])),add=T,col=) # shows that 44 ft apart in centroids not much

What about looking at some segments that are farther apart?

rr # matchtable %>% filter(closest_dist>1000)

rr # plot(st_geometry(sw_poly %>% filter(SWK_ID %in% matchtable\(SWK_ID_t1[8]))) # these should be overlapping # plot(st_geometry(sw_poly_t2 %>% filter(SWK_ID %in% matchtable\)SWK_ID_t2[8])),add=T,col=) # shows that 44 ft apart in centroids not much # plot(st_geometry(sw_poly %>% filter(SWK_ID %in% matchtable\(SWK_ID_t1[1181]))) # these should be overlapping # plot(st_geometry(sw_poly_t2 %>% filter(SWK_ID %in% matchtable\)SWK_ID_t2[1181])),add=T,col=) # shows that even 1047 ft apart in centroids not much, and probably a correct match! # #{r} # plot(st_geometry(sw_poly %>% filter(SWK_ID %in% matchtable\(SWK_ID_t1[1181:1187]))) # these should be overlapping # plot(st_geometry(sw_poly_t2 %>% filter(SWK_ID %in% matchtable\)SWK_ID_t2[1181:1187])),add=T,col=) # shows that even 1047 ft apart in centroids not much, and probably a correct match!

What this seems to be showing is that actually there are just some sidewalk segments that are missing in Wave 2 of the SCI survey. Shows we should also do the matching in the opposite direction - e.g. find closest segment to each SWK in wave 2 from wave 1.

Matching in opposite direction (wave 1 to wave 2):

rr # distmat2 <- st_distance(sw_pts_t2,sw_pts) # in ft (US) # closest2 <- apply(distmat2,1,function(x){which(x==min(x))}) # closest_dist2 <- apply(distmat2,1,min) # distance in feet # matchtable2 <- tibble(index_t2 = 1:length(unlist(closest2)), # closest_index = unlist(closest2), # closest_dist = closest_dist2, # SWK_ID_t2 = as.numeric(as.character(sw_pts_t2\(SWK_ID))) # matchtable2\)SWK_ID_t1 <- sw_pts\(SWK_ID[matchtable2\)closest_index] # summary(matchtable2$closest_dist) # maximum 1114 ft, which is totally allowable

Now, time to match and create over-time change metrics

rr # matchtable2\(SCI_t1 <- sw_pts\)SCI[match(matchtable2\(SWK_ID_t1,sw_pts\)SWK_ID)] # matchtable2\(SCI_t2 <- sw_pts_t2\)New_SCI[match(matchtable2\(SWK_ID_t2,sw_pts_t2\)SWK_ID)] # matchtable2 <- matchtable2 %>% # mutate(SCI_change = SCI_t2-SCI_t1, # SCI_change_perc = SCI_change/SCI_t1) # summary(matchtable2) # on average, got better by 0.1, but median = -1.39. percent messed up b/c some have SCI=0

Time to match these data back to the polygons

summary(sw_poly_t2)

     SWK_ID         MATERIAL       SWK_WIDTH                 DISTRICT        SWK_AREA         PARENT     
 Min.   :    1   CC     :20160   6      : 4584   SOUTH DORCHESTER: 3117   20209  :  169   WASHI1 :  295  
 1st Qu.: 6355   BR     : 1368   6.5    : 3800   NORTH DORCHESTER: 2710   16857  :   36   CENTR6 :  241  
 Median :12724   BC     :  909   7      : 2272   WEST ROXBURY    : 2543   12951  :   25   DORCH1 :  198  
 Mean   :12628   CB     :  562   7.5    : 1654   DOWNTOWN        : 2151   18198  :   25   TLBRO1 :  180  
 3rd Qu.:18907   UNK    :  312   0      : 1510   ALLSTON/BRIGHTON: 2063   2598   :   22   RIVER1 :  162  
 Max.   :24778   (Other):  191   (Other):10371   (Other)         :11502   (Other):23809   (Other):23010  
 NA's   :441     NA's   : 1025   NA's   :  336   NA's            :  441   NA's   :  441   NA's   :  441  
          SEG_ID         SIDE           CG_ID           Rpr_Yr          New_SCI         Recon_Date            index_t2    
 TLBRO1_14828:  170   LEFT :11839   24258  :  169   Min.   :   0.0   Min.   :  0.00   Min.   :2010-05-05   Min.   :    1  
 SUMME9_1224 :   36   RIGHT:12245   17759  :   36   1st Qu.:   0.0   1st Qu.: 45.00   1st Qu.:2013-09-23   1st Qu.: 6118  
 SHAWM2_7336 :   26   NA's :  443   17728  :   25   Median :   0.0   Median : 73.00   Median :2014-03-31   Median :12235  
 AMERI1_1688 :   25                 10277  :   16   Mean   : 254.7   Mean   : 65.67   Mean   :2014-07-21   Mean   :12204  
 DOONE1_122  :   20                 18301  :   16   3rd Qu.:   0.0   3rd Qu.: 92.00   3rd Qu.:2015-08-24   3rd Qu.:18352  
 (Other)     :23809                 (Other):23407   Max.   :2016.0   Max.   :100.00   Max.   :2016-11-18   Max.   :23351  
 NA's        :  441                 NA's   :  858                                     NA's   :23833                       
 closest_index    closest_dist        SWK_ID_t1         SCI_t1           SCI_t2         SCI_change        SCI_change_perc  
 Min.   :    1   Min.   :   0.000   Min.   :    2   Min.   :  0.00   Min.   :  0.00   Min.   :-100.0000   Min.   :-1.0000  
 1st Qu.: 7038   1st Qu.:   1.953   1st Qu.: 8472   1st Qu.: 44.97   1st Qu.: 45.00   1st Qu.: -10.3604   1st Qu.:-0.1636  
 Median :13800   Median :   4.838   Median :15801   Median : 71.65   Median : 73.00   Median :  -1.2045   Median :-0.0185  
 Mean   :13801   Mean   :  20.522   Mean   :15854   Mean   : 65.45   Mean   : 65.69   Mean   :   0.2373   Mean   :    Inf  
 3rd Qu.:20685   3rd Qu.:  15.781   3rd Qu.:23574   3rd Qu.: 91.56   3rd Qu.: 92.00   3rd Qu.:   4.5861   3rd Qu.: 0.0898  
 Max.   :27388   Max.   :1114.329   Max.   :30757   Max.   :100.00   Max.   :100.00   Max.   : 100.0000   Max.   :    Inf  
                                                                                                          NA's   :350      
      TLID              BG_GEOID            CT_GEOID                  geometry    
 Min.   : 85694288   Min.   :2.503e+11   Min.   :2.503e+10   MULTIPOLYGON :24527  
 1st Qu.: 85701197   1st Qu.:2.503e+11   1st Qu.:2.503e+10   epsg:NA      :    0  
 Median : 85705981   Median :2.503e+11   Median :2.503e+10   +proj=lcc ...:    0  
 Mean   :130739389   Mean   :2.503e+11   Mean   :2.503e+10                        
 3rd Qu.: 85720558   3rd Qu.:2.503e+11   3rd Qu.:2.503e+10                        
 Max.   :645513578   Max.   :2.503e+11   Max.   :2.503e+10                        
                     NA's   :41          NA's   :71                               

Matching to Census geographies:

Loading Census geographies:

Map Census geographies:

# nicer plots:
boston_base <- get_map(location="Boston Latin Academy, Boston, MA",zoom=12, color="color",maptype="terrain",crop=T,source="google")

Error in data.frame(ll.lat = ll[1], ll.lon = ll[2], ur.lat = ur[1], ur.lon = ur[2]) : 
  arguments imply differing number of rows: 0, 1

rr (b1 <- b0 + geom_sf(data=boston_tracts,color = ,alpha=0.4,inherit.aes = F,guide=F,aes(fill=GEOID)) )

Error in UseMethod(\element_grob\) : 
  no applicable method for 'element_grob' applied to an object of class \NULL\

First match up the closest TLID

sum(!is.na(sw_pts_streets$TLID)) # got all of them!

[1] 24527

Visualize

Next, going to plot the sidewalk conditions at various geographies:

Street-level SCI changes

tmap_mode("view")

Error in tmap_mode("view") : could not find function "tmap_mode"

This map shows where sidewalk conditions got better between these two surveys (areas in green, with positive values of change in SCI) and where conditions got worse (red, or negative values of change in SCI). Looks like things improved in Jamaica Plain and East Bostn, but got worse in Dorchester and the northern edges of Charlestown.

Sidewalk conditions within tracts:

# join in CT of sidewalk segment:
boston_tracts <- st_transform(boston_tracts,st_crs(sw_pts_streets))

Error in st_crs(sw_pts_streets) : object 'sw_pts_streets' not found

Tract SCI changes

(b2 <- b0 + 
      geom_polygon(data=boston_tracts3,aes(x=long,y=lat,group=group,fill = mean_change_sci)) +
      theme(legend.key.width = unit(0.75, "cm"),legend.key.height = unit(2, "cm"),
            axis.line = NULL,panel.border = NULL,panel.grid = NULL) + 
            theme_bw()
 )

Error: object 'b0' not found

rr ggsave(b2,filename = /ct_mean_change_sci.png) # interactive plot: tmap_mode() tm_shape(boston_tracts2) + tm_fill(col = _change_sci,title = in SCI, palette=, n=20,midpoint=0, id = )

As with the segment-level map, this shows that conditions improved in JP and East Boston, but got worse in Mattapan/Dorchester and Charlestown.

Replicate this for BGs:

rr # join in BG of sidewalk segment: boston_bg <- st_transform(boston_bg,st_crs(sw_pts_streets)) sw_pts_bg <- st_join(x=sw_pts_streets,y=boston_bg,join=st_within,left=T)

bg_summ <- sw_pts_bg %>% as_tibble() %>% group_by(GEOID) %>% summarize(mean_sci_t1 = mean(SCI_t1,na.rm=T), mean_sci_t2 = mean(SCI_t2,na.rm=T), mean_change_sci = mean(SCI_change,na.rm=T))

boston_bg2 <- left_join(boston_bg,bg_summ,by=) # Output the BG-level sf data for other uses: save(boston_bg2,file = /boston_bg_sci.RData)

rr (b2 <- ggplot() + geom_sf(data=boston_bg2,aes(fill = mean_change_sci),alpha=1,inherit.aes = F,show.legend = ) )

BG SCI changes

rr ggsave(b2,filename = /bg_mean_change_sci.png) # interactive plot: tm_shape(boston_bg2) + tm_fill(col = _change_sci,title = in SCI, palette=, n=20,midpoint=0, id = )

This BG-level map corroborates the tract- and street-level visuals.

Adding census geographies back to crosswalk table

rr # matchtable2\(TLID <- sw_pts_streets\)TLID[match(matchtable2\(SWK_ID_t2,sw_pts_streets\)SWK_ID)] # matchtable2\(BG_GEOID <- sw_pts_bg\)GEOID[match(matchtable2\(SWK_ID_t2,sw_pts_bg\)SWK_ID)] # matchtable2\(CT_GEOID <- sw_pts_ct\)GEOID[match(matchtable2\(SWK_ID_t2,sw_pts_ct\)SWK_ID)] # write.csv(matchtable2,/SWK_matched_cwalk.csv,row.names = F) matchtable2 <- read.csv(/SWK_matched_cwalk.csv,stringsAsFactors = F)

Adding 311 data to analyses

First need to bring in 311 data from between the two sidewalk audits:

Matching 311 calls to census geographies:

rr sw_calls_pts\(SWK_ID_t2 <- NA for(i in 1:nrow(sw_calls)){ sw_calls_pts\)SWK_ID_t2[i] <- as.character( # match to closest sidewalk segment centroid sw_pts_streets\(SWK_ID[which.min(st_distance(sw_calls_pts[i,\geometry\], sw_pts_streets))] ) } sum(!is.na(sw_calls_pts\)SWK_ID_t2)) sw_calls_pts\(TLID <- matchtable2\)TLID[match(sw_calls_pts\(SWK_ID_t2,matchtable2\)SWK_ID_t2)] sw_calls_pts\(BG_GEOID <- matchtable2\)BG_GEOID[match(sw_calls_pts\(SWK_ID_t2,matchtable2\)SWK_ID_t2)] sw_calls_pts\(CT_GEOID <- matchtable2\)CT_GEOID[match(sw_calls_pts\(SWK_ID_t2,matchtable2\)SWK_ID_t2)] # save(sw_calls_pts,file = /sw_calls_geomatched.RData) load(file = /sw_calls_geomatched.RData)

Aggregating 311 data at geographic levels:

Street-level 311 visuals:

rr streets_summ_311 <- sw_calls_pts %>% as_tibble() %>% group_by(TLID) %>% summarize(n_calls = n()) %>% as.data.frame()

boston_streets_sci\(TLID <- as.numeric(boston_streets_sci\)TLID) boston_streets_sci <- left_join(boston_streets_sci,streets_summ_311,by=) boston_streets_sci\(n_calls[is.na(boston_streets_sci\)n_calls)] <- 0 boston_streets_sci\(nonzero_calls <- as.numeric(boston_streets_sci\)n_calls>0) boston_streets_sci\(log_calls <- log1p(boston_streets_sci\)n_calls) boston_streets_sci\(bin_calls <- cut(boston_streets_sci\)n_calls,breaks = c(-Inf,1,2,4,6,Inf), labels=c(,-2,-4,-6,+)) boston_streets_sci <- boston_streets_sci %>% mutate(change_sci_binned = cut(mean_change_sci, breaks=c(-Inf, -30, 30, Inf), labels=c(,,))) tm_shape(boston_streets_sci) + tm_lines(col = _calls,title.col = # of 311 Sidewalk Calls,lwd=2, palette=, n=5, id = )

Blockgroup 311 visuals:

Tract 311 visuals:

rr ct_summ_311 <- sw_calls_pts %>% as_tibble() %>% group_by(CT_GEOID) %>% summarize(n_calls = n()) %>% as.data.frame()

boston_tracts2\(GEOID <- as.numeric(boston_tracts2\)GEOID) boston_tracts2 <- left_join(boston_tracts2,ct_summ_311,by=c( = _GEOID)) boston_tracts2\(n_calls[is.na(boston_tracts2\)n_calls)] <- 0 boston_tracts2\(log_calls <- log1p(boston_tracts2\)n_calls) boston_tracts2\(bin_calls <- cut(boston_tracts2\)n_calls,breaks = c(-Inf,10,25,40,55,Inf), labels=c(-10,1-25,6-40,1-55,6+)) boston_tracts2 <- boston_tracts2 %>% mutate(change_sci_binned = cut(mean_change_sci, breaks=c(-Inf, -10, 10, Inf), labels=c(,,)))

tm_shape(boston_tracts2) + tm_fill(col = _calls,title = # of 311 Sidewalk Calls, palette=, n=5,midpoint=, id = )

How do 311 calls and SW quality differences match up at various aggregate levels?

Tract-level:

summary(lm((boston_tracts2$change_sci_binned=="Better") ~ boston_tracts2$n_calls*(boston_tracts2$mean_sci_t1>median(boston_tracts2$mean_sci_t1,na.rm=T)))) # differential impact of calls: all insig except less likely to get better if nicer area

Call:
lm(formula = (boston_tracts2$change_sci_binned == "Better") ~ 
    boston_tracts2$n_calls * (boston_tracts2$mean_sci_t1 > median(boston_tracts2$mean_sci_t1, 
        na.rm = T)))

Residuals:
     Min       1Q   Median       3Q      Max 
-0.40948 -0.31796 -0.06491 -0.04193  0.94358 

Coefficients:
                                                                                                       Estimate Std. Error
(Intercept)                                                                                            0.412433   0.066670
boston_tracts2$n_calls                                                                                -0.001476   0.001228
boston_tracts2$mean_sci_t1 > median(boston_tracts2$mean_sci_t1, na.rm = T)TRUE                        -0.336210   0.083694
boston_tracts2$n_calls:boston_tracts2$mean_sci_t1 > median(boston_tracts2$mean_sci_t1, na.rm = T)TRUE  0.001123   0.001349
                                                                                                      t value Pr(>|t|)    
(Intercept)                                                                                             6.186 4.32e-09 ***
boston_tracts2$n_calls                                                                                 -1.202    0.231    
boston_tracts2$mean_sci_t1 > median(boston_tracts2$mean_sci_t1, na.rm = T)TRUE                         -4.017 8.77e-05 ***
boston_tracts2$n_calls:boston_tracts2$mean_sci_t1 > median(boston_tracts2$mean_sci_t1, na.rm = T)TRUE   0.832    0.406    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.3775 on 173 degrees of freedom
  (1 observation deleted due to missingness)
Multiple R-squared:  0.1403,    Adjusted R-squared:  0.1254 
F-statistic: 9.409 on 3 and 173 DF,  p-value: 8.565e-06

BG-level:

summary(lm((boston_bg2$change_sci_binned=="Better") ~ (boston_bg2$n_calls)*(boston_bg2$mean_sci_t1>median(boston_bg2$mean_sci_t1,na.rm=T)))) # differential impact of calls: nothing significant except nicer areas less likely to get better

Call:
lm(formula = (boston_bg2$change_sci_binned == "Better") ~ (boston_bg2$n_calls) * 
    (boston_bg2$mean_sci_t1 > median(boston_bg2$mean_sci_t1, 
        na.rm = T)))

Residuals:
     Min       1Q   Median       3Q      Max 
-0.35772 -0.34536 -0.04819 -0.03306  0.97703 

Coefficients:
                                                                                            Estimate Std. Error t value
(Intercept)                                                                                3.577e-01  2.479e-02  14.429
boston_bg2$n_calls                                                                        -6.178e-04  7.037e-04  -0.878
boston_bg2$mean_sci_t1 > median(boston_bg2$mean_sci_t1, na.rm = T)TRUE                    -3.051e-01  4.044e-02  -7.544
boston_bg2$n_calls:boston_bg2$mean_sci_t1 > median(boston_bg2$mean_sci_t1, na.rm = T)TRUE -1.257e-05  1.699e-03  -0.007
                                                                                          Pr(>|t|)    
(Intercept)                                                                                < 2e-16 ***
boston_bg2$n_calls                                                                           0.380    
boston_bg2$mean_sci_t1 > median(boston_bg2$mean_sci_t1, na.rm = T)TRUE                    1.88e-13 ***
boston_bg2$n_calls:boston_bg2$mean_sci_t1 > median(boston_bg2$mean_sci_t1, na.rm = T)TRUE    0.994    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.3674 on 553 degrees of freedom
  (1 observation deleted due to missingness)
Multiple R-squared:  0.1487,    Adjusted R-squared:  0.1441 
F-statistic:  32.2 on 3 and 553 DF,  p-value: < 2.2e-16

street-level:

stats::cor(boston_streets_sci$mean_change_sci,y=boston_streets_sci$n_calls,use = "complete.obs")

Error in stats::cor(boston_streets_sci$mean_change_sci, y = boston_streets_sci$n_calls,  : 
  supply both 'x' and 'y' or a matrix-like 'x'

Visualizing correlation between calls and change in sidewalk conditions:

rr plot(log1p(boston_streets_sci\(n_calls),boston_streets_sci\)mean_change_sci,xlim=c(0,4),pch=16,col=,main=segment-level,ylab=in sidewalk conditions,xlab=of 311 calls) # lines(lowess(boston_streets_sci\(mean_change_sci ~ log1p(boston_streets_sci\)n_calls)),col=) lines(lowess(boston_streets_sci\(mean_change_sci[which(boston_streets_sci\)mean_sci_t1<median(boston_streets_sci\(mean_sci_t1,na.rm=T))] ~ log1p(boston_streets_sci\)n_calls[which(boston_streets_sci\(mean_sci_t1<median(boston_streets_sci\)mean_sci_t1,na.rm=T))])),col=,lwd=2) lines(lowess(boston_streets_sci\(mean_change_sci[which(boston_streets_sci\)mean_sci_t1>median(boston_streets_sci\(mean_sci_t1,na.rm=T))] ~ log1p(boston_streets_sci\)n_calls[which(boston_streets_sci\(mean_sci_t1>median(boston_streets_sci\)mean_sci_t1,na.rm=T))])),col=,lwd=2)

Nicer bivariate visuals:

rr (street_bivariate <- ggplot(boston_streets_sci) + geom_point(aes(x=n_calls,y=mean_change_sci),col=) + scale_x_continuous(of 311 calls(log scale),trans=10,limits=c(0.8,50),breaks=c(1,5,10,20,40)) + scale_y_continuous(in sidewalk conditions, limits=c(-100,100), breaks=seq(-100,100,50), labels=c(\n-100(Worse),-50,,0,\(Better)\n100\n\)) + geom_smooth(data=subset(boston_streets_sci,mean_sci_t1>median(boston_streets_sci\(mean_sci_t1,na.rm=T)), aes(x=n_calls,y=mean_change_sci),col=\blue\,lwd=1,method=\loess\,se=F) + geom_smooth(data=subset(boston_streets_sci,mean_sci_t1<=median(boston_streets_sci\)mean_sci_t1,na.rm=T)), aes(x=n_calls,y=mean_change_sci),col=,lwd=1,method=,se=F) + annotate(,x=0.8,y=15,label=street segments in 2012,col=,size=3,hjust=0) + annotate(,x=0.8,y=-15,label=street segments in 2012,col=,size=3,hjust=0) + theme_bw() )

# Saving visuals
ggsave(tract_bivariate,file="figures/calls_changeSCI_ct.pdf",height=4,width=6)
ggsave(bg_bivariate,file="figures/calls_changeSCI_bg.pdf",height=4,width=6)
ggsave(street_bivariate,file="figures/calls_changeSCI_streets.pdf",height=4,width=6)

Demographic analyses

Now lets bring in demographics to do something more than bivariate analyses:

summary(lm(mean_change_sci ~ log1p(n_calls)*B19013_001E, data = boston_tracts3)) # nothing sig

Call:
lm(formula = mean_change_sci ~ log1p(n_calls) * B19013_001E, 
    data = boston_tracts3)

Residuals:
    Min      1Q  Median      3Q     Max 
-26.193  -6.871  -1.547   3.899  38.867 

Coefficients:
                              Estimate  Std. Error t value Pr(>|t|)
(Intercept)                -0.18393946  7.27526449  -0.025    0.980
log1p(n_calls)              0.39596671  2.15971702   0.183    0.855
B19013_001E                 0.00006832  0.00010417   0.656    0.513
log1p(n_calls):B19013_001E -0.00001809  0.00002833  -0.639    0.524

Residual standard error: 12.23 on 165 degrees of freedom
  (9 observations deleted due to missingness)
Multiple R-squared:  0.004897,  Adjusted R-squared:  -0.0132 
F-statistic: 0.2707 on 3 and 165 DF,  p-value: 0.8465

The main lessons coming out of these analyses are that: (1) Whiter and higher income tracts and BGs were more likely to have improvement in sidewalk conditions between the two sidewalk conditions audits; and (2) In tracts and BGs with more white residents and with higher levels of education, the number of 311 calls doesn’t seem to correlate with improvements in sidewalk conditions, but in tracts and BGs with fewer white residents and lower levels of education, the number of 311 calls is positively correlated with improvements in sidewalk conditions.

Visualizing these dynamics:

# saving plots:
ggsave(tract_bivariate_inc,file="figures/calls_changeSCI_ct_inc.pdf",height=4,width=6)
ggsave(bg_bivariate_inc,file="figures/calls_changeSCI_bg_inc.pdf",height=4,width=6)
ggsave(bg_bivariate_inc_lm,file="figures/calls_changeSCI_bg_inc_lm.pdf",height=4,width=6)