Example 1: Africa’s Continental Road Network

The africa_network, taken from Krantz (2024) Optimal Investments in Africa’s Road Network, is included in the package. It was generated by intersecting and simplifying fastest OSRM car routes between 453 African cities with population > 100,000 and international ports—provided in africa_cities_ports. The procedure is described in the paper, and further demonstrated in the introductory vignette using flownet’s network processing tools. For this blog post we will take the network as given and defer the network processing workflow to the second (FAF5) example below.

The network includes 481 new links proposed by a network finding algorithm described in Section 4.2 of the paper. Below I plot the network with proposed links in grey and the 453 (port-)cities in black.

library(fastverse)
## -- Attaching packages ------------------------------------------------------------------------------------------------------------- fastverse 0.3.4 --
## v data.table 1.17.0     v kit        0.0.21
## v magrittr   2.0.4      v collapse   2.1.6
fastverse_extend(flownet, sf, tmap)
## -- Attaching extension packages --------------------------------------------------------------------------------------------------- fastverse 0.3.4 --
## v flownet 0.2.0      v tmap    4.2   
## v sf      1.0.20
# Plot network colored by travel speed
tm_basemap("CartoDB.Positron", zoom = 4) +
tm_shape(africa_network) +
  tm_lines(col = "speed_kmh",
           col.scale = tm_scale_continuous(values = "turbo", 
                                           values.range = c(0.1, 0.9), 
                                           value.na = "grey"),
           col.legend = tm_legend("Speed (km/h)", position = c("left", "bottom"),
                                  frame = FALSE, text.size = 0.8, title.size = 1, 
                                  item.height = 2, na.show = FALSE), lwd = 1.5) +
tm_shape(africa_cities_ports) + tm_dots(size = 0.1) +
tm_layout(frame = FALSE, outer.margins = 0)

Evidently, OSRM link speeds differ widely, with speeds along many central African roads around 40km/h, and higher speeds closer to urban centers. Below, I further describe the network after removing the proposed links. As detailed in Section 3 of the paper, I extracted border and documentary times and costs of exporting and importing from the last World Bank Doing Business Survey (data collected in 2019), and converted them to travel-time-equivalent frictions (in minutes) along border-crossing links. There is thus a frictionless duration (travel time) variable and border_time (which includes documentary time—median 76h), which added together give the total_time needed to trade across a link.

# Removing potential new links
africa_net <- fsubset(africa_network, !add, -add)
names(africa_net) |> cat(sep = ", ")
## from, to, from_ctry, to_ctry, FX, FY, TX, TY, sp_distance, distance, duration, speed_kmh, passes, gravity, gravity_rd, border_dist, total_dist, border_time, total_time, duration_100kmh, total_time_100kmh, rugg, pop_wpop, pop_wpop_km2, cost_km, upgrade_cat, ug_cost_km, geometry
qsu(africa_net, cols = .c(from, to, speed_kmh, distance, duration, border_time, total_time))
##                 N       Mean          SD     Min         Max
## from         2344   669.4347    391.7331       1        1377
## to           2344   688.3921    395.8184       2        1379
## speed_kmh    2344    65.2302     16.0805  5.1429     127.749
## distance     2344  134411.13  115553.485   16968  1'801830.5
## duration     2344    135.585    136.9445   12.05      2151.9
## border_time  2344   687.2841   1910.1195       0  11871.9998
## total_time   2344    822.869   1947.0973   12.05  12134.6998

The package also provides, in africa_trade, a dataset of bilateral trade flows between the 47 African countries that accommodate any of the 453 selected (port-)cities. It is derived from the CEPII BACI database, HS96 version, averaged over 2012-2022 by 21 HS sections.

# Convert to tibble for compact printing of section names
qTBL(africa_trade)
## # A tibble: 27,721 × 8
##    iso3_o iso3_d section_code section_name                                                                         hs2_codes   value value_kd quantity
##    <fct>  <fct>         <int> <fct>                                                                                <fct>       <dbl>    <dbl>    <dbl>
##  1 AGO    BDI              16 Machinery and mechanical appliances, electrical equipment, parts thereof, sound rec… 84        5.10e+0    5.10   9.87e-1
##  2 AGO    BEN               1 Live animals and animal products                                                     3         6.81e+3 6527.     8.78e+3
##  3 AGO    BEN               4 Prepared foodstuffs, beverages, spirits and vinegar, tobacco and manufactured tobac… 19, 20, … 9.51e+0    9.10   2.07e+1
##  4 AGO    BEN               5 Mineral products                                                                     27        3.58e+3 3536.     8.37e+3
##  5 AGO    BEN               6 Product of the chemicals or allied industries                                        30, 32, … 9.44e-1    0.932  2.75e-2
##  6 AGO    BEN               7 Plastics and articles thereof, rubber and articles thereof                           39, 40    7.13e+1   72.0    3.13e+1
##  7 AGO    BEN               8 Raw hides and skins, leather, furskins and articles thereof, saddlery and harness, … 42        1.18e+0    1.17   2.5 e-2
##  8 AGO    BEN               9 Wood and articles of wood, wood charcoal, cork and articles of cork, manufacturers … 44, 46    1.5 e-1    0.140  3.2 e-2
##  9 AGO    BEN              10 Pulp of wood or of other fibrous cellulosic material, recovered (waste and scrap) p… 48, 49    8.9 e-1    0.863  4.36e-1
## 10 AGO    BEN              11 Textile and textile articles                                                         52, 57, … 3.00e+1   29.6    1.08e+1
## # ℹ 27,711 more rows

Our exercise will be to assign these trade flows, in particular the quantity in metric tons, to the network. While certainly not all intra-African trade travels by road, UNECA 2022 estimate, in their 2019 baseline scenario, that 76.7% of intra-African freight traveled by road, followed by 22.1% maritime, 0.9% air, and only 0.3% by rail. Thus, focusing on the road network alone is not a horrible simplification. For simplicity, we will aggregate the trade data across sections and consider assignments with or without trade frictions and the 481 proposed new links.

# Aggregating the trade data across HS sections
africa_trade_agg <- africa_trade |> 
  collap(quantity ~ iso3_o + iso3_d, fsum)

The Africa network is already in a graph format with from and to node columns. Thus, all we need to do here to get the representation flownet expects is drop the geometry. Next, we need to map the (port-)city locations to the nearest network nodes.

# Convert to graph
graph <- st_drop_geometry(africa_net)
# Extract nodes with spatial coordinates
nodes <- nodes_from_graph(graph, sf = TRUE)
head(nodes, 3)
## Simple feature collection with 3 features and 1 field
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -17.44671 ymin: 14.69281 xmax: -16.63849 ymax: 15.11222
## Geodetic CRS:  WGS 84
##   node                   geometry
## 1    1 POINT (-17.44671 14.69281)
## 2    2 POINT (-17.04453 14.70297)
## 3    3 POINT (-16.63849 15.11222)

# Map (port-)cities to the nearest nodes
nearest_nodes <- nodes$node[st_nearest_feature(africa_cities_ports, nodes)]

To construct an OD matrix for assignment to this network, we need to disaggregate the country-level trade flows using (port-)city population shares. The code below demonstrates this procedure, resulting in an OD matrix with columns from, to, and flow (in metric tons) at the (port-)city level.

# Compute each city's share of its country's population
city_pop <- st_drop_geometry(africa_cities_ports) |>
  fcompute(node = nearest_nodes, city = qF(city_country),
           pop_share = fsum(population, iso3, TRA = "/"), keep = "iso3")
head(city_pop, 3)
##      iso3  node                        city pop_share
##    <char> <int>                      <fctr>     <num>
## 1:    EGY   937               Cairo - Egypt 0.6554678
## 2:    NGA   289             Lagos - Nigeria 0.3860030
## 3:    COD   635 Kinshasa - Congo (Kinshasa) 0.4784988

# Join with city population shares for origin and destination
# add_stub adds suffix to all columns, so iso3 -> iso3_o matches africa_trade_agg$iso3_o
od_matrix_trade <- africa_trade_agg |>
  join(city_pop |> add_stub("_o", FALSE), multiple = TRUE) |>
  join(city_pop |> add_stub("_d", FALSE), multiple = TRUE) |>
  fmutate(flow = quantity * pop_share_o * pop_share_d) |>
  frename(from = node_o, to = node_d) |>
  fsubset(flow > 0 & from != to)
## left join: africa_trade_agg[iso3_o] 1971/1971 (100%) <41.94:9.62> y[iso3_o] 452/453 (99.8%)
## left join: x[iso3_d] 19685/19685 (100%) <418.83:9.62> y[iso3_d] 452/453 (99.8%)
nrow(od_matrix_trade)
## [1] 189020
od_matrix_trade |> fselect(from:flow) |> head(3)
##     from           city_o pop_share_o    to              city_d pop_share_d       flow
##    <int>           <fctr>       <num> <int>              <fctr>       <num>      <num>
## 1:   577  Luanda - Angola  0.53616303   962 Bujumbura - Burundi           1 0.52919291
## 2:   550 Lubango - Angola  0.03794550   962 Bujumbura - Burundi           1 0.03745221
## 3:   540 Cabinda - Angola  0.03202289   962 Bujumbura - Burundi           1 0.03160660

We are now ready to assign traffic using the PSL model, which is straightforward using run_assignment(). To increase performance, I set nthreads = 8 to use 8 cores on this M4 Pro chip. R-level parallelism using mirai is highly efficient, but requires additional memory. In this example we also save all intermediate results, including individual path alternatives and associated probabilities, by setting return.extra = "all". This can get very memory-intensive, especially if there are many plausible paths per OD pair. Thus, we limit the number of paths per OD-pair to 150 by setting npaths.max = 150. Another crucial step for PSL modelling is cost-scaling. Multinomial logits, of which the PSL is a penalized variant, do not deal well with very large path-costs. Thus, mean or median scaling of the generalized cost (dividing all data points by the mean or median) is good practice. We will later also need to calibrate the PSL parameter beta (default 1) to achieve the desired level of penalization of overlapping paths. But first, we conduct a basic dry run of the model and explore the outputs.

# Median scaling cost column: recommended for PSL
settfm(graph, duration_ms = fmedian(duration, TRA = "/"))
# Run Traffic Assignment using the PSL model
system.time({
result <- run_assignment(graph, od_matrix_trade, cost.column = "duration_ms",
            nthreads = 8, npaths.max = 150, return.extra = "all", verbose = FALSE)
})
##    user  system elapsed 
##  32.782   8.887  39.307
print(result)
## FlowNet object
## Call: run_assignment(graph_df = graph, od_matrix_long = od_matrix_trade,      cost.column = "duration_ms", npaths.max = 150, return.extra = "all",      verbose = FALSE, nthreads = 8) 
## 
## Number of nodes: 1379 
## Number of edges: 2344 
## Number of simulations/OD-pairs: 189020 
## 
## Average number of paths per simulation (SD): 79.42657  (30.90874)
## Average number of edges utilized per simulation (SD): 436.6385  (251.9788)
## Average number of visits per edge (SD): 7.879177  (13.34574)
## Average path cost (SD): 53.4557  (5.859316)
## Average path-size factors (SD): 0.1437334  (0.07117963)
## Average path weight (SD): 0.02389012  (0.03021725)
## Average summed edge weight (SD): 0.108716  (0.2317558)
## 
## Final flows summary statistics:
##      N  Ndist         Mean           SD  Min          Max  Skew  Kurt
##   2344   2322  1'347742.43  2'591303.02    0  20'806237.1  3.52  17.4
##        1%       5%       10%       25%        50%          75%          90%          95%          99%
##   1048.96  9720.13  27794.68  93975.69  398554.56  1'169703.79  3'757161.33  6'509143.87  13'062843.5

Processing OD-pairs at a rate of around 6000 per second is quite fast, given that on average 80 alternative paths are retained per OD-pair—i.e., we are generating 0.5 million paths per second. Overall, we generated 15 million paths stored in result$paths, yielding an object more than 5 GB in size.

str(result, max.level = 1)         # Overview of results objects
## List of 11
##  $ call             : language run_assignment(graph_df = graph, od_matrix_long = od_matrix_trade, cost.column = "duration_ms", npaths.max = 150,| __truncated__
##  $ graph            :Class 'igraph'  hidden list of 10
##  $ final_flows      : num [1:2344] 6071643 966528 907662 4289932 349595 ...
##  $ od_pairs_used    : int [1:189020] 1 2 3 4 5 6 7 8 9 10 ...
##  $ paths            :List of 189020
##  $ path_costs       :List of 189020
##  $ path_size_factors:List of 189020
##  $ path_weights     :List of 189020
##  $ edges            :List of 189020
##  $ edge_counts      :List of 189020
##  $ edge_weights     :List of 189020
##  - attr(*, "class")= chr "flownet"
format(object.size(result), "Mb")  # Object size
## [1] "5317.7 Mb"
sum(vlengths(result$paths))        # Total Number of paths
## [1] 15013210
Qprobs <- c(0, 0.01, 0.05, 0.25, 0.5, 0.75, 0.95, 0.99, 1)
quantile(vlengths(result$paths), Qprobs) # Number of paths distribution
##   0%   1%   5%  25%  50%  75%  95%  99% 100% 
##    1    4   15   61   92  102  112  118  131

The default, return.extra = NULL, would have only returned the final flows vector equal in length to the number of edges (2344). In general, return.extra = "paths", responsible for the biggest memory bloat (the object without "paths" is only 1.5 GB), is hardly ever needed.

The print method above shows, among other things, the average degree of overlap between paths in terms of visits per edge, computed as mean(fmean(result$edge_counts)) = 7.87, the average adjusted path probability as mean(fmean(result$path_weights)) = 0.024, as well as the path probabilities summed across each edge as mean(fmean(result$edge_weights)) = 0.11. We can use this information to visualize the paths and their probabilities for a specific OD-pair.

Let’s take an iconic Cape Town to Cairo (C2C) routing example:

# See which OD-pair is Cape Town to Cairo
c2c <- od_matrix_trade |> 
  with(which(city_o %like% "Cape Town" & city_d %like% "Cairo"))
od_matrix_trade[c2c, ]
##    iso3_o iso3_d quantity  from                   city_o pop_share_o    to        city_d pop_share_d     flow
##    <fctr> <fctr>    <num> <int>                   <fctr>       <num> <int>        <fctr>       <num>    <num>
## 1:    ZAF    EGY 974865.4   699 Cape Town - South Africa   0.2271359   937 Cairo - Egypt   0.6554678 145138.2
# In this case all OD-pairs are used, otherwise need to adjust index
length(result$od_pairs_used) == nrow(od_matrix_trade)
## [1] TRUE
# Extract results for Cape Town to Cairo
cost <- graph$duration_ms
c2c_paths <- result$paths[[c2c]]
c2c_edges <- result$edges[[c2c]] # !! C to R bug in versions <= 0.1.2: need to subtract 1 !!
c2c_ecounts <- result$edge_counts[[c2c]]
c2c_eweights <- result$edge_weights[[c2c]]
c2c_pcosts <- result$path_costs[[c2c]]
c2c_PSF <- result$path_size_factors[[c2c]]
length(c2c_pweights <- result$path_weights[[c2c]]) # Number of paths generated/retained
## [1] 96

Let’s start by running a number of tests to validate that the software computes the path probabilities and costs correctly. The path cost is computed as the sum of link costs along the path.

all.equal(c2c_pcosts, fsum(lapply(c2c_paths, \(x) cost[x]))) # Test path cost computation
## [1] TRUE

The path probabilities are computed using the sum of the log-path-size factors (PSFs) (which account for path overlap) and the negative path cost. The code below tests that these computations are correct, and also shows how to compute the PSFs from the paths, costs, and edge counts.

# Compute path-size factors
PSF <- sapply(c2c_paths, \(x) sum(cost[x] / c2c_ecounts[match(x, c2c_edges)])) / c2c_pcosts
all.equal(PSF, c2c_PSF)
## [1] TRUE
quantile(c2c_pcosts, Qprobs)
##        0%        1%        5%       25%       50%       75%       95%       99%      100% 
##  80.70831  80.84662  81.23735  84.36138  89.11926 102.08080 108.97703 118.06345 119.18069
quantile(PSF, Qprobs)
##         0%         1%         5%        25%        50%        75%        95%        99%       100% 
## 0.02408269 0.02985957 0.04826749 0.08517544 0.10678103 0.15676674 0.24896484 0.30524840 0.33583496
quantile(log(PSF), Qprobs)
##        0%        1%        5%       25%       50%       75%       95%       99%      100% 
## -3.726262 -3.512376 -3.031051 -2.463042 -2.236975 -1.852997 -1.390452 -1.186878 -1.091135
quantile(log(PSF) / -c2c_pcosts, Qprobs) # Adjustment amount with default beta = 1
##         0%         1%         5%        25%        50%        75%        95%        99%       100% 
## 0.01003899 0.01258266 0.01388331 0.01872674 0.02279938 0.02859784 0.03630842 0.04338826 0.04616949

The quantiles show that log(PSF) ranges between -3.7 and -1.1, whereas the cost is between 80.7 and 119, which yields a median ratio of 2.3%. This is likely too weak a corrective effect; practitioners usually aim for the PSF penalty to represent roughly 10% to 20% of the utility for heavily overlapped paths. That should approximately be the case when setting beta = 4:

quantile(4*log(PSF) / -c2c_pcosts, Qprobs)
##         0%         1%         5%        25%        50%        75%        95%        99%       100% 
## 0.04015597 0.05033063 0.05553323 0.07490697 0.09119751 0.11439135 0.14523370 0.17355304 0.18467798
# Testing on all paths
fmedian(t(mapply(\(x, y) fquantile(4*log(x)/-y), result$path_size_factors, result$path_costs)))
##         0%        25%        50%        75%       100% 
## 0.06814703 0.14517954 0.18032579 0.21843395 0.32888192

The median correction across all paths is a bit higher, but long paths like C2C are well penalized, and I expect traders to be more optimizing along shorter paths, thus a value of beta = 4 is agreeable. We will then need to re-estimate the model with this value of beta. However, before doing so, let’s do a final test that the software computes the path probabilities correctly.

# Test that software computes probabilities correctly (beta = 1)
all.equal(proportions(exp(-c2c_pcosts + log(c2c_PSF))) , c2c_pweights) 
## [1] TRUE

Now let’s run the calibrated model, not returning paths or restricting the number of paths this time:

# Run Traffic Assignment using the calibrated PSL model - omitting paths this time to save memory
system.time({
result <- run_assignment(graph, od_matrix_trade, 
            cost.column = "duration_ms", beta = 4, nthreads = 8, verbose = FALSE,
            return.extra = c("edges", "counts", "costs", "weights", "eweights"))
})
##    user  system elapsed 
##  25.507   5.625  31.061
print(result)
## FlowNet object
## Call: run_assignment(graph_df = graph, od_matrix_long = od_matrix_trade,      cost.column = "duration_ms", beta = 4, return.extra = c("edges",          "counts", "costs", "weights", "eweights"), verbose = FALSE,      nthreads = 8) 
## 
## Number of edges: 2344 
## Number of simulations/OD-pairs: 189020 
## 
## Average number of edges utilized per simulation (SD): 581.9307  (432.7984)
## Average number of visits per edge (SD): 11.26684  (22.75359)
## Average path cost (SD): 53.48491  (5.858939)
## Average path weight (SD): 0.02091092  (0.04234497)
## Average summed edge weight (SD): 0.09600654  (0.2067006)
## 
## Final flows summary statistics:
##      N  Ndist         Mean           SD  Min          Max  Skew   Kurt
##   2344   2322  1'330454.53  2'399186.13    0  17'965431.2  3.34  15.91
##        1%        5%       10%        25%        50%          75%          90%          95%          99%
##   1042.41  14289.95  33555.03  120524.42  403739.31  1'310539.57  3'711287.11  6'144711.81  12'818351.2

And let’s look again at the Cape Town to Cairo routes.

c2c_edges <- result$edges[[c2c]] # !! C to R Bug in versions <= 0.1.2: need to subtract 1 !!
c2c_ecounts <- result$edge_counts[[c2c]]
c2c_pcosts <- result$path_costs[[c2c]]
c2c_eweights <- result$edge_weights[[c2c]]
quantile(c2c_pweights <- result$path_weights[[c2c]], Qprobs) |> round(4)
##     0%     1%     5%    25%    50%    75%    95%    99%   100% 
## 0.0000 0.0000 0.0000 0.0000 0.0000 0.0008 0.0125 0.0276 0.2721

We can plot the paths in various ways. Let’s start by visualizing the edge counts:

africa_net$c2c_ecounts[c2c_edges] <- c2c_ecounts
tm_basemap("CartoDB.Positron", zoom = 4) +
tm_shape(africa_net) +
  tm_lines(col = "c2c_ecounts",
           col.scale = tm_scale_continuous_sqrt(5, values = "turbo", 
                                           values.range = c(0.1, 0.9), 
                                           value.na = "grey"),
           col.legend = tm_legend("Edge Visits", position = c("left", "bottom"),
                                  frame = FALSE, text.size = 0.8, title.size = 1, 
                                  item.height = 2, na.show = FALSE), lwd = 1.5) +
tm_shape(africa_cities_ports) + tm_dots(size = 0.1) +
tm_layout(frame = FALSE, outer.margins = 0)

As this plot makes evident, by virtue of the various edge-level statistics run_assignment() can return, it is not necessary to retain the full paths to fully understand the model.

Now, let’s also plot the probabilities. The edge_weights returned by the model represent the sum of path probabilities over all paths using each edge. Thus, in the context of probabilistic assignment, they can be interpreted as the proportion of C2C trade that traverses the edge. For additional clarity, let’s highlight only those edges where the probability is above 0.0001.

africa_net$c2c_eweights[c2c_edges] <- replace_outliers(c2c_eweights, 0.0001, NA, "min")
tm_basemap("CartoDB.Positron", zoom = 4) +
tm_shape(africa_net) +
  tm_lines(col = "c2c_eweights",
           col.scale = tm_scale_continuous_sqrt(6, values = "turbo", limits = c(0, 1),
                                           values.range = c(0.1, 0.9), 
                                           value.na = "grey"),
           col.legend = tm_legend("Edge Probabilities", position = c("left", "bottom"),
                                  frame = FALSE, text.size = 0.8, title.size = 1, 
                                  item.height = 2, na.show = FALSE), lwd = 1.5) +
tm_shape(africa_cities_ports) + tm_dots(size = 0.1) +
tm_layout(frame = FALSE, outer.margins = 0)

Clearly, and in contrast to what the edge counts from the raw routes suggested, no meaningful C2C traffic is routed through central Africa or the Sahara.

The model thus seems well-behaved, and we can plot the final flows on the entire network:

africa_net$final_flows <- result$final_flows
tm_basemap("CartoDB.Positron", zoom = 4) +
tm_shape(africa_net) +
  tm_lines(col = "final_flows",
           col.scale = tm_scale_continuous_sqrt(values = "turbo", 
                                           values.range = c(0.1, 0.9), 
                                           value.na = "grey"),
           col.legend = tm_legend("Frictionless Flows", position = c("left", "bottom"),
                                  frame = FALSE, text.size = 0.8, title.size = 1, 
                                  item.height = 2, na.show = FALSE), lwd = 1.5) +
tm_shape(africa_cities_ports) + tm_dots(size = 0.1) +
tm_layout(frame = FALSE, outer.margins = 0)

Evidently, certain trade routes are much more utilized than others. But this, of course, assumes the frictionless scenario. Let’s now see how the picture changes with the realistic trade costs added:

# Median scaling cost column: recommended for PSL
settfm(graph, total_time_ms = fmedian(total_time, TRA = "/"))
# Run Traffic Assignment using the PSL model
system.time({
result_tc <- run_assignment(graph, od_matrix_trade, cost.column = "total_time_ms", 
                            beta = 4, nthreads = 8, verbose = FALSE)
})
##    user  system elapsed 
##  25.675   2.666  27.640
print(result_tc)
## FlowNet object
## Call: run_assignment(graph_df = graph, od_matrix_long = od_matrix_trade,      cost.column = "total_time_ms", beta = 4, verbose = FALSE,      nthreads = 8) 
## 
## Number of edges: 2344 
## Number of simulations/OD-pairs: 189020 
## 
## Final flows summary statistics:
##      N  Ndist         Mean           SD  Min          Max  Skew   Kurt
##   2344   2314  1'401715.01  3'019114.05    0  32'492559.6  3.86  21.47
##   1%       5%       10%       25%       50%          75%       90%          95%          99%
##    0  3035.57  11555.93  55039.95  273655.4  1'140869.45  3'780896  7'276797.09  16'361834.1

This result is quite fascinating as it suggests that, if the Doing Business 2019 Trade Frictions are accurate and traders are rational, these frictions could strongly distort intra-African trade patterns from the efficient equilibrium determined by the quality of infrastructure. This could be further investigated...

Speaking about infrastructure quality, what if the existing network were fully upgraded? If all roads had a minimum travel speed of 100km/h? The network includes a column duration_100kmh simulating just that. The median link under this scenario has a travel time of only 65% of the current travel time.

quantile(africa_net$duration_100kmh / africa_net$duration, Qprobs)
##         0%         1%         5%        25%        50%        75%        95%        99%       100% 
## 0.05142949 0.31306222 0.39842537 0.53691407 0.64688128 0.80874861 0.85202685 0.94515228 1.00000000
settfm(graph, duration_100kmh_ms = fmedian(duration_100kmh, TRA = "/"))
result_ug <- run_assignment(graph, od_matrix_trade, cost.column = "duration_100kmh_ms", 
                            beta = 4, nthreads = 8, verbose = FALSE)
print(result_ug)
## FlowNet object
## Call: run_assignment(graph_df = graph, od_matrix_long = od_matrix_trade,      cost.column = "duration_100kmh_ms", beta = 4, verbose = FALSE,      nthreads = 8) 
## 
## Number of edges: 2344 
## Number of simulations/OD-pairs: 189020 
## 
## Final flows summary statistics:
##      N  Ndist         Mean           SD  Min          Max  Skew   Kurt
##   2344   2312  1'299050.05  2'196434.83    0  15'383521.6  3.45  16.51
##        1%        5%       10%        25%        50%          75%          90%          95%          99%
##   4404.87  27001.59  67602.42  192133.57  537029.72  1'379204.11  3'069293.25  5'558163.65  12'401186.9

The plot appears similar to the previous frictionless plot, with a bit more traffic routed through central Africa and the Sahara where at present the road quality is very poor. However, given the present low volume of trade between Eastern and Western Africa (less than 1% of total intra-African trade), paving roads in central Africa wouldn’t pay off. Such investments thus appear hinged on changing regional trade patterns, and, as the paper finds using a generative gravity-like spatial equilibrium model that does allow trade flows to adjust to infrastructure changes, on unrealistically low trade elasticities.

Lastly, we can simulate flows on the network with the proposed links added, and see how much they would be utilized. These links, although drawn as straight lines, are assumed to be 1.2 times longer than the line, which is the average across existing links when comparing them to a straight line.

qDT(africa_network)[add == TRUE, quantile(distance / sp_distance)]
##      0%     25%     50%     75%    100% 
## 1.20812 1.20812 1.20812 1.20812 1.20812

They are given a speed of 100km/h, and I will also assume the existing network was upgraded first.

graph_total <- st_drop_geometry(africa_network)
settfm(graph_total, duration_100kmh_ms = fmedian(duration_100kmh, TRA = "/"))
result_add <- run_assignment(graph_total, od_matrix_trade, 
                             cost.column = "duration_100kmh_ms", 
                             beta = 4, nthreads = 8, verbose = FALSE)
print(result_add)
## FlowNet object
## Call: run_assignment(graph_df = graph_total, od_matrix_long = od_matrix_trade,      cost.column = "duration_100kmh_ms", beta = 4, verbose = FALSE,      nthreads = 8) 
## 
## Number of edges: 2825 
## Number of simulations/OD-pairs: 189020 
## 
## Final flows summary statistics:
##      N  Ndist       Mean           SD  Min          Max  Skew  Kurt
##   2825   2789  943826.09  1'718125.92    0  16'443663.3  4.22  25.5
##   1%        5%       10%        25%        50%     75%          90%         95%          99%
##    0  14333.81  34879.15  121091.46  361495.66  980800  2'313254.89  3'765464.8  9'265394.48

The results suggest that some new national links, e.g., in Botswana, additional trans-Saharan links, and reopening the Morocco-Algeria border, could be utilized significantly under current trade patterns.

Let me note again that all of this assumes intra-African trade patterns are static, which of course they are not, as infrastructure improvements can alter trade flows. The joint endogeneity of infrastructure and trade is appropriately handled in the paper, building on Fajgelbaum and Schaal (2020).

Example 2: The US Freight Analysis Framework (FAF) Network

The Freight Analysis Framework (FAF), produced jointly by the Bureau of Transportation Statistics (BTS) and the Federal Highway Administration (FHWA), integrates data from a variety of sources—most notably the Commodity Flow Survey—to create a comprehensive picture of freight movement among US states and major metropolitan areas by all modes of transportation. It provides estimates of tonnage, value, and domestic ton-miles by origin-destination pairs, commodity type, and transportation mode, along with 30-year forecasts through 2050 under different economic growth scenarios.

The latest version, FAF5, is benchmarked on the 2017 Commodity Flow Survey and includes a model highway network with 487,384 links and 348,498 nodes. The links cover all roads in the National Highway System (NHS) and the National Highway Freight Network (NHFN) that are currently open to traffic. FAF5 also provides truck flow assignments that route commodity movements onto this highway network. An update to FAF6, benchmarked on the 2022 Commodity Flow Survey, is expected in 2026.

We begin by loading the network links from a geodatabase using st_read().

# Loading FAF5 network from geodatabase format
FAF5 <- st_read(FAF5_path, layer = "FAF5_Links")
## Reading layer `FAF5_Links' from data source `/Users/sebastiankrantz/Documents/CPCS/FAF5/Networks/Geodatabase Format/FAF5Network.gdb' using driver `OpenFileGDB'
## Simple feature collection with 487394 features and 52 fields
## Geometry type: MULTILINESTRING
## Dimension:     XY
## Bounding box:  xmin: -167.0152 ymin: 18.91474 xmax: -66.98005 ymax: 71.3198
## Geodetic CRS:  NAD83
nrow(FAF5)
## [1] 487394
table(vlengths(FAF5$SHAPE))
## 
##      1 
## 487394
head(FAF5, 1)
## Simple feature collection with 1 feature and 52 fields
## Geometry type: MULTILINESTRING
## Dimension:     XY
## Bounding box:  xmin: -132.9754 ymin: 56.80636 xmax: -132.975 ymax: 56.80701
## Geodetic CRS:  NAD83
##   ID     LENGTH DIR    DATA  VERSION Class               Class_Description                    Road_Name Sign_Rte Rte_Type Rte_Number Rte_Qualifier
## 1  1 0.05408278   1 1324805 V2021.05    19 Facility Access/Circulator Road PETERSBURG FERRY TERMINAL RD     <NA>     <NA>       <NA>          <NA>
##   Country STATE STFIPS County_Name CTFIPS Urban_Code FAFZONE Status F_Class Facility_Type NHS STRAHNET NHFN Truck AB_Lanes BA_Lanes Speed_Limit
## 1     USA    AK     02  PETERSBURG  02195      99999      20      1       5            NA  NA       NA   NA  <NA>        1       NA          10
##   Toll_Type Toll_Name Toll_Link Toll_Link_Name HPMS_USA_RouteID HPMS_Begin_Point HPMS_End_Point BorderState1 BorderState2 BorderFAF1 BorderFAF2
## 1        NA      <NA>        NA           <NA>             <NA>               NA             NA         <NA>         <NA>         NA         NA
##   TRUCKTOLL BorderLink AddedBorderTime AdjustSpeed AdjustReason AB_FinalSpeed BA_FinalSpeed AB_CombinedSpeed BA_CombinedSpeed AB_FreeFlowTime
## 1        NA         NA              NA          NA         <NA>            43            43               43               43      0.07546435
##   BA_FreeFlowTime SHAPE_Length                          SHAPE
## 1      0.07546435  0.001008685 MULTILINESTRING ((-132.975 ...

The FAF5 network is large and spatially accurate—too large to visualize in R—but you can view it online.

The SHAPE column contains MULTILINESTRING geometries, but, as table(vlengths(FAF5$SHAPE)) confirms, all are of length 1 and can be cast to simple LINESTRINGs. This is required by flownet::linestrings_to_graph(), which matches start and end points across linestrings to build a graph, subject to a numerical tolerance (by default, 6-digit rounding \(\approx\) 11cm at the equator). To ensure this rounding is properly applied, we also transform the coordinates to WGS84 (EPSG:4326).

graph <- FAF5 |> st_cast("LINESTRING") |> st_transform(4326) |> 
    linestrings_to_graph()
nrow(graph)
## [1] 487394
graph[1:5, 1:10]
##   edge from        FX       FY to        TX       TY         .length ID      LENGTH
## 1    1    1 -132.9750 56.80636  2 -132.9750 56.80701    86.86074 [m]  1  0.05408278
## 2    2    2 -132.9750 56.80701  4 -132.9762 56.80849   184.49595 [m]  2  0.11485356
## 3    3    2 -132.9750 56.80701  3 -132.9746 56.80664    52.08027 [m]  3  0.03243200
## 4    4    3 -132.9746 56.80664  6 -132.9601 56.80941  1004.86210 [m]  4  0.62628710
## 5    5    4 -132.9762 56.80849 10 -132.6638 56.71238 24432.32444 [m]  5 15.22300434
# 'edge' is always unique
any_duplicated(graph$edge)
## [1] FALSE
# But there may be duplicate edges between the same from-to nodes
sum(fduplicated(graph[, c("from", "to")]))
## [1] 679

Evidently, casting to LINESTRING did not increase the row count in this case. linestrings_to_graph() then removed the geometry (SHAPE) column and added 8 columns: a unique edge identifier, from and to node IDs with corresponding geodetic coordinates (WGS84), and .length computed directly from the shape in meters (which here matches the LENGTH column expressed in miles).

We can again extract nodes with nodes_from_graph() to determine the nearest node to each of the 3796 FAF5 zones provided as origin and destination locations for commodity flows:

zones <- st_read(FAF5_path, layer = "FAF5_Nodes") |> 
  fsubset(!is.na(CentroidID)) |> st_transform(4326)
## Reading layer `FAF5_Nodes' from data source `/Users/sebastiankrantz/Documents/CPCS/FAF5/Networks/Geodatabase Format/FAF5Network.gdb' using driver `OpenFileGDB'
## Simple feature collection with 974788 features and 15 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -167.0152 ymin: 18.91474 xmax: -66.98005 ymax: 71.3198
## Geodetic CRS:  NAD83
nrow(zones)
## [1] 3796
head(zones, 1)
## Simple feature collection with 1 feature and 15 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -132.9393 ymin: 56.83877 xmax: -132.9393 ymax: 56.83877
## Geodetic CRS:  WGS 84
##   ID     DATA Entry_or_Exit Exit_Number Interchange Centroid CentroidID Facility_Type Facility_Name County State StateID StateName FAFID StateNameBak
## 1 14 47179393          <NA>        <NA>        <NA>        1       2195          <NA>          <NA>   <NA>  <NA>       2    Alaska    20       Alaska
##                        SHAPE
## 1 POINT (-132.9393 56.83877)
nodes <- nodes_from_graph(graph, sf = TRUE)
nrow(nodes)
## [1] 348495

Using the FAF5 Data Tabulation Tool, I have generated an OD matrix of total 2024 truck flows:

OD <- fread(FAF5_2024_truck_flows) |> janitor::clean_names() |> 
  ftransform(id_o = as.integer(substr(dms_orig, 1, 3)), 
             id_d = as.integer(substr(dms_dest, 1, 3)))
nrow(OD)
## [1] 16798
head(OD, 3)
##             dms_orig          dms_dest dms_mode thousand_tons_in_2024  id_o  id_d
##               <char>            <char>   <char>                 <num> <int> <int>
## 1: 011-Birmingham AL 011-Birmingham AL  1-Truck            35382.9943    11    11
## 2: 011-Birmingham AL     012-Mobile AL  1-Truck              970.8396    11    12
## 3: 011-Birmingham AL    019-Rest of AL  1-Truck            10178.2525    11    19

This data can be matched to zone nodes, but only at the coarser 3-digit FAF zone level:

zones |> join(fslice(OD, id_o), on = c("FAFID" = "id_o")) |> invisible()
## left join: zones[FAFID] 3796/3796 (100%) <28.76:1st> y[id_o] 132/132 (100%)
zones |> join(fslice(OD, id_d), on = c("FAFID" = "id_d")) |> invisible()
## left join: zones[FAFID] 3796/3796 (100%) <28.76:1st> y[id_d] 132/132 (100%)

We therefore aggregate the centroids to the 3-digit level and map them to the nearest network nodes:

# Aggregating zones and computing aggregate centroids
zones_agg <- zones |> fgroup_by(FAFID) |> 
  fsummarise(SHAPE = st_centroid(st_combine(SHAPE)))
# Matching each aggregate zone centroid to the nearest network node
zones_agg$NN <- nodes$node[st_nearest_feature(zones_agg, nodes)]

We are now ready to create a mapped OD-matrix with from and to node columns as well as flow:

OD_mapped <- OD |> 
  join(zones_agg |> st_drop_geometry() |> fselect(FAFID, NN), 
       on = c("id_o" = "FAFID")) |> frename(from = NN) |>
  join(zones_agg |> st_drop_geometry() |> fselect(FAFID, NN), 
       on = c("id_d" = "FAFID")) |> frename(to = NN) |>
  fmutate(flow = thousand_tons_in_2024) |> 
  fsubset(is.finite(flow) / flow > 0, from, dms_orig, to, dms_dest, flow)
## left join: OD[id_o] 16798/16798 (100%) <127.26:1st> y[FAFID] 132/132 (100%)
## left join: x[id_d] 16798/16798 (100%) <127.26:1st> y[FAFID] 132/132 (100%)
head(OD_mapped)
##     from          dms_orig     to          dms_dest       flow
##    <int>            <char>  <int>            <char>      <num>
## 1:  6551 011-Birmingham AL   6551 011-Birmingham AL 35382.9943
## 2:  6551 011-Birmingham AL 124499     012-Mobile AL   970.8396
## 3:  6551 011-Birmingham AL 125253    019-Rest of AL 10178.2525
## 4:  6551 011-Birmingham AL   1691        020-Alaska     0.0000
## 5:  6551 011-Birmingham AL  15659    041-Phoenix AZ    50.0572
## 6:  6551 011-Birmingham AL   5981     042-Tucson AZ     1.3969

Let us now proceed to a basic flows assignment using the efficient All-or-Nothing (AoN) method. Before running it, we need to further process the graph in two ways:

1. Create a column representing the generalized cost of traversing a link.
2. Ensure directed links are properly represented.

For (1), I combine the free flow time (in minutes) with a truck toll estimate (average per-mile toll for a 5-axle vehicle \(\times\) segment length), converted to minutes assuming a value of time (VOT) of 50 USD/hour.

fnobs(graph$TRUCKTOLL) # Number of links with tolls
## [1] 3245
graph %<>% fmutate(TollTime = replace_na(TRUCKTOLL, 0) / 50 * 60,
                   cost_AB = replace_na(AB_FreeFlowTime + TollTime, 1e4),
                   cost_BA = replace_na(BA_FreeFlowTime + TollTime, 1e4))
graph %$% fquantile(setv(TollTime / cost_AB, 0, NA), Qprobs)
##         0%         1%         5%        25%        50%        75%        95%        99%       100% 
## 0.09420283 0.11402505 0.13810940 0.22898990 0.28057551 0.84988865 0.98935454 0.99612581 0.99964115

Among the 3245 links with tolls, tolls account for ~28% of the generalized cost. A few links (~3800 in each direction) are missing free flow time; these are imputed with a very high cost of 10,000 minutes.

The network provides free flow time estimates in both directions, and, to complicate things further, a DIR column indicates whether the link is bidirectional (0) or unidirectional (1 or -1). We thus need to convert the graph to a fully directed one by duplicating bidirectional links with swapped endpoints.

table(graph$DIR) # See direction or undirectedness of links
## 
##     -1      0      1 
##    391 168215 318788
# Create fully directed graph representation
graph_dir <- rowbind(
   graph |> fselect(from, to, FX, FY, TX, TY, cost = cost_AB), 
   graph |> fsubset(DIR == 0,
     from = to, to = from, FX = TX, FY = TY, TX = FX, TY = FY, cost = cost_BA)                       
)
nrow(graph_dir)
## [1] 655609

We are now ready for directed All-or-Nothing assignment:

system.time({
result_AoN <- run_assignment(graph_dir, OD_mapped, directed = TRUE, 
     method = "AoN", return.extra = "costs", verbose = FALSE)
})
##    user  system elapsed 
##  10.310   0.199  10.519
print(result_AoN)
## FlowNet object
## Call: run_assignment(graph_df = graph_dir, od_matrix_long = OD_mapped,      directed = TRUE, method = "AoN", return.extra = "costs",      verbose = FALSE) 
## 
## Number of edges: 655609 
## Number of simulations/OD-pairs: 16438 
## 
## Average path cost (SD): 1207.033  (759.4758)
## 
## Final flows summary statistics:
##        N  Ndist     Mean       SD  Min        Max  Skew   Kurt
##   655609   5401  1948.29  6721.89    0  137376.81  4.99  35.61
##   1%  5%  10%  25%  50%  75%      90%       95%       99%
##    0   0    0    0    0    0  5378.46  15025.71  34257.51

The igraph library called under the hood still warns about some unreachable nodes, leaving 16798-16438 = 360 OD-pairs unassigned. A remedy would be to duplicate all directed links with a very high cost in the opposite direction, but with 655,609 edges already, further edge inflation is undesirable.

As noted above, this network is a borderline case for PSL assignment in terms of computational complexity, but, with only ~16.8k OD-pairs, we can manage by restricting detours to 1.2\(\times\) the shortest path and the angle for intermediate target nodes to 30 degrees.² Since the US network is very route efficient, these restrictions are reasonable. They do not fully tame the combinatorial explosion, however—some connections (e.g., San Francisco to New York) still admit over 90,000 alternatives—so we additionally cap the number of paths at a random sample of 1000.³ For memory-efficient multithreading, I also limit the pre-computed OD cost and geodesic distance matrices to 5000\(^2\).

We also need to calibrate the PSL model. The average path cost here is 1207 minutes—exponentiating such large numbers in the MNL concentrates virtually all probability on the shortest path, reducing the PSL to AoN. Having calibrated the Africa model with beta = 4 at an average normalized cost of 53.5, I apply a heuristic scaling of 53.5 / 1207 = 0.0443 to the FAF5 link costs and reuse the same beta.

graph_dir$cost_scaled <- graph_dir$cost * 53.5 / 1207
system.time({
result_PSL <- run_assignment(
    graph_dir, OD_mapped, directed = TRUE, 
    cost.column = "cost_scaled", method = "PSL", beta = 4,
    detour.max = 1.2, angle.max = 30, npaths.max = 1000, 
    dmat.max.size = 5000^2, nthreads = 8, verbose = FALSE,
    return.extra = c("edges", "counts", "weights", "eweights")
) |> suppressWarnings()
})
##    user  system elapsed 
## 444.772  20.004 476.424
print(result_PSL)
## FlowNet object
## Call: run_assignment(graph_df = graph_dir, od_matrix_long = OD_mapped,      directed = TRUE, cost.column = "cost_scaled", method = "PSL",      beta = 4, detour.max = 1.2, angle.max = 30, npaths.max = 1000,      dmat.max.size = 5000^2, return.extra = c("edges", "counts",          "weights", "eweights"), verbose = FALSE, nthreads = 8) 
## 
## Number of edges: 655609 
## Number of simulations/OD-pairs: 16438 
## 
## Average number of edges utilized per simulation (SD): 13803.19  (8072.216)
## Average number of visits per edge (SD): 28.39304  (69.88708)
## Average path weight (SD): 0.002916186  (0.01594657)
## Average summed edge weight (SD): 0.06338159  (0.18493)
## 
## Final flows summary statistics:
##        N   Ndist     Mean       SD  Min        Max  Skew   Kurt
##   655609  397919  1882.31  5631.94    0  132405.13  4.86  35.47
##   1%  5%  10%   25%    50%     75%      90%       95%       99%
##    0   0    0  0.79  25.25  464.02  5373.66  12819.44  28378.51

Solving 16,438 OD pairs (\(\leq\) 1000 paths each) in about 8 minutes—again generating around 15 million paths, but on a network with 253\(\times\) more nodes and 280\(\times\) more edges than the Africa network, while taking only 16\(\times\) more time—is rather impressive. Still, the throughput of only ~35 OD pairs per second imposes clear limits for considering much larger OD matrices.⁴

Now that we have a result, let’s visualize the generated routes from San Francisco to New York.

sf2ny <- OD_mapped |> 
  with(which(dms_orig %like% "San Francisco" & dms_dest %like% "363-New York"))
# Here we need to adjust the index because some OD pairs were removed
sf2ny <- whichv(result_PSL$od_pairs_used, sf2ny)
length(result_PSL$path_weights[[sf2ny]]) # Number of paths retained
## [1] 408
sf2ny_edges <- result_PSL$edges[[sf2ny]]
sf2ny_net <- linestrings_from_graph(ss(graph_dir, sf2ny_edges))
sf2ny_net$edge_counts <- result_PSL$edge_counts[[sf2ny]]
sf2ny_net$edge_weights <- result_PSL$edge_weights[[sf2ny]]

tm_basemap("CartoDB.Positron", zoom = 4) +
tm_shape(roworder(sf2ny_net, edge_counts)) +
  tm_lines(col = "edge_counts",
           col.scale = tm_scale_continuous_sqrt(6, values = "turbo", 
                                           values.range = c(0.1, 0.9), 
                                           value.na = "grey"),
           col.legend = tm_legend("Edge Visits", position = c("left", "bottom"),
                                  orientation = "landscape",
                                  frame = FALSE, text.size = 0.8, title.size = 1,
                                  item.width = 3, bg.alpha = 0.6,
                                  na.show = FALSE), lwd = 1.5) +
tm_shape(zones_agg) + tm_dots(size = 0.1) +
tm_layout(frame = FALSE, outer.margins = 0)

As expected, we obtain a large number of paths, many of which take curious detours. The route enumeration algorithm filters out paths with duplicate directional edges, ensuring no route traverses a road segment twice—this ex-post elimination is the main reason we retain only 408 of the sampled 1000. Some intermediate nodes generating valid routes lie inside city centers or in the open field, yielding complex local patterns. Nonetheless, the edge counts clearly reveal two main corridors (north and south), both branching out as they approach New York.

Let’s now see what the edge probabilities suggest where traffic is actually going:

# Again clipping small probabilities below 0.0001
sf2ny_net$edge_weights_clip <- replace_outliers(sf2ny_net$edge_weights, 0.0001, NA, "min")
tm_basemap("CartoDB.Positron", zoom = 4) +
tm_shape(roworder(sf2ny_net, edge_weights_clip)) +
  tm_lines(col = "edge_weights_clip",
           col.scale = tm_scale_continuous_sqrt(6, values = "turbo", limits = c(0, 1),
                                           values.range = c(0.1, 0.9), 
                                           value.na = "grey"),
           col.legend = tm_legend("Edge Probabilities", position = c("left", "bottom"),
                                  orientation = "landscape",
                                  frame = FALSE, text.size = 0.8, title.size = 1,
                                  item.width = 3, bg.alpha = 0.6,
                                  na.show = FALSE), lwd = 1.5) +
tm_shape(zones_agg) + tm_dots(size = 0.1) +
tm_layout(frame = FALSE, outer.margins = 0)

The southern route is clearly not deemed very viable by the MNL function. Most traffic follows the northern corridor, with meaningful heterogeneity only in the Midwest where it splits into a few near-equally probable branches that later merge. A minor southern variant carries about 5% of traffic.

As with the Africa network, the PSL model imposes economically sound structure on a large set of heterogeneous routes. Let us now attempt to visualize the full network flows. To reduce spatial complexity, we will aggregate the directed graph back to an undirected one and filter out links with negligible flows, as well as links going to Alaska (upwards of 49.1 degrees latitude).

flows <- graph_dir %>%
  ftransform(flows = result_PSL$final_flows,
             from = fpmax(from, to), to = fpmin(from, to)) %>%
  fgroup_by(from, to) %>%
  fsummarise(across(FX:TY, ffirst), 
             flows = fsum(flows),
             cost = fmean(cost)) %>%
  fsubset(flows > 1 & FY < 49.1 & TY < 49.1)
head(flows, 3)
##   from to        FX       FY        TX       TY     flows      cost
## 1   94 93 -117.7272 33.48681 -117.7854 33.54277  1184.096 8.0597573
## 2   95 94 -117.7272 33.48681 -117.7067 33.46553  1184.096 3.0502339
## 3  100 99 -117.4452 33.27583 -117.4406 33.27092 13576.867 0.4469114

For the visualization, I use a dark map and order links by flow so the important ones are plotted last.⁵

tm_basemap("CartoDB.DarkMatter", zoom = 4) +
tm_shape(roworder(linestrings_from_graph(flows), flows)) +
  tm_lines(col = "flows",
           col.scale = tm_scale_continuous_log(6, values = "inferno"),
           col.legend = tm_legend("PSL Flows", position = c("left", "bottom"),
                                  frame = FALSE, text.size = 0.8, title.size = 1, 
                                  item.height = 2, na.show = FALSE, bg.alpha = 0.4), lwd = 0.5) +
tm_layout(frame = FALSE, outer.margins = 0)

To speed up PSL assignments on very large networks, permitting the use of larger OD matrices within reasonable computing times, we can also use several graph simplification tools flownet provides.

The first, consolidate_graph(), reduces graph complexity by contracting intermediate nodes that connect only two edges, and dropping singleton, loop, and duplicate edges. It supports several levels of recursion: recursive = "full" (the default) repeats edge elimination, node contraction, and attribute aggregation until convergence, yielding the most compact result but making it impossible to trace it back to the original edges. recursive = "partial" omits the aggregation step from the recursion loop and attaches attributes mapping to original edges. This is useful particularly when a more detailed network geometry needs to be unionized along with the graph consolidation for visualization purposes. For aggregation, consolidate_graph() delegates to collap() in collapse, which supports multi-type and custom aggregation with different functions and weights.⁶ Below, I apply full recursive consolidation on this directed graph, summing all numeric columns (here only "cost" is aggregated).

graph_dir_c <- consolidate_graph(graph_dir, keep = zones_agg$NN, directed = TRUE, FUN = "fsum")
## Consolidating directed graph graph_dir with 655609 edges using full recursion
## Initial node degrees:
##      1      2      3      4      5      6      7      8      9     10     11     12 
##  12478  50928 135599  53020  26793  56446   1257  11574     40    351      3      6 
## 
## Dropped 47 loop edges
## Dropped 1090 duplicate edges
## Dropped 12358 edges leading to singleton nodes
## Dropped 2164 edges leading to singleton nodes
## Dropped 43 edges leading to singleton nodes
## Dropped 9 edges leading to singleton nodes
## Dropped 4 edges leading to singleton nodes
## Dropped 1 edges leading to singleton nodes
## Contracted 61403 intermediate nodes
## Dropped 12 edges leading to singleton nodes
## Aggregated 639881 edges down to 578232 edges
## Dropped 4872 loop edges
## Dropped 5 edges leading to singleton nodes
## Dropped 1 edges leading to singleton nodes
## Contracted 1031 intermediate nodes
## Dropped 10 edges leading to singleton nodes
## Aggregated 573344 edges down to 572279 edges
## Dropped 598 loop edges
## Contracted 287 intermediate nodes
## Dropped 2 edges leading to singleton nodes
## Aggregated 571679 edges down to 571384 edges
## Dropped 227 loop edges
## Contracted 122 intermediate nodes
## Aggregated 571157 edges down to 571030 edges
## Dropped 109 loop edges
## Contracted 58 intermediate nodes
## Aggregated 570921 edges down to 570862 edges
## Dropped 52 loop edges
## Contracted 36 intermediate nodes
## Aggregated 570810 edges down to 570774 edges
## Dropped 33 loop edges
## Contracted 27 intermediate nodes
## Aggregated 570741 edges down to 570714 edges
## Dropped 27 loop edges
## Contracted 23 intermediate nodes
## Aggregated 570687 edges down to 570663 edges
## Dropped 22 loop edges
## Contracted 15 intermediate nodes
## Aggregated 570641 edges down to 570626 edges
## Dropped 15 loop edges
## Contracted 13 intermediate nodes
## Aggregated 570611 edges down to 570598 edges
## Dropped 13 loop edges
## Contracted 11 intermediate nodes
## Aggregated 570585 edges down to 570574 edges
## Dropped 11 loop edges
## Contracted 10 intermediate nodes
## Aggregated 570563 edges down to 570553 edges
## Dropped 10 loop edges
## Contracted 7 intermediate nodes
## Aggregated 570543 edges down to 570536 edges
## Dropped 7 loop edges
## Contracted 4 intermediate nodes
## Aggregated 570529 edges down to 570525 edges
## Dropped 4 loop edges
## Contracted 4 intermediate nodes
## Aggregated 570521 edges down to 570517 edges
## Dropped 4 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570513 edges down to 570511 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570509 edges down to 570507 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570505 edges down to 570503 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570501 edges down to 570499 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570497 edges down to 570495 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570493 edges down to 570491 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570489 edges down to 570487 edges
## Dropped 2 loop edges
## Contracted 2 intermediate nodes
## Aggregated 570485 edges down to 570483 edges
## Dropped 2 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570481 edges down to 570480 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570479 edges down to 570478 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570477 edges down to 570476 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570475 edges down to 570474 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570473 edges down to 570472 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570471 edges down to 570470 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570469 edges down to 570468 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570467 edges down to 570466 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570465 edges down to 570464 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570463 edges down to 570462 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570461 edges down to 570460 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570459 edges down to 570458 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570457 edges down to 570456 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570455 edges down to 570454 edges
## Dropped 1 loop edges
## Contracted 1 intermediate nodes
## Aggregated 570453 edges down to 570452 edges
## Dropped 1 loop edges
## No nodes to contract, returning graph
## 
## Consolidated directed graph graph_dir from 655609 edges to 570451 edges (87.0%)
## Final node degrees:
##      1      2      3      4      5      6      7      8      9     10     11     12 
##      1    209 122726  55411  26528  53742   1132  10816     28     82      3      1
nrow(graph_dir_c)
## [1] 570451

Full consolidation in this case reduced the number of edges by only 13%, suggesting that most edges in the FAF5 network serve an important connecting function.

For a more drastic network simplification, we can turn to simplify_network(), which provides two topological network simplification methods. The default, "shortest-paths", computes all shortest paths between a given set of nodes (or OD pairs) and retains only the edges traversed by any path. This eliminates links not needed for primary navigation, at the cost of reducing alternative routing options.

graph_dir_c_sc <- simplify_network(graph_dir_c, zones_agg$NN, directed = TRUE, 
                                   method = "shortest-paths") |>
  consolidate_graph(keep = zones_agg$NN, directed = TRUE, FUN = "fsum")
## Created graph with 270679 nodes and 570451 edges...
## Retained 70854/570451 edges traversed by shortest paths (12.4%)
## Consolidating directed graph . with 70854 edges using full recursion
## Initial node degrees:
##     1     2     3     4     5     6     7     8 
##     1 49675  3162  7499   281   223     4    13 
## 
## Contracted 49631 intermediate nodes
## Aggregated 70854 edges down to 21223 edges
## No nodes to contract, returning graph
## 
## Consolidated directed graph . from 70854 edges to 21223 edges (30.0%)
## Final node degrees:
##    1    2    3    4    5    6    7    8 
##    1   44 3162 7499  281  223    4   13
nrow(graph_dir_c_sc)
## [1] 21223

The method is very effective, cutting the consolidated graph by 87% and then a further 70% through follow-up consolidation. igraph still warns about a few unreachable nodes.

We can also simplify the undirected flow graph created above (where costs were averaged across directions)—a reasonable simplifying assumption given symmetric highway connectivity. Let us first match the nearest nodes and consolidate.⁷

# Matching nearest nodes and consolidating
flows_nodes <- nodes_from_graph(flows, sf = TRUE)
zones_agg$NN_undir <- flows_nodes$node[st_nearest_feature(zones_agg, flows_nodes)]
flows_c <- consolidate_graph(flows, keep = zones_agg$NN_undir, w = ~ cost)
## Consolidating undirected graph flows with 380531 edges using full recursion
## Initial node degrees:
##      1      2      3      4      5      6      7      8 
##   2022 144346 127137  21398    530    111      3      1 
## 
## Dropped 1878 edges leading to singleton nodes
## Dropped 739 edges leading to singleton nodes
## Dropped 361 edges leading to singleton nodes
## Dropped 202 edges leading to singleton nodes
## Dropped 110 edges leading to singleton nodes
## Dropped 69 edges leading to singleton nodes
## Dropped 47 edges leading to singleton nodes
## Dropped 29 edges leading to singleton nodes
## Dropped 24 edges leading to singleton nodes
## Dropped 20 edges leading to singleton nodes
## Dropped 18 edges leading to singleton nodes
## Dropped 13 edges leading to singleton nodes
## Dropped 10 edges leading to singleton nodes
## Dropped 8 edges leading to singleton nodes
## Dropped 6 edges leading to singleton nodes
## Dropped 3 edges leading to singleton nodes
## Dropped 3 edges leading to singleton nodes
## Dropped 3 edges leading to singleton nodes
## Dropped 3 edges leading to singleton nodes
## Dropped 2 edges leading to singleton nodes
## Dropped 2 edges leading to singleton nodes
## Dropped 1 edges leading to singleton nodes
## Oriented 45693 undirected intermediate edges
## Contracted 143923 intermediate nodes
## Oriented 1964 undirected intermediate edges
## Contracted 1964 intermediate nodes
## Oriented 15 undirected intermediate edges
## Contracted 15 intermediate nodes
## Aggregated 376980 edges down to 248202 edges
## Dropped 8 loop edges
## Dropped 15 edges leading to singleton nodes
## Oriented 15515 undirected intermediate edges
## Contracted 17786 intermediate nodes
## Oriented 403 undirected intermediate edges
## Contracted 403 intermediate nodes
## Oriented 25 undirected intermediate edges
## Contracted 25 intermediate nodes
## Oriented 2 undirected intermediate edges
## Contracted 2 intermediate nodes
## Aggregated 248179 edges down to 232379 edges
## Dropped 3 loop edges
## Dropped 1 edges leading to singleton nodes
## Oriented 2210 undirected intermediate edges
## Contracted 2491 intermediate nodes
## Oriented 34 undirected intermediate edges
## Contracted 34 intermediate nodes
## Oriented 1 undirected intermediate edges
## Contracted 1 intermediate nodes
## Aggregated 232375 edges down to 230068 edges
## Oriented 253 undirected intermediate edges
## Contracted 310 intermediate nodes
## Oriented 1 undirected intermediate edges
## Contracted 1 intermediate nodes
## Aggregated 230068 edges down to 229777 edges
## Oriented 40 undirected intermediate edges
## Contracted 51 intermediate nodes
## Aggregated 229777 edges down to 229732 edges
## Dropped 1 edges leading to singleton nodes
## Oriented 7 undirected intermediate edges
## Contracted 7 intermediate nodes
## Aggregated 229731 edges down to 229724 edges
## No nodes to contract, returning graph
## 
## Consolidated undirected graph flows from 380531 edges to 229724 edges (60.4%)
## Final node degrees:
##      1      2      3      4      5      6      7      8 
##      3     64 124282  20840    493    104      2      1

We then run shortest-path simplification followed by consolidation.

flows_c_sc <- simplify_network(flows_c, zones_agg$NN_undir) |> 
  consolidate_graph(keep = zones_agg$NN_undir, w = ~ cost, verbose = FALSE)
## Created graph with 145789 nodes and 229724 edges...
## Retained 32118/229724 edges traversed by shortest paths (14.0%)
nrow(flows_c_sc)
## [1] 3091

And voila, that I would call a radical simplification, first retaining 32,118 edges traversed by shortest paths and then recursively consolidating them down to 3091 edges.

The result is visually sparse, and the simplification discards flows on non-traversed links. Ideally one would re-assign the OD matrix to the simplified network; I leave that as an exercise since the procedure should be clear by now.

A viable alternative retaining far more edges for alternative routing is to base the shortest-path simplification on the full 3796 disaggregated zones rather than only the 132 aggregated zones:

# Need to first match them to the undirected graph
flows_c_nodes <- nodes_from_graph(flows_c, sf = TRUE)
zones$NN_undir <- flows_c_nodes$node[st_nearest_feature(zones, flows_c_nodes)]
# Combining with the aggregate zone nearest nodes
sp_nodes <- unique(c(zones$NN_undir, zones_agg$NN_undir))
length(sp_nodes)
## [1] 3457
# Now simplifying again
flows_c_sc <- simplify_network(flows_c, sp_nodes) |> 
   consolidate_graph(keep = zones_agg$NN_undir, w = ~ cost, verbose = FALSE)
## Created graph with 145789 nodes and 229724 edges...
## Retained 107695/229724 edges traversed by shortest paths (46.9%)
nrow(flows_c_sc)
## [1] 48672

The resulting graph is much more detailed. This required computing 3457*(3457-1)/2 = 5,973,696 shortest paths, which took ~3 min—a future update will add multithreading to simplify_network().

This simplified and consolidated network certainly looks more appealing and provides a reasonable simplification for routing and stochastic traffic assignment using the PSL in this case.

The second method, "cluster", takes a fundamentally different approach: it spatially clusters nearby nodes and contracts the graph accordingly, (1) dropping intra-cluster loop edges and (2) aggregating inter-cluster edges via collap(). Clustering proceeds in two stages: first, optionally, designate key nodes (e.g., zone centroids) as cluster seeds, absorbing all nodes within a specified radius; then, use Hartigan (1975)’s Leader Algorithm—implemented efficiently in C by leaderCluster with geographic coordinate support—to cluster the remaining nodes using a second radius. If no key nodes are provided, all nodes are clustered via the Leader Algorithm.

Below, we use the 132 zone nodes as cluster seeds and a 7km radius for both stages. The larger the radius, the more aggressive the simplification.⁸

flows_c_cc <- simplify_network(flows_c, zones_agg$NN_undir, method = "cluster", 
                      radius_km = list(nodes = 7, cluster = 7), w = ~ flows) |> 
   consolidate_graph(keep = zones_agg$NN_undir, w = ~ cost)
## Clustering nodes close to 'keep' nodes using a radius of 7km
## Clustering the remaining nodes with the leaderCluster algorithm using a radius of 7km
## leaderCluster algorithm converged in 13 iterations
## Dropped 183503 self-loop edges (following clustering)
## Oriented 30362 undirected edges
## Contracting 46221 edges down to 26395 edges
## Consolidating undirected graph . with 26395 edges using full recursion
## Initial node degrees:
##    1    2    3    4    5    6    7    8    9   10   11   13 
##   55 2349 5358 3197 1709  972  412  163   46   15    3    1 
## 
## Dropped 54 edges leading to singleton nodes
## Oriented 1129 undirected intermediate edges
## Contracted 2325 intermediate nodes
## Oriented 1 undirected intermediate edges
## Contracted 1 intermediate nodes
## Aggregated 26341 edges down to 23449 edges
## Dropped 2 loop edges
## Oriented 103 undirected intermediate edges
## Contracted 149 intermediate nodes
## Aggregated 23447 edges down to 23293 edges
## Oriented 6 undirected intermediate edges
## Contracted 6 intermediate nodes
## Aggregated 23293 edges down to 23287 edges
## No nodes to contract, returning graph
## 
## Consolidated undirected graph . from 26395 edges to 23287 edges (88.2%)
## Final node degrees:
##    1    2    3    4    5    6    7    8    9   10   12 
##    1   24 5477 3288 1641  882  330  101   25    9    1
nrow(flows_c_cc)
## [1] 23287

It is notable that clustering leaves less room for follow-up consolidation than shortest-path simplification, which tends to produce long chains of connected edges.

Let’s look at the result:

Also pretty neat—I think—and very similar. Finally, I note that while this network is unimodal, both consolidate_graph() and simplify_network() support multimodal networks—passing mode identifiers to their ‘by’ arguments prevents edges of different modes from being conflated.

Conclusion

flownet is a new R package for transport modeling. It presently provides route enumeration and traffic assignment using the Path-Sized Logit model, powerful tools for network processing, and a parsimonious API. These features make it a compelling choice for transport analytics, particularly in R. The package is built on top of several fastverse libraries and custom C code to ensure high performance.

In this post, I demonstrated the package on African and US road networks, showcasing how to assign trade/traffic flows with the PSL method, and how to investigate/visualize the results. I additionally demonstrated the package’s network simplification tools on the detailed US network.

Future flownet updates may comprise additional traffic assignment methods, more advanced network processing tools, and performance optimizations. But even in its present state, I believe the package is computationally capable of handling most networks we deal with at CPCS and a wide variety of other applications, including modeling on regional or global multimodal transport networks.

References

Ben-Akiva, M., & Bierlaire, M. (1999). Discrete choice methods and their applications to short term travel decisions. In R. W. Hall (Ed.), Handbook of Transportation Science (pp. 5–33). Springer US. https://doi.org/10.1007/978-1-4615-5203-1_2

Cascetta, E. (2001). Transportation systems engineering: Theory and methods. Springer.

Ben-Akiva, M., & Lerman, S. R. (1985). Discrete choice analysis: Theory and application to travel demand. The MIT Press.

Ramming, M. S. (2002). Network knowledge and route choice (Doctoral dissertation). Massachusetts Institute of Technology.

Prato, C. G. (2009). Route choice modeling: Past, present and future research directions. Journal of Choice Modelling, 2(1), 65–100. https://doi.org/10.1016/S1755-5345(13)70005-8

AequilibraE Python Documentation: https://www.aequilibrae.com/develop/python/route_choice/path_size_logit.html

Hartigan, J. A. (1975). Clustering algorithms. John Wiley & Sons, Inc.

The Story of dfms: From Simple Beginnings to Fully-Featured DFM Package

As an economist training in macroeconomics, trade, and development, I got to know about DFMs almost by accident during my Master’s in Geneva at a summer school on “Big Data in Macroeconomics and Finance” at the Kiel Institute for the World Economy in 2018—which also marks my first encounter with the Kiel Institute where I ended up doing my PhD. The course covered a variety of topics via external lecturers: household finance, social networks, geospatial big data, text mining, and also a day of “Nowcasting” with Michele Modugno from the Federal Reserve Board—where he presented his mixed-frequency DFM methodology that dfms now efficiently implements in R and C++. I didn’t understand much of it back then and was more interested in the other topics, but I had gotten the gist of it.

Following my Master’s, I was posted to Uganda as an ODI Fellow on a 2-year assignment (2020/21) in the Macroeconomic Policy Department of Uganda’s Ministry of Finance, Planning, and Economic Development (MoFPED). Most of my work involved financial programming, data science, and other kinds of econometric and CGE analysis. In spring 2021, I was, however, working part-time on a research paper on Macroeconomic Dynamics and the Effects of Fiscal Spending in Uganda. Its aim was to assess the dynamic impact of fiscal spending on the Ugandan economy and answer a few critical questions that kept coming up, such as are we crowding out credit to the private sector? What happens to interest/tbill rates when we spend more? and what is the economic/growth impact of our spending? Annual time series in Uganda are relatively short, but we observed fiscal spending and a few other key indicators on a monthly basis. Putting together a monthly estimation dataset was thus key for meaningful dynamic modelling.

The main monthly indicator of economic activity in Uganda with some history is the Composite Index of Economic Activity (CIEA) published by the Bank of Uganda. It combines 10 monthly series: real currency in circulation, real VAT on domestic goods, real exports of goods and services, real imports, real government expenditure, real sales of selected companies, real cement production, real excise taxes, real PAYE and real private sector credit. They are combined by first using the Henderson Moving Average procedure for seasonal adjustment and separation of irregular components, and aggregation of the trend-cycle series into a composite trend-cycle indicator using weights derived from PCA and correlations of series with quarterly GDP.

And that is where my problem was—the inclusion of real government expenditure in this index defeated my purposes of using it to assess fiscal spending impacts. I thus needed an index without it, and I also thought the removal of irregular components and complicated aggregation procedure was suboptimal for research purposes. I wanted a simple, transparent procedure to obtain a monthly indicator of economic activity for Uganda, and a basic DFM with a single factor seemed the appropriate

\[\textbf{x}_t = \textbf{c} f_t + \textbf{e}_t \ \sim\ N(\textbf{0}, \textbf{R})\] \[f_t = \sum_{j=1}^p a_j f_{t-j} + u_t \ \sim\ N(0, q)\]

methodology—with observation weights c and transition coefficients \(a_j\) to be jointly estimated.

So I looked for a simple implementation of DFMs and found, on GitHub, the R package dynfactoR by Rtys Bagduzinas that estimated single-frequency DFMs with the EM/QML algorithm following Doz, Giannone, and Reichlin (2012), and also produced PCA and 2-step estimates following Doz, Giannone, and Reichlin (2011). It used a Julia backend for some of the filters, thus I forked it and made some changes—rewriting the Kalman Filter and Smoother and some parts of the EM algorithm in Armadillo C++, and linking through Rcpp. The package served the purposes of my paper well, and I had thought of creating something more organized and releasing it to CRAN, but didn’t follow through at that point (2021) as I was wrapping up my assignment in Uganda.

I returned to dynfactoR a year later in the early stages of my PhD—still working on empirical macroeconomics in Africa—and managed to refactor the package and put a first version on CRAN. For this refactor, I took much inspiration from the excellent vars package to estimate (S)VAR and (S)VEC models in R, which provides a compelling nomenclature with main function VAR() and tight observance of the object-oriented conventions for statistical R packages—including print(), plot(), coef(), summary(), residuals(), fitted(), predict(), and logLik() methods for the varest objects returned by VAR(), and various other methods, e.g., print() and plot() for the varprd objects returned by predict(). It also provides information criteria to select the VAR lag order via VARselect(). Furthermore, its function documentation includes mathematical formulations alongside brief explanations, which I liked a lot. I thus got inspired and called the package dfms, with main function DFM(), implemented information criteria to select the number of factors r following Bai and Ng (2002) in ICr(), including a screeplot() method following Onatski (2010),¹ and a comprehensive set of methods like vars. I also exported the C++ Kalman Filter and Smoother—which to my knowledge is still the most efficient implementation in R—alongside the function tsnarmimp() to impute time series matrices using cubic splines and moving averages (needed internally to obtain initial PCA-based system matrices to initialize the Kalman Filter), and Armadillo’s inverse and pseudo-inverse functions which I found somewhat more robust than R’s native ones. dfms version 0.1.3, including these features, hit CRAN in October 2022, and I introduced it with a brief blog post. I also submitted it for the rOpenSci Software Peer Review as I thought that might increase its quality.

It then occurred, one year into the PhD, that I was getting a bit bored in Kiel during the winter of 2022/23, and, through connections, organized myself a 3-month research visit at Stellenbosch University in South Africa—from February-April 2023. Parts of the department were very interested in nowcasting the South African economy. They had attempted it with regression and ML-based approaches, but, given my dfms package on CRAN, they asked me to work on an interpretable DFM-based methodology. This interest in nowcasting was warranted as, in the spring of 2023, the South African energy crisis was at its peak, with the implementation of load-shedding level 6—which meant about 8 hours per day on generators—inducing justified fears that it would stifle the South African economy.

Thus, I set out to implement a mixed-frequency DFM to nowcast the South African economy, particularly real GDP and unemployment. The first step, which took up much of my time, was to assemble and automate a database of high quality macroeconomic indicators. I ended up creating the South Africa Macroeconomic Database (SAMADB)—an open relational database with ~10,000 macroeconomic time series obtained from the South African Reserve Bank (SARB) and Statistics South Africa (STATSSA) and updated on a weekly basis via EconData and automated scraping of the SARB and STATSSA websites. I hosted it on servers at Codera Analytics, implemented the updating through GitHub Actions, and created the samadb R package for easy access. As of January 2026, the weekly updates still run, and the R package enjoys almost 15,000 downloads per month. I also wrote Python and Julia packages as these languages were more popular in the department.

With the database in place, I took a deep-dive on DFMs for nowcasting applications, revisiting the workshop materials by Michele Modugno, carefully reading Banbura and Modugno (2014), and looking at various nowcasting codes. The theoretical vignette, published in March 2023, is a result of this deep-dive and was principally written to assist my own understanding. I started implementing some of the features described there, and also received the rOpenSci software reviews during this time, which helped me improve the package. I released dfms 0.2.0, adding autoregressive errors and various smaller improvements, to CRAN at the end of March 2023. I mention in the news for that release that “I plan to implement all features described in this vignette until summer 2023”, but that turned out to be highly optimistic. With one month to go in my research visit, it dawned on me that I wouldn’t be able to complete dfms and build a nowcasting model in good time.

Thus, I switched to Python, where Chad Fulton had done some excellent work implementing the DynamicFactorMQ class for mixed-frequency nowcasting in statsmodels alongside a comprehensive tutorial. Following selection of a set of indicators for nowcasting, integration with the database and running the model on a weekly basis—also implemented through GitHub Actions—went quite smoothly. I presented the database, model, and model evaluation results at the Bureau of Economic Research seminar in Stellenbosch on April 20. It was a great success, with additional staff from the Reserve Bank, Treasury, and Statistics South Africa joining online.

Afterwards, and as announced in the slides, I devoted the rest of my time and also some time in April/May to the development of a NY-Fed-style Nowcasting Dashboard hosted through Codera Analytics at nowcast.codera.co.za and published in May 2023. Built with Dash and Plotly in Python, it provides interactive visualizations of the nowcast evolution and the data releases driving it, as well as historical nowcasting performance and release impacts by sector. This South Africa Nowcasting Model ran until November 2024, when it broke down due to the unavailability of some time series. So that is also a warning right there—if you are building a nowcasting platform using dfms or other tools, make sure you have a robust data pipeline in place and only include series that will remain available for years.

With the nowcasting platform in place, and the initial software reviews completed, there was not much urgency to work more on dfms. I had shifted my research interests to infrastructure and value chains in Africa, and was busy with other projects. rOpenSci editors kept pinging me in 2024 for the resubmit, but I was wrapping up my PhD, and also still had the ambition to implement mixed-frequency features. This state dragged on for a while after the PhD defense (Nov’24) as I was consulting, job-searching, and doing other things, but I managed, in May 2025, to push out dfms 0.3.0 with the mixed-frequency DFM implementation and resubmitted it to rOpenSci. The reviewers approved, and, given that it was to be published through rOpenSci in January 2026, I forced myself to complete the scope of the package. I thus spent two intense weekends and pushed out dfms 0.4.0, adding support for mixed-frequency estimation with autoregressive errors, on January 18, followed by this monumental 1.0.0 release, including the news decomposition following Banbura and Modugno (2014), full-state predictions, a package logo and updated practical vignette, on January 26. The package was then published through rOpenSci, which means the repo moved to rOpenSci GitHub and its docs are served from docs.ropensci.org.

The final push was greatly facilitated by the availability of modern AI, in particular Cursor and the Opus 4.5 and GPT 5.2 Codex models, which could take into context Banbura and Modugno (2014)’s original Matlab code and their paper + appendix, and help make and execute detailed implementation plans. I tested these by translating the Matlab code to Julia and testing it against R—using the Cursor debugger to hunt down complicated bugs.

This thus concludes the story of dfms—from simple single-frequency package to a full-blown DFM/nowcasting library in four years. Apart from some differences in design choices, Kalman Filter initialization, and reporting, the package produces identical results to Banbura and Modugno (2014)’s research codes.

The literature on DFMs has, of course, moved on—with regime switching/time-varying volatility/parameter Bayesian DFMs now the state of the art.² Since the state of the art is complicated and computationally intense though, and the methodology of Banbura and Modugno (2014) works very well when shocks are moderate—we also tested the DFM against various ML/DL based approaches on US data, including the COVID shock, and found that it outperformed most ML/DL methods—I believe dfms 1.0+ can serve the community well, and I hope that it will find use in academia and policy institutions.

New dfms Features: Mixed Frequency DFMs with Autoregressive Errors, Full-State Predictions, and Multi-Target News Decomposition

The two latest dfms updates principally introduce three new features: (1) mixed-frequency estimation with autoregressive errors implemented in dfms 0.4.0; (2) decomposition of forecast revisions into news contributions following Banbura and Modugno (2014), and (3) full-state predictions and forecasts implemented in dfms 1.0.0.

To stick with the context of its history, and since the documentation and vignette provide lots of examples using the included dataset of Banbura and Modugno (2014), I will re-estimate my South Africa nowcasting model with the last available vintages for end-November and early-December 2024.

library(fastverse)
## -- Attaching packages ------------------------------------------------------------------------------------------------------------- fastverse 0.3.4 --
## v data.table 1.17.0     v kit        0.0.21
## v magrittr   2.0.4      v collapse   2.1.6
fastverse_extend(xts, dfms, readxl)
## -- Attaching extension packages --------------------------------------------------------------------------------------------------- fastverse 0.3.4 --
## v xts    0.14.1     v readxl 1.4.5 
## v dfms   1.0.0
## -- Conflicts ---------------------------------------------------------------------------------------------------------------- fastverse_conflicts() --
## x xts::first() masks data.table::first()
## x xts::last()  masks data.table::last()
## x dfms::news() masks utils::news()
# Get Last November 2024 Vintage
download.file("https://github.com/coderaanalytics-models/SA-Nowcast/raw/refs/heads/main/vintages/econdata_nowcast_data_22_11_2024.xlsx",
              destfile = "econdata_nowcast_data_22_11_2024.xlsx", mode = "wb")
data_m <- read_xlsx("econdata_nowcast_data_22_11_2024.xlsx", 
                    sheet = "data_logdiff_m") |> qDT() |> as.xts()
ncol(data_m)
## [1] 54
data_q <- read_xlsx("econdata_nowcast_data_22_11_2024.xlsx", 
                    sheet = "data_logdiff_q") |> qDT() |> 
  fmutate(date = as.Date(date)) |> 
  # dfms expects quarterly data to be released on the 3rd month of each quarter
  within(lubridate::month(date) <- lubridate::month(date) + 2L) |> as.xts()
colnames(data_q)
## [1] "UNEMP" "GDP"   "RGDP"
# The xts data format makes temporal merging and subsetting very easy
data <- merge(data_m, data_q)["1990-02/"]
# .. it also has a nice plot method
plot(scale(data), lwd = 1, ylim = c(-5, 5))

The usual dfms workflow is starts with information criteria to determine the number of factors and the factor-VAR order

(ic <- ICr(data))
## Missing values detected: imputing data with tsnarmimp() with default settings
## Optimal Number of Factors (r) from Bai and Ng (2002) Criteria
## 
## IC1 IC2 IC3 
##   1   1  20
screeplot(ic)

vars::VARselect(ic$F_pca[, 1:4])
## $selection
## AIC(n)  HQ(n)  SC(n) FPE(n) 
##      7      3      3      7 
## 
## $criteria
##                1         2        3        4        5        6        7        8        9       10
## AIC(n)  3.372492  2.959518 1.718657 1.667090 1.668591 1.636513 1.606690 1.618062 1.652979 1.673131
## HQ(n)   3.450602  3.100117 1.921743 1.932665 1.996653 2.027064 2.059729 2.133589 2.230994 2.313634
## SC(n)   3.569849  3.314762 2.231786 2.338105 2.497491 2.623300 2.751363 2.920620 3.113423 3.291460
## FPE(n) 29.151229 19.289241 5.577523 5.297771 5.306648 5.140434 4.991144 5.050561 5.233119 5.343569

Since the data includes the COVID shock, the first principal component is very dominant, and the information criteria suggest 1 factor. However, since the screeplot drops a bit after the 4th eigenvalue, I opt for four factors, also given that series from the four sectors—real, financial, fiscal, and external—are represented in the dataset. The VAR order is selected as 3 by the HQ and SC criteria. I thus estimate the DFM with 4 factors and VAR(3) dynamics, including autoregressive errors of order 1 and an adjusted state-space form where quarterly variables are represented by unobserved monthly counterparts following Mariano and Murasawa (2003). Importantly for the later news decomposition, setting max.missing = 1 prevents further rows from being dropped from the estimation dataset.³ These two features increase the size of the state-space, and thus computation time, a lot compared to simple estimation (which takes just 2 seconds), but the robust C++ backend still delivers a very respectable computation time of less than one minute for this most complex model case.

system.time(DFM(data, r = 4, p = 3, max.missing = 1))
## Converged after 33 iterations.
##    user  system elapsed 
##   1.373   0.046   1.421
system.time({
dfm <- DFM(data, r = 4, p = 3, idio.ar1 = TRUE, max.missing = 1,
           quarterly.vars = colnames(data_q))
})
## Converged after 26 iterations.
##    user  system elapsed 
##  32.635   0.533  33.225
summary(dfm)
## Mixed Frequency Dynamic Factor Model
## n = 57, nm = 54, nq = 3, T = 417, r = 4, p = 3
## %NA = 26.2695, %NAm = 23.8209
##    with AR(1) errors: mean(abs(rho)) = 0.296 
## 
## Call:  DFM(X = data, r = 4, p = 3, max.missing = 1, idio.ar1 = TRUE,      quarterly.vars = colnames(data_q))
## 
## Summary Statistics of Factors [F]
##       N    Mean  Median      SD       Min      Max
## f1  417  0.0358  0.0224  3.1427  -54.3033  25.3044
## f2  417  0.0148  0.0358  1.5887   -19.842     21.7
## f3  417  0.0464  0.0729  1.6763  -25.5152  12.9381
## f4  417  0.0239  0.0049  1.1397   -8.1336  12.0924
## 
## Factor Transition Matrix [A]
##       L1.f1   L1.f2   L1.f3   L1.f4     L2.f1    L2.f2   L2.f3   L2.f4   L3.f1    L3.f2    L3.f3    L3.f4
## f1 -0.47917 -0.4016 1.49438  0.4893 -0.970167 -0.64590  0.2723 -0.4588 -0.4225 -0.10730 -0.12302 -0.37666
## f2  0.07605 -0.4483 0.05939  0.1679 -0.008145 -0.30928  0.2850  0.1486  0.2977 -0.12425 -0.08882 -0.13348
## f3  0.42230  0.2774 0.02289  0.5551  0.080860 -0.02339 -0.4085  0.1032  0.1769  0.10793 -0.07216  0.10206
## f4  0.16261  0.1108 0.12947 -0.2689  0.005231  0.10899  0.1003 -0.3174  0.2039 -0.02751 -0.12524 -0.07243
## 
## Factor Covariance Matrix [cov(F)]
##           f1        f2        f3        f4
## f1   9.8763   -0.1549    0.2107    0.2422 
## f2  -0.1549    2.5241    0.1329    0.9066*
## f3   0.2107    0.1329    2.8101    0.4524*
## f4   0.2422    0.9066*   0.4524*   1.2990 
## 
## Factor Transition Error Covariance Matrix [Q]
##        u1      u2     u3      u4
## u1 7.6784  0.1027 0.9381  0.7389
## u2 0.1027  0.2946 0.1342 -0.2394
## u3 0.9381  0.1342 0.4943  0.1539
## u4 0.7389 -0.2394 0.1539  0.7417
## 
## Summary of Residual AR(1) Serial Correlations
##    N     Mean   Median      SD      Min     Max
##   57  -0.1739  -0.2529  0.2912  -0.6048  0.4128
## 
## Summary of Individual R-Squared's
##    N    Mean  Median      SD      Min     Max
##   57  0.5093  0.5816  0.3811  -0.0188  0.9995
plot(dfm, xlim = c(200, 415))

plot(dfm, type = "individual", method = "all")

The factor model is, ostensibly, heavily impacted by the COVID shock, although the extent to which this shock introduced error in the model parameters is not clear. For this demonstration at least, I will not modify the data to deal with the shock. Ostensibly, a significant amount of series still display autoregressive dynamics at mean(abs(rho)) = 0.3, with autoregressive parameters \(\rho\) ranging from -0.6 to 0.41. As further described in the theoretical vignette, the model with autoregressive errors not only estimates these \(\rho\) parameters for each series—saved in dfm$rho—but also the error series \(e_t\) itself—saved in dfm$e—which are modeled as part of the state vector along with the factors. This implies that for these models one can make predictions using either the full state including the modeled residual values or using just the factors. The difference, in this case, is vast, with modeled residuals giving a much better fit to the data.

# Computing residual absolute ratio in percentage terms
rarp <- fmedian(abs(resid(dfm))) / fmedian(abs(resid(dfm, use.full.state = FALSE))) * 100
descr(rarp)
## Dataset: rarp, 1 Variables, N = 57
## ------------------------------------------------------------------------------------------------------------------------------------------------------
## rarp (numeric): 
## Statistics
##    N  Ndist  Mean    SD   Min  Max  Skew  Kurt
##   57     57  0.04  0.06  0.01  0.3  2.41  8.89
## Quantiles
##     1%    5%   10%   25%   50%   75%   90%   95%   99%
##   0.01  0.01  0.01  0.01  0.02  0.05  0.13  0.16  0.27
## ------------------------------------------------------------------------------------------------------------------------------------------------------

While using the full state (the new default) changes the interpretation of in-sample residuals and fitted values, it generally slightly improves the accuracy of dynamic predictions obtainable with predict().

plot(predict(dfm), xlim = c(400, 428), ylim = c(-2, 2))

Now, the main addition in dfms 1.0, as mentioned, is the news decomposition via news(). For this we first need to load the latest vintage and set it to the same range.

download.file("https://github.com/coderaanalytics-models/SA-Nowcast/raw/refs/heads/main/vintages/econdata_nowcast_data_03_12_2024.xlsx",
              destfile = "econdata_nowcast_data_03_12_2024.xlsx", mode = "wb")
data_m_dec <- read_xlsx("econdata_nowcast_data_03_12_2024.xlsx", sheet = "data_logdiff_m") |>
  qDT() |> as.xts()
data_q_dec <- read_xlsx("econdata_nowcast_data_03_12_2024.xlsx", sheet = "data_logdiff_q") |>
  qDT() |> fmutate(date = as.Date(date)) |> within(lubridate::month(date) <- lubridate::month(date) + 2L) |> as.xts()
data_dec <- merge(data_m_dec, data_q_dec)["1990-02/2024-10"]

We could then either estimate a second DFM using this vintage and pass both model objects to news(), or simply pass the new vintage dataset to news() and it will internally estimate a second DFM of the exact same specification. The function supports one or multiple targets and, by default, chooses the last period in the dataset as the nowcasting target period.

news_res <- news(dfm, data_dec, target.vars = colnames(data_q))
## Converged after 26 iterations.
print(news_res)      # Multiple targets -> dfm_news_list object
## DFM News (Multiple Targets)
## Target time: 417 
## Targets: 3 
## Standardized: FALSE 
##         y_old   y_new revision
## UNEMP -0.4463 -3.2878  -2.8415
## GDP    1.5853  2.0275   0.4421
## RGDP   0.0134  0.4465   0.4332
print(news_res$RGDP) # Single target -> dfm_news object
## DFM News
## Target variable: RGDP 
## Target time: 417 
## Old forecast: 0.0134 
## New forecast: 0.4465 
## Revision: 0.4332 
## Standardized: FALSE
# Target period: 
index(data)[417]
## [1] "2024-10-01 UTC"
# Basically this is our prediction of RGDP if it were measured 
# across August-October 2024. To do a proper Q4 nowcast 
# we would need to extend the dataset by two months. 

Apart from the forecast revision, the object includes, for each target, a dataframe giving the news for each variable with revisions and its impact on the target forecast revision.

series <- read_xlsx("econdata_nowcast_data_03_12_2024.xlsx", sheet = "series")
news_rgdp <- news_res$RGDP$news_df |> na_omit() |> 
  join(slt(series, series, label, broad_sector, topic)) |>
  colorder(series, label, broad_sector, topic)
## left join: x[series] 40/40 (100%) <1:1st> y[series] 40/57 (70.2%)

news_rgdp |> tfmv(is.numeric, round, 4) |> 
  fselect(label, topic, actual, forecast, news, gain, impact)
##                                             label            topic   actual forecast     news    gain  impact
## 1                                 Consumer Prices           Prices  -0.0247   0.4317  -0.4564  0.0026 -0.0012
## 2                        Final manufactured goods           Prices  -0.6941   0.1364  -0.8305  0.0349 -0.0290
## 3                     Coal and petroleum products           Prices  -4.0912  -1.3569  -2.7344  0.0072 -0.0198
## 4                                          Petrol           Prices  -6.0095  -1.3109  -4.6985  0.0053 -0.0247
## 5                                  Motor vehicles           Prices  -0.4008   0.4983  -0.8991  0.0001 -0.0001
## 6                                     Grand Total          Tourism   0.7678   1.7822  -1.0144  0.0001 -0.0001
## 7                                     Grand Total          Tourism   3.6389  -2.6752   6.3140  0.0040  0.0254
## 8                            Overnight (tourists)          Tourism   2.0994  -9.3852  11.4846  0.0025  0.0287
## 9                            Overnight (tourists)          Tourism   0.9646  -5.9568   6.9213  0.0001  0.0008
## 10                  Total income - Total industry          Tourism  -0.0664  -7.1929   7.1265  0.0036  0.0254
## 11        Stay units nights sold - Total industry          Tourism  -0.9814  -6.2616   5.2802  0.0039  0.0208
## 12                Occupancy rate - Total industry          Tourism  -0.2642  -6.3626   6.0984  0.0040  0.0243
## 13                              Leading indicator       Other Real   0.9353  -0.3900   1.3253  0.0099  0.0131
## 14                                 Total: Payload       Other Real   1.4904  -0.0783   1.5687  0.0046  0.0072
## 15       Total: Income for freight transportation       Other Real  -1.2610  -0.4410  -0.8199  0.0060 -0.0049
## 16                             Passenger journeys       Other Real  -6.9646  -2.6520  -4.3126  0.0028 -0.0121
## 17            Income for passenger transportation       Other Real -10.1055  -2.3960  -7.7095  0.0053 -0.0410
## 18                                             M0 Money and Credit  -0.3816  -0.2107  -0.1709  0.0121 -0.0021
## 19                   Total monetary (M3) deposits Money and Credit   0.3206   0.8764  -0.5558 -0.0281  0.0156
## 20          Claims on the domestic private sector Money and Credit  -0.7167   0.8042  -1.5208 -0.0169  0.0257
## 21 Domestic claims on the government sector (nsa) Money and Credit  -4.2307  -0.0585  -4.1722 -0.0020  0.0082
## 22   External position - net foreign assets (nsa)   Other Fiancial   0.6238   2.7275  -2.1037 -0.0001  0.0002
## 23                                          Total   Other Fiancial  65.1872   2.0438  63.1434  0.0047  0.2972
## 24                                  Total exports            Trade   2.5785  -0.7230   3.3015  0.0338  0.1117
## 25                                  Total imports            Trade  -3.7547   0.8862  -4.6409  0.0046 -0.0211
## 26                        Official Reserve Assets         Reserves  -0.9553   0.8221  -1.7774 -0.0003  0.0005
## 27                      Foreign currency reserves         Reserves  -2.2546   0.5593  -2.8139  0.0001 -0.0004
## 28                              Cash-flow revenue        Cash Flow  -3.3586  -0.5585  -2.8000  0.0082 -0.0231
## 29                          Cash-flow expenditure        Cash Flow  -2.4694   1.2563  -3.7258 -0.0005  0.0020
## 30        Cash-flow balance (deficit -/surplus +)        Cash Flow  -0.4770 -15.9455  15.4685  0.0004  0.0065
## 31                      Domestic government bonds        Financing   0.5948   0.0164   0.5784  0.0001  0.0000
## 32                        Foreign bonds and loans        Financing -64.4709   0.0312 -64.5021 -0.0001  0.0090
## 33            Treasury bills and short-term loans        Financing  -1.6063  12.1153 -13.7216 -0.0003  0.0047
## 34                        Change in cash balances        Financing   6.3097  -7.1304  13.4401  0.0012  0.0166
## 35                            Total net financing        Financing   0.0669   5.2526  -5.1856  0.0000 -0.0001
## 36                          Total gross loan debt             Debt   0.6452   0.9158  -0.2706  0.0142 -0.0038
## 37                            Domestic Marketable             Debt   0.7577   0.9854  -0.2278  0.0131 -0.0030
## 38                                   Foreign Debt             Debt   0.5219   1.4193  -0.8974  0.0005 -0.0004
## 39                        Domestic non-marketable             Debt  -4.3718  -1.8796  -2.4922 -0.0001  0.0002
## 40                              Unemployment rate       Other Real  -4.2689  -0.0486  -4.2204  0.0024 -0.0101

The impact on the target (real GDP in this case) is the news (actual - forecast) times the gain (series weight). These impacts sum to (or their sum closely approximates), the difference between the nowcasts. Naturally, they can also be summed across sectors or other groups of series to provide a more interpretable nowcast news decomposition.

with(news_res$RGDP, (y_new - y_old) / sum(news_df$impact))
##      RGDP 
## 0.9696488

news_rgdp |> 
  collap(impact ~ broad_sector + topic, fsum) |>
  fmutate(impact = round(impact, 3)) |>
  fsubset(order(-abs(impact)))
##    broad_sector            topic impact
## 1     Financial   Other Fiancial  0.297
## 2          Real          Tourism  0.125
## 3      External            Trade  0.091
## 4          Real           Prices -0.075
## 5          Real       Other Real -0.048
## 6     Financial Money and Credit  0.047
## 7        Fiscal        Financing  0.030
## 8        Fiscal        Cash Flow -0.015
## 9        Fiscal             Debt -0.007
## 10     External         Reserves  0.000

As mentioned, this dataset likely needs further processing to do something about the stark shocks before nowcasting using dfms—issues that more current methodologies attempt to address in more sophisticated ways. Nevertheless, the package now provides a full, efficient, and user-friendly implementation of the Banbura and Modugno (2014) methodology in R—which remains the baseline as far as linear Gaussian factor and nowcasting models are concerned. I thus hope that it will be useful to researchers and practitioners interested in DFMs and nowcasting.

References

Doz, C., Giannone, D., & Reichlin, L. (2011). A two-step estimator for large approximate dynamic factor models based on Kalman filtering. Journal of Econometrics, 164(1), 188-205.

Doz, C., Giannone, D., & Reichlin, L. (2012). A quasi-maximum likelihood approach for large, approximate dynamic factor models. Review of Economics and Statistics, 94(4), 1014-1024.

Banbura, M., & Modugno, M. (2014). Maximum likelihood estimation of factor models on datasets with arbitrary pattern of missing data. Journal of Applied Econometrics, 29(1), 133-160.

Mariano, R. S., & Murasawa, Y. (2003). A new coincident index of business cycles based on monthly and quarterly series. Journal of Applied Econometrics, 18(4), 427-443.

Bai, J., Ng, S. (2002). Determining the Number of Factors in Approximate Factor Models. Econometrica, 70(1), 191-221.

Onatski, A. (2010). Determining the number of factors from empirical distribution of eigenvalues. The Review of Economics and Statistics, 92(4), 1004-1016.

Stock, J. H., & Watson, M. W. (2016). Dynamic Factor Models, Factor-Augmented Vector Autoregressions, and Structural Vector Autoregressions in Macroeconomics. Handbook of Macroeconomics, 2, 415–525.

Example

The code for this example is in example04.jl. See the examples folder for more examples.

This plot shows the endowments on a map-graph: circle size is population, circle colour is productivity (the central node is more productive), the black lines indicate geographic barriers, and the background is shaded according to the cost of network building (elevation), indicating a mountain in the upper right corner.

The following plot shows the optimal network after 200 iterations, keeping population fixed. The size of nodes indicates consumption in each node. The blue lines are the proposed roads and their thickness indicates their capacity.²

You may wonder why are there multiple roads to certain cities? The reason is decreasing returns to infrastructure (\(\beta \leq \gamma\), where \(\beta\) governs the strength of congestion forces and \(\gamma\) the returns to infrastructure). This guarantees the global convexity of the nested optimization problem. In this example \(\beta = \gamma = 1\).

However, we can assume increasing returns to infrastructure, e.g., by setting \(\gamma = 2\). In this case the nested optimization problem is not globally convex, and the software automatically calls a Simulated Annealing algorithm to approximate the global solution following convex optimization. The result:

In reality, which assumption is reasonable depends on the setting. Inside cities, estimates of the empirical relationship between speed, roads, and vehicles by Couture, Duranton, and Turner (2018) using U.S. data imply the DRS/convex case, i.e., congestion forces are strong and it is better to ‘build several smaller roads than a few huge roads’. Outside of cities there is (to my knowledge) not much evidence on this matter.

Customization and Research Use

While the examples are nice and illustrative, the library permits users to provide custom graphs which must not be dense/fully connected.

My own recent research on Optimal Investments in Africa’s Road Network, considers, amongst other scenarios, optimal $10 billion (2015 USD) upgrades to the trans-African transport network using a sparse graph derived from fastest Open Street Map routes between 47 large (port-)cities - see the simulation code, the following figures are taken from the slides.

I find that optimal upgrades depend not so much on the returns to infrastructure (as the network is fixed/sparse), but rather on heterogeneous road construction costs, the elasticity of substitution between different city-goods (\(\sigma\) - a trade elasticity) and whether social planners are inequality averse (\(\rho = 2\) instead of \(0\)).

I have forked available replication materials for papers using this framework on the OptimalTransportNetworks organization. Further works I am aware of include:

Graff, T. (2024). Spatial inefficiencies in Africa’s trade network. Journal of Development Economics, 103319. Available at https://tilmangraff.github.io/

Gorton, Nicole and Ianchovichina, Elena, Trade Networks in Latin America: Spatial Inefficiencies and Optimal Expansions. Available at SSRN: https://ssrn.com/abstract=4041108 or http://dx.doi.org/10.2139/ssrn.4041108

Kreindler, G., Gaduh, A., Graff, T., Hanna, R., & Olken, B. A. (2023). Optimal Public Transportation Networks: Evidence from the World’s Largest Bus Rapid Transit System in Jakarta (No. w31369). National Bureau of Economic Research. Available at https://www.nber.org/papers/w31369

Going Forward

Community efforts to further improve the code are very welcome. I started the GitHub organization OptimalTransportNetworks to maintain both the Julia and MATLAB libraries, but also to gather/start similar contributions, including replication materials of relevant research papers.

The overall aim of the organization is to develop powerful open tools to solve (large-scale) transport infrastructure allocation problems from an economics/welfare perspective. Global infrastructure investment needs are estimated at 3.5% of global GDP - around 100 trillion USD by 2040 according to the Global Infrastructure Outlook - and transport investments are a good part of that - e.g. the African Development Bank estimates that 73% of Africa’s estimated ~$400B annual financing gap until 2030 is in transportation. Thus it is high time to start thinking about economic/welfare maximizing planning and develop relevant open tools. If you’re interested in contributing/maintaining or have new ideas/research/approaches, don’t hesitate to reach out - happy to welcome smart minds to the organization.

Fast, Class-Agnostic, and Verbose Table Joins

Joins in collapse has been a much-requested feature. Still, I was long hesitant to take them on because they are complex, high-risk, operations, and I was unsure on how to go about them or provide an implementation that would satisfy my own ambitious demands to their performance, generality and verbosity.

I am glad that, following repeated requests, I have overcome these hesitations and designed an implementation - inspired by polars - that I am very satisfied with. collapse’s join function is simply called join(), and provides 6 types of joins (left, inner, full, right, semi and anti), controlled by a how argument - the default being a left join. It also provides two separate join algorithms: a vectorized hash join (the default, sort = FALSE) and a sort-merge-join (sort = TRUE). The join-column argument is called on, and, if left empty, selects columns present in both datasets. An example with generated data follows:

library(collapse)
df1 <- data.frame(
  id1 = c(1, 1, 2, 3),
  id2 = c("a", "b", "b", "c"),
  name = c("John", "Jane", "Bob", "Carl"),
  age = c(35, 28, 42, 50)
)
df2 <- data.frame(
  id1 = c(1, 2, 3, 3),
  id2 = c("a", "b", "c", "e"),
  salary = c(60000, 55000, 70000, 80000),
  dept = c("IT", "Marketing", "Sales", "IT")
)

# Different types of joins
for (i in c("left","inner","right","full","semi","anti"))
    join(df1, df2, how = i) |> print()
## left join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age salary      dept
## 1   1   a John  35  60000        IT
## 2   1   b Jane  28     NA      <NA>
## 3   2   b  Bob  42  55000 Marketing
## 4   3   c Carl  50  70000     Sales
## inner join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age salary      dept
## 1   1   a John  35  60000        IT
## 2   2   b  Bob  42  55000 Marketing
## 3   3   c Carl  50  70000     Sales
## right join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age salary      dept
## 1   1   a John  35  60000        IT
## 2   2   b  Bob  42  55000 Marketing
## 3   3   c Carl  50  70000     Sales
## 4   3   e <NA>  NA  80000        IT
## full join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age salary      dept
## 1   1   a John  35  60000        IT
## 2   1   b Jane  28     NA      <NA>
## 3   2   b  Bob  42  55000 Marketing
## 4   3   c Carl  50  70000     Sales
## 5   3   e <NA>  NA  80000        IT
## semi join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age
## 1   1   a John  35
## 2   2   b  Bob  42
## 3   3   c Carl  50
## anti join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age
## 1   1   b Jane  28

Notice how, by default (verbose = 1), a compact summary of the operation is printed, indicating the type of join, the datasets and columns, and the number and percentage of records from each dataset matched in the join operation. join() also preserves the attributes of the first argument (x) and the order of columns and rows (default keep.col.order = TRUE, sort = FALSE) in it. We can thus think of a join operation as adding columns to a data frame-like object (x) from another similar object (y) .

There are several additional options to increase verbosity and assimilate the join operation:

# verbose = 2 also shows classes, allowing you to detect implicit conversions (inside fmatch())
join(df1, df2, how = "left", verbose = 2)
## left join: df1[id1:numeric, id2:character] 3/4 (75%) <m:m> df2[id1:numeric, id2:character] 3/4 (75%)
##   id1 id2 name age salary      dept
## 1   1   a John  35  60000        IT
## 2   1   b Jane  28     NA      <NA>
## 3   2   b  Bob  42  55000 Marketing
## 4   3   c Carl  50  70000     Sales

# Adding join column: useful especially for full join
join(df1, df2, how = "full", column = TRUE)
## full join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 name age salary      dept   .join
## 1   1   a John  35  60000        IT matched
## 2   1   b Jane  28     NA      <NA>     df1
## 3   2   b  Bob  42  55000 Marketing matched
## 4   3   c Carl  50  70000     Sales matched
## 5   3   e <NA>  NA  80000        IT     df2

# Custom column + rearranging
join(df1, df2, how = "full", column = list("join", c("x", "y", "x_y")), 
     keep.col.order = FALSE)
## full join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
##   id1 id2 join name age salary      dept
## 1   1   a  x_y John  35  60000        IT
## 2   1   b    x Jane  28     NA      <NA>
## 3   2   b  x_y  Bob  42  55000 Marketing
## 4   3   c  x_y Carl  50  70000     Sales
## 5   3   e    y <NA>  NA  80000        IT

# Attaching match attribute
str(join(df1, df2, attr = TRUE))
## left join: df1[id1, id2] 3/4 (75%) <m:m> df2[id1, id2] 3/4 (75%)
## 'data.frame':	4 obs. of  6 variables:
##  $ id1   : num  1 1 2 3
##  $ id2   : chr  "a" "b" "b" "c"
##  $ name  : chr  "John" "Jane" "Bob" "Carl"
##  $ age   : num  35 28 42 50
##  $ salary: num  60000 NA 55000 70000
##  $ dept  : chr  "IT" NA "Marketing" "Sales"
##  - attr(*, "join.match")=List of 3
##   ..$ call   : language join(x = df1, y = df2, attr = TRUE)
##   ..$ on.cols:List of 2
##   .. ..$ x: chr [1:2] "id1" "id2"
##   .. ..$ y: chr [1:2] "id1" "id2"
##   ..$ match  : 'qG' int [1:4] 1 NA 2 3
##   .. ..- attr(*, "N.nomatch")= int 1
##   .. ..- attr(*, "N.groups")= int 4
##   .. ..- attr(*, "N.distinct")= int 3

Finally, it is possible to validate the join operation to be either one of "m:m" (default, no checks), "1:m", "m:1" or "1:1". For example:

join(df1, rowbind(df2, df2), validate = "1:1")
## Error in join(df1, rowbind(df2, df2), validate = "1:1"): Join is not 1:1: df1 (x) is unique on the join columns; rowbind (y) is not unique on the join columns

Another check being automatically executed inside the workhorse function fmatch() (if sort = FALSE) is for overidentified join conditions, i.e., if the records are more than identified by the join columns. For example if we added "name" and "dept" to the join condition, this would issue a warning as the match is already identified by "id1" and "id2":

join(df1, df2, on = c("id1", "id2", "name" = "dept"), how = "left")
## Warning in fmatch(x[ixon], y[iyon], nomatch = NA_integer_, count = count, : Overidentified match/join: the first 2 of 3 columns uniquely match the records. With overid > 0, fmatch() continues to
## match columns. Consider removing columns or setting overid = 0 to terminate the algorithm after 2 columns (the results may differ, see ?fmatch). Alternatively set overid = 2 to silence this warning.
## left join: df1[id1, id2, name] 0/4 (0%) <m:m> df2[id1, id2, dept] 0/4 (0%)
##   id1 id2 name age salary
## 1   1   a John  35     NA
## 2   1   b Jane  28     NA
## 3   2   b  Bob  42     NA
## 4   3   c Carl  50     NA

The warning can be silenced by passing overid = 2 to join(). To see better where this may be useful, consider the following example using fmatch().

df1 <- data.frame(
  id1 = c(1, 1, 2, 3),
  id2 = c("a", "b", "b", "c"),
  name = c("John", "Bob", "Jane", "Carl")
)
df2 <- data.frame(
  id1 = c(1, 2, 3, 3),
  id2 = c("a", "b", "c", "e"),
  name = c("John", "Janne", "Carl", "Lynne")
)

# This gives an overidentification warning: columns 1:2 identify the data
fmatch(df1, df2)
## Warning in fmatch(df1, df2): Overidentified match/join: the first 2 of 3 columns uniquely match the records. With overid > 0, fmatch() continues to match columns. Consider removing columns or setting
## overid = 0 to terminate the algorithm after 2 columns (the results may differ, see ?fmatch). Alternatively set overid = 2 to silence this warning.
## [1]  1 NA NA  3
# This just runs through without warning
fmatch(df1, df2, overid = 2)
## [1]  1 NA NA  3
# This terminates computation after first 2 columns
fmatch(df1, df2, overid = 0)
## [1]  1 NA  2  3
fmatch(df1[1:2], df2[1:2])  # Same thing!
## [1]  1 NA  2  3
# -> note that here we get an additional match based on the unique ids,
# which we didn't get before because "Jane" != "Janne"

So, in summary, the implementation of joins on collapse as provided by the join() function is not only blazing fast¹ and class-agnostic but also allows you to verify all aspects of this high-risk operation.

Advanced Pivots

The second big addition in collapse 2.0 is pivot(), which provides advanced data reshaping capabilities in a single parsimonious API. Notably, it supports longer-, wider-, and recast-pivoting functionality and can accommodate variable labels in the reshaping process.

Fortunately, collapse supplies a perfect test dataset to illustrate these capabilities: the 2014 Groningen Growth and Development Centre 10-Sector Database, which provides sectoral employment and value-added series for 10 broad sectors in 43 countries:

head(GGDC10S)
##   Country Regioncode             Region Variable Year      AGR      MIN       MAN        PU       CON      WRT      TRA     FIRE      GOV      OTH      SUM
## 1     BWA        SSA Sub-saharan Africa       VA 1960       NA       NA        NA        NA        NA       NA       NA       NA       NA       NA       NA
## 2     BWA        SSA Sub-saharan Africa       VA 1961       NA       NA        NA        NA        NA       NA       NA       NA       NA       NA       NA
## 3     BWA        SSA Sub-saharan Africa       VA 1962       NA       NA        NA        NA        NA       NA       NA       NA       NA       NA       NA
## 4     BWA        SSA Sub-saharan Africa       VA 1963       NA       NA        NA        NA        NA       NA       NA       NA       NA       NA       NA
## 5     BWA        SSA Sub-saharan Africa       VA 1964 16.30154 3.494075 0.7365696 0.1043936 0.6600454 6.243732 1.658928 1.119194 4.822485 2.341328 37.48229
## 6     BWA        SSA Sub-saharan Africa       VA 1965 15.72700 2.495768 1.0181992 0.1350976 1.3462312 7.064825 1.939007 1.246789 5.695848 2.678338 39.34710

namlab(GGDC10S, N = TRUE, Ndistinct = TRUE)
##      Variable    N Ndist                                                 Label
## 1     Country 5027    43                                               Country
## 2  Regioncode 5027     6                                           Region code
## 3      Region 5027     6                                                Region
## 4    Variable 5027     2                                              Variable
## 5        Year 5027    67                                                  Year
## 6         AGR 4364  4353                                          Agriculture 
## 7         MIN 4355  4224                                                Mining
## 8         MAN 4355  4353                                         Manufacturing
## 9          PU 4354  4237                                             Utilities
## 10        CON 4355  4339                                          Construction
## 11        WRT 4355  4344                         Trade, restaurants and hotels
## 12        TRA 4355  4334                  Transport, storage and communication
## 13       FIRE 4355  4349 Finance, insurance, real estate and business services
## 14        GOV 3482  3470                                   Government services
## 15        OTH 4248  4238               Community, social and personal services
## 16        SUM 4364  4364                               Summation of sector GDP

Evidently, the data is supplied in a format where two variables, employment and value-added, are stacked in each sector column. The data is also labeled, with descriptions attached as "label" attributes (retrievable using vlabels() or, together with names, using namlab()).

There are 3 different ways to reshape this data to make it easier to analyze. The first is to simply melt it into a long frame, e.g. for plotting with ggplot2:

# Pivot Longer
pivot(GGDC10S, ids = 1:5, 
      names = list(variable = "Sectorcode", value = "Value"), 
      labels = "Sector", how = "longer", na.rm = TRUE) |> head()
##   Country Regioncode             Region Variable Year Sectorcode       Sector    Value
## 1     BWA        SSA Sub-saharan Africa       VA 1964        AGR Agriculture  16.30154
## 2     BWA        SSA Sub-saharan Africa       VA 1965        AGR Agriculture  15.72700
## 3     BWA        SSA Sub-saharan Africa       VA 1966        AGR Agriculture  17.68066
## 4     BWA        SSA Sub-saharan Africa       VA 1967        AGR Agriculture  19.14591
## 5     BWA        SSA Sub-saharan Africa       VA 1968        AGR Agriculture  21.09957
## 6     BWA        SSA Sub-saharan Africa       VA 1969        AGR Agriculture  21.86221

Note how specifying the labels argument created a column that captures the sector descriptions, which would otherwise be lost in the reshaping process, and na.rm = TRUE removed missing values in the long frame. I note without demonstration that this operation has an exact reverse operation: pivot(long_df, 1:5, "Value", "Sector", "Description", how = "wider").

The second way to reshape the data is to create a wider frame with sector-variable columns:

# Pivot Wider
pivot(GGDC10S, ids = 1:5, names = "Variable", how = "wider", na.rm = TRUE) |> 
  namlab(N = TRUE, Ndistinct = TRUE)
##      Variable    N Ndist                                                 Label
## 1     Country 3376    36                                               Country
## 2  Regioncode 3376     6                                           Region code
## 3      Region 3376     6                                                Region
## 4    Variable 3376     2                                              Variable
## 5        Year 3376    67                                                  Year
## 6      AGR_VA 1702  1700                                          Agriculture 
## 7     AGR_EMP 1674  1669                                          Agriculture 
## 8      MIN_VA 1702  1641                                                Mining
## 9     MIN_EMP 1674  1622                                                Mining
## 10     MAN_VA 1702  1702                                         Manufacturing
## 11    MAN_EMP 1674  1672                                         Manufacturing
## 12      PU_VA 1702  1665                                             Utilities
## 13     PU_EMP 1674  1615                                             Utilities
## 14     CON_VA 1702  1693                                          Construction
## 15    CON_EMP 1674  1668                                          Construction
## 16     WRT_VA 1702  1695                         Trade, restaurants and hotels
## 17    WRT_EMP 1674  1670                         Trade, restaurants and hotels
## 18     TRA_VA 1702  1694                  Transport, storage and communication
## 19    TRA_EMP 1674  1662                  Transport, storage and communication
## 20    FIRE_VA 1702  1696 Finance, insurance, real estate and business services
## 21   FIRE_EMP 1674  1674 Finance, insurance, real estate and business services
## 22     GOV_VA 1702  1698                                   Government services
## 23    GOV_EMP 1674  1666                                   Government services
## 24     OTH_VA 1702  1695               Community, social and personal services
## 25    OTH_EMP 1674  1671               Community, social and personal services
## 26     SUM_VA 1702  1702                               Summation of sector GDP
## 27    SUM_EMP 1674  1674                               Summation of sector GDP

Note how the variable labels were copied to each of the two variables created for each sector. It is also possible to pass argument transpose = c("columns", "names") to change the order of columns and/or naming of the casted columns. Wide pivots where multiple columns are cast do not have a well-defined reverse operation. It may nevertheless be very useful to analyze individual sectors.

The third useful way to reshape this data for analysis is to recast it such that each variable goes into a separate column and the sectors are stacked in one column:

# Pivot Recast
recast_df = pivot(GGDC10S, values = 6:16, 
      names = list(from = "Variable", to = "Sectorcode"),
      labels = list(to = "Sector"), how = "recast", na.rm = TRUE)
head(recast_df)
##   Country Regioncode             Region Year Sectorcode       Sector       VA      EMP
## 1     BWA        SSA Sub-saharan Africa 1964        AGR Agriculture  16.30154 152.1179
## 2     BWA        SSA Sub-saharan Africa 1965        AGR Agriculture  15.72700 153.2971
## 3     BWA        SSA Sub-saharan Africa 1966        AGR Agriculture  17.68066 153.8867
## 4     BWA        SSA Sub-saharan Africa 1967        AGR Agriculture  19.14591 155.0659
## 5     BWA        SSA Sub-saharan Africa 1968        AGR Agriculture  21.09957 156.2451
## 6     BWA        SSA Sub-saharan Africa 1969        AGR Agriculture  21.86221 157.4243

This is useful, for example, if we wanted to run a regression with sector-fixed effects. The code to reverse this pivot is

# Reverse Pivot Recast 
pivot(recast_df, values = c("VA", "EMP"), 
      names = list(from = "Sectorcode", to = "Variable"),
      labels = list(from = "Sector"), how = "recast") |> head(3)
##   Country Regioncode             Region Year Variable      AGR      MIN       MAN        PU       CON      WRT      TRA     FIRE      GOV      OTH      SUM
## 1     BWA        SSA Sub-saharan Africa 1964       VA 16.30154 3.494075 0.7365696 0.1043936 0.6600454 6.243732 1.658928 1.119194 4.822485 2.341328 37.48229
## 2     BWA        SSA Sub-saharan Africa 1965       VA 15.72700 2.495768 1.0181992 0.1350976 1.3462312 7.064825 1.939007 1.246789 5.695848 2.678338 39.34710
## 3     BWA        SSA Sub-saharan Africa 1966       VA 17.68066 1.970343 0.8038415 0.2026464 1.3462312 8.271015 2.154452 1.358193 6.365948 2.993436 43.14677

This showcased just some of the functionality of pivot(), more extensive examples are available in the documentation (?pivot). But the above is enough to demonstrate this unified API’s power and flexibility; it is also blazing fast.

Global Configurability and Interactive Namespace Masking

The third major feature of collapse 2.0 is its extensive global configurability via the set_collapse() function, which includes the default behavior for missing values (na.rm arguments in all statistical functions and algorithms), sorted grouping (sort), multithreading and algorithmic optimizations (nthreads, stable.algo), presentational settings (stub, digits, verbose), and, surpassing all else, the package namespace itself (mask, remove).

Why should the namespace, in particular, be modifiable? The main reason is that collapse provides many enhanced and performance improved equivalents to functions present in base R and dplyr, such as the Fast Statistical Functions, fast Grouping and Ordering functions and algorithms, Data Manipulation and Time Series functions.

collapse is intentionally fully compatible with the base R and dplyr namespaces by adding f-prefixes to these performance-improved functions where conflicts exist. Since v1.7.0, there exists a global option "collapse_mask" which can be set before the package is loaded to export non-prefixed versions of these functions, but this was somewhat tedious and best done with an .Rprofile file. collapse 2.0 also adds this option to set_collapse() and makes it fully interactive; that is, it can be set and changed at any point within the active session.

Concretely, what does this mean? Base R and dplyr are relatively slow compared to what can be achieved with group-level vectorization, SIMD instructions, and efficient algorithms, especially as data grows. To provide an example, I generate some large vectors and run some benchmarks for basic operations:

ul <- outer(letters, letters, paste0)
l <- sample(ul, 1e7, replace = TRUE)
m <- sample(outer(month.abb, month.abb, paste0), 1e7, replace = TRUE)
x <- na_insert(rnorm(1e7), prop = 0.05)
data <- data.frame(l, m, x)

library(microbenchmark)
microbenchmark(
  unique(l),
  table(l, m),
  sum(x, na.rm = TRUE),
  median(x, na.rm = TRUE),
  mean(x, na.rm = TRUE),
times = 10)
## Warning in microbenchmark(unique(l), table(l, m), sum(x, na.rm = TRUE), : less accurate nanosecond times to avoid potential integer overflows
## Unit: milliseconds
##                     expr       min        lq      mean    median        uq       max neval
##                unique(l)  82.07856  85.14671  91.08940  86.02663  87.65242 124.87604    10
##              table(l, m) 506.91215 546.24042 554.55146 549.27130 565.78729 640.67941    10
##     sum(x, na.rm = TRUE)  15.39316  15.40485  15.58453  15.45362  15.54109  16.57486    10
##  median(x, na.rm = TRUE) 155.55667 157.19572 164.38405 160.75044 165.29642 196.26446    10
##    mean(x, na.rm = TRUE)  53.79520  54.12406  60.39059  55.94202  57.72792  97.40887    10

library(dplyr)
microbenchmark(
  dplyr = data |>
    subset(l %in% ul[1:500]) |>
    group_by(l, m) |>
    summarize(mean_x = mean(x, na.rm = TRUE), 
              median_x = median(x, na.rm = TRUE)), 
times = 10)
## Unit: seconds
##   expr      min       lq     mean   median       uq      max neval
##  dplyr 2.159383 2.193034 2.230608 2.226005 2.250952 2.370895    10

The beauty of namespace masking is that we can turn parts or all of this code into collapse code by simply invoking the mask option to set_collapse(). The most comprehensive setting is mask = "all". It is a secure option because invoking it instantly exports these functions in the collapse namespace and re-attaches the namespace to make sure it is at the top of the search path:

set_collapse(mask = "all")
# This is all collapse code now + no need to set na.rm = TRUE (default in collapse)
# We could use set_collapse(na.rm = FALSE) to bring collapse in-line with base R
microbenchmark(
  unique(l),
  table(l, m),
  sum(x),
  median(x),
  mean(x),
times = 10)
## Unit: milliseconds
##         expr       min        lq       mean     median         uq        max neval
##    unique(l) 14.215561 15.289105  15.516647  15.564871  15.786722  16.411152    10
##  table(l, m) 94.875968 97.539410 107.189014 108.895508 115.038948 118.004806    10
##       sum(x)  1.968984  1.998955   2.053936   2.037946   2.128843   2.152500    10
##    median(x) 90.736772 91.784609  93.486921  92.288725  94.812787  99.236277    10
##      mean(x)  2.384314  2.389931   2.454666   2.419861   2.456023   2.680621    10

microbenchmark(
  collapse = data |>
    subset(l %in% ul[1:500]) |>
    group_by(l, m) |>
    summarize(mean_x = mean(x), 
              median_x = median(x)), 
times = 10)
## Unit: milliseconds
##      expr      min       lq     mean   median       uq      max neval
##  collapse 344.2272 351.6525 363.8762 358.4373 373.9692 402.6943    10

# Reset the masking 
# set_collapse(mask = NULL)

Evidently, the collapse code runs much faster. The 5-10x speedups shown here are quite normal. Higher speedups can be experienced for grouped operations as the number of groups grows large and repetition in R becomes very costly. As indicated before, masking in collapse 2.0 is fully interactive and reversible: invoking set_collapse(mask = NULL) and running the same code again will execute it again with base R and dplyr.

So, in summary, collapse 2.0 provides fast R, in R, in a very simple and broadly accessible way. There are many other advantages to using collapse, e.g., given that its Fast Statistical Functions are S3 generic and support grouped and weighted aggregations and transformations out of the box, this saves many unnecessary calls to apply(), lapply() or summarise(), etc. (in addition to many unnecessary specifications of na.rm = TRUE) e.g.:

# S3 generic statistical functions save a lot of syntax
mean(mtcars)                 # = sapply(mtcars, mean)
##        mpg        cyl       disp         hp       drat         wt       qsec         vs         am       gear       carb 
##  20.090625   6.187500 230.721875 146.687500   3.596563   3.217250  17.848750   0.437500   0.406250   3.687500   2.812500
mean(mtcars, w = runif(32))  # = sapply(mtcars, weighted.mean, w = runif(32))
##         mpg         cyl        disp          hp        drat          wt        qsec          vs          am        gear        carb 
##  20.9009889   5.9682791 221.9436951 137.7951392   3.6740174   3.1670541  18.0195300   0.4878638   0.4240404   3.7486737   2.6293563
mean(mtcars$mpg, mtcars$cyl) # = tapply(mtcars$mpg, mtcars$cyl, mean)
##        4        6        8 
## 26.66364 19.74286 15.10000
mean(mtcars, TRA = "-") |>   # = sweep(mtcars, 2, sapply(mtcars, mean))
  head()
##                         mpg     cyl        disp       hp       drat       wt     qsec      vs       am    gear    carb
## Mazda RX4          0.909375 -0.1875  -70.721875 -36.6875  0.3034375 -0.59725 -1.38875 -0.4375  0.59375  0.3125  1.1875
## Mazda RX4 Wag      0.909375 -0.1875  -70.721875 -36.6875  0.3034375 -0.34225 -0.82875 -0.4375  0.59375  0.3125  1.1875
## Datsun 710         2.709375 -2.1875 -122.721875 -53.6875  0.2534375 -0.89725  0.76125  0.5625  0.59375  0.3125 -1.8125
## Hornet 4 Drive     1.309375 -0.1875   27.278125 -36.6875 -0.5165625 -0.00225  1.59125  0.5625 -0.40625 -0.6875 -1.8125
## Hornet Sportabout -1.390625  1.8125  129.278125  28.3125 -0.4465625  0.22275 -0.82875 -0.4375 -0.40625 -0.6875 -0.8125
## Valiant           -1.990625 -0.1875   -5.721875 -41.6875 -0.8365625  0.24275  2.37125  0.5625 -0.40625 -0.6875 -1.8125
mtcars |> group_by(cyl, vs, am) |> 
  mean() # = summarize(across(everything(), mean))
##   cyl vs am      mpg     disp        hp     drat       wt     qsec     gear     carb
## 1   4  0  1 26.00000 120.3000  91.00000 4.430000 2.140000 16.70000 5.000000 2.000000
## 2   4  1  0 22.90000 135.8667  84.66667 3.770000 2.935000 20.97000 3.666667 1.666667
## 3   4  1  1 28.37143  89.8000  80.57143 4.148571 2.028286 18.70000 4.142857 1.428571
## 4   6  0  1 20.56667 155.0000 131.66667 3.806667 2.755000 16.32667 4.333333 4.666667
## 5   6  1  0 19.12500 204.5500 115.25000 3.420000 3.388750 19.21500 3.500000 2.500000
## 6   8  0  0 15.05000 357.6167 194.16667 3.120833 4.104083 17.14250 3.000000 3.083333
## 7   8  0  1 15.40000 326.0000 299.50000 3.880000 3.370000 14.55000 5.000000 6.000000

Concluding Reflections

It has been a remarkable 3.5-year-long journey leading up to the development of collapse 2.0, and a tremendous feat of time, energy, and determination. I could probably have published 2 academic papers instead, but would still be writing horrible code like most economists, be trying to do complex things in econometrics, etc., using other mainstream data science libraries not really designed for that, or, worst case, just be stuck to commercial software. I’m happy I came out as an open-source developer and that I’ve been accompanied on this path by other great people from my profession.

I also never regretted choosing R as a primary language. I find it unique in its simplicity and parsimony, the ability to work with different objects like vectors, matrices, and data frames in a fluent way, and to do rather complex things like matching with a single function call.

On the other hand, R for me always lacked speed and the ability to do advanced statistical and data manipulation operations with ease, as I was used to coming from commercial environments (STATA, Mathematica).

collapse is my determined attempt to bring statistical complexity, parsimony, speed, and joy to statistics and data manipulation in R, and I believe it is the most encompassing attempt out there and preserves the fundamental character of the language.

Notably, the collapse approach is not limited to a certain object (like e.g. data.table, which remains a great idea and implementation), and does not rely on data structures and syntax that are somewhat alien/external to the language and do not integrate with many of its first-order features (e.g. arrow, polars, duckdb). It is also arguably more successful than alternative ways to implement or compile the language (FastR / Graal VM), because the fundamental performance problem in R is algorithmic efficiency and the lack of low-level vectorization for repetitive tasks².

By reimplementing core parts of the language using efficient algorithms and providing rich and flexible vectorizations for many statistical operations across columns and groups in a class-agnostic way supporting nearly all frequently used data structures, collapse solves the fundamental performance problem in a way that integrates seamlessly with the core of the language. It also adds much-needed statistical complexity, particularly for weighted statistics, time series, and panel data. In short, it provides advanced and fast R, inside GNU R.

It is not, and will never be, the absolute best that can be done in performance terms. The data formats used by the best-performing systems (such as the arrow columnar format underlying polars) are designed at the memory level to optimally use computer resources (SIMD etc.), with database applications in mind, and the people doing this did not study economics. But it is not yet clear that such architectures are very suitable for languages meant to do broad and linear-algebra heavy statistical computing tasks, and R just celebrated its 30th birthday this year. So, given the constraints imposed by a 30-year-old C-based language and API, frameworks like collapse and data.table are pushing the boundaries very far³.

Let me stop here; collapse 2.0 is out. It changed my R life, and I hope it will change yours.

The Past

collapse started in 2019 as a small package with only two functions: collap() - intended to facilitate the aggregation of mixed-type data in R, and qsu() - intended to facilitate summarizing panel data in R. Both were inspired by STATA’s collapse and (xt)summarize commands, and implemented with data.table as a backend. The package - called collapse alluding to the STATA command - would probably have stayed this way, had not unforeseen events affected my career plans.

Having completed a master’s in international economics in summer 2019, I was preparing for a two-year posting as an ODI Fellow in the Central Bank of Papua New Guinea in fall. However, things did not work out, I had difficulties getting a working visa and there were coordination issues with the Bank, so ODI decided to offer me a posting in the Ugandan Ministry of Finance, starting in January 2020. This gave me 4 months, September-December 2019, during which I ended up writing a new backend for collapse - in C++.

While collapse with data.table backed was never particularly slow, some of the underlying metaprogramming seemed arcane, especially because I wanted to utilize data.table’s GeForce optimizations which require the aggregation function to be recognizable in the call for data.table to internally replace it with an optimized version. But there were also statistical limitations. As an economist, I often employed sampling or trade weights in statistics, and in this respect, R was quite limited. There was also no straightforward way to aggregate categorical data, using, as I would have it, a (weighted) statistical mode function. I also felt R was lacking basic things in the time series domain - evidenced by the lengths I went to handle (irregular) trade panels. Finally, I felt limited by the division of software development around different classes in R. I found data.table useful for analytics, but the class too complex to behave in predictable ways. Thus I often ended up converting back to ‘data.frame’ or ‘tibble’ to use functions from a different package. Sometimes it would also have been practical to simply keep data as a vector or matrix - in linear-algebra-heavy programs - but I needed data.table to do something ‘by groups’. So in short, my workflow in R employed frequent object conversions, faced statistical limitations, and, in the case of early collapse’s data.table backend, also involved tedious metaprogramming.

The will for change pushed me to practically rethink the way statistics could be done in R. It required a framework that encompassed increased statistical complexity, including advanced statistical algorithms like (weighted) medians, quantiles, modes, support for (irregular) time series and panels etc., and enabling these operations to be vectored efficiently across many groups and columns without a limiting syntax that would again encourage metaprogramming. The framework would also need to be class-agnostic/support multiple R objects and classes, to easily integrate with different frameworks and reduce the need for object conversions. These considerations led to the creation of a comprehensive set of S3 generic grouped and weighted Fast Statistical Functions for vectors matrices and data.frame-like objects, initially programmed fully in C++. The functions natively supported R factors for grouping. To facilitate programming further, I created multivariate grouping (‘GRP’) objects that could be used to perform multiple statistical operations across the same groups without grouping overhead. With this backend and hand, it was easy to reimplement collap()¹, and also provide a whole array of other useful functions, including dplyr-like functions like fgroup_by(), and time series functions that could be used ad-hoc but also supported plm’s indexed ‘pseries’ and ‘pdata.frame’ classes. collapse 1.0.0, released to CRAN on 19th March 2020 (me sitting in the Ugandan finance ministry) was already a substantial piece of statistical software offering cutting-edge performance (see the benchmarks in the introductory blog post).

To then cut a long story short, in the coming 3 years collapse became better, broader, and faster in multiple iterations. Additional speed came especially from rewriting central parts of the package in C - reimplementing some core algorithms in C rather than relying on the C++ standard library or Rcpp sugar - as well as introducing data transformation by reference and OpenMP multithreading. For example, fmode(), rewritten from C++ to C for v1.8.0 (May 2022), became about 3x faster in serial mode (grouped execution), with additional gains through multithreading across groups. Other noteworthy functionality was a modern reimplementation of ‘pseries’ and ‘pdata.frame’, through ‘indexed_frame’ and ‘indexed_series’ classes, fully fledged fsummarise(), fmutate() and across() functions enabling tidyverse-like programming with vectorization for Fast Statistical Functions in the backend, a set of functions facilitating memory efficient R programming and low-cost data object conversions, functions to effectively deal with (nested) lists of data objects - such as unlisting to data frame with unlist2d(), and additional descriptive statistical tools like qtab() and descr(). Particularly 2022 has seen two major updates: v1.7 and v1.8, and the bulk of development for 1.9 - released in January 2023. In improving collapse, I always took inspiration from other packages, most notably data.table, kit, dplyr, fixest, and R itself, to which I am highly indebted. The presentation of collapse at UseR 2022 in June 2022 marks another milestone of its establishment in the R community.

While using R and improving collapse, I became increasingly aware that I was not alone in the pursuit of making R faster and statistically more powerful. Apart from well-established packages like data.table, matrixStats, and fst, I noticed and started using many smaller packages like kit, roll, stringfish, qs, Rfast, coop, fastmap, fasttime, rrapply etc. aimed at improving particular aspects of R in a statistical or computational sense, often offering clean C or C++ implementations with few R-level dependencies. I saw a pattern of common traits and development efforts that were largely complimentary and needed encouragement. My impression at the time - largely unaltered today - was that such efforts were ignored by large parts of the R user community. One reason is of course the lack of visibility and coordination, compared to institutional stakeholders like Rstudio and H2O backing the tidyverse and data.table. Another consideration, it seemed to me, was that the tidyverse is particularly popular simply because there exists an R package and website called tidyverse which loads a set of packages that work well together, and thus alleviates users of the burden of searching CRAN and choosing their own collection of data manipulation packages.

Thus I decided in early 2021 to also create a meta package and GitHub repo called fastverse and use it to promote high-performance R packages with few dependencies. The first version 0.1.6 made it to CRAN in August 2021, attaching 6 core packages (data.table, collapse, matrixStats, kit, fst and magrittr), and allowing easy extension with additional packages using the fastverse_extend() function. With 7 total dependencies instead of 80, it was a considerably more lightweight and computationally powerful alternative to the tidyverse. The README of the GitHub repository has grown largely due to suggestions from the community and now lists many of the highest performing and (mostly) lightweight R packages. Over time I also introduced more useful functionality into the fastverse package, such as the ability to configure the environment and set of packages included using a .fastverse file, an option to install missing packages on the fly, and the fastverse_child() function to create wholly separate package verses. Observing my own frequent usage of data.table, collapse, kit, and magrittr in combination, I did a poll on Twitter in Fall 2022 suggesting the removal of matrixStats and fst from the core set of packages - which as accepted and implemented from v0.3.0 (November 2022). The fastverse package has thus become an extremely lightweight, customizable, and fast tidyverse alternative.

The Present

Today, both collapse and fastverse are well established in a part of the R community closer to econometrics and high-performance statistics. A growing number of econometric packages benefit from collapse as a computational backend, most notably the well-known plm package - which experienced order-of-magnitude performance gains. I am also developing dfms (first CRAN release October 2022), demonstrating that very efficient estimation of Dynamic Factor Models is possible in R combining collapse and RcppArmadillo. collapse is also powering various shiny apps across the web. I ended up creating a collapse-powered public macroeconomic data portal for Uganda, and later, at the Kiel Institute for the World Economy, for Africa at large.

So collapse has made it into production in my own work and the work of others. Core benefits in my experience are that it is lightweight to install on a server, has very low baseline function execution speeds (of a few microseconds instead of milliseconds with most other frameworks) making for speedy reaction times, scales very well to large data, and supports multiple R objects and modes of programming - reducing the need for metaprogramming. Since my own work and the work of others depends on it, API stability has always been important. collapse has not seen any major API changes in updates v1.7-v1.9, and currently no further API changes are planned. This lightweight and robust nature - characteristic of all core fastverse packages esp. data.table - stands in contrast to dplyr, who’s core API involving summarise(), mutate() and across() keeps changing to an extent that at some point in 2022 I removed unit tests of fsummarise() and fmutate() against the dplyr versions from CRAN.

Apart from development, it has also been very fun using the fastverse in the wild for some research projects. Lately, I’ve been working a lot with geospatial data, where the fastverse has enabled numerous interesting applications.

For example, I was interested in how the area of OSM buildings needs to be scaled using a power weight to correlate optimally with nightlights luminosity within a million cells of populated places in Sub-Saharan Africa. Having extracted around 12 million buildings from OSM, I programmed the following objective function and optimized it for power weights between 0.0001 and 5.

library(fastverse)       
library(microbenchmark)

a <- abs(rnorm(12e6, 100, 100))            # Think of this as building areas in m^2
g <- GRP(sample.int(1e6, 12e6, TRUE))      # Think of this as grid cells
y <- fsum(a^1.5, g, use.g.names = FALSE) + # Think of this as nightlights 
     rnorm(g$N.groups, sd = 10000)  
length(y)
## [1] 999989

# Objective function
cor_ay <- function(w, a, y) {
  aw_agg = fsum(a^w, g, use.g.names = FALSE, na.rm = FALSE)
  cor(aw_agg, y) 
}

# Checking the speed of the objective
microbenchmark(cor_ay(2, a, y))
## Unit: milliseconds
##             expr      min      lq     mean   median       uq      max neval
##  cor_ay(2, a, y) 30.42331 32.1136 35.02078 34.43118 36.75326 55.36505   100

# Now the optimization
system.time(res <- optimise(cor_ay, c(0.0001, 5), a, y, maximum = TRUE))
##    user  system elapsed 
##   1.375   0.051   1.427
res
## $maximum
## [1] 1.501067
## 
## $objective
## [1] 0.5792703

The speed of the objective due to GRP() and fsum()² allowed further subdivision of buildings into different classes, and experimentation with finer spatial resolutions.

Another recent application involved finding the 100 nearest neighbors for each of around 100,000 cells (rows) in a rich geospatial dataset with about 50 variables (columns), and estimating a simple proximity-weighted linear regression of an outcome of interest y on a variable of interest z. Since computing a distance matrix on 100,000 rows up-front is infeasible memory-wise, I needed to go row-by-row. Here functions dapply(), fdist() and flm() from collapse, and topn() from kit became very handy.

# Generating the data
X <- rnorm(5e6)       # 100,000 x 50 matrix of characteristics
dim(X) <- c(1e5, 50)
z <- rnorm(1e5)       # Characteristic of interest
y <- z + rnorm(1e5)   # Outcome of interest
Xm <- t(forwardsolve(t(chol(cov(X))), t(X)))    # Transform X to compute Mahalanobis distance (takes account of correlations)

# Coefficients for a single row
coef_i <- function(row_i) {
    mdist = fdist(Xm, row_i, nthreads = 2L)                           # Mahalanobis distance
    best_idx = topn(mdist, 101L, hasna = FALSE, decreasing = FALSE)   # 100 closest points
    best_idx = best_idx[mdist[best_idx] > 0]                          # Removing the point itself (mdist = 0)
    weights = 1 / mdist[best_idx]                                     # Distance weights
    flm(y[best_idx], z[best_idx], weights, add.icpt = TRUE)           # Weighted lm coefficients
}

# Benchmarking a single execution
microbenchmark(coef_i(Xm[1L, ]))
## Unit: microseconds
##              expr     min      lq     mean  median       uq      max neval
##  coef_i(Xm[1L, ]) 927.051 965.591 1149.184 998.473 1031.068 3167.988   100

# Compute coefficients for all rows
system.time(coefs <- dapply(Xm, coef_i, MARGIN = 1))
##    user  system elapsed 
## 214.942  10.322 114.123
head(coefs, 3)
##         coef_i1  coef_i2
## [1,] 0.04329208 1.189331
## [2,] 0.20741015 1.107963
## [3,] 0.02860692 1.106427

Due to the efficiency of fdist() and topn(), a single call to the function takes around 1.2 milliseconds on the M1, giving a total execution time of around 120 seconds for 100,000 iterations of the program - one for each row of Xm.

A final recent application involved creating geospatial GINI coefficients for South Africa using remotely sensed population and nightlights data. Since population data from WorldPop and Nightlights from Google Earth Engine are easily obtained from the web, I reproduce the exercise here in full.

# Downloading 1km2 UN-Adjusted population data for South Africa from WorldPop
pop_year <- function(y) sprintf("https://data.worldpop.org/GIS/Population/Global_2000_2020_1km_UNadj/%i/ZAF/zaf_ppp_%i_1km_Aggregated_UNadj.tif", y, y)
for (y in 2014:2020) download.file(pop_year(y), mode = "wb", destfile = sprintf("data/WPOP_SA_1km_UNadj/zaf_ppp_%i_1km_Aggregated_UNadj.tif", y))

VIIRS Nightlights are available on Google Earth Engine on a monthly basis from 2014 to 2022. I extracted annual median composites for South Africa using instructions found here and saved them to my google drive³.

# Reading population files using terra and creating a single data.table
pop_data <- list.files(pop_path) %>% 
  set_names(substr(., 9, 12)) %>% 
  lapply(function(x) paste0(pop_path, "/", x) %>% 
           terra::rast() %>% 
           terra::as.data.frame(xy = TRUE) %>% 
           set_names(c("lon", "lat", "pop"))) %>% 
  unlist2d("year", id.factor = TRUE, DT = TRUE) %>% 
  fmutate(year = as.integer(levels(year))[year]) %T>% print(2)
##            year      lon       lat      pop
##           <int>    <num>     <num>    <num>
##        1:  2014 29.62792 -22.12958 38.21894
##        2:  2014 29.63625 -22.12958 19.25175
##       ---                                  
## 11420562:  2020 37.83625 -46.97958  0.00000
## 11420563:  2020 37.84458 -46.97958  0.00000

# Same for nightlights
nl_data <- list.files(nl_annual_path) %>% 
  set_names(substr(., 1, 4)) %>% 
  lapply(function(x) paste0(nl_annual_path, "/", x) %>% 
           terra::rast() %>% 
           terra::as.data.frame(xy = TRUE) %>% 
           fsubset(avg_rad %!=% -9999)) %>%  # Values outside land area of SA, coded using a mask in GEE
  unlist2d("year", id.factor = TRUE, DT = TRUE) %>%
  frename(x = lon, y = lat) %>% 
  fmutate(year = as.integer(levels(year))[year]) %T>% print(2)
##            year      lon       lat    avg_rad
##           <int>    <num>     <num>      <num>
##        1:  2014 29.64583 -22.12500 0.08928293
##        2:  2014 29.65000 -22.12500 0.04348474
##       ---                                    
## 58722767:  2022 20.00833 -34.83333 0.37000000
## 58722768:  2022 20.01250 -34.83333 0.41000000

Since nightlights are available up to 2022, but population only up to 2020, I did a crude cell-level population forecast for 2021 and 2022 based on 1.6 million linear models of cell-level population between 2014 and 2020.

# Unset unneeded options for greater efficiency
set_collapse(na.rm = FALSE, sort = FALSE)
system.time({
# Forecasting population in 1.6 million grid cells based on linear regression
pop_forecast <- pop_data %>% 
  fgroup_by(lat, lon) %>% 
  fmutate(dm_year = fwithin(year)) %>% 
  fsummarise(pop_2020 = flast(pop),
             beta = fsum(pop, dm_year) %/=% fsum(dm_year^2)) %>% 
  fmutate(pop_2021 = pop_2020 + beta, 
          pop_2022 = pop_2021 + beta, 
          beta = NULL)
})
##    user  system elapsed 
##   0.210   0.054   0.263

head(pop_forecast)
##          lat      lon  pop_2020  pop_2021  pop_2022
##        <num>    <num>     <num>     <num>     <num>
## 1: -22.12958 29.62792  52.35952  54.35387  56.34821
## 2: -22.12958 29.63625  23.65122  24.44591  25.24060
## 3: -22.12958 29.64458  33.29427  34.10418  34.91409
## 4: -22.12958 29.65292 194.08760 216.78054 239.47348
## 5: -22.12958 29.66125 123.92527 139.52940 155.13353
## 6: -22.13792 29.56958  13.61020  13.39950  13.18880

The above expression is an optimized version of univariate linear regression: beta = cov(pop, year)/var(year) = sum(pop * dm_year) / sum(dm_year^2), where dm_year = year - mean(year), that is fully vectorized across 1.6 million groups. Two further tricks are applied here: fsum() has an argument for sampling weights, which I utilize here instead of writing fsum(pop * dm_year), which would require materializing a vector pop * dm_year before summing. The division by reference (%/=%) saves another unneeded copy. The expression could also have been written in one line as fsummarise(beta = fsum(pop, W(year)) %/=% fsum(W(year)^2)), given that 3/4 of the computation time here is actually spent on grouping 11.4 million records by lat and lon.

# Appending population data with cell-level forecasts for 2021 and 2022
pop_data_forecast <- rbind(pop_data,
  pop_forecast %>% fselect(-pop_2020) %>% rm_stub("pop_") %>% 
  melt(1:2, variable.name = "year", value.name = "pop") %>% 
  fmutate(year = as.integer(levels(year))[year]) %>% 
  colorder(year))

As you may have noticed, the nightlights data has a higher resolution of around 464m than the population data at 1km resolution. To match the two datasets, I use a function that transforms the coordinates to a rectilinear grid of a certain size in km, using an Approximation to the Haversine Formula which rescales longitude coordinates based on the latitude coordinate (to have them approximately represent distance as at the equator). The coordinates are then divided by the grid size in km transformed to degrees at the equator, and the modulus from this division is removed. Afterward, half of the grid size is added again, reflecting the grid centroids. Finally, longitudes are rescaled back to their original extent using the same scale factor.

# Transform coordinates to cell centroids of a rectilinear square grid of a certain size in kms
round_to_kms_fast <- function(lon, lat, km, round = TRUE, digits = 6) {
  degrees = km / (40075.017 / 360)             # Gets the degree-distance of the kms at the equator
  if(round) div = round(degrees, digits)       # Round to precision
  res_lat = TRA(lat, div, "-%%") %+=% (div/2)  # This transforms the data to the grid centroid
  scale_lat = cos(res_lat * pi/180)            # Approx. scale factor based on grid centroid
  res_lon = setTRA(lon * scale_lat, div, "-%%") %+=% (div/2) %/=% scale_lat  
  return(list(lon = res_lon, lat = res_lat))
}

The virtue of this approach, while appearing crude and not fully respecting the spherical earth model, is that it allows arbitrary grid sizes and transforms coordinates from different datasets in the same way. To determine the grid size, I take the largest 2-digit grid size that keeps the population cells unique, i.e. that largest number such that:

pop_data %>% ftransform(round_to_kms_fast(lon, lat, 0.63)) %>% 
  fselect(year, lat, lon) %>% any_duplicated()
## [1] FALSE

It turns out that 0.63km is the ideal grid size. I apply this to both datasets and merge them, aggregating nightlights using the mean⁴.

system.time({
nl_pop_data <- pop_data_forecast %>% 
   ftransform(round_to_kms_fast(lon, lat, 0.63)) %>% 
   merge(nl_data %>% ftransform(round_to_kms_fast(lon, lat, 0.63)) %>% 
         fgroup_by(year, lat, lon) %>% fmean(), 
         by = .c(year, lat, lon))
})
##    user  system elapsed 
##   8.195   1.380   4.280
head(nl_pop_data, 2)
## Key: <year, lat, lon>
##     year       lat      lon      pop    avg_rad
##    <int>     <num>    <num>    <num>      <num>
## 1:  2014 -34.82266 19.98068 2.140570 0.07518135
## 2:  2014 -34.82266 19.98758 4.118959 0.09241374

Given the matched data, I define a function to compute the weighted GINI coefficient and an unweighted version for comparison.

# Taken from Wikipedia: with small-sample correction
gini_wiki <- function(x) 1 + 2/(length(x)-1) * (sum(seq_along(x)*sort(x)) / sum(x) - length(x))

# No small-sample correction
gini_noss <- function(x) 2/length(x) * sum(seq_along(x)*sort(x)) / sum(x) - (length(x)+1)/length(x) 

Skp1qm1 <- function(k, q) (q-1)/2 * (2*(k+1) + q) + k + 1
all.equal(Skp1qm1(30-1, 70+1), sum(30:100))
## [1] TRUE

# Weighted GINI (by default without correction)
w_gini <- function(x, w, sscor = FALSE) {
  o = radixorder(x)
  w = w[o]
  x = x[o]
  sw = sum(w)
  csw = cumsum(w)
  sx = Skp1qm1(c(0, csw[-length(csw)]), w) 
  if(sscor) return(1 + 2/(sw-1)*(sum(sx*x) / sum(x*w) - sw)) 
  2/sw * sum(sx*x) / sum(x*w) - (sw+1)/sw
}

This computes the population-weighted and unweighted GINI on a percentage scale for each year.

raw_gini_ts <- nl_pop_data %>% 
  fsubset(pop > 0 & avg_rad > 0) %>%
  fgroup_by(year) %>% 
  fsummarise(gini = gini_noss(avg_rad)*100, 
             w_gini = w_gini(avg_rad, pop)*100) %T>% print()
##     year     gini   w_gini
##    <int>    <num>    <num>
## 1:  2014 79.34750 55.51574
## 2:  2015 91.35048 55.06437
## 3:  2016 92.16993 54.75063
## 4:  2017 55.96135 53.53097
## 5:  2018 59.87219 52.84233
## 6:  2019 64.43899 52.23766
## 7:  2020 53.05498 51.15202
## 8:  2021 52.19359 50.26020
## 9:  2022 48.07294 49.69182

# Plotting
library(ggplot2)
raw_gini_ts %>% melt(1) %>% 
  ggplot(aes(x = year, y = value, colour = variable)) + 
      geom_line()

As evident from the plot, the population-weighted GINI is more smooth, which could be due to unpopulated areas exhibiting greater fluctuations in nightlights (such as fires or flares).

A final thing that we can do is calibrate the GINI to an official estimate. I use the africamonitor R API to get World Bank GINI estimates for South Africa.

WB_GINI <- africamonitor::am_data("ZAF", "SI_POV_GINI") %T>% print()
## Key: <Date>
##          Date SI_POV_GINI
##        <Date>       <num>
## 1: 1993-01-01        59.3
## 2: 2000-01-01        57.8
## 3: 2005-01-01        64.8
## 4: 2008-01-01        63.0
## 5: 2010-01-01        63.4
## 6: 2014-01-01        63.0

The last estimate in the series is from 2014, estimating a GINI of 63%. To bring the nightlights data in line with this estimate, I again use optimize() to determine an appropriate power weight:

np_pop_data_pos_14 <- nl_pop_data %>% 
  fsubset(pop > 0 & avg_rad > 0 & year == 2014, year, pop, avg_rad) 

objective <- function(k) {
  nl_gini = np_pop_data_pos_14 %$% w_gini(avg_rad^k, pop) * 100
  abs(63 - nl_gini)
}

res <- optimize(objective, c(0.0001, 5)) %T>% print()
## $minimum
## [1] 1.308973
## 
## $objective
## [1] 0.0002598319

With the ideal weight determined, it is easy to obtain a final calibrated nightlights-based GINI series and use it to extend the World Bank estimate.

final_gini_ts <- nl_pop_data %>% 
  fsubset(pop > 0 & avg_rad > 0) %>%
  fgroup_by(year) %>% 
  fsummarise(nl_gini = w_gini(avg_rad^res$minimum, pop)*100) %T>% print()
##     year  nl_gini
##    <int>    <num>
## 1:  2014 62.99974
## 2:  2015 62.49832
## 3:  2016 62.22387
## 4:  2017 61.22247
## 5:  2018 60.54190
## 6:  2019 59.82656
## 7:  2020 58.83987
## 8:  2021 57.93322
## 9:  2022 57.51001

final_gini_ts %>% 
  merge(WB_GINI %>% fcompute(year = year(Date), wb_gini = SI_POV_GINI), 
        by = "year", all = TRUE) %>% 
  melt("year", na.rm = TRUE) %>% 
  ggplot(aes(x = year, y = value, colour = variable)) + 
      geom_line() + scale_y_continuous(limits = c(50, 70))

It should be noted, at this point, that this estimate and the declining trend it shows may be seriously misguided. Research by Galimberti et al. (2020) using the old DMSP OLS Nightlights series from 1992-2013 for 234 countries and territories, shows that nightlights based inequality measures much better resemble the cross-sectional variation in inequality between countries than the time series dimension within countries.

The example is nevertheless instrumental in showing how the fastverse, in various respects, facilitates and enables complex data science in R.

The Future

Future development of collapse will see an increased use of SIMD instructions to further increase performance. The impact of such instructions - visible in frameworks like Apache arrow and Python’s polars (which is based on arrow) can be considerable. The following shows a benchmark computing the means of a matrix with 100 columns and 1 million rows using base R, collapse 1.9.0 (no SIMD), and collapse 1.9.5 (with SIMD).

library(collapse)
library(microbenchmark)

fmean19 <- collapsedev19::fmean
m <- rnorm(1e8)
dim(m) <- c(1e6, 100) # matrix with 100 columns and 1 million rows

microbenchmark(colMeans(m), 
               fmean19(m, na.rm = FALSE), 
               fmean(m, na.rm = FALSE), 
               fmean(m), # default is na.rm = TRUE, can be changed with set_collapse()
               fmean19(m, nthreads = 4, na.rm = FALSE), 
               fmean(m, nthreads = 4, na.rm = FALSE), 
               fmean(m, nthreads = 4))
## Unit: milliseconds
##                                     expr      min       lq     mean   median       uq       max neval
##                              colMeans(m) 93.09308 97.52766 98.80975 97.99094 99.05563 190.67317   100
##                fmean19(m, na.rm = FALSE) 93.04056 97.47590 97.68101 98.05097 99.14058 100.48612   100
##                  fmean(m, na.rm = FALSE) 12.75202 13.04181 14.05289 13.49043 13.81448  18.79206   100
##                                 fmean(m) 12.67806 13.02974 14.02059 13.49638 13.81009  18.72581   100
##  fmean19(m, nthreads = 4, na.rm = FALSE) 24.84251 25.20573 26.12640 25.52416 27.08612  28.71300   100
##    fmean(m, nthreads = 4, na.rm = FALSE) 13.07941 13.18853 13.96326 13.38853 13.68627  18.04652   100
##                   fmean(m, nthreads = 4) 13.05813 13.18277 13.99704 13.33753 13.71505  19.18242   100

Despite these impressive results, I am somewhat doubtful that much of collapse will benefit from SIMD. The main reason is that SIMD is a low-level vectorization that can be used to speed up simple operations like addition, subtraction, division, and multiplication. This is especially effective with large amounts of adjacent data. But with many groups and little data in each group, serial programming can be just as efficient or even more efficient if it allows writing grouped operations in a non-nested way. So it depends on the data to groups ratio. My arrow benchmark from August 2022 showed just that: with few groups relative to the data size, arrow considerably outperforms collapse and data.table, but with more groups the latter catch up considerably and collapse took lead with many very small groups. More complex statistics algorithms like the median (involving selection) or mode / distinct value count (involving hashing), also cannot (to my knowledge) benefit from SIMD, and here collapse implementations are already pretty much state of the art.

Apart from additional vectorization, I am also considering a possible broadening of the package to support further data manipulation operations such as table joins. This may take a while for me to get into though, so I cannot promise an update including this in 2023. At this stage, I am very happy with the API, so no changes are planned here, and I will also try to keep collapse harmonious with other fastverse packages, in particular data.table and kit.

Most of all, I hope to see an increased breadth of statistical R packages using collapse as a backend, so that its potential for increasing the performance and complexity of statistical R packages is realized in the community. I have in the past assisted package maintainers interested in developing collapse backends and hope to increase further collaborations along these lines.

At last, I wish to thank all users that provided feedback and inspiration or promoted this software in the community, and more generally all people that encouraged, contributed to, and facilitated these projects. Much credit is also due to the CRAN maintainers who endured many of my mistakes and insisted on high standards, which made collapse better and more robust.

Core Packages

The fastverse installs 6 core packages (data.table, collapse, matrixStats, kit, magrittr and fst) that are attached with library(fastverse). These packages were selected because they provide high quality compiled code for most common statistical and data manipulation tasks, have carefully managed APIs, jointly depend only on base R and Rcpp, and work very well together. The functionality offered by these packages can be summarized as follows:

• data.table: Enhanced data frame class with concise data manipulation framework offering powerful aggregation, extremely flexible split-apply-combine computing, reshaping, joins, rolling statistics, set operations on tables, fast csv read/write, and various utilities such as transposition of data.

• collapse: Fast grouped & weighted statistical computations, time series and panel data transformations, list-processing, data manipulation functions, summary statistics and various utilities such as support for variable labels. Class-agnostic framework designed to work with vectors, matrices, data frames, lists and related classes i.e. xts, data.table, tibble, pdata.frame, sf.

• matrixStats: Efficient row-and column-wise (weighted) statistics on matrices and vectors, including computations on subsets of rows and columns.

• kit: Fast vectorized and nested switches, some parallel (row-wise) statistics, and some utilities such as efficient partial sorting and unique values.

• magrittr: Efficient pipe operators for enhanced programming and code unnesting.

• fst: A compressed data file format that is very fast to read and write. Full random access in both rows and columns allows reading subsets from a ‘.fst’ file.

options(fastverse.styling = FALSE) # Disabling coloured output for this post
library(fastverse)
## -- Attaching packages --------------------------------------- fastverse 0.1.8 --
## v data.table  1.14.0     v collapse    1.6.5 
## v magrittr    2.0.1      v matrixStats 0.60.0
## v kit         0.0.7      v fst         0.9.4

# Extending the fastverse for the session, installing packages if unavailable
fastverse_extend(fixest, robustbase, xts, roll, ggplot2, Rfast, install = TRUE)
## -- Attaching extension packages ----------------------------- fastverse 0.1.8 --
## v fixest     0.8.4      v roll       1.1.6 
## v robustbase 0.93.6     v ggplot2    3.3.5 
## v xts        0.12.1     v Rfast      2.0.1
## -- Conflicts ------------------------------------------ fastverse_conflicts() --
## x Rfast::colMads()    masks matrixStats::colMads()
## x Rfast::colMaxs()    masks matrixStats::colMaxs()
## x Rfast::colMedians() masks robustbase::colMedians(), matrixStats::colMedians()
## x Rfast::colMins()    masks matrixStats::colMins()
## x Rfast::colRanks()   masks matrixStats::colRanks()
## x Rfast::colVars()    masks matrixStats::colVars()
## x xts::first()        masks data.table::first()
## x xts::last()         masks data.table::last()
## x robustbase::plot()  masks graphics::plot(), base::plot()
## x Rfast::rowMads()    masks matrixStats::rowMads()
## x Rfast::rowMaxs()    masks matrixStats::rowMaxs()
## x Rfast::rowMedians() masks robustbase::rowMedians(), matrixStats::rowMedians()
## x Rfast::rowMins()    masks matrixStats::rowMins()
## x Rfast::rowRanks()   masks matrixStats::rowRanks()
## x Rfast::rowVars()    masks matrixStats::rowVars()
## x Rfast::transpose()  masks data.table::transpose()

# Generate situation report
fastverse_sitrep()
## -- fastverse 0.1.8: Situation Report -------------------------------- R 4.1.0 --
##  * Global config file: FALSE
##  * Project config file: FALSE
## -- Core packages --------------------------------------------------------------- 
##  * data.table    (1.14.0)
##  * magrittr      (2.0.1)
##  * kit           (0.0.7)
##  * collapse      (1.6.5)
##  * matrixStats   (0.60.0)
##  * fst           (0.9.4)
## -- Extension packages ---------------------------------------------------------- 
##  * fixest        (0.8.4 < 0.9.0)
##  * robustbase    (0.93.6 < 0.93.8)
##  * xts           (0.12.1)
##  * roll          (1.1.6)
##  * ggplot2       (3.3.5)
##  * Rfast         (2.0.1 < 2.0.3)
## -- Dependencies ---------------------------------------------------------------- 
##  * DEoptimR      (1.0.8 < 1.0.9)
##  * digest        (0.6.27)
##  * dreamerr      (1.2.3)
##  * glue          (1.4.2)
##  * gtable        (0.3.0)
##  * isoband       (0.2.5)
##  * MASS          (7.3.54)
##  * mgcv          (1.8.36)
##  * nlme          (3.1.152)
##  * numDeriv      (2016.8.1.1)
##  * Rcpp          (1.0.7)
##  * RcppArmadillo (0.10.2.1.0 < 0.10.6.0.0)
##  * RcppParallel  (5.0.2 < 5.1.4)
##  * RcppZiggurat  (0.1.5 < 0.1.6)
##  * rlang         (0.4.11)
##  * sandwich      (3.0.0 < 3.0.1)
##  * scales        (1.1.1)
##  * tibble        (3.1.3)
##  * withr         (2.4.2)
##  * zoo           (1.8.9)

# Extensions are here
options("fastverse.extend")
## $fastverse.extend
## [1] "fixest"     "robustbase" "xts"        "roll"       "ggplot2"   
## [6] "Rfast"

# This detaches Rfast and roll, also removing them from options("fastverse.extend")
fastverse_detach(Rfast, roll, session = TRUE)
# This confirms that they were removed
fastverse_packages()
##  [1] "data.table"  "magrittr"    "kit"         "collapse"    "matrixStats"
##  [6] "fst"         "fixest"      "robustbase"  "xts"         "ggplot2"    
## [11] "fastverse"
# Now detaching all packages
fastverse_detach()
# Attaching again includes extensions except for "Rfast" and "roll"
library(fastverse)
## -- Attaching packages --------------------------------------- fastverse 0.1.8 --
## v data.table  1.14.0     v fst         0.9.4 
## v magrittr    2.0.1      v fixest      0.8.4 
## v kit         0.0.7      v robustbase  0.93.6
## v collapse    1.6.5      v xts         0.12.1
## v matrixStats 0.60.0     v ggplot2     3.3.5
## -- Conflicts ------------------------------------------ fastverse_conflicts() --
## x matrixStats::colMedians() masks robustbase::colMedians()
## x xts::first()              masks data.table::first()
## x collapse::is.regular()    masks zoo::is.regular()
## x xts::last()               masks data.table::last()
## x robustbase::plot()        masks graphics::plot(), base::plot()
## x matrixStats::rowMedians() masks robustbase::rowMedians()

# This detaches all packages and clears all options
fastverse_detach(session = TRUE)

options(fastverse.styling = FALSE)
library(fastverse)
## -- Attaching packages --------------------------------------- fastverse 0.1.8 --
## v data.table  1.14.0     v collapse    1.6.5 
## v magrittr    2.0.1      v matrixStats 0.60.0
## v kit         0.0.7      v fst         0.9.4
## -- Conflicts ------------------------------------------ fastverse_conflicts() --
## x collapse::is.regular() masks zoo::is.regular()

# Adding extensions
fastverse_extend(xts, zoo, roll, dygraphs, permanent = TRUE)
## -- Attaching extension packages ----------------------------- fastverse 0.1.8 --
## v xts      0.12.1      v dygraphs 1.1.1.6
## v roll     1.1.6
## -- Conflicts ------------------------------------------ fastverse_conflicts() --
## x zoo::as.Date()         masks base::as.Date()
## x zoo::as.Date.numeric() masks base::as.Date.numeric()
## x xts::first()           masks data.table::first()
## x collapse::is.regular() masks zoo::is.regular()
## x xts::last()            masks data.table::last()

# Removing some core packages
fastverse_detach(data.table, fst, matrixStats, permanent = TRUE)
# Adding data.table again, so it is attached last
fastverse_extend(data.table, permanent = TRUE)
## -- Attaching extension packages ----------------------------- fastverse 0.1.8 --
## v data.table 1.14.0
## -- Conflicts ------------------------------------------ fastverse_conflicts() --
## x data.table::first() masks xts::first()
## x data.table::last()  masks xts::last()

# detach all packages and clear all options
fastverse_detach(session = TRUE)
options(fastverse.styling = FALSE)
library(fastverse) 
## -- Attaching packages --------------------------------------- fastverse 0.1.8 --
## v magrittr   2.0.1       v zoo        1.8.9  
## v kit        0.0.7       v roll       1.1.6  
## v collapse   1.6.5       v dygraphs   1.1.1.6
## v xts        0.12.1      v data.table 1.14.0
## -- Conflicts ------------------------------------------ fastverse_conflicts() --
## x zoo::as.Date()         masks base::as.Date()
## x zoo::as.Date.numeric() masks base::as.Date.numeric()
## x data.table::first()    masks xts::first()
## x zoo::is.regular()      masks collapse::is.regular()
## x data.table::last()     masks xts::last()

# Install the CRAN version
install.packages("fastverse")

# Install the GitHub version (Requires Rtools)
remotes::install_github("SebKrantz/fastverse")

# Resetting the fastverse to defaults (clearing all permanent extensions and options)
fastverse_reset()
# Detaching 
fastverse_detach()

Further References on (V)ECM’s

Engle, Robert, and Clive Granger. 1987. Co-integration and Error Correction: Representation, Estimation and Testing. Econometrica 55 (2): 251–76.

Johansen, Søren (1991). Estimation and Hypothesis Testing of Cointegration Vectors in Gaussian Vector Autoregressive Models. Econometrica. 59 (6): 1551–1580. JSTOR 2938278.

Enders, Walter (2010). Applied Econometric Time Series (Third ed.). New York: John Wiley & Sons. pp. 272–355. ISBN 978-0-470-50539-7.

Lütkepohl, Helmut (2006). New Introduction to Multiple Time Series Analysis. Berlin: Springer. pp. 237–352. ISBN 978-3-540-26239-8.

Alogoskoufis, G., & Smith, R. (1991). On error correction models: specification, interpretation, estimation. Journal of Economic Surveys, 5(1), 97-128.

https://en.wikipedia.org/wiki/Error_correction_model

https://www.econometrics-with-r.org/16-3-cointegration.html

https://bookdown.org/ccolonescu/RPoE4/time-series-nonstationarity.html#the-error-correction-model

https://www.youtube.com/watch?v=wYQ_v_0tk_c

Data Frame Based Objects

The three major data frame based classes in R are the base R data.frame, the data.table and the tibble, for which there also exists grouped (dplyr) and time based (tsibble, tibbletime) versions. Additional notable classes are the panel data frame (plm) and the spatial features data frame (sf).

For the former three collapse offer extremely fast and versatile converters qDF, qDT and qTBL that can be used to turn many R objects into data.frame’s, data.table’s or tibble’s, respectively:

library(collapse); library(data.table); library(tibble)
options(datatable.print.nrows = 10, 
        datatable.print.topn = 2)

identical(qDF(mtcars), mtcars)
## [1] TRUE

mtcarsDT <- qDT(mtcars, row.names.col = "car")
mtcarsDT
##               car  mpg cyl disp  hp drat    wt  qsec vs am gear carb
##  1:     Mazda RX4 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
##  2: Mazda RX4 Wag 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
## ---                                                                 
## 31: Maserati Bora 15.0   8  301 335 3.54 3.570 14.60  0  1    5    8
## 32:    Volvo 142E 21.4   4  121 109 4.11 2.780 18.60  1  1    4    2

mtcarsTBL <- qTBL(mtcars, row.names.col = "car")
print(mtcarsTBL, n = 3)
## # A tibble: 32 x 12
##   car             mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
##   <chr>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Mazda RX4      21       6   160   110  3.9   2.62  16.5     0     1     4     4
## 2 Mazda RX4 Wag  21       6   160   110  3.9   2.88  17.0     0     1     4     4
## 3 Datsun 710     22.8     4   108    93  3.85  2.32  18.6     1     1     4     1
## # ... with 29 more rows

These objects can then be manipulated using an advanced and attribute preserving set of (S3 generic) statistical and data manipulation functions. The following infographic summarizes the core collapse namespace:

More details are provided in the freshly released cheat sheet, and further in the documentation and vignettes.

The statistical functions internally handle grouped and / or weighted computations on vectors, matrices and data frames, and seek to keep the attributes of the object.

# Simple data frame: Grouped mean by cyl -> groups = row.names  
fmean(fselect(mtcars, mpg, disp, drat), g = mtcars$cyl)
##        mpg     disp     drat
## 4 26.66364 105.1364 4.070909
## 6 19.74286 183.3143 3.585714
## 8 15.10000 353.1000 3.229286

With fgroup_by, collapse also introduces a fast grouping mechanism that works together with grouped_df versions of all statistical and transformation functions:

# Using Pipe operators and grouped data frames
library(magrittr)
mtcars %>% fgroup_by(cyl) %>% 
  fselect(mpg, disp, drat, wt) %>% fmean  
##   cyl      mpg     disp     drat       wt
## 1   4 26.66364 105.1364 4.070909 2.285727
## 2   6 19.74286 183.3143 3.585714 3.117143
## 3   8 15.10000 353.1000 3.229286 3.999214

# This is still a data.table 
mtcarsDT %>% fgroup_by(cyl) %>% 
  fselect(mpg, disp, drat, wt) %>% fmean
##    cyl      mpg     disp     drat       wt
## 1:   4 26.66364 105.1364 4.070909 2.285727
## 2:   6 19.74286 183.3143 3.585714 3.117143
## 3:   8 15.10000 353.1000 3.229286 3.999214

# Same with tibble: here computing weighted group means -> also saves sum of weights in each group
mtcarsTBL %>% fgroup_by(cyl) %>% 
  fselect(mpg, disp, drat, wt) %>% fmean(wt)
## # A tibble: 3 x 5
##     cyl sum.wt   mpg  disp  drat
##   <dbl>  <dbl> <dbl> <dbl> <dbl>
## 1     4   25.1  25.9  110.  4.03
## 2     6   21.8  19.6  185.  3.57
## 3     8   56.0  14.8  362.  3.21

A specialty of the grouping mechanism is that it fully preserves the structure / attributes of the object, and thus permits the creation of a grouped version of any data frame like object.

# This created a grouped data.table
gmtcarsDT <- mtcarsDT %>% fgroup_by(cyl)
gmtcarsDT
##               car  mpg cyl disp  hp drat    wt  qsec vs am gear carb
##  1:     Mazda RX4 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
##  2: Mazda RX4 Wag 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
## ---                                                                 
## 31: Maserati Bora 15.0   8  301 335 3.54 3.570 14.60  0  1    5    8
## 32:    Volvo 142E 21.4   4  121 109 4.11 2.780 18.60  1  1    4    2
## 
## Grouped by:  cyl  [3 | 11 (3.5)]
# The print shows: [N. groups | Avg. group size (SD around avg. group size)]

# Subsetting drops groups 
gmtcarsDT[1:2]
##              car mpg cyl disp  hp drat    wt  qsec vs am gear carb
## 1:     Mazda RX4  21   6  160 110  3.9 2.620 16.46  0  1    4    4
## 2: Mazda RX4 Wag  21   6  160 110  3.9 2.875 17.02  0  1    4    4

# Any class-specific methods are independent of the attached groups
gmtcarsDT[, new := mean(mpg)]
gmtcarsDT[, lapply(.SD, mean), by = vs, .SDcols = -1L] # Again groups are dropped
##    vs      mpg      cyl     disp        hp     drat       wt     qsec        am     gear     carb
## 1:  0 16.61667 7.444444 307.1500 189.72222 3.392222 3.688556 16.69389 0.3333333 3.555556 3.611111
## 2:  1 24.55714 4.571429 132.4571  91.35714 3.859286 2.611286 19.33357 0.5000000 3.857143 1.785714
##         new
## 1: 20.09062
## 2: 20.09062

# Groups are always preserved in column-subsetting operations
gmtcarsDT[, 9:13] 
##     vs am gear carb      new
##  1:  0  1    4    4 20.09062
##  2:  0  1    4    4 20.09062
## ---                         
## 31:  0  1    5    8 20.09062
## 32:  1  1    4    2 20.09062
## 
## Grouped by:  cyl  [3 | 11 (3.5)]

The grouping is also dropped in aggregations, but preserved in transformations keeping data dimensions:

# Grouped medians 
fmedian(gmtcarsDT[, 9:13])
##    cyl vs am gear carb      new
## 1:   4  1  1    4  2.0 20.09062
## 2:   6  1  0    4  4.0 20.09062
## 3:   8  0  0    3  3.5 20.09062
# Note: unique grouping columns are stored in the attached grouping object 
# and added if keep.group_vars = TRUE (the default)

# Replacing data by grouped median (grouping columns are not selected and thus not present)
fmedian(gmtcarsDT[, 4:5], TRA = "replace")
##      disp    hp
##  1: 167.6 110.0
##  2: 167.6 110.0
## ---            
## 31: 350.5 192.5
## 32: 108.0  91.0
## 
## Grouped by:  cyl  [3 | 11 (3.5)]

# Weighted scaling and centering data (here also selecting grouping column)
mtcarsDT %>% fgroup_by(cyl) %>% 
  fselect(cyl, mpg, disp, drat, wt) %>% fscale(wt)
##     cyl    wt         mpg       disp      drat
##  1:   6 2.620  0.96916875 -0.6376553 0.7123846
##  2:   6 2.875  0.96916875 -0.6376553 0.7123846
## ---                                           
## 31:   8 3.570  0.07335466 -0.8685527 0.9844833
## 32:   4 2.780 -1.06076989  0.3997723 0.2400387
## 
## Grouped by:  cyl  [3 | 11 (3.5)]

As mentioned, this works for any data frame like object, even a suitable list:

# Here computing a weighted grouped standard deviation
as.list(mtcars) %>% fgroup_by(cyl, vs, am) %>% 
  fsd(wt) %>% str
## List of 11
##  $ cyl   : num [1:7] 4 4 4 6 6 8 8
##  $ vs    : num [1:7] 0 1 1 0 1 0 0
##  $ am    : num [1:7] 1 0 1 1 0 0 1
##  $ sum.wt: num [1:7] 2.14 8.8 14.2 8.27 13.55 ...
##  $ mpg   : num [1:7] 0 1.236 4.833 0.655 1.448 ...
##  $ disp  : num [1:7] 0 11.6 19.25 7.55 39.93 ...
##  $ hp    : num [1:7] 0 17.3 22.7 32.7 8.3 ...
##  $ drat  : num [1:7] 0 0.115 0.33 0.141 0.535 ...
##  $ qsec  : num [1:7] 0 1.474 0.825 0.676 0.74 ...
##  $ gear  : num [1:7] 0 0.477 0.32 0.503 0.519 ...
##  $ carb  : num [1:7] 0 0.477 0.511 1.007 1.558 ...
##  - attr(*, "row.names")= int [1:7] 1 2 3 4 5 6 7

The function fungroup can be used to undo any grouping operation.

identical(mtcarsDT,
          mtcarsDT %>% fgroup_by(cyl, vs, am) %>% fungroup)
## [1] TRUE

Apart from the grouping mechanism with fgroup_by, which is very fast and versatile, collapse also supports regular grouped tibbles created with dplyr:

library(dplyr)
# Same as summarize_all(sum) and considerably faster
mtcars %>% group_by(cyl) %>% fsum
## # A tibble: 3 x 11
##     cyl   mpg  disp    hp  drat    wt  qsec    vs    am  gear  carb
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     4  293. 1157.   909  44.8  25.1  211.    10     8    45    17
## 2     6  138. 1283.   856  25.1  21.8  126.     4     3    27    24
## 3     8  211. 4943.  2929  45.2  56.0  235.     0     2    46    49

# Same as muatate_all(sum)
mtcars %>% group_by(cyl) %>% fsum(TRA = "replace_fill") %>% head(3)
## # A tibble: 3 x 11
## # Groups:   cyl [2]
##     cyl   mpg  disp    hp  drat    wt  qsec    vs    am  gear  carb
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     6  138. 1283.   856  25.1  21.8  126.     4     3    27    24
## 2     6  138. 1283.   856  25.1  21.8  126.     4     3    27    24
## 3     4  293. 1157.   909  44.8  25.1  211.    10     8    45    17

One major goal of the package is to make R suitable for (large) panel data, thus collapse also supports panel-data.frames created with the plm package:

library(plm)
pwlddev <- pdata.frame(wlddev, index = c("iso3c", "year"))

# Centering (within-transforming) columns 9-12 using the within operator W()
head(W(pwlddev, cols = 9:12), 3)
##          iso3c year W.PCGDP  W.LIFEEX W.GINI W.ODA
## ABW-1960   ABW 1960      NA -6.547351     NA    NA
## ABW-1961   ABW 1961      NA -6.135351     NA    NA
## ABW-1962   ABW 1962      NA -5.765351     NA    NA

# Computing growth rates of columns 9-12 using the growth operator G()
head(G(pwlddev, cols = 9:12), 3)
##          iso3c year G1.PCGDP G1.LIFEEX G1.GINI G1.ODA
## ABW-1960   ABW 1960       NA        NA      NA     NA
## ABW-1961   ABW 1961       NA 0.6274558      NA     NA
## ABW-1962   ABW 1962       NA 0.5599782      NA     NA

Perhaps a note about operators is necessary here before proceeding: collapse offers a set of transformation operators for its vector-valued fast functions:

# Operators
.OPERATOR_FUN
##  [1] "STD"  "B"    "W"    "HDB"  "HDW"  "L"    "F"    "D"    "Dlog" "G"

# Corresponding (programmers) functions
setdiff(.FAST_FUN, .FAST_STAT_FUN)
## [1] "fscale"     "fbetween"   "fwithin"    "fHDbetween" "fHDwithin"  "flag"       "fdiff"     
## [8] "fgrowth"

These operators are principally just function shortcuts that exist for parsimony and in-formula use (e.g. to specify dynamic or fixed effects models using lm(), see the documentation). They however also have some useful extra features in the data.frame method, such as internal column-subsetting using the cols argument or stub-renaming transformed columns (adding a ‘W.’ or ‘Gn.’ prefix as shown above). They also permit grouping variables to be passed using formulas, including options to keep (default) or drop those variables in the output. We will see this feature when using time series below.

To round things off for data frames, I demonstrate the use of collapse with classes it was not directly built to support but can also handle very well. Through it’s built in capabilities for handling panel data, tsibble’s can seamlessly be utilized:

library(tsibble)
tsib <- as_tsibble(EuStockMarkets)

# Computing daily and annual growth rates on tsibble
head(G(tsib, c(1, 260), by = ~ key, t = ~ index), 3)
## # A tsibble: 3 x 4 [1s] <UTC>
## # Key:       key [1]
##   key   index               G1.value L260G1.value
##   <chr> <dttm>                 <dbl>        <dbl>
## 1 DAX   1991-07-01 02:18:33   NA               NA
## 2 DAX   1991-07-02 12:00:00   -0.928           NA
## 3 DAX   1991-07-03 21:41:27   -0.441           NA

# Computing a compounded annual growth rate
head(G(tsib, 260, by = ~ key, t = ~ index, power = 1/260), 3)
## # A tsibble: 3 x 3 [1s] <UTC>
## # Key:       key [1]
##   key   index               L260G1.value
##   <chr> <dttm>                     <dbl>
## 1 DAX   1991-07-01 02:18:33           NA
## 2 DAX   1991-07-02 12:00:00           NA
## 3 DAX   1991-07-03 21:41:27           NA

Similarly for tibbletime:

library(tibbletime); library(tsbox)
# Using the tsbox converter
tibtm <- ts_tibbletime(EuStockMarkets)

# Computing daily and annual growth rates on tibbletime
head(G(tibtm, c(1, 260), t = ~ time), 3)
## # A time tibble: 3 x 9
## # Index: time
##   time                G1.DAX L260G1.DAX G1.SMI L260G1.SMI G1.CAC L260G1.CAC G1.FTSE L260G1.FTSE
##   <dttm>               <dbl>      <dbl>  <dbl>      <dbl>  <dbl>      <dbl>   <dbl>       <dbl>
## 1 1991-07-01 02:18:27 NA             NA NA             NA  NA            NA  NA              NA
## 2 1991-07-02 12:01:32 -0.928         NA  0.620         NA  -1.26         NA   0.679          NA
## 3 1991-07-03 21:44:38 -0.441         NA -0.586         NA  -1.86         NA  -0.488          NA
# ...

Finally lets consider the simple features data frame:

library(sf)
nc <- st_read(system.file("shape/nc.shp", package="sf"))
## Reading layer `nc' from data source `C:\Users\Sebastian Krantz\Documents\R\win-library\4.0\sf\shape\nc.shp' using driver `ESRI Shapefile'
## Simple feature collection with 100 features and 14 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: -84.32385 ymin: 33.88199 xmax: -75.45698 ymax: 36.58965
## geographic CRS: NAD27

# Fast selecting columns (need to add 'geometry' column to not break the class)
plot(fselect(nc, AREA, geometry))

# Subsetting 
fsubset(nc, AREA > 0.23, NAME, AREA, geometry)
## Simple feature collection with 3 features and 2 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: -84.32385 ymin: 33.88199 xmax: -75.45698 ymax: 36.58965
## geographic CRS: NAD27
##       NAME  AREA                       geometry
## 1  Sampson 0.241 MULTIPOLYGON (((-78.11377 3...
## 2  Robeson 0.240 MULTIPOLYGON (((-78.86451 3...
## 3 Columbus 0.240 MULTIPOLYGON (((-78.65572 3...

# Standardizing numeric columns (by reference)
settransformv(nc, is.numeric, STD, apply = FALSE)
# Note: Here using using operator STD() instead of fscale() to stub-rename standardized columns.
# apply = FALSE uses STD.data.frame on all numeric columns instead of lapply(data, STD)
head(nc, 2)
## Simple feature collection with 2 features and 26 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: -81.74107 ymin: 36.23436 xmax: -80.90344 ymax: 36.58965
## geographic CRS: NAD27
##    AREA PERIMETER CNTY_ CNTY_ID      NAME  FIPS FIPSNO CRESS_ID BIR74 SID74 NWBIR74 BIR79 SID79
## 1 0.114     1.442  1825    1825      Ashe 37009  37009        5  1091     1      10  1364     0
## 2 0.061     1.231  1827    1827 Alleghany 37005  37005        3   487     0      10   542     3
##   NWBIR79                       geometry  STD.AREA STD.PERIMETER STD.CNTY_ STD.CNTY_ID STD.FIPSNO
## 1      19 MULTIPOLYGON (((-81.47276 3... -0.249186    -0.4788595 -1.511125   -1.511125  -1.568344
## 2      12 MULTIPOLYGON (((-81.23989 3... -1.326418    -0.9163351 -1.492349   -1.492349  -1.637282
##   STD.CRESS_ID  STD.BIR74  STD.SID74 STD.NWBIR74  STD.BIR79  STD.SID79 STD.NWBIR79
## 1    -1.568344 -0.5739411 -0.7286824  -0.7263602 -0.5521659 -0.8863574  -0.6750055
## 2    -1.637282 -0.7308990 -0.8571979  -0.7263602 -0.7108697 -0.5682866  -0.6785480

Matrix Based Objects

collapse also offers a converter qM to efficiently convert various objects to matrix:

m <- qM(mtcars)

Grouped and / or weighted computations and transformations work as with with data frames:

# Grouped means
fmean(m, g = mtcars$cyl)
##        mpg cyl     disp        hp     drat       wt     qsec        vs        am     gear     carb
## 4 26.66364   4 105.1364  82.63636 4.070909 2.285727 19.13727 0.9090909 0.7272727 4.090909 1.545455
## 6 19.74286   6 183.3143 122.28571 3.585714 3.117143 17.97714 0.5714286 0.4285714 3.857143 3.428571
## 8 15.10000   8 353.1000 209.21429 3.229286 3.999214 16.77214 0.0000000 0.1428571 3.285714 3.500000

# Grouped and weighted standardizing
head(fscale(m, g = mtcars$cyl, w = mtcars$wt), 3)
##                      mpg cyl        disp         hp       drat         wt       qsec         vs
## Mazda RX4      0.9691687 NaN -0.63765527 -0.5263758  0.7123846 -1.6085211 -1.0438559 -1.2509539
## Mazda RX4 Wag  0.9691687 NaN -0.63765527 -0.5263758  0.7123846 -0.8376064 -0.6921302 -1.2509539
## Datsun 710    -0.7333024 NaN -0.08822497  0.4896429 -0.5526066 -0.1688057 -0.4488514  0.2988833
##                     am        gear      carb
## Mazda RX4     1.250954  0.27612029  0.386125
## Mazda RX4 Wag 1.250954  0.27612029  0.386125
## Datsun 710    0.719370 -0.09429567 -1.133397

Various matrix-based time series classes such as xts / zoo and timeSeries are also easily handled:

# ts / mts
# Note: G() by default renames the columns, fgrowth() does not
plot(G(EuStockMarkets))

# xts
library(xts) 
ESM_xts <- ts_xts(EuStockMarkets) # using tsbox::ts_xts
head(G(ESM_xts), 3)
##                         G1.DAX     G1.SMI    G1.CAC    G1.FTSE
## 1991-07-01 02:18:27         NA         NA        NA         NA
## 1991-07-02 12:01:32 -0.9283193  0.6197485 -1.257897  0.6793256
## 1991-07-03 21:44:38 -0.4412412 -0.5863192 -1.856612 -0.4877652

plot(G(ESM_xts), legend.loc = "bottomleft")

# timeSeries
library(timeSeries) # using tsbox::ts_timeSeries
ESM_timeSeries <- ts_timeSeries(EuStockMarkets)
# Note: G() here also renames the columns but the names of the series are also stored in an attribute
head(G(ESM_timeSeries), 3)
## GMT
##                            DAX        SMI       CAC       FTSE
## 1991-06-30 23:18:27         NA         NA        NA         NA
## 1991-07-02 09:01:32 -0.9283193  0.6197485 -1.257897  0.6793256
## 1991-07-03 18:44:38 -0.4412412 -0.5863192 -1.856612 -0.4877652

plot(G(ESM_timeSeries), plot.type = "single", at = "pretty")
legend("bottomleft", colnames(G(qM(ESM_timeSeries))), lty = 1, col = 1:4)

Aggregating these objects yields a plain matrix with groups in the row-names:

# Aggregating by year: creates plain matrix with row-names (g is second argument)
EuStockMarkets %>% fmedian(round(time(.)))
##           DAX     SMI    CAC    FTSE
## 1991 1628.750 1678.10 1772.8 2443.60
## 1992 1649.550 1733.30 1863.5 2558.50
## 1993 1606.640 2061.70 1837.5 2773.40
## 1994 2089.770 2727.10 2148.0 3111.40
## 1995 2072.680 2591.60 1918.5 3091.70
## 1996 2291.820 3251.60 1946.2 3661.65
## 1997 2861.240 3906.55 2297.1 4075.35
## 1998 4278.725 6077.40 3002.7 5222.20
## 1999 5905.150 8102.70 4205.4 5884.50

# Same thing with the other objects
all_obj_equal(ESM_xts %>% fmedian(substr(time(.), 1L, 4L)),
              ESM_timeSeries %>% fmedian(substr(time(.), 1L, 4L)))
## [1] TRUE

Benchmarks

Extensive benchmarks and examples against native dplyr / tibble and plm are provided here and here, making it evident that collapse provides both greater versatility and massive performance improvements over the methods defined for these objects. Benchmarks against data.table were provided in a previous post, where collapse compared favorably on a 2-core machine (particularly for weighted and := type operations). In general collapse functions are extremely well optimized, with basic execution speeds below 30 microseconds, and efficiently scale to larger operations. Most importantly, they preserve the data structure and attributes (including column attributes) of the objects passed to them. They also efficiently skip missing values and avoid some of the undesirable behavior endemic of base R¹.

Here I will add to the above resources just a small benchmark to prove that computations with collapse are also faster than any native methods and suggested programming principles for the various time series classes:

library(dplyr) # needed for tibbletime / tsibble comparison    
library(microbenchmark)

# Computing the first difference
microbenchmark(ts = diff(EuStockMarkets),
               collapse_ts = fdiff(EuStockMarkets),
               xts = diff(ESM_xts),
               collapse_xts = fdiff(ESM_xts),
               timeSeries = diff(ESM_timeSeries),
               collapse_timeSeries = fdiff(ESM_timeSeries),
               # taking difference function from tsibble
               dplyr_tibbletime = mutate_at(tibtm, 2:5, difference, order_by = tibtm$time),
               collapse_tibbletime_D = D(tibtm, t = ~ time),
               # collapse equivalent to the dplyr method (tfmv() abbreviates ftransformv())
               collapse_tibbletime_tfmv = tfmv(tibtm, 2:5, fdiff, t = time, apply = FALSE),
               # dplyr helpers provided by tsibble package
               dplyr_tsibble = mutate(group_by_key(tsib), value = difference(value, order_by = index)),
               collapse_tsibble_D = D(tsib, 1, 1, ~ key, ~ index),
               # Again we can do the same using collapse (tfm() abbreviates ftransform())
               collapse_tsibble_tfm = tfm(tsib, value = fdiff(value, 1, 1, key, index)))
## Unit: microseconds
##                      expr       min         lq       mean     median         uq        max neval cld
##                        ts  1681.018  2061.2220  2719.8758  2313.1290  3055.6870   9473.855   100  a 
##               collapse_ts    25.883    56.4505   163.3896    70.9540    88.1340   8732.636   100  a 
##                       xts    93.713   176.7150   279.5615   200.3655   257.0395   3656.561   100  a 
##              collapse_xts    42.840    78.0940   116.1231    99.7370   126.5120    597.973   100  a 
##                timeSeries  1964.386  2287.4700  3185.6565  2742.4210  3310.7180  17093.102   100  a 
##       collapse_timeSeries    52.658    93.9355  2483.3061   108.4390   132.7590 235259.074   100  a 
##          dplyr_tibbletime  8097.625 10173.1265 14784.9888 11176.0700 12863.3355 239144.113   100   b
##     collapse_tibbletime_D   568.967   630.5490   857.0829   751.2595   850.3270   8017.301   100  a 
##  collapse_tibbletime_tfmv   501.137   585.4780   773.2819   664.2410   817.0815   2922.035   100  a 
##             dplyr_tsibble 10386.434 12641.1040 14690.4243 13558.5910 15970.5640  32364.171   100   b
##        collapse_tsibble_D   963.897  1056.4935  1338.5404  1210.8955  1477.7525   3665.485   100  a 
##      collapse_tsibble_tfm   940.246   993.5720  1272.6027  1114.9525  1420.6320   6188.128   100  a

# Sequence of lagged/leaded and iterated differences (not supported by either of these methods)
head(fdiff(ESM_xts, -1:1, diff = 1:2)[, 1:6], 3) 
##                     FD1.DAX FD2.DAX     DAX D1.DAX D2.DAX FD1.SMI
## 1991-07-01 02:18:27   15.12    8.00 1628.75     NA     NA   -10.4
## 1991-07-02 12:01:32    7.12   21.65 1613.63 -15.12     NA     9.9
## 1991-07-03 21:44:38  -14.53  -17.41 1606.51  -7.12      8    -5.5
head(D(tibtm, -1:1, diff = 1:2, t = ~ time), 3)
## # A time tibble: 3 x 21
## # Index: time
##   time                FD1.DAX FD2.DAX   DAX D1.DAX D2.DAX FD1.SMI FD2.SMI   SMI D1.SMI D2.SMI FD1.CAC
##   <dttm>                <dbl>   <dbl> <dbl>  <dbl>  <dbl>   <dbl>   <dbl> <dbl>  <dbl>  <dbl>   <dbl>
## 1 1991-07-01 02:18:27   15.1     8.00 1629.  NA     NA      -10.4   -20.3 1678.   NA     NA      22.3
## 2 1991-07-02 12:01:32    7.12   21.7  1614. -15.1   NA        9.9    15.4 1688.   10.4   NA      32.5
## 3 1991-07-03 21:44:38  -14.5   -17.4  1607.  -7.12   8.00    -5.5    -3   1679.   -9.9  -20.3     9.9
## # ... with 9 more variables: FD2.CAC <dbl>, CAC <dbl>, D1.CAC <dbl>, D2.CAC <dbl>, FD1.FTSE <dbl>,
## #   FD2.FTSE <dbl>, FTSE <dbl>, D1.FTSE <dbl>, D2.FTSE <dbl>
head(D(tsib, -1:1, diff = 1:2, ~ key, ~ index), 3)
## # A tsibble: 3 x 7 [1s] <UTC>
## # Key:       key [1]
##   key   index               FD1.value FD2.value value D1.value D2.value
##   <chr> <dttm>                  <dbl>     <dbl> <dbl>    <dbl>    <dbl>
## 1 DAX   1991-07-01 02:18:33     15.1       8.00 1629.    NA       NA   
## 2 DAX   1991-07-02 12:00:00      7.12     21.7  1614.   -15.1     NA   
## 3 DAX   1991-07-03 21:41:27    -14.5     -17.4  1607.    -7.12     8.00

microbenchmark(collapse_xts = fdiff(ESM_xts, -1:1, diff = 1:2),
               collapse_tibbletime = D(tibtm, -1:1, diff = 1:2, t = ~ time),
               collapse_tsibble = D(tsib, -1:1, diff = 1:2, ~ key, ~ index))
## Unit: microseconds
##                 expr      min        lq      mean   median       uq       max neval cld
##         collapse_xts  147.263  218.2155  358.0477  254.362  290.508  8398.843   100 a  
##  collapse_tibbletime  750.144  988.4405 1348.9559 1026.149 1085.722 13947.942   100  b 
##     collapse_tsibble 1258.421 1653.3505 1793.5130 1707.793 1757.327  8411.784   100   c

Conclusion

This concludes this short demonstration. collapse is an advanced, fast and versatile data manipulation package. If you have followed until here I am convinced you will find it very useful, particularly if you are working in advanced statistics, econometrics, surveys, time series, panel data and the like, or if you care much about performance and non-destructive working in R. For more information about the package see the website, study the cheat sheet or call help("collapse-documentation") after install to bring up the built-in documentation.

Appendix: So how does this all actually work?

Statistical functions like fmean are S3 generic with user visible ‘default’, ‘matrix’ and ‘data.frame’ methods, and hidden ‘list’ and ‘grouped_df’ methods. Transformation functions like fwithin additionally have ‘pseries’ and ‘pdata.frame’ methods to support plm objects.

The ‘default’, ‘matrix’ and ‘data.frame’ methods handle object attributes intelligently. In the case of ‘data.frame’s’ only the ‘row.names’ attribute is modified accordingly, other attributes (including column attributes) are preserved. This also holds for data manipulation functions like fselect, fsubset, ftransform etc.. ‘default’ and ‘matrix’ methods preserve attributes as long as the data dimensions are kept.

In addition, the ‘default’ method checks if its argument is actually a matrix, and calls the matrix method if is.matrix(x) && !inherits(x, "matrix") is TRUE. This prevents classed matrix-based objects (such as xts time series) not inheriting from ‘matrix’ being handled by the default method.

Essentials: collapse Grouping Objects

collapse uses grouping objects as essential inputs for grouped computations. These objects are created from vectors or lists of vectors (i.e. data frames) using the function GRP():

library(collapse)
# A dataset supplied with collapse providing sectoral value added (VA) and employment (EMP)
head(GGDC10S, 3)
##   Country Regioncode             Region Variable Year AGR MIN MAN PU CON WRT TRA FIRE GOV OTH SUM
## 1     BWA        SSA Sub-saharan Africa       VA 1960  NA  NA  NA NA  NA  NA  NA   NA  NA  NA  NA
## 2     BWA        SSA Sub-saharan Africa       VA 1961  NA  NA  NA NA  NA  NA  NA   NA  NA  NA  NA
## 3     BWA        SSA Sub-saharan Africa       VA 1962  NA  NA  NA NA  NA  NA  NA   NA  NA  NA  NA
fdim(GGDC10S)
## [1] 5027   16

# Creating a grouping object (by default return.order = FALSE as the ordering is typically not needed)
g <- GRP(GGDC10S, c("Country", "Variable"), return.order = TRUE)
# Printing it
print(g)
## collapse grouping object of length 5027 with 85 ordered groups
## 
## Call: GRP.default(X = GGDC10S, by = c("Country", "Variable"), return.order = TRUE), X is unordered
## 
## Distribution of group sizes: 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    4.00   53.00   62.00   59.14   63.00   65.00 
## 
## Groups with sizes: 
## ARG.EMP  ARG.VA BOL.EMP  BOL.VA BRA.EMP  BRA.VA 
##      62      62      61      62      62      62 
##   ---
## VEN.EMP  VEN.VA ZAF.EMP  ZAF.VA ZMB.EMP  ZMB.VA 
##      62      63      52      52      52      52
# Plotting it
plot(g)

Grouping is done very efficiently using radix-based ordering in C (thanks to data.table source code). The structure of this object is shown below:

str(g)
## List of 8
##  $ N.groups   : int 85
##  $ group.id   : int [1:5027] 8 8 8 8 8 8 8 8 8 8 ...
##  $ group.sizes: int [1:85] 62 62 61 62 62 62 52 52 63 62 ...
##  $ groups     :'data.frame': 85 obs. of  2 variables:
##   ..$ Country : chr [1:85] "ARG" "ARG" "BOL" "BOL" ...
##   .. ..- attr(*, "label")= chr "Country"
##   .. ..- attr(*, "format.stata")= chr "%9s"
##   ..$ Variable: chr [1:85] "EMP" "VA" "EMP" "VA" ...
##   .. ..- attr(*, "label")= chr "Variable"
##   .. ..- attr(*, "format.stata")= chr "%9s"
##  $ group.vars : chr [1:2] "Country" "Variable"
##  $ ordered    : Named logi [1:2] TRUE FALSE
##   ..- attr(*, "names")= chr [1:2] "GRP.sort" "initially.ordered"
##  $ order      : int [1:5027] 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 ...
##   ..- attr(*, "starts")= int [1:85] 1 63 125 186 248 310 372 424 476 539 ...
##   ..- attr(*, "maxgrpn")= int 65
##   ..- attr(*, "sorted")= logi FALSE
##  $ call       : language GRP.default(X = GGDC10S, by = c("Country", "Variable"), return.order = TRUE)
##  - attr(*, "class")= chr "GRP"

The first three slots of this object provide the number of unique groups, a group-id matching each value/row to a group¹, and a vector of group-sizes. The fourth slot provides the unique groups (default return.groups = TRUE), followed by the names of the grouping variables, a logical vector showing whether the grouping is ordered (default sort = TRUE), and the ordering vector which can be used to sort the data alphabetically according to the grouping variables (default return.order = FALSE).

Grouped Programming in R

collapse provides a whole ensemble of C++ based generic statistical functions that can use these ‘GRP’ objects to internally perform (column-wise) grouped (and weighted) computations on vectors, matrices and data frames in R. Their names are contained in the global macro .FAST_FUN:

.FAST_FUN
##  [1] "fmean"      "fmedian"    "fmode"      "fsum"       "fprod"      "fsd"        "fvar"      
##  [8] "fmin"       "fmax"       "fnth"       "ffirst"     "flast"      "fNobs"      "fNdistinct"
## [15] "fscale"     "fbetween"   "fwithin"    "fHDbetween" "fHDwithin"  "flag"       "fdiff"     
## [22] "fgrowth"

Additional functions supporting grouping objects are TRA (grouped replacing and sweeping out statistics), BY (split-apply-combine computing) and collap (advanced data aggregation with multiple functions).

To provide a brief example, we can compute a grouped mean of the above data using:

head(fmean(GGDC10S[6:16], g))
##                AGR         MIN         MAN           PU        CON         WRT        TRA
## ARG.EMP  1419.8013    52.08903   1931.7602   101.720936   742.4044   1982.1775   648.5119
## ARG.VA  14951.2918  6454.94152  36346.5456  2722.762554  9426.0033  26633.1292 14404.6626
## BOL.EMP   964.2103    56.03295    235.0332     5.346433   122.7827    281.5164   115.4728
## BOL.VA   3299.7182  2846.83763   3458.2904   664.289574   729.0152   2757.9795  2727.4414
## BRA.EMP 17191.3529   206.02389   6991.3710   364.573404  3524.7384   8509.4612  2054.3731
## BRA.VA  76870.1456 30916.64606 223330.4487 43549.277879 70211.4219 178357.8685 89880.9743
##                 FIRE        GOV        OTH         SUM
## ARG.EMP    627.79291   2043.471   992.4475   10542.177
## ARG.VA    8547.37278  25390.774  7656.3565  152533.839
## BOL.EMP     44.56442         NA   395.5650    2220.524
## BOL.VA    1752.06208         NA  4383.5425   22619.177
## BRA.EMP   4413.54448   5307.280  5710.2665   54272.985
## BRA.VA  183027.46189 249135.452 55282.9748 1200562.671

By default (use.g.names = TRUE), group names are added as names (vectors) or row-names (matrices and data frames) to the result. For data frames we can also add the grouping columns again using²:

head(add_vars(g[["groups"]], fmean(get_vars(GGDC10S, 6:16), g, use.g.names = FALSE)))
##   Country Variable        AGR         MIN         MAN           PU        CON         WRT        TRA
## 1     ARG      EMP  1419.8013    52.08903   1931.7602   101.720936   742.4044   1982.1775   648.5119
## 2     ARG       VA 14951.2918  6454.94152  36346.5456  2722.762554  9426.0033  26633.1292 14404.6626
## 3     BOL      EMP   964.2103    56.03295    235.0332     5.346433   122.7827    281.5164   115.4728
## 4     BOL       VA  3299.7182  2846.83763   3458.2904   664.289574   729.0152   2757.9795  2727.4414
## 5     BRA      EMP 17191.3529   206.02389   6991.3710   364.573404  3524.7384   8509.4612  2054.3731
## 6     BRA       VA 76870.1456 30916.64606 223330.4487 43549.277879 70211.4219 178357.8685 89880.9743
##           FIRE        GOV        OTH         SUM
## 1    627.79291   2043.471   992.4475   10542.177
## 2   8547.37278  25390.774  7656.3565  152533.839
## 3     44.56442         NA   395.5650    2220.524
## 4   1752.06208         NA  4383.5425   22619.177
## 5   4413.54448   5307.280  5710.2665   54272.985
## 6 183027.46189 249135.452 55282.9748 1200562.671

The execution cost of all of these functions is extremely small, so the performance is essentially limited by C++, not by R.

library(microbenchmark) 
microbenchmark(call = add_vars(g[["groups"]], fmean(get_vars(GGDC10S, 6:16), g, use.g.names = FALSE)))
## Unit: microseconds
##  expr     min       lq     mean  median      uq      max neval
##  call 394.038 434.6465 582.3857 471.685 566.959 2403.495   100

We can use these functions to write very efficient grouped code in R. This shows a simple application in panel data econometrics comparing a pooled OLS to a group means, a between and a within estimator computed on the demeaned data³:

Panel_Ests <- function(formula, data, pids, weights = NULL, ...) {
  # Get variables as character string, first variable is dependent variable
  vars <- all.vars(formula)
  # na_omit is a fast replacement for na.omit
  data_cc <- na_omit(get_vars(data, c(vars, pids, weights)))
  # Create grouped object (pids should be a character vector)
  g <- GRP(data_cc, pids, return.groups = FALSE, call = FALSE)
  # Getting weights from data (weights should be character string)
  if(length(weights)) weights <- .subset2(data_cc, weights)
  # qM is a faster as.matrix
  data_cc <- qM(get_vars(data_cc, vars))
  # Computing group means 
  mean_data_cc <- fmean(data_cc, g, weights, use.g.names = FALSE)
  # This computes regression coefficients, dots options regard different fitting methods
  reg <- function(x, w = weights, ...) 
    drop(flm(x[, 1L], x[, -1L, drop = FALSE], w, add.icpt = TRUE, ...))
  
  qM(list(Pooled = reg(data_cc),
          Means = reg(mean_data_cc, w = if(length(weights)) fsum(weights, g) else NULL),
          # This replaces data values with the group-mean -> between-group estimator
          Between = reg(TRA(data_cc, mean_data_cc, "replace_fill", g)),
          # This subtracts the group-means -> within-group estimator
          Within = reg(TRA(data_cc, mean_data_cc, "-", g))))
}

library(magrittr)  # Pipe operators

# Calculating Value Added Percentage Shares (data is in local currency)
VA_shares <- fsubset(GGDC10S, Variable == "VA") %>% ftransformv(6:16, `*`, 100/SUM)
  
# Value Added data (regressing Government on Agriculture, Manufactoring and Finance & Real Estate)
Panel_Ests(GOV ~ AGR + MAN + FIRE, VA_shares, "Country") %>% round(4)
##              Pooled   Means Between  Within
## (Intercept) 25.8818 26.6702 26.5828  0.0000
## AGR         -0.3425 -0.3962 -0.3749 -0.2124
## MAN         -0.2339 -0.1744 -0.2215 -0.2680
## FIRE        -0.2083 -0.3337 -0.2572 -0.0742

# Employment data
fsubset(GGDC10S, Variable == "EMP") %>% ftransformv(6:16, `*`, 100/SUM) %>%
  Panel_Ests(formula = GOV ~ AGR + MAN + FIRE, "Country") %>% round(4)
##              Pooled   Means Between  Within
## (Intercept) 33.2047 34.6626 35.4332  0.0000
## AGR         -0.3543 -0.3767 -0.3873 -0.2762
## MAN         -0.4444 -0.4595 -0.4790 -0.4912
## FIRE        -0.1721 -0.3097 -0.2892 -0.1087

A benchmark below shows that this series of estimators is executed very efficiently and scales nicely to large data (quite a bit faster than using plm to do it).

VA_shares$weights <- abs(rnorm(fnrow(VA_shares))) # Random weights

# Benchmark on VA data    
microbenchmark(lm.fit = Panel_Ests(SUM ~ AGR + MIN + MAN, VA_shares, "Country"), 
               chol = Panel_Ests(SUM ~ AGR + MIN + MAN, VA_shares, "Country", method = "chol"),
               lm.fit.w = Panel_Ests(SUM ~ AGR + MIN + MAN, VA_shares, "Country", "weights"), 
               chol.w = Panel_Ests(SUM ~ AGR + MIN + MAN, VA_shares, "Country", "weights", method = "chol"))
## Unit: milliseconds
##      expr      min       lq     mean   median       uq       max neval cld
##    lm.fit 1.490470 1.663838 2.185618 1.942743 2.187956  9.982579   100   a
##      chol 1.469943 1.668300 2.161204 1.903919 2.140430  8.107889   100   a
##  lm.fit.w 1.686819 1.926232 2.469664 2.243068 2.611892 10.030328   100   a
##    chol.w 1.719842 1.935603 2.500210 2.326963 2.647592  7.600058   100   a

There are lots and lots of other applications that can be devised in R using the .FAST_FUN and efficient programming with grouping objects.

// [[Rcpp::plugins(cpp11)]]
#include <Rcpp.h>
using namespace Rcpp;

// Inputs: 
// x - A vector of any type 
// ng - The number of groups - supplied by GRP() in R
// g - An integer grouping vector - supplied by GRP() in R

// Output: A plain logical vector of size ng

template <int RTYPE>
LogicalVector ganyNACppImpl(Vector<RTYPE> x, int ng, IntegerVector g) {
  int l = x.size();
  if(l != g.size()) stop("length(x) must match length(g)");
  LogicalVector out(ng); // Initializes as false

  if(RTYPE == REALSXP) { // Numeric vector: all logical operations on NA/NaN evaluate to false, except != which is true.
    for(int i = 0; i < l; ++i) {
      if(x[i] != x[i] && !out[g[i]-1]) out[g[i]-1] = true;
    }
  } else { // other vectors
    for(int i = 0; i < l; ++i) {
      if(x[i] == Vector<RTYPE>::get_na() && !out[g[i]-1]) out[g[i]-1] = true;
    }
  }

  return out;
}

// Disabling complex and non-atomic vector types
template <>
LogicalVector ganyNACppImpl(Vector<CPLXSXP> x, int ng, IntegerVector) {
  stop("Not supported SEXP type!");
}

template <>
LogicalVector ganyNACppImpl(Vector<VECSXP> x, int ng, IntegerVector) {
  stop("Not supported SEXP type!");
}

template <>
LogicalVector ganyNACppImpl(Vector<RAWSXP> x, int ng, IntegerVector) {
  stop("Not supported SEXP type!");
}

template <> 
LogicalVector ganyNACppImpl(Vector<EXPRSXP> x, int ng, IntegerVector) {
  stop("Not supported SEXP type!");
}

// [[Rcpp::export]]
LogicalVector ganyNACpp(const SEXP& x, int ng = 0, const IntegerVector& g = 0){
  RCPP_RETURN_VECTOR(ganyNACppImpl, x, ng, g);
}

library(Rcpp)    
sourceCpp("ganyNA.cpp") 
 
ganyNA <- function(x, g, use.g.names = TRUE, ...) { 
  # Option group.sizes = FALSE prevents tabulation of levels if a factor is passed
  g <- GRP(g, return.groups = use.g.names, group.sizes = FALSE, call = FALSE, ...)
  res <- ganyNACpp(x, g[[1L]], g[[2L]]) 
  # GRPnames creates unique group names. For vectors they need not be character typed.
  if(use.g.names) names(res) <- GRPnames(g, force.char = FALSE)
  res
}

GGDC10S %$% ganyNA(SUM, list(Country, Variable)) %>% head
## ARG.EMP  ARG.VA BOL.EMP  BOL.VA BRA.EMP  BRA.VA 
##   FALSE   FALSE   FALSE    TRUE   FALSE    TRUE
  
# 10 million obs and 1 million groups, 1% of data missing  
x <- na_insert(rnorm(1e7), prop = 0.01)
g <- sample.int(1e6, 1e7, TRUE)
system.time(ganyNA(x, g)) 
##    user  system elapsed 
##    0.82    0.04    0.84
system.time(ganyNA(x, g, use.g.names = FALSE))
##    user  system elapsed 
##    0.57    0.06    0.64

# Using a factor grouping variable: more efficient 
f <- qF(g, na.exclude = FALSE) # Efficiently creating a factor (qF is faster as.factor)
system.time(ganyNA(x, f))
##    user  system elapsed 
##    0.03    0.01    0.04
system.time(ganyNA(x, f, drop = TRUE)) # This also checks for unused levels and drops them (if found)
##    user  system elapsed 
##    0.13    0.03    0.15
# Note: use.g.names = FALSE does not give a performance improvement with factors because unique factor levels are already computed

# We can also efficiently pass a 'GRP' object: both GRP.GRP and GRP.default simply return it.
g <- GRP(g)
system.time(ganyNA(x, g))
##    user  system elapsed 
##    0.03    0.00    0.03
system.time(ganyNA(x, g, use.g.names = FALSE))
##    user  system elapsed 
##    0.04    0.00    0.05

Introduction

collapse is a C/C++ based package for data transformation and statistical computing in R. It was first released on CRAN end of March 2020. The current version 1.3.1 is a mature piece of statistical software tested with > 7700 unit tests. collapse has 2 main aims:

1. To facilitate complex data transformation, exploration and computing tasks in R.

   (In particular grouped and weighted statistical computations, advanced aggregation of multi-type data, advanced transformations of time series and panel data, and the manipulation of lists)

2. To help make R code fast, flexible, parsimonious and programmer friendly.

   (Provide order of magnitude performance improvements via C/C++ and highly optimized R code, broad object orientation and attribute preservation, and a flexible programming infrastructure in standard and non-standard evaluation)

It is made compatible with dplyr, data.table and the plm approach to panel data. It can be installed in R using:

install.packages('collapse')

# See Documentation
help('collapse-documentation')

With this post I want to formally and briefly introduce collapse, provide a basic demonstration of important features, and end with a small benchmark comparing collapse to dplyr and data.table. I hope to convince that collapse provides a superior architecture for data manipulation and statistical computing in R, particularly in terms of flexibility, functionality, performance, and programmability.

Note: Please read this article here for better code appearance.

Demonstration

I start by briefly demonstrating the Fast Statistical Functions, which are a central feature of collapse. Currently there are 14 of them (fmean, fmedian, fmode, fsum, fprod, fsd, fvar, fmin, fmax, fnth, ffirst, flast, fNobs and fNdistinct), they are all S3 generic and support fast grouped and weighted computations on vectors, matrices, data frames, lists and grouped tibbles (class grouped_df). Calling these functions on different objects yields column-wise statistical computations:

library(collapse)
data("iris")            # iris dataset in base R
v <- iris$Sepal.Length  # Vector
d <- num_vars(iris)     # Saving numeric variables 
g <- iris$Species       # Grouping variable (could also be a list of variables)

# Simple statistics
fmean(v)              # Vector
## [1] 5.843333
fsd(qM(d))            # Matrix (qM is a faster as.matrix)
## Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
##    0.8280661    0.4358663    1.7652982    0.7622377
fmode(d)              # Data frame
## Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
##          5.0          3.0          1.5          0.2

# Preserving data structure
fmean(qM(d), drop = FALSE)     # Still a matrix
##      Sepal.Length Sepal.Width Petal.Length Petal.Width
## [1,]     5.843333    3.057333        3.758    1.199333
fmax(d, drop = FALSE)          # Still a data.frame
##   Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1          7.9         4.4          6.9         2.5

The functions fmean, fmedian, fmode, fnth, fsum, fprod, fvar and fsd additionally support weights¹.

# Weighted statistics, similarly for vectors and matrices ...
wt <- abs(rnorm(fnrow(iris)))
fmedian(d, w = wt)     
## Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
##          5.7          3.0          4.1          1.3

The second argument of these functions is called g and supports vectors or lists of grouping variables for grouped computations. For functions supporting weights, w is the third argument².

# Grouped statistics
fmean(d, g) 
##            Sepal.Length Sepal.Width Petal.Length Petal.Width
## setosa            5.006       3.428        1.462       0.246
## versicolor        5.936       2.770        4.260       1.326
## virginica         6.588       2.974        5.552       2.026

# Groupwise-weighted statistics 
fmean(d, g, wt)
##            Sepal.Length Sepal.Width Petal.Length Petal.Width
## setosa         4.964652    3.389885     1.436666   0.2493647
## versicolor     5.924013    2.814171     4.255227   1.3273743
## virginica      6.630702    2.990253     5.601473   2.0724544

fmode(d, g, wt, ties = "max")  # Grouped & weighted maximum mode.. 
##            Sepal.Length Sepal.Width Petal.Length Petal.Width
## setosa              5.0           3          1.4         0.2
## versicolor          5.8           3          4.5         1.3
## virginica           6.3           3          5.1         2.3

Grouping becomes more efficient when factors or grouping objects are passed to g. Factors can efficiently be created using the function qF, and grouping objects are efficiently created with the function GRP³. As a final layer of complexity, all functions support transformations through the TRA argument.

library(magrittr)  # Pipe operators
# Simple Transformations
fnth(v, 0.9, TRA = "replace") %>% head   # Replacing values with the 90th percentile
## [1] 6.9 6.9 6.9 6.9 6.9 6.9
fsd(v, TRA = "/") %>% head               # Dividing by the overall standard-deviation (scaling)
## [1] 6.158928 5.917402 5.675875 5.555112 6.038165 6.521218

# Grouped transformations
fsd(v, g, TRA = "/") %>% head         # Grouped scaling
## [1] 14.46851 13.90112 13.33372 13.05003 14.18481 15.31960
fmin(v, g, TRA = "-") %>% head        # Setting the minimum value in each species to 0
## [1] 0.8 0.6 0.4 0.3 0.7 1.1
fsum(v, g, TRA = "%") %>% head        # Computing percentages
## [1] 2.037555 1.957651 1.877747 1.837795 1.997603 2.157411
ffirst(v, g, TRA = "%%") %>% head     # Taking modulus of first group-value, etc ...
## [1] 0.0 4.9 4.7 4.6 5.0 0.3

# Grouped and weighted transformations
fmedian(v, g, wt, "-") %>% head                      # Subtracting weighted group-medians
## [1]  0.1 -0.1 -0.3 -0.4  0.0  0.4
fmode(d, g, wt, "replace", ties = "min") %>% head(3) # replace with weighted minimum mode
##   Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1            5           3          1.4         0.2
## 2            5           3          1.4         0.2
## 3            5           3          1.4         0.2

Currently there are 10 different replacing or sweeping operations supported by TRA, see ?TRA. TRA can also be called directly as a function which performs simple and grouped replacing and sweeping operations with computed statistics:

# Same as fmedian(v, TRA = "-")
TRA(v, median(v), "-") %>% head               
## [1] -0.7 -0.9 -1.1 -1.2 -0.8 -0.4

# Replace values with 5% percentile by species
TRA(d, BY(d, g, quantile, 0.05), "replace", g) %>% head(3) 
##   Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1          4.4           3          1.2         0.1
## 2          4.4           3          1.2         0.1
## 3          4.4           3          1.2         0.1

The function BY is generic for Split-Apply-Combine computing with user-supplied functions. Another useful function is dapply (data-apply) for efficient column- and row-operations on matrices and data frames.

Some common panel data transformations like between- and (quasi-)within-transformations (averaging and centering using the mean) are implemented slightly more memory efficient in the functions fbetween and fwithin. The function fscale also exists for fast (grouped, weighted) scaling and centering (standardizing) and mean-preserving scaling. These functions provide further options for data harmonization, such as centering on the overall data mean or scaling to the within-group standard deviation⁴ (as shown below), as well as scaling / centering to arbitrary supplied means and standard deviations.

oldpar <- par(mfrow = c(1,3))
gv(d, 1:2) %>% {  # gv = shortcut for get_vars is > 2x faster than [.data.frame
plot(., col = g, main = "Raw Data")                      
plot(fwithin(., g, mean = "overall.mean"), col = g, 
     main = "Centered on Overall Mean")
plot(fscale(., g, mean = "overall.mean", sd = "within.sd"), col = g,    
     main = "Harmonized Mean and Variance")
}

par(oldpar)

For the manipulation of time series and panel series, collapse offers the functions flag, fdiff and fgrowth.

# A sequence of lags and leads
flag(EuStockMarkets, -1:1) %>% head(3)             
##       F1.DAX     DAX  L1.DAX F1.SMI    SMI L1.SMI F1.CAC    CAC L1.CAC F1.FTSE   FTSE L1.FTSE
## [1,] 1613.63 1628.75      NA 1688.5 1678.1     NA 1750.5 1772.8     NA  2460.2 2443.6      NA
## [2,] 1606.51 1613.63 1628.75 1678.6 1688.5 1678.1 1718.0 1750.5 1772.8  2448.2 2460.2  2443.6
## [3,] 1621.04 1606.51 1613.63 1684.1 1678.6 1688.5 1708.1 1718.0 1750.5  2470.4 2448.2  2460.2

# First and second annual difference of SAX and SMI indices (.c is for non-standard concatenation)
EuStockMarkets[, .c(DAX, SMI)] %>% 
  fdiff(0:1 * frequency(.), 1:2) %>% 
  plot(main = c("DAX and SMI")) 

To facilitate programming and integration with dplyr, all functions introduced so far have a grouped_df method.

library(dplyr)
iris %>% add_vars(wt) %>%             # Adding weight vector to dataset
  filter(Sepal.Length < fmean(Sepal.Length)) %>% 
  select(Species, Sepal.Width:wt) %>% 
  group_by(Species) %>%               # Frequency-weighted group-variance, default (keep.w = TRUE)  
  fvar(wt) %>% arrange(sum.wt)        # also saves group weights in a column called 'sum.wt'
## # A tibble: 3 x 5
##   Species    sum.wt Sepal.Width Petal.Length Petal.Width
##   <fct>       <dbl>       <dbl>        <dbl>       <dbl>
## 1 virginica    3.68      0.0193      0.00993      0.0281
## 2 versicolor  19.2       0.0802      0.181        0.0299
## 3 setosa      43.8       0.142       0.0281       0.0134

Since dplyr operations are rather slow, collapse provides its own set of manipulation verbs yielding significant performance gains.

# Same as above.. executes about 15x faster 
iris %>% add_vars(wt) %>%                    
  fsubset(Sepal.Length < fmean(Sepal.Length), 
          Species, Sepal.Width:wt) %>% 
  fgroup_by(Species) %>%                     
  fvar(wt) %>% roworder(sum.wt)       
## # A tibble: 3 x 5
##   Species    sum.wt Sepal.Width Petal.Length Petal.Width
##   <fct>       <dbl>       <dbl>        <dbl>       <dbl>
## 1 virginica    3.68      0.0193      0.00993      0.0281
## 2 versicolor  19.2       0.0802      0.181        0.0299
## 3 setosa      43.8       0.142       0.0281       0.0134

# Weighted demeaning
iris %>% fgroup_by(Species) %>% num_vars %>% 
  fwithin(wt) %>% head(3)  
## # A tibble: 3 x 4
##   Sepal.Length Sepal.Width Petal.Length Petal.Width
##          <dbl>       <dbl>        <dbl>       <dbl>
## 1       0.135        0.110      -0.0367     -0.0494
## 2      -0.0647      -0.390      -0.0367     -0.0494
## 3      -0.265       -0.190      -0.137      -0.0494

# Generate some additional logical data
settransform(iris, 
  AWMSL = Sepal.Length > fmedian(Sepal.Length, w = wt), 
  AGWMSL = Sepal.Length > fmedian(Sepal.Length, Species, wt, "replace"))

 # Grouped and weighted statistical mode
iris %>% fgroup_by(Species) %>% fmode(wt)
## # A tibble: 3 x 7
##   Species    Sepal.Length Sepal.Width Petal.Length Petal.Width AWMSL AGWMSL
##   <fct>             <dbl>       <dbl>        <dbl>       <dbl> <lgl> <lgl> 
## 1 setosa              5             3          1.4         0.2 FALSE FALSE 
## 2 versicolor          5.8           3          4.5         1.3 TRUE  FALSE 
## 3 virginica           6.3           3          5.1         2.3 TRUE  FALSE

To take things a bit further, let’s consider some multilevel / panel data:

# World Bank World Development Data - supplied with collapse
head(wlddev, 3)
##       country iso3c       date year decade     region     income  OECD PCGDP LIFEEX GINI       ODA
## 1 Afghanistan   AFG 1961-01-01 1960   1960 South Asia Low income FALSE    NA 32.292   NA 114440000
## 2 Afghanistan   AFG 1962-01-01 1961   1960 South Asia Low income FALSE    NA 32.742   NA 233350000
## 3 Afghanistan   AFG 1963-01-01 1962   1960 South Asia Low income FALSE    NA 33.185   NA 114880000

All variables in this data have labels stored in a ‘label’ attribute (the default if you import from STATA / SPSS / SAS with haven). Variable labels can be accessed and set using vlabels and vlabels<-, and viewed together with names and classes using namlab. In general variable labels and other attributes will be preserved in when working with collapse. collapse provides some of the fastest and most advanced summary statistics:

# Fast distinct value count
fNdistinct(wlddev)
## country   iso3c    date    year  decade  region  income    OECD   PCGDP  LIFEEX    GINI     ODA 
##     216     216      59      59       7       7       4       2    8995   10048     363    7564
# Use descr(wlddev) for a detailed description of each variable

# Checking for within-country variation
varying(wlddev, ~ iso3c)
## country    date    year  decade  region  income    OECD   PCGDP  LIFEEX    GINI     ODA 
##   FALSE    TRUE    TRUE    TRUE   FALSE   FALSE   FALSE    TRUE    TRUE    TRUE    TRUE

# Panel data statistics: Summarize GDP and GINI overall, between and within countries
qsu(wlddev, pid = PCGDP + GINI ~ iso3c, 
    vlabels = TRUE, higher = TRUE)
## , , PCGDP: GDP per capita (constant 2010 US$)
## 
##              N/T        Mean          SD          Min         Max    Skew     Kurt
## Overall     8995  11563.6529  18348.4052     131.6464   191586.64  3.1121  16.9585
## Between      203  12488.8577  19628.3668     255.3999  141165.083   3.214  17.2533
## Within   44.3103  11563.6529   6334.9523  -30529.0928   75348.067   0.696  17.0534
## 
## , , GINI: GINI index (World Bank estimate)
## 
##             N/T     Mean      SD      Min      Max    Skew    Kurt
## Overall    1356  39.3976  9.6764     16.2     65.8  0.4613  2.2932
## Between     161  39.5799  8.3679  23.3667  61.7143  0.5169  2.6715
## Within   8.4224  39.3976  3.0406  23.9576  54.7976  0.1421  5.7781

# Panel data ACF: Efficient grouped standardizing and computing covariance with panel-lags
psacf(wlddev, ~ iso3c, ~ year, cols = 9:12)

collapse also has its own very flexible data aggregation command called collap, providing fast and easy multi-data-type, multi-function, weighted, parallelized and fully customized data aggregation.

# Applying the mean to numeric and the mode to categorical data (first 2 arguments are 'by' and 'FUN')
collap(wlddev, ~ iso3c + decade, fmean, 
       catFUN = fmode) %>% head(3)
##   country iso3c       date   year decade                     region      income  OECD PCGDP   LIFEEX
## 1   Aruba   ABW 1961-01-01 1962.5   1960 Latin America & Caribbean  High income FALSE    NA 66.58583
## 2   Aruba   ABW 1967-01-01 1970.0   1970 Latin America & Caribbean  High income FALSE    NA 69.14178
## 3   Aruba   ABW 1976-01-01 1980.0   1980 Latin America & Caribbean  High income FALSE    NA 72.17600
##   GINI      ODA
## 1   NA       NA
## 2   NA       NA
## 3   NA 33630000

# Same as a piped call.. 
wlddev %>% fgroup_by(iso3c, decade) %>% 
  collapg(fmean, fmode) %>% head(3)
## # A tibble: 3 x 12
##   iso3c decade country date        year region             income    OECD  PCGDP LIFEEX  GINI     ODA
##   <fct>  <dbl> <chr>   <date>     <dbl> <fct>              <fct>     <lgl> <dbl>  <dbl> <dbl>   <dbl>
## 1 ABW     1960 Aruba   1961-01-01 1962. "Latin America & ~ High inc~ FALSE    NA   66.6    NA NA     
## 2 ABW     1970 Aruba   1967-01-01 1970  "Latin America & ~ High inc~ FALSE    NA   69.1    NA NA     
## 3 ABW     1980 Aruba   1976-01-01 1980  "Latin America & ~ High inc~ FALSE    NA   72.2    NA  3.36e7

# Same thing done manually... without column reordering 
wlddev %>% fgroup_by(iso3c, decade) %>% {
  add_vars(fmode(cat_vars(.)),  # cat_vars selects non-numeric (categorical) columns
           fmean(num_vars(.), keep.group_vars = FALSE)) 
} %>% head(3)
## # A tibble: 3 x 12
##   iso3c decade country date       region             income    OECD   year PCGDP LIFEEX  GINI     ODA
##   <fct>  <dbl> <chr>   <date>     <fct>              <fct>     <lgl> <dbl> <dbl>  <dbl> <dbl>   <dbl>
## 1 ABW     1960 Aruba   1961-01-01 "Latin America & ~ High inc~ FALSE 1962.    NA   66.6    NA NA     
## 2 ABW     1970 Aruba   1967-01-01 "Latin America & ~ High inc~ FALSE 1970     NA   69.1    NA NA     
## 3 ABW     1980 Aruba   1976-01-01 "Latin America & ~ High inc~ FALSE 1980     NA   72.2    NA  3.36e7

# Adding weights: weighted mean and weighted mode (catFUN is 3rd argument) 
wlddev$weights <- abs(rnorm(fnrow(wlddev)))
collap(wlddev, ~ iso3c + decade, fmean, fmode, # weights are also aggregated using sum
       w = ~ weights, wFUN = fsum) %>% head(3)
##   country iso3c       date     year decade                     region      income  OECD PCGDP
## 1   Aruba   ABW 1965-01-01 1963.375   1960 Latin America & Caribbean  High income FALSE    NA
## 2   Aruba   ABW 1967-01-01 1969.179   1970 Latin America & Caribbean  High income FALSE    NA
## 3   Aruba   ABW 1980-01-01 1980.443   1980 Latin America & Caribbean  High income FALSE    NA
##     LIFEEX GINI      ODA  weights
## 1 66.87902   NA       NA 4.527996
## 2 68.85522   NA       NA 7.314234
## 3 72.29649   NA 33630000 6.525710

# Can also apply multiple functions to columns, return in wide or long format or as list of data frames 
collap(wlddev, PCGDP + LIFEEX ~ region + income, 
       list(fmean, fsd, fmin, fmax), return = "long") %>% head(3)
##   Function              region              income     PCGDP   LIFEEX
## 1    fmean East Asia & Pacific         High income 26042.280 73.22799
## 2    fmean East Asia & Pacific Lower middle income  1621.178 58.83796
## 3    fmean East Asia & Pacific Upper middle income  3432.559 66.41750

The default (keep.col.order = TRUE) ensures that the data remains in the same order, and, when working with Fast Statistical Functions, all column attributes are preserved. When aggregating with multiple functions, you can parallelize over them (internally done with parallel::mclapply).

Time computations on panel data are also simple and computationally very fast.

# Panel Lag and lead of PCGDP and LIFEEX
L(wlddev, -1:1, PCGDP + LIFEEX ~ iso3c, ~year) %>% head3
##   iso3c year F1.PCGDP PCGDP L1.PCGDP F1.LIFEEX LIFEEX L1.LIFEEX
## 1   AFG 1960       NA    NA       NA    32.742 32.292        NA
## 2   AFG 1961       NA    NA       NA    33.185 32.742    32.292
## 3   AFG 1962       NA    NA       NA    33.624 33.185    32.742

# Equivalent piped call
wlddev %>% fgroup_by(iso3c) %>% 
  fselect(iso3c, year, PCGDP, LIFEEX) %>% 
  flag(-1:1, year) %>% head(3)
## # A tibble: 3 x 8
##   iso3c  year F1.PCGDP PCGDP L1.PCGDP F1.LIFEEX LIFEEX L1.LIFEEX
##   <fct> <int>    <dbl> <dbl>    <dbl>     <dbl>  <dbl>     <dbl>
## 1 AFG    1960       NA    NA       NA      32.7   32.3      NA  
## 2 AFG    1961       NA    NA       NA      33.2   32.7      32.3
## 3 AFG    1962       NA    NA       NA      33.6   33.2      32.7

# Or using plm classes for panel data
pwlddev <- plm::pdata.frame(wlddev, index = .c(iso3c, year))
L(pwlddev, -1:1, cols = .c(PCGDP, LIFEEX)) %>% head(3)
##          iso3c year F1.PCGDP PCGDP L1.PCGDP F1.LIFEEX LIFEEX L1.LIFEEX
## ABW-1960   ABW 1960       NA    NA       NA    66.074 65.662        NA
## ABW-1961   ABW 1961       NA    NA       NA    66.444 66.074    65.662
## ABW-1962   ABW 1962       NA    NA       NA    66.787 66.444    66.074

# Growth rates in percentage terms: 1 and 10-year
G(pwlddev, c(1, 10), cols = 9:12) %>% head(3) # or use Dlog, or G(..., logdiff = TRUE) for percentages
##          iso3c year G1.PCGDP L10G1.PCGDP G1.LIFEEX L10G1.LIFEEX G1.GINI L10G1.GINI G1.ODA L10G1.ODA
## ABW-1960   ABW 1960       NA          NA        NA           NA      NA         NA     NA        NA
## ABW-1961   ABW 1961       NA          NA 0.6274558           NA      NA         NA     NA        NA
## ABW-1962   ABW 1962       NA          NA 0.5599782           NA      NA         NA     NA        NA

Equivalently we can can compute lagged / leaded and suitably iterated (log-) differences, as well as quasi-(log-)differences of the form \(x_t - \rho x_{t-1}\). The operators L, D, Dlog and G are shorthand’s for the functions flag, fdiff and fgrowth allowing formula input. Similar operators exist for fwithin, fscale, etc. which also support plm classes.

This short demonstration illustrated some basic features of collapse. A more complete overview of the package is provided in the documentation and the vignettes.

Benchmark

For benchmarking I use some product-level trade data from the UN Comtrade database, processed by tadestatistics.io.

library(tradestatistics)
# US HS4-level trade from 2000 to 2018
us_trade <- ots_create_tidy_data(years = 2000:2018,
                                 reporters = "usa",
                                 table = "yrpc")

Downloading US product-level trade (HS4) from 2000 to 2018 gives about 2.6 million observations:

fdim(us_trade)
## [1] 2569787      16
head(us_trade, 1)
##    year reporter_iso                                                   reporter_fullname_english
## 1: 2017          usa USA, Puerto Rico and US Virgin Islands (excludes Virgin Islands until 1981)
##    partner_iso partner_fullname_english section_code section_color section_shortname_english
## 1:         afg              Afghanistan           01       #74c0e2           Animal Products
##         section_fullname_english group_code group_fullname_english product_code
## 1: Live Animals; Animal Products         01          Animals; live         0101
##    product_shortname_english               product_fullname_english export_value_usd
## 1:                    Horses Horses, asses, mules and hinnies; live             3005
##    import_value_usd
## 1:               NA

# 19 years, 221 trading partners, 1222 products, unbalanced panel with product-time gaps...
fNdistinct(us_trade)
##                      year              reporter_iso reporter_fullname_english 
##                        19                         1                         1 
##               partner_iso  partner_fullname_english              section_code 
##                       221                       221                        22 
##             section_color section_shortname_english  section_fullname_english 
##                        22                        22                        22 
##                group_code    group_fullname_english              product_code 
##                        97                        97                      1222 
## product_shortname_english  product_fullname_english          export_value_usd 
##                      1217                      1222                   1081492 
##          import_value_usd 
##                    684781

# Summarizing data between and within partner-product pairs
qsu(us_trade, pid = export_value_usd + import_value_usd ~ partner_iso + product_code)
## , , export_value_usd
## 
##               N/T         Mean           SD              Min             Max
## Overall  2,450301  11,054800.6   157,295999                1  2.83030606e+10
## Between    205513  7,268011.31   118,709845                1  1.66436161e+10
## Within    11.9229  11,054800.6  68,344396.5  -1.01599067e+10  1.67185229e+10
## 
## , , import_value_usd
## 
##               N/T         Mean          SD              Min             Max
## Overall  1,248201  31,421502.4  505,644905                1  8.51970855e+10
## Between    130114  16,250758.2  328,538895                1  4.36545695e+10
## Within     9.5931  31,421502.4  212,076350  -3.32316111e+10  4.15739375e+10

It would also be interesting to summarize the trade flows for each partner, but that would be too large to print to the console. We can however get the qsu output as a list of matrices:

# Doing all of that by partner - variance of flows between and within traded products for each partner
l <- qsu(us_trade, 
         by = export_value_usd + import_value_usd ~ partner_iso,
         pid = ~ partner_iso + product_code, array = FALSE)
str(l, give.attr = FALSE)
## List of 2
##  $ export_value_usd:List of 3
##   ..$ Overall: 'qsu' num [1:221, 1:5] 7250 12427 6692 5941 4017 ...
##   ..$ Between: 'qsu' num [1:221, 1:5] 901 1151 872 903 695 ...
##   ..$ Within : 'qsu' num [1:221, 1:5] 8.05 10.8 7.67 6.58 5.78 ...
##  $ import_value_usd:List of 3
##   ..$ Overall: 'qsu' num [1:221, 1:5] 1157 1547 361 1512 685 ...
##   ..$ Between: 'qsu' num [1:221, 1:5] 312 532 167 347 235 ...
##   ..$ Within : 'qsu' num [1:221, 1:5] 3.71 2.91 2.16 4.36 2.91 ...

Now with the function unlist2d, we can efficiently turn this into a tidy data frame:

unlist2d(l, idcols = c("Variable", "Trans"),
         row.names = "Partner", DT = TRUE) %>% head(3)
##            Variable   Trans Partner     N      Mean         SD  Min        Max
## 1: export_value_usd Overall     afg  7250 2170074.0 21176449.3   56 1115125722
## 2: export_value_usd Overall     ago 12427 2188174.6 17158413.8    1  687323408
## 3: export_value_usd Overall     aia  6692  125729.3   586862.2 2503   17698445

If l were some statistical object we could first pull out relevant elements using get_elem, possibly process those elements using rapply2d and then apply unlist2d to get the data frame (or data.table with DT = TRUE). These are the main collapse list-processing functions.

Now on to the benchmark. It is run on a Windows 8.1 laptop with a 2x 2.2 GHZ Intel i5 processor, 8GB DDR3 RAM and a Samsung 850 EVO SSD hard drive.

library(microbenchmark)
library(dplyr)
library(data.table) # Default for this machine is 2 threads

# Grouping (data.table:::forderv does not compute the unique groups yet)
microbenchmark(collapse = fgroup_by(us_trade, partner_iso, group_code, year),
               data.table = data.table:::forderv(us_trade, c("partner_iso", "group_code", "year"), retGrp = TRUE),
               dplyr = group_by(us_trade, partner_iso, group_code, year), times = 10)
## Unit: milliseconds
##        expr       min        lq      mean    median        uq        max neval cld
##    collapse  97.23371  98.32389  123.7255  107.0449  135.9751   239.6009    10   a
##  data.table 102.88811 107.66742 1267.0891  111.4340  118.1944 11658.7908    10   a
##       dplyr 924.67524 979.54759 1042.8808 1008.5981 1078.1861  1354.4466    10   a

# Sum
microbenchmark(collapse = collap(us_trade, export_value_usd + import_value_usd ~ partner_iso + group_code + year, fsum),
               data.table = us_trade[, list(export_value_usd = sum(export_value_usd, na.rm = TRUE),
                                            import_value_usd = sum(import_value_usd, na.rm = TRUE)),
                                     by = c("partner_iso", "group_code", "year")],
               dplyr = group_by(us_trade, partner_iso, group_code, year) %>%
                 dplyr::select(export_value_usd, import_value_usd) %>% summarise_all(sum, na.rm = TRUE), times = 10)
## Unit: milliseconds
##        expr       min        lq      mean    median        uq       max neval cld
##    collapse  107.1917  116.5861  128.3973  118.9365  150.3367  161.3135    10  a 
##  data.table  169.3562  182.7400  198.2929  189.3267  221.8608  226.7869    10  a 
##       dplyr 2332.0459 2426.7485 2652.3324 2568.5637 2791.4008 3263.4077    10   b

# Mean
microbenchmark(collapse = collap(us_trade, export_value_usd + import_value_usd ~ partner_iso + group_code + year, fmean),
               data.table = us_trade[, list(export_value_usd = mean(export_value_usd, na.rm = TRUE),
                                            import_value_usd = mean(import_value_usd, na.rm = TRUE)),
                                     by = c("partner_iso", "group_code", "year")],
               dplyr = group_by(us_trade, partner_iso, group_code, year) %>%
                 dplyr::select(export_value_usd, import_value_usd) %>% summarise_all(mean, na.rm = TRUE), times = 10)
## Unit: milliseconds
##        expr       min        lq      mean    median        uq       max neval cld
##    collapse  121.3204  125.5664  142.8944  132.4904  137.1090  214.3933    10  a 
##  data.table  177.7091  187.3493  210.5166  201.0806  224.2513  269.5401    10  a 
##       dplyr 6303.0662 7037.0073 7270.0693 7242.0813 7872.5290 8066.6510    10   b

# Variance
microbenchmark(collapse = collap(us_trade, export_value_usd + import_value_usd ~ partner_iso + group_code + year, fvar),
               data.table = us_trade[, list(export_value_usd = var(export_value_usd, na.rm = TRUE),
                                            import_value_usd = var(import_value_usd, na.rm = TRUE)),
                                     by = c("partner_iso", "group_code", "year")],
               dplyr = group_by(us_trade, partner_iso, group_code, year) %>%
                 dplyr::select(export_value_usd, import_value_usd) %>% summarise_all(var, na.rm = TRUE), times = 10)
## Unit: milliseconds
##        expr        min         lq       mean     median         uq        max neval cld
##    collapse   123.8475   126.6842   135.6485   134.5366   142.3431   153.3176    10  a 
##  data.table   269.8578   284.1863   300.0291   287.6637   300.2628   365.7684    10  a 
##       dplyr 10408.3787 10815.5928 11298.6246 11225.9573 11726.4892 12275.4899    10   b

# Mode (forget trying to do this with dplyr or data.table using some mode function created in base R, it runs forever...)
microbenchmark(collapse = fgroup_by(us_trade, partner_iso, group_code, year) %>% 
                 fselect(export_value_usd, import_value_usd) %>% fmode, times = 10)
## Unit: milliseconds
##      expr      min       lq     mean  median       uq     max neval
##  collapse 413.1148 430.7063 451.1648 443.147 459.1362 525.748    10

# Weighted Mean (not easily done with dplyr)
settransform(us_trade, weights = abs(rnorm(length(year))))
microbenchmark(collapse = collap(us_trade, export_value_usd + import_value_usd ~ partner_iso + group_code + year, fmean, w = ~ weights, keep.w = FALSE),
               data.table = us_trade[, list(export_value_usd = weighted.mean(export_value_usd, weights, na.rm = TRUE),
                                            import_value_usd = weighted.mean(import_value_usd, weights, na.rm = TRUE)),
                                     by = c("partner_iso", "group_code", "year")], times = 10)
## Unit: milliseconds
##        expr       min        lq      mean    median        uq       max neval cld
##    collapse  114.2594  115.2599  118.7735  118.5715  122.2374  124.0246    10  a 
##  data.table 5808.7005 5867.3619 5957.9288 5904.3373 5963.8040 6507.7393    10   b


# Replace values with group-sum
microbenchmark(collapse = fgroup_by(us_trade, partner_iso, group_code, year) %>%
                 fselect(export_value_usd, import_value_usd) %>% fsum(TRA = "replace_fill"),
               data.table = us_trade[, `:=`(export_value_usd2 = sum(export_value_usd, na.rm = TRUE),
                                            import_value_usd2 = sum(import_value_usd, na.rm = TRUE)),
                                     by = c("partner_iso", "group_code", "year")],
               dplyr = group_by(us_trade, partner_iso, group_code, year) %>%
                 dplyr::select(export_value_usd, import_value_usd) %>% mutate_all(sum, na.rm = TRUE), times = 10)
## Unit: milliseconds
##        expr       min        lq      mean    median        uq       max neval cld
##    collapse  128.8186  139.7133  154.8318  153.3190  167.7827  189.6136    10 a  
##  data.table  823.7694  849.4982  861.1539  853.3544  869.0394  917.6767    10  b 
##       dplyr 2464.5943 2653.9227 2812.6778 2772.3155 2884.5482 3335.0273    10   c

# Centering, partner-product
microbenchmark(collapse = fgroup_by(us_trade, partner_iso, product_code) %>%
                 fselect(export_value_usd, import_value_usd) %>% fwithin,
               data.table = us_trade[, `:=`(export_value_usd2 = export_value_usd - mean(export_value_usd, na.rm = TRUE),
                                            import_value_usd2 = import_value_usd - mean(import_value_usd, na.rm = TRUE)),
                                     by = c("partner_iso", "group_code", "year")],
               dplyr = group_by(us_trade, partner_iso, group_code, year) %>%
                 dplyr::select(export_value_usd, import_value_usd) %>% mutate_all(function(x) x - mean(x, na.rm = TRUE)), times = 10)
## Unit: milliseconds
##        expr       min         lq       mean     median        uq       max neval cld
##    collapse   80.1893   88.50289   96.74396   96.62168  105.6455  109.0914    10 a  
##  data.table 4537.3741 4578.44447 4788.89139 4816.80366 4876.4886 5071.2853    10  b 
##       dplyr 6822.4752 7190.71493 7388.08024 7372.80011 7706.3514 7902.9720    10   c

# Lag
# Much better to sort data for dplyr
setorder(us_trade, partner_iso, product_code, year)
# We have an additional problem here: There are time-gaps within some partner-product pairs
tryCatch(L(us_trade, 1, export_value_usd + import_value_usd ~ partner_iso + product_code, ~ year),
         error = function(e) e)
## <Rcpp::exception in L.data.frame(us_trade, 1, export_value_usd + import_value_usd ~     partner_iso + product_code, ~year): Gaps in timevar within one or more groups>
# The solution is that we create a unique id for each continuous partner-product sequence
settransform(us_trade, id = seqid(year + unattrib(finteraction(partner_iso, product_code)) * 20L))
# Notes: Normally id = seqid(year) would be enough on sorted data, but here we also have very different start and end dates, with the potential of overlaps...
fNdistinct(us_trade$id)
## [1] 423884
# Another comparison..
microbenchmark(fNdistinct(us_trade$id), n_distinct(us_trade$id))
## Unit: milliseconds
##                     expr      min       lq     mean   median       uq       max neval cld
##  fNdistinct(us_trade$id) 26.46380 26.84445 27.91192 27.25768 28.42417  37.60704   100  a 
##  n_distinct(us_trade$id) 56.70598 64.67573 69.11154 65.50040 68.60963 145.39718   100   b

# Here we go now:
microbenchmark(collapse = L(us_trade, 1, export_value_usd + import_value_usd ~ id),
               collapse_ordered = L(us_trade, 1, export_value_usd + import_value_usd ~ id, ~ year),
               data.table = us_trade[, shift(.SD), keyby = id,
                                     .SDcols = c("export_value_usd","import_value_usd")],
               data.table_ordered = us_trade[order(year), shift(.SD), keyby = id,
                                             .SDcols = c("export_value_usd","import_value_usd")],
               dplyr = group_by(us_trade, id) %>% dplyr::select(export_value_usd, import_value_usd) %>%
                 mutate_all(lag), times = 10)
## Unit: milliseconds
##                expr         min          lq        mean      median          uq         max neval
##            collapse    18.57103    29.47686    34.75352    34.34208    39.30635    55.87373    10
##    collapse_ordered    51.26266    57.90416    67.40628    66.86212    73.63482    94.11623    10
##          data.table  7594.63120  7820.26944  7968.29873  7879.71628  8266.03880  8353.21097    10
##  data.table_ordered  7622.66044  7635.12055  8090.12031  7726.25161  8492.04252  9428.44336    10
##               dplyr 32428.73832 32583.82844 33584.48046 32903.50014 34725.72392 36189.46410    10
##  cld
##  a  
##  a  
##   b 
##   b 
##    c

# Note: you can do ordered lags using mutate_all(lag, order_by = "year") for dplyr, but at computation times in excess of 90 seconds..

The benchmarks show that collapse is consistently very fast. More extensive benchmarks against dplyr and plm are provided in the corresponding vignettes.