NYC buses： company level predictors with R

1. Basic Statistics

---

Tags

• Data Management
• R Programming

We are following on from our previously loaded data of NYC bus delays, and from our simple Cubist regression fit. We know that we need to add in more predictors, and we have access to company level data. A warning to the faint-hearted: this post is essentially all data manipulation and joins. No pretty graphs, no conclusions. I am documenting the slog because the slog is required. We will move on to better things afterwards.

Preparation of company and route level data

We read in all of our data and take a look:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617

#---II_Breakdown_and_Delays ##NR: this actually isn't what I want here. Where is the other data? in_csv <- "../data/II_Bus_Breakdown_and_Delays.csv" ii_breakdowns <- read_csv(in_csv) ii_breakdowns %>% glimpse ## Observations: 259,637 ## Variables: 21 ## $ School_Year "2015-2016", "2015-2016", "201... ## $ Busbreakdown_ID 1212699, 1212700, 1212701, 121... ## $ Run_Type "Special Ed AM Run", "Special ... ## $ Bus_No "48186", "2518", "235", "2102"... ## $ Route_Number "N758", "L530", "K168", "K216"... ## $ Reason "Other", "Mechanical Problem",... ## $ Schools_Serviced "75485", "21854", "18366", "21... ## $ Occurred_On 2015-09-02 06:27:00, 2015-09-... ## $ Created_On 2015-09-02 06:29:00, 2015-09-... ## $ Boro "Nassau County", "Brooklyn", "... ## $ Bus_Company_Name "BORO TRANSIT, INC.", "RELIANT... ## $ How_Long_Delayed "25 minutes", NA, "30MINS", "2... ## $ Number_Of_Students_On_The_Bus 0, 0, 0, 1, 0, 0, 0, 9, 0, 2, ... ## $ Has_Contractor_Notified_Schools "Yes", "Yes", "Yes", "Yes", "Y... ## $ Has_Contractor_Notified_Parents "No", "Yes", "Yes", "Yes", "Ye... ## $ Have_You_Alerted_OPT "No", "Yes", "No", "No", "No",... ## $ Informed_On 2015-09-02 06:29:00, 2015-09-... ## $ Incident_Number NA, NA, NA, NA, NA, NA, NA, NA... ## $ Last_Updated_On 2015-09-02 06:29:16, 2015-09-... ## $ Breakdown_or_Running_Late "Running Late", "Breakdown", "... ## $ School_Age_or_PreK "School-Age", "School-Age", "S... ##-------data loading #---III_Drivers_and_Attendants in_csv <- "../data/III_Drivers_and_Attendants.csv" iii_drivers <- read_csv(in_csv) iii_drivers %>% glimpse ## Observations: 832 ## Variables: 5 ## $ School_Year "2018-2019", "2018-2019", "2018-2019", "2018-... ## $ Vendor_Name "ACADEMY EXPRESS LLC", "E-Z BUS LLC (B2321)",... ## $ Type_of_Service "Coach", "School Age", "School Age", "School ... ## $ Active_Employees 65, 5, 3, 2, 1, 3, 6, 226, 22, 18, 13, 2, 20,... ## $ Job_Type "Driver", "Attendant", "Driver", "Driver&Atte... #---IV_Routes in_csv <- "../data/IV_Routes.csv" iv_routes <- read_csv(in_csv) iv_routes %>% glimpse ## Observations: 42,114 ## Variables: 14 ## $ School_Year "2015-2016", "2015-2016", "2015-2016"... ## $ Route_Number "C911", "J499", "J500", "J501", "J502... ## $ Service_Type "D2D", "D2D", "D2D", "D2D", "D2D", "D... ## $ Vehicle_TypeDescription "Non-Wheelchair Accessible Alternativ... ## $ Route_Start_Date "03/21/2016", "09/09/2015", "09/01/20... ## $ Vendor_Code "VN", "RV", "HT", "HT", "HT", "HT", "... ## $ Vendor_Name "VAN TRANS LLC (B2192)", "RELIANT TRA... ## $ Vendor_Affiliation "VAN TRANS LLC (B2192)", "RELIANT TRA... ## $ `Garage _Street_Address` "670 Hillside Road", "297 NORMAN AVEN... ## $ Garage_City "Pelham Manor", "Brooklyn", "BROOKLYN... ## $ Garage_State "NY", "NY", "NY", "NY", "NY", "NY", "... ## $ Garage_Zip 10803, 11222, 11224, 11224, 11224, 11... ## $ XCoordinates 1034574, 1000787, 983439, 983439, 983... ## $ YCoordinates 265547.6, 204481.0, 148884.0, 148884.... #---V_Routes_by_Transportation_Sites in_csv <- "../data/V_Routes_by_Transportation_Sites.csv" v_rbt <- read_csv(in_csv) v_rbt %>% glimpse ## Observations: 98,506 ## Variables: 3 ## $ School_Year "2015-2016", "2015-2016", "2015-2016", "2015-2016... ## $ Route_Number "J698", "J699", "J700", "J700", "J701", "J701", "... ## $ OPT_Code 75004, 75580, 75003, 75140, 75003, 75140, 75003, ... #---VI_Transportation_Sites in_csv <- "../data/VI_Transportation_Sites.csv" vi_transport <- read_csv(in_csv) vi_transport %>% glimpse ## Observations: 18,220 ## Variables: 18 ## $ School_Year "2016-2017", "2016-2017", "2016-... ## $ OPT_Code "01001", "01569", "01600", "0161... ## $ Name "Comprehensive Kids Devel. Scho"... ## $ Affiliation "Other Religion", "Public", "Pub... ## $ Site_Type "School", "School", "School", "S... ## $ Street_Address "101 Norfolk Street", "525 EAST ... ## $ City "Manhattan", "Manhattan", "Manha... ## $ State "NY", "NY", "NY", "NY", "NY", "N... ## $ Zip 10002, 10002, 10002, 10002, 1000... ## $ Longitude -73.98727, -73.97544, -73.99063,... ## $ Latitude 40.71879, 40.71876, 40.72249, 40... ## $ Door_To_Door_Service "Yes", "Yes", "No", "Yes", "Yes"... ## $ Stop_To_School_Service "No", "No", "No", "No", "Yes", "... ## $ Common_Carrier_Svc_Metrocards "No", "Yes", "Yes", "Yes", "Yes"... ## $ Site_Reimbursement "No", "No", "No", "No", "No", "N... ## $ Mid_Day_Service "No", "No", "No", "Yes", "Yes", ... ## $ D2D_Late_Day_Programs "No", "No", "No", "No", "No", "N... ## $ S2S_Late_Day_Programs "No", "No", "No", "No", "No", "N... #---VII_Vehicles in_csv <- "../data/VII_Vehicles.csv" vii_vehicles <- read_csv(in_csv) vii_vehicles %>% glimpse ## Observations: 764 ## Variables: 4 ## $ School_Year "2015-2016", "2015-2016", "2015-2016",... ## $ Vendor_Name "ACADEMY EXPRESS LLC", "ACME BUS CORP.... ## $ Vehicle_TypeDescription "Motor Coach Bus", "Mini-Wagon", "Mini... ## $ Active_Vehicles 22, 71, 6, 62, 1, 9, 71, 6, 63, 47, 67... #---VIII_PreK_Riders_by_Transportation_Site in_csv <- "../data/VIII_PreK_Riders_by_Transportation_Site.csv" viii_prt <- read_csv(in_csv) viii_prt %>% glimpse ## Observations: 1,268 ## Variables: 5 ## $ School_Year "2017-2018", "2017-2018", "2017-2018", "2017-... ## $ OPT_Code "C225", "E011", "E019", "E082", "E148", "E187... ## $ Site_Name "Highbridge Advisory Council", "Crossroads Sc... ## $ School_Name "Marshall England", "Crossroads School for Ch... ## $ Number_of_Riders 50, 2, 1, 3, 3, 2, 90, 67, 22, 6, 7, 8, 4, 3,... #---IX_PreK_Vendors_by_Transportation_Site in_csv <- "../data/IX_PreK_Vendors_by_Transportation_Site.csv" ix_pvt <- read_csv(in_csv) ix_pvt %>% glimpse ## Observations: 1,833 ## Variables: 5 ## $ School_Year "2017-2018", "2017-2018", "2017-2018", "2017-2018"... ## $ OPT_Code "C053", "C104", "C149", "C153", "C157", "C158", "C... ## $ Site_Name "Bank Street Family Center", "PAL WORLD OF CREATIV... ## $ School_Name "Bank Street Family Center", "KIDS CENTRIC, INC", ... ## $ Vendor_Name "PHILLIPS BUS SERVICE", "L & M BUS CORP.", "L & M ... And we begin to engage in some 'exploratory' data cleaning. That is, we aren't quite yet sure what we are going to use, and what we aren't going to use. But we know dirt when we see it. First we try to clean up iv_routes a little: #iv_routes check_similar <- function(df){ df %>% mutate( diff= stringdist(Vendor_Affiliation, str_trunc(Vendor_Name,str_length(Vendor_Affiliation))), flag_company_same = ifelse(diff <= str_length(Vendor_Affiliation)/6, 1L, 0L), diff = NULL ) } iv_routes %>% check_similar() %>% filter(flag_company_same != 1) %>% distinct(Vendor_Name, Vendor_Affiliation) ## # A tibble: 12 x 2 ## Vendor_Name Vendor_Affiliation ## ## 1 EMPIRE STATE BUS CORP. ALLIED TRANSIT CORP. ## 2 LOGAN BUS COMPANY INC. LITTLE LINDA BUS CO.,INC. ## 3 LORINDA ENT. LTD. LITTLE LINDA BUS CO.,INC. ## 4 CONSOLIDATED BUS TRANS. INC. BORO TRANSIT, INC. ## 5 LORISSA BUS SERVICE INC. BOBBY`S BUS CO. INC. ## 6 GRANDPA`S BUS CO., INC. BOBBY`S BUS CO. INC. ## 7 LITTLE RICHIE BUS SERVICE LITTLE LINDA BUS CO.,INC. ## 8 THIRD AVENUE TRANSIT JOFAZ TRANSPORTATION INC. ## 9 LOGAN TRANSPORTATION SYSTEMS BOBBY`S BUS CO. INC. ## 10 CONSOLIDATED BUS TRANSIT, INC. BORO TRANSIT, INC. ## 11 LORINDA ENTERPRISES, LTD. LITTLE LINDA BUS CO.,INC. ## 12 THIRD AVENUE TRANSIT, INC JOFAZ TRANSPORTATION INC. #cleaning that needs to be done prior to welding iv_cleaned <- iv_routes %>% mutate(Route_Start_Date = mdy(Route_Start_Date), Garage_City = tolower(Garage_City) ) %>% dplyr::rename( "Garage_Street_Address" = 'Garage _Street_Address', "Garage_XCoord" = "XCoordinates", "Garage_YCoord" = "YCoordinates" ) %>% check_similar() iv_cleaned %>% glimpse ## Observations: 42,114 ## Variables: 15 ## $ School_Year "2015-2016", "2015-2016", "2015-2016",... ## $ Route_Number "C911", "J499", "J500", "J501", "J502"... ## $ Service_Type "D2D", "D2D", "D2D", "D2D", "D2D", "D2... ## $ Vehicle_TypeDescription "Non-Wheelchair Accessible Alternative... ## $ Route_Start_Date 2016-03-21, 2015-09-09, 2015-09-01, 2... ## $ Vendor_Code "VN", "RV", "HT", "HT", "HT", "HT", "H... ## $ Vendor_Name "VAN TRANS LLC (B2192)", "RELIANT TRAN... ## $ Vendor_Affiliation "VAN TRANS LLC (B2192)", "RELIANT TRAN... ## $ Garage_Street_Address "670 Hillside Road", "297 NORMAN AVENU... ## $ Garage_City "pelham manor", "brooklyn", "brooklyn"... ## $ Garage_State "NY", "NY", "NY", "NY", "NY", "NY", "N... ## $ Garage_Zip 10803, 11222, 11224, 11224, 11224, 112... ## $ Garage_XCoord 1034574, 1000787, 983439, 983439, 9834... ## $ Garage_YCoord 265547.6, 204481.0, 148884.0, 148884.0... ## $ flag_company_same 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,... Next we join this to v_rbt, trying as best we can to figure out how they join, and to account for any observations which can't be joined as cleanly. 'School_Year' and 'Route_Number' appear to be our main joining headers, but this join leaves out 'OPT_Code' for some observations. These observations are not represented in the correct school year. We take a guess, and assign these an OPT_Code based only on the route, hoping that things haven't changed from year to year. `v_rbt %>% group_by(School_Year,Route_Number) %>% count %>% filter(n>1)` ## # A tibble: 27,712 x 3 ## # Groups: School_Year, Route_Number [27,712] ## School_Year Route_Number n ## ## 1 2015-2016 J510 2 ## 2 2015-2016 J690 2 ## 3 2015-2016 J700 2 ## 4 2015-2016 J701 2 ## 5 2015-2016 J702 2 ## 6 2015-2016 J703 2 ## 7 2015-2016 J704 2 ## 8 2015-2016 J705 2 ## 9 2015-2016 J706 2 ## 10 2015-2016 J707 2 ## # ... with 27,702 more rows # There are 27712 School_Year, Route_Number combinations in v_rbt which appear more than once. Why is that? #Some year/route combinations have more than one OPT_Code. Why? #OPT_Code represents an organization in a specific location. Each Route/School_Year combination thus can serve multiple organizations in multiple locations. #This is going to cause us some problems later on, since we will have bus level data with multiple organizations attached. It will probably require some summary operations. v_joined <- iv_cleaned %>% left_join(v_rbt, by = c("School_Year", "Route_Number")) #62 observations have no OPT_code after this join. Check if the Route_Numbers can be matched alone iv_cleaned %>% anti_join(v_rbt, by = c("School_Year", "Route_Number")) %>% distinct(Route_Number) #59 routes ## # A tibble: 59 x 1 ## Route_Number ## ## 1 Z003 ## 2 T003 ## 3 T004 ## 4 Q8227 ## 5 T008 ## 6 T009 ## 7 Z001 ## 8 Z002 ## 9 Z004 ## 10 Z005 ## # ... with 49 more rows #question: are all of these routes represented in the v_rbt, even if the year is wrong? iv_cleaned %>% anti_join(v_rbt, by = c("School_Year", "Route_Number")) %>% inner_join(v_rbt, by = "Route_Number") %>% distinct(Route_Number) #39 routes can be filled by ignoring year. Check. ## # A tibble: 39 x 1 ## Route_Number ## ## 1 Z003 ## 2 T004 ## 3 T008 ## 4 T009 ## 5 Z001 ## 6 Z002 ## 7 Z004 ## 8 Z005 ## 9 X2353 ## 10 X9353 ## # ... with 29 more rows `iv_cleaned %>% anti_join(v_rbt, by = "Route_Number") %>% distinct(Route_Number) #Yes, 20 routes left for which we have no OPT information.` ## # A tibble: 20 x 1 ## Route_Number ## ## 1 T003 ## 2 Q8227 ## 3 X8304 ## 4 X8338 ## 5 X8339 ## 6 X8406 ## 7 X9874 ## 8 X9875 ## 9 X9881 ## 10 M8068 ## 11 M8246 ## 12 M9068 ## 13 M9246 ## 14 X8621 ## 15 X9621 ## 16 D002 ## 17 Q2455 ## 18 Q9455 ## 19 A002 ## 20 I001 #OK, so I have 39 routes which need to join the OPT_Code on. But I only want to perform this join on the members of v_joined which are missing OPT data v_sub <- v_joined %>% filter(is.na(OPT_Code)) %>% mutate(OPT_Code = NULL) %>% left_join(v_rbt %>% select(Route_Number,OPT_Code), by = "Route_Number") v_corrected <- v_joined %>% filter(!is.na(OPT_Code)) %>% rbind(v_sub) #and 20 routes remain without an OPT_Code v_corrected %>% glimpse ## Observations: 98,632 ## Variables: 16 ## $ School_Year "2015-2016", "2015-2016", "2015-2016",... ## $ Route_Number "C911", "J499", "J500", "J501", "J502"... ## $ Service_Type "D2D", "D2D", "D2D", "D2D", "D2D", "D2... ## $ Vehicle_TypeDescription "Non-Wheelchair Accessible Alternative... ## $ Route_Start_Date 2016-03-21, 2015-09-09, 2015-09-01, 2... ## $ Vendor_Code "VN", "RV", "HT", "HT", "HT", "HT", "H... ## $ Vendor_Name "VAN TRANS LLC (B2192)", "RELIANT TRAN... ## $ Vendor_Affiliation "VAN TRANS LLC (B2192)", "RELIANT TRAN... ## $ Garage_Street_Address "670 Hillside Road", "297 NORMAN AVENU... ## $ Garage_City "pelham manor", "brooklyn", "brooklyn"... ## $ Garage_State "NY", "NY", "NY", "NY", "NY", "NY", "N... ## $ Garage_Zip 10803, 11222, 11224, 11224, 11224, 112... ## $ Garage_XCoord 1034574, 1000787, 983439, 983439, 9834... ## $ Garage_YCoord 265547.6, 204481.0, 148884.0, 148884.0... ## $ flag_company_same 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,... ## $ OPT_Code 75666, 75760, 75006, 75437, 75437, 759... Next we work on vi_transport, including looking into how unique OPT_Codes really are. We transform the vehicle descriptions into counts of the various kinds of passengers and attributes of each vehicle. This approach is a kind of 'type agnostic' approach, so that a new vehicle type can be predicted based on its properties, rather than just being a new predictor which the model cannot account for. vi_cleaned <- vi_transport %>% mutate(City = tolower(City), OPT_Code = as.integer(OPT_Code) ) %>% dplyr::rename( "location_city" = "City", "location_state" = "State", "location_zip" = "Zip", "location_longitude" = "Longitude", "location_latitude" = "Latitude" ) %>% filter(!is.na(OPT_Code)) #OPT_Codes with non-duplicate lat/long vi_code_and_first_location <- vi_cleaned %>% group_by(OPT_Code, School_Year) %>% distinct(location_longitude,location_latitude) %>% count() %>% filter(n>1) %>% inner_join(vi_cleaned, by = c("OPT_Code","School_Year")) %>% filter(row_number() == 1) %>% select(OPT_Code, School_Year, location_longitude, location_latitude) mismatches_location <- vi_cleaned %>% inner_join(vi_code_and_first_location, by = c("OPT_Code", "School_Year")) %>% select(OPT_Code, School_Year, location_longitude.x, location_longitude.y, location_latitude.x, location_latitude.y) %>% mutate( diff_longitude = location_longitude.x - location_longitude.y, diff_latitude = location_latitude.x - location_latitude.y ) %>% filter(diff_longitude > 0 | diff_latitude > 0) #So there are 65 non unique OPT_Codes, it seems, with 85 that produce duplicates. #When performed with OPT_Code and School_Year, it seems there are no matches. #So I need make my match by OPT_Code / School_Year. OPT_Codes are changing from year to year. vi_joined <- v_corrected %>% left_join(vi_cleaned, by = c("OPT_Code", "School_Year")) vi_joined %>% distinct(Vehicle_TypeDescription) ## # A tibble: 10 x 1 ## Vehicle_TypeDescription ## ## 1 Non-Wheelchair Accessible Alternative (NWC) ## 2 Mini-Wagon ## 3 Type A or B Flex Vehicle ## 4 Standard Bus (SE) ## 5 Standard Bus (GE) ## 6 Ambulance Transportation Service ## 7 Hydraulic Lift ## 8 Type C or D Flex ## 9 Ramp-Wagon ## 10 Wheelchair Accessible Alternative (WC) #Vehicle_TypeDescription: Number_of_Riders, vehicle_reg_seats, vehicle_disabled_seats, vehicle_amblatory_seats, vehicle_lift, vehicle_attendant vehicle_typedescription <- data.frame(Vehicle_TypeDescription = c("Non-Wheelchair Accessible Alternative (NWC)", "Mini-Wagon", "Type A or B Flex Vehicle", "Standard Bus (SE)", "Standard Bus (GE)","Ambulance Transportation Service", "Hydraulic Lift", "Type C or D Flex","Ramp-Wagon","Wheelchair Accessible Alternative (WC)", "Motor Coach Bus"), vehicle_max_riders = c(3,15,6,36,60,1,16,35,8,4, 55), vehicle_reg_seats = c(3,15,6,36,60,0,0,35,0,0, 55), vehicle_disabled_seats = c(0,0,6,0,0,0,8,10,4,2, 0), vehicle_ambulatory_seats = c(0,0,0,0,0,1,8,0,4,2, 0), vehicle_lift = as.integer(c(0,0,1,0,0,0,1,1,0,1, 0)), vehicle_attendant = as.integer(c(1,1,1,0,0,0,1,1,1,1,0)), vehicle_emt = c(0,0,0,0,0,2,0,0,0,0,0), vehicle_bathroom = c(0,0,0,0,0,0,0,0,0,0,1) ) %>% mutate( Vehicle_TypeDescription = as.character(Vehicle_TypeDescription) ) %>% arrange(vehicle_max_riders) # c("Non-Wheelchair Accessible Alternative (NWC)", 3, 3, 0, 0, 0, 1), # c("Mini-Wagon", 15, 15, 0, 0, 0, 1), # c("Type A or B Flex Vehicle", 6, 6, 6, 0, 1, 1), # c("Standard Bus (SE)", 36, 36, 0, 0, 0, 0), # c("Standard Bus (GE)", 60, 60, 0, 0, 0, 0), # c("Ambulance Transportation Service", 1, 0, 0, 1, 0, 1), # c("Hydraulic Lift", 16, 0, 8, 8, 1, 1), # c("Type C or D Flex", 35, 35, 10, 0, 1, 1), # c("Ramp-Wagon", 8, 0, 4, 4, 0, 1), # c("Wheelchair Accessible Alternative (WC)", 4, 0, 2, 2, 1, 1)) vi_vehicle_details <- vi_joined %>% left_join(vehicle_typedescription, by = "Vehicle_TypeDescription") #Worth noting that Number_of_Riders from ix_joined has no analogue in this data set. I have that data only for the PreK data, it seems #Put the garage count by Vendor_Code, School_Year garage_count_abs <- v_corrected %>% select(School_Year, Vendor_Code, Garage_XCoord, Garage_YCoord) %>% group_by(School_Year, Vendor_Code) %>% distinct(Garage_XCoord, Garage_YCoord) %>% count() %>% mutate( garage_max = n, garage_min = n, n = NULL ) vi_garage_count <- vi_vehicle_details %>% left_join(garage_count_abs, by = c("School_Year", "Vendor_Code")) %>% mutate( OPT_Code = as.character(OPT_Code) ) vi_garage_count %>% glimpse ## Observations: 98,632 ## Variables: 42 ## $ School_Year "2015-2016", "2015-2016", "2015-... ## $ Route_Number "C911", "J499", "J500", "J501", ... ## $ Service_Type "D2D", "D2D", "D2D", "D2D", "D2D... ## $ Vehicle_TypeDescription "Non-Wheelchair Accessible Alter... ## $ Route_Start_Date 2016-03-21, 2015-09-09, 2015-09... ## $ Vendor_Code "VN", "RV", "HT", "HT", "HT", "H... ## $ Vendor_Name "VAN TRANS LLC (B2192)", "RELIAN... ## $ Vendor_Affiliation "VAN TRANS LLC (B2192)", "RELIAN... ## $ Garage_Street_Address "670 Hillside Road", "297 NORMAN... ## $ Garage_City "pelham manor", "brooklyn", "bro... ## $ Garage_State "NY", "NY", "NY", "NY", "NY", "N... ## $ Garage_Zip 10803, 11222, 11224, 11224, 1122... ## $ Garage_XCoord 1034574, 1000787, 983439, 983439... ## $ Garage_YCoord 265547.6, 204481.0, 148884.0, 14... ## $ flag_company_same 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,... ## $ OPT_Code "75666", "75760", "75006", "7543... ## $ Name "CARMEL ACADEMY", "THE SINAI SCH... ## $ Affiliation "Yeshiva", "Yeshiva", "Nonsectar... ## $ Site_Type "School", "School", "School", "S... ## $ Street_Address "270 LAKE AVENUE", "110 SOUTH OR... ## $ location_city "connecticut", "new jersey", "ne... ## $ location_state "CT", "NJ", "NJ", "NJ", "NJ", "N... ## $ location_zip 6830, 7039, 7083, 7666, 7666, 87... ## $ location_longitude -73.63757, -74.36126, -74.27827,... ## $ location_latitude 41.04900, 40.77635, 40.70391, 40... ## $ Door_To_Door_Service "Yes", "Yes", "Yes", "Yes", "Yes... ## $ Stop_To_School_Service "No", "No", "No", "No", "No", "N... ## $ Common_Carrier_Svc_Metrocards "Yes", "No", "No", "No", "No", "... ## $ Site_Reimbursement "No", "No", "No", "No", "No", "N... ## $ Mid_Day_Service "No", "No", "No", "No", "No", "N... ## $ D2D_Late_Day_Programs "No", "No", "No", "No", "No", "N... ## $ S2S_Late_Day_Programs "No", "No", "No", "No", "No", "N... ## $ vehicle_max_riders 3, 15, 3, 3, 3, 3, 3, 15, 3, 3, ... ## $ vehicle_reg_seats 3, 15, 3, 3, 3, 3, 3, 15, 3, 3, ... ## $ vehicle_disabled_seats 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,... ## $ vehicle_ambulatory_seats 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,... ## $ vehicle_lift 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,... ## $ vehicle_attendant 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,... ## $ vehicle_emt 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,... ## $ vehicle_bathroom 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,... ## $ garage_max 3, 4, 2, 2, 2, 2, 2, 4, 2, 2, 2,... ## $ garage_min 3, 4, 2, 2, 2, 2, 2, 4, 2, 2, 2,... When I initially worked through this data, I tinkered with the pre-K data, ix_pvt, quite a lot. But in the end, it turned out that this data set only really existed as a way to join vehicle and staff metadata to the main data set via OPT_Code. The issue is that the school- and pre-K-level data don't share headers. So pulling, say, the garage information from the school-level data leaves NA values in the pre-K. The driver and vehicle level data is, in the end, what I am after. The school and pre-K data is really just a way of attaching that metadata to the main data. Here is my cleaning work. #---drivers and attendants, and vehicles, by vendor name--- #NR: next, I want to join on the driver numbers and vehicle numbers metadata. #This must be joined by Vendor Name and School Year, and might require fuzzy joining. iii_drivers %>% glimpse #832 obs ## Observations: 832 ## Variables: 5 ## $ School_Year "2018-2019", "2018-2019", "2018-2019", "2018-... ## $ Vendor_Name "ACADEMY EXPRESS LLC", "E-Z BUS LLC (B2321)",... ## $ Type_of_Service "Coach", "School Age", "School Age", "School ... ## $ Active_Employees 65, 5, 3, 2, 1, 3, 6, 226, 22, 18, 13, 2, 20,... ## $ Job_Type "Driver", "Attendant", "Driver", "Driver&Atte... vendors_unique <- vi_garage_count %>% select(Vendor_Name) %>% rbind(ix_pvt %>% select(Vendor_Name)) %>% distinct(Vendor_Name) %>% arrange(Vendor_Name) #87 unique vendors vendors_unique %>% anti_join(iii_drivers %>% filter(Type_of_Service != "Coach"), by = "Vendor_Name") %>% glimpse ## Observations: 1 ## Variables: 1 ## $ Vendor_Name "ROBIN TRANSPORTATION" #only "Robin Transportation" isn't covered by either iii or vii. Check check. #All vendors are covered by both iii_ and vii_ *except* ROBIN. Goddamn it, Robin. #iii_drivers #needs turning into tidy data. What do I mean by this? #We are after company level information. #Per company and school year, we want the following counts #number of coach services #number of school services #number of pre-k services #number of ambulance services #number of attendant services #number of drivers (count doubles) #number of attendants (count doubles) #number of EMTs (count doubles) #number of paramedics (count doubles) #service counts iii_service_count <- iii_drivers %>% group_by(Vendor_Name, School_Year) %>% summarise( drivers_numServ_coach = sum(Type_of_Service == "Coach"), drivers_numServ_school = sum(Type_of_Service == "School Age"), drivers_numServ_prek = sum(Type_of_Service == "Pre-K"), drivers_numServ_amb = sum(Type_of_Service == "Ambulance"), drivers_numServ_att = sum(Type_of_Service == "Attendant") ) #staff counts iii_staff_count <- iii_drivers %>% spread(Job_Type, Active_Employees, fill = 0) %>% group_by(Vendor_Name, School_Year) %>% summarise( drivers_total_driver = sum(Driver + `Driver&Attendant` + `Driver&EMT`+ `Driver&Paramedic`), drivers_total_attendant = sum(`Driver&Attendant` + Attendant), drivers_total_EMT = sum(`Driver&EMT` + EMT), drivers_total_paramedic = sum(`Driver&Paramedic` + Paramedic) ) #counts left: staff per service, and each category of staff per service. #I'm only going to count drivers per service #drivers per service iii_drivers_per_service <- iii_drivers %>% spread(Job_Type, Active_Employees, fill = 0) %>% mutate( drivers_total_driver = Driver + `Driver&Attendant` + `Driver&EMT`+ `Driver&Paramedic` ) %>% group_by(Vendor_Name, School_Year, Type_of_Service) %>% summarise( drivers_dummy = sum(drivers_total_driver) ) %>% ungroup() %>% spread(Type_of_Service, drivers_dummy, fill = 0) %>% dplyr::rename( "drivers_num_servAmb" = "Ambulance", "drivers_num_servAttend" = "Attendant", "drivers_num_servCoach" = "Coach", "drivers_num_servPreK" = "Pre-K", "drivers_num_servSchool" = "School Age" ) #total staff per service iii_total_staff_per_service <- iii_drivers %>% group_by(Vendor_Name, School_Year, Type_of_Service) %>% summarise( drivers_total_dummy = sum(Active_Employees) ) %>% spread(Type_of_Service, drivers_total_dummy, fill = 0) %>% dplyr::rename( "drivers_staff_servAmb" = "Ambulance", "drivers_staff_servAttend" = "Attendant", "drivers_staff_servCoach" = "Coach", "drivers_staff_servPreK" = "Pre-K", "drivers_staff_servSchool" = "School Age" ) iii_joined <- iii_service_count %>% left_join(iii_staff_count, by = c("Vendor_Name", "School_Year")) %>% left_join(iii_drivers_per_service, by = c("Vendor_Name", "School_Year")) %>% left_join(iii_total_staff_per_service, by = c("Vendor_Name", "School_Year")) #vii_vehicles vii_vehicles %>% glimpse #764 obs ## Observations: 764 ## Variables: 4 ## $ School_Year "2015-2016", "2015-2016", "2015-2016",... ## $ Vendor_Name "ACADEMY EXPRESS LLC", "ACME BUS CORP.... ## $ Vehicle_TypeDescription "Motor Coach Bus", "Mini-Wagon", "Mini... ## $ Active_Vehicles 22, 71, 6, 62, 1, 9, 71, 6, 63, 47, 67... #total vehicles of each kind is actually not relevant. #total seats of each kind vii_vehicle_counts <- vii_vehicles %>% left_join(vehicle_typedescription, by = "Vehicle_TypeDescription") %>% mutate( vehicle_total_max_riders = Active_Vehicles * vehicle_max_riders, vehicle_total_reg_seats = Active_Vehicles * vehicle_reg_seats, vehicle_total_disabled_seats = Active_Vehicles * vehicle_disabled_seats, vehicle_total_ambulatory_seats = Active_Vehicles * vehicle_ambulatory_seats, vehicle_total_with_lifts = Active_Vehicles * vehicle_lift, vehicle_total_with_attendants = Active_Vehicles * vehicle_attendant, vehicle_total_with_emts = Active_Vehicles * vehicle_emt, vehicle_total_with_bathrooms = Active_Vehicles * vehicle_bathroom ) %>% mutate( vehicle_max_riders = NULL, vehicle_reg_seats = NULL, vehicle_disabled_seats = NULL, vehicle_ambulatory_seats = NULL, vehicle_lift = NULL, vehicle_attendant = NULL, vehicle_emt = NULL, vehicle_bathroom = NULL ) %>% #spread(Vehicle_TypeDescription, Active_Vehicles, fill = 0) %>% group_by(Vendor_Name, School_Year) %>% summarise_if(is.numeric, sum )

In my actual workflow, I wrote out all of my intermediate outputs as files that I could keep, and joined them in a separate workbook. In lieu of that process, the code below the fold simply renames some of the data sets that we have developed above. Apologies for any confusion: I promise that my project organization is a little less chaotic than this reporting markdown presentation.

1 2 3 4

vi_school <- vi_garage_count iii_staff <- iii_joined vii_vehicles <- vii_vehicle_counts

Joining the data

After a lot of messing around, we are at the stage where we can join the company level staff and vehicle data onto the main data set. We also use the times to make variables that tell us how close to either rush hour we are.

---

Related Post

• Visualizations for correlation matrices in R
• Interpretation of the AUC
• Simple Experiments with Smoothed Scatterplots
• Understanding the Covariance Matrix
• Six Sigma DMAIC Series in R – Part 3

Related

---