Kirkwood IPF Process Review

library(tidyverse)
library(readxl)
library(ipfr)
library(janitor)
library(kableExtra)

Create functions to re-arrange matricies from Excel format to IPF input and then back again

These are applied later in the process

re_arrange_matrix <- function(input_matrix) {

    matrix_new <- matrix(nrow=4, ncol = 4,byrow=T)
  matrix_new[1,1] <- input_matrix[1,1]
  matrix_new[1,3] <- input_matrix[1,2]
  matrix_new[1,2] <- input_matrix[1,3]
  matrix_new[1,4] <- input_matrix[1,4]
  matrix_new[2,2] <- input_matrix[2,1]
  matrix_new[2,4] <- input_matrix[2,2]
  matrix_new[2,1] <- input_matrix[2,3]
  matrix_new[2,3] <- input_matrix[2,4]
  matrix_new[3,3] <- input_matrix[3,1]
  matrix_new[3,2] <- input_matrix[3,2] 
  matrix_new[3,4] <- input_matrix[3,3]
  matrix_new[3,1] <- input_matrix[3,4]
  matrix_new[4,4] <- input_matrix[4,1]
  matrix_new[4,1] <- input_matrix[4,2]
  matrix_new[4,3] <- input_matrix[4,3]
  matrix_new[4,2] <- input_matrix[4,4]
  
  return(matrix_new)
  
}

reverse_re_arrange_matrix <- function(input_matrix) {
  
  matrix_reverse <- matrix(nrow=4, ncol=4, byrow=TRUE)
  matrix_reverse[1,1] <- input_matrix[1,1]
  matrix_reverse[1,2] <- input_matrix[1,3]
  matrix_reverse[1,3] <- input_matrix[1,2]
  matrix_reverse[1,4] <- input_matrix[1,4]
  matrix_reverse[2,1] <- input_matrix[2,2]
  matrix_reverse[2,2] <- input_matrix[2,4]
  matrix_reverse[2,3] <- input_matrix[2,1]
  matrix_reverse[2,4] <- input_matrix[2,3]
  matrix_reverse[3,1] <- input_matrix[3,3]
  matrix_reverse[3,2] <- input_matrix[3,2]
  matrix_reverse[3,3] <- input_matrix[3,4]
  matrix_reverse[3,4] <- input_matrix[3,1]
  matrix_reverse[4,1] <- input_matrix[4,4]
  matrix_reverse[4,2] <- input_matrix[4,1]
  matrix_reverse[4,3] <- input_matrix[4,3]
  matrix_reverse[4,4] <- input_matrix[4,2]
  
  return(matrix_reverse)
  
}

Read in 2043 no-build targets from Excel sheet

#2043 nobuild balanced
nobuild_2034 <- readxl::read_excel("Kirkwood_NCHRP255_V2.xlsx",
                               sheet = "LinkVolumes", skip = 4)[c(1:3, 34:37)] %>% 
  clean_names() %>% 
  drop_na(leg) %>% 
  rename(am_in = am_in_34,
        am_out = am_out_35,
         pm_in = pm_in_36,
         pm_out = pm_out_37) %>% 
  dplyr::select(int_number, leg, x3, am_in, am_out, pm_in, pm_out) %>% 
  replace(is.na(.), 0) %>% 
  dplyr::filter(int_number == "101")

kbl(nobuild_2034, digits = 0) %>% 
  kable_styling()
int_number leg x3 am_in am_out pm_in pm_out
101 1 Retail driveway 36 68 93 139
101 2 SR 72 614 525 530 611
101 3 SR 2 1099 999 1268 1041
101 4 SR 2 1134 1293 1242 1349

Read in seed data from IPFSeeds Excel worksheet

Replace NA values with 0

seed_data <- readxl::read_excel("Kirkwood_NCHRP255_V2.xlsx",
                   sheet = "IPFSeeds", skip = 5)[c(1:3, 15:22)] %>% 
  clean_names() %>% 
  drop_na(int_number)  %>% 
  replace(is.na(.), 0) %>% 
  dplyr::filter(int_number == 101)

kbl(seed_data, digits = 1) %>% 
  kable_styling()
int_number leg x3 am_u am_l am_t am_r pm_u pm_l pm_t pm_r
101 1 Retail driveway 0 10 12 13 0 29 30 32
101 2 SR 72 1 380 11 201 2 305 19 186
101 3 SR 2 0 247 825 25 0 242 952 72
101 4 SR 2 33 31 786 247 16 45 824 316

Convert seed data to matrix

seed_matrix_am <- seed_data %>% 
  dplyr::select(4:7) %>% 
  as.matrix()

print(seed_matrix_am)
     am_u am_l am_t am_r
[1,]    0   10   12   13
[2,]    1  380   11  201
[3,]    0  247  825   25
[4,]   33   31  786  247

Re-arrange matrix to format needed for IPF

seed_matrix_arrange_am <- re_arrange_matrix(seed_matrix_am)

print(seed_matrix_arrange_am)
     [,1] [,2] [,3] [,4]
[1,]    0   12   10   13
[2,]   11    1  201  380
[3,]   25  247    0  825
[4,]   31  247  786   33

Set row targets by selecting “AM IN” column from target table

set_row_targes <- nobuild_2034$am_in

print(set_row_targes)
[1]   35.66232  613.72249 1098.69084 1134.24555

Set column targets by selecting “AM OUT” column from target table

set_column_targets <- nobuild_2034$am_out

print(set_column_targets)
[1]   68.26786  524.71721  998.53671 1293.47419

Solve matrix based on column and row targets

solved_matrix_am_build <- ipfr::ipu_matrix(
  mtx = seed_matrix_arrange_am,
  row_targets = set_row_targes,
  column_targets = set_column_targets,
  max_iterations = 1000,
  #relative_gap = 1,
  absolute_diff = 1,
  verbose=T,
  min_ratio = 0
)
Scaling target tables:  col

 Finished iteration  2 . %RMSE =  1.498268
 Finished iteration  3 . %RMSE =  0.7289313
 Finished iteration  4 . %RMSE =  0.3777479
 Finished iteration  5 . %RMSE =  0.197295
 Finished iteration  6 . %RMSE =  0.103288
 Finished iteration  7 . %RMSE =  0.05413063
 Finished iteration  8 . %RMSE =  0.02838371
 Finished iteration  9 . %RMSE =  0.01488733
 Finished iteration  10 . %RMSE =  0.007809586

IPU converged
All targets matched within the absolute_diff of 1

Resulting solved matrix

kbl(solved_matrix_am_build) %>% 
  kable_styling()
0.00001 12.332680 9.525488 13.80415
11.18734 1.039021 193.567041 407.94154
23.92379 241.477784 0.000010 833.34373
33.09343 269.381240 794.518395 37.18556

Re-arrange matrix back into original format

solved_matrix_reformatted <- reverse_re_arrange_matrix(round(seed_matrix_arrange_am)) 
print(solved_matrix_reformatted)
     [,1] [,2] [,3] [,4]
[1,]    0   10   12   13
[2,]    1  380   11  201
[3,]    0  247  825   25
[4,]   33   31  786  247