Compute fabio footprints

[lbm364dl]

No description provided.

[github-actions]

Remaining comments which cannot be posted as a review comment to avoid GitHub Rate Limit

air

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 360 in 1e57dab

cbs_yr, shares_mat, dims, fd_cols

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 364 in 1e57dab

fd_flat, shares_mat, dims$n_areas, length(fd_cols)

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 375 in 1e57dab

area_code, item_cbs_code, dplyr::all_of(fd_cols)

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 383 in 1e57dab

dplyr::all_of(fd_cols), ~ tidyr::replace_na(.x, 0)

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 430 in 1e57dab

i = integer(0), j = integer(0), x = numeric(0),

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 446 in 1e57dab

value = sum(value), .by = c(proc_idx, item_idx)

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 449 in 1e57dab

i = agg$proc_idx, j = agg$item_idx, x = agg$value,

---

[air] _{reported by reviewdog 🐶}

whep/R/io_model.R

Line 494 in 1e57dab

dims$areas, each = length(fd_cols)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Line 6 in 1e57dab

nrow = 2, byrow = TRUE

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 17 to 18 in 1e57dab

	z = z, x = x, l_inv = l_inv, y = y,
	extensions = extensions, labels = labels

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 24 to 30 in 1e57dab

	testthat::test_that(
	"compute_footprint returns tidy tibble",
	{
	f <- footprint_2sector_fixture()
	result <- compute_footprint(
	f$l_inv, f$x, f$y, f$extensions, f$labels
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 32 to 38 in 1e57dab

	testthat::expect_s3_class(result, "tbl_df")
	pointblank::expect_col_exists(
	result,
	c(
	"origin_area", "origin_item",
	"target_area", "target_item", "value"
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 40 to 42 in 1e57dab

	testthat::expect_true(nrow(result) > 0)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 44 to 58 in 1e57dab

	testthat::test_that(
	"footprint sums match total extensions",
	{
	z <- matrix(
	c(5, 10, 3, 2),
	nrow = 2, byrow = TRUE
	)
	y <- matrix(c(85, 45), ncol = 1)
	x <- rowSums(z) + as.vector(y)
	l_inv <- compute_leontief_inverse(z, x)
	extensions <- c(30, 10)
	labels <- tibble::tibble(
	area_code = c(1L, 1L),
	item_cbs_code = c(10L, 20L)
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 60 to 62 in 1e57dab

	result <- compute_footprint(
	l_inv, x, y, extensions, labels
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 64 to 69 in 1e57dab

	testthat::expect_equal(
	sum(result$value), sum(extensions),
	tolerance = 1e-6
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 71 to 82 in 1e57dab

	testthat::test_that(
	"footprint zeros yield no rows",
	{
	z <- matrix(c(0, 0, 0, 0), nrow = 2)
	x <- c(100, 200)
	l_inv <- compute_leontief_inverse(z, x)
	y <- matrix(c(100, 200), ncol = 1)
	extensions <- c(0, 0)
	labels <- tibble::tibble(
	area_code = c(1L, 1L),
	item_cbs_code = c(10L, 20L)
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 84 to 89 in 1e57dab

	result <- compute_footprint(
	l_inv, x, y, extensions, labels
	)
	testthat::expect_equal(nrow(result), 0)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Line 107 in 1e57dab

x_vec = x, y_mat = y, extensions = ext,

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 114 to 128 in 1e57dab

	testthat::test_that(
	"2-country footprint traces origin correctly",
	{
	z <- matrix(
	c(5, 2, 1, 0, 3, 1, 0, 2, 0, 1, 4, 0, 1, 0, 1, 3),
	nrow = 4, byrow = TRUE
	)
	y <- diag(4) * 50
	x <- rowSums(z) + rowSums(y)
	l_inv <- compute_leontief_inverse(z, x)
	extensions <- c(10, 5, 8, 3)
	labels <- tibble::tibble(
	area_code = c(1L, 1L, 2L, 2L),
	item_cbs_code = c(10L, 20L, 10L, 20L)
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 130 to 132 in 1e57dab

	result <- compute_footprint(
	l_inv, x, y, extensions, labels
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 134 to 140 in 1e57dab

	testthat::expect_true(nrow(result) > 0)
	testthat::expect_equal(
	sum(result$value), sum(extensions),
	tolerance = 1e-6
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 142 to 153 in 1e57dab

	testthat::test_that(
	"sparse path (z_mat) matches dense path (l_inv)",
	{
	f <- footprint_2sector_fixture()
	dense <- compute_footprint(
	f$l_inv, f$x, f$y, f$extensions, f$labels
	)
	sparse <- compute_footprint(
	x_vec = f$x, y_mat = f$y,
	extensions = f$extensions, labels = f$labels,
	z_mat = f$z
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 155 to 161 in 1e57dab

	testthat::expect_equal(
	sum(sparse$value), sum(dense$value),
	tolerance = 1e-6
	)
	testthat::expect_equal(nrow(sparse), nrow(dense))
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 163 to 184 in 1e57dab

	testthat::test_that(
	"fd_labels populates target_area and target_item",
	{
	z <- matrix(
	c(5, 2, 1, 0, 3, 1, 0, 2, 0, 1, 4, 0, 1, 0, 1, 3),
	nrow = 4, byrow = TRUE
	)
	y <- matrix(
	c(30, 20, 10, 5, 25, 15, 8, 3),
	nrow = 4, ncol = 4
	)
	x <- rowSums(z) + rowSums(y)
	l_inv <- compute_leontief_inverse(z, x)
	extensions <- c(10, 5, 8, 3)
	labels <- tibble::tibble(
	area_code = c(1L, 1L, 2L, 2L),
	item_cbs_code = c(10L, 20L, 10L, 20L)
	)
	fd_labels <- tibble::tibble(
	area_code = c(1L, 1L, 2L, 2L),
	fd_col = c("food", "other", "food", "other")
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 186 to 189 in 1e57dab

	result <- compute_footprint(
	l_inv, x, y, extensions, labels,
	fd_labels = fd_labels
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 191 to 206 in 1e57dab

	pointblank::expect_col_vals_not_null(
	result, target_area
	)
	pointblank::expect_col_vals_not_null(
	result, target_item
	)
	pointblank::expect_col_vals_in_set(
	result, target_area,
	set = c(1L, 2L)
	)
	pointblank::expect_col_vals_in_set(
	result, target_item,
	set = c(10L, 20L)
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 208 to 211 in 1e57dab

	testthat::test_that(
	"fd_labels yields target_fd and target_item columns",
	{
	su <- tibble::tribble(

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 219 to 223 in 1e57dab

	btd <- tibble::tibble(
	year = 2000L, item_cbs_code = 10,
	bilateral_trade = list(matrix(c(0, 5, 3, 0), 2))
	)
	cbs <- tibble::tribble(

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Line 231 in 1e57dab

io <- build_io_model(su, btd, cbs)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 233 to 239 in 1e57dab

	# fd_labels is present in io output
	pointblank::expect_col_exists(io, "fd_labels")
	fd_labs <- io$fd_labels[[1]]
	pointblank::expect_col_exists(
	fd_labs, c("area_code", "fd_col")
	)
	pointblank::expect_col_vals_not_null(fd_labs, fd_col)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 241 to 248 in 1e57dab

	# compute_footprint with fd_labels adds target_fd
	x <- io$X[[1]]
	ext <- rep(1, length(x))
	result <- compute_footprint(
	x_vec = x, y_mat = io$Y[[1]],
	extensions = ext, labels = io$labels[[1]],
	z_mat = io$Z[[1]], fd_labels = fd_labs
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 250 to 262 in 1e57dab

	pointblank::expect_col_exists(result, "target_fd")
	pointblank::expect_col_vals_not_null(result, target_area)
	pointblank::expect_col_vals_not_null(result, target_item)
	pointblank::expect_col_vals_in_set(
	result, target_fd,
	set = c("food", "other_uses")
	)
	pointblank::expect_col_vals_in_set(
	result, target_item,
	set = io$labels[[1]]$item_cbs_code
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 1 to 4 in 1e57dab

	testthat::test_that(
	"get_land_fp_production example returns expected structure",
	{
	result <- get_land_fp_production(example = TRUE)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 6 to 19 in 1e57dab

	testthat::expect_s3_class(result, "tbl_df")
	pointblank::expect_col_exists(
	result,
	c(
	"year", "area_code", "item_cbs_code", "impact",
	"element", "origin", "group", "impact_u"
	)
	)
	testthat::expect_type(result$year, "integer")
	testthat::expect_type(result$area_code, "integer")
	testthat::expect_type(result$item_cbs_code, "integer")
	pointblank::expect_col_vals_in_set(
	result, impact,
	set = "Land"

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 21 to 26 in 1e57dab

	pointblank::expect_col_vals_in_set(
	result, origin,
	set = "Production"
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 29 to 34 in 1e57dab

	testthat::test_that(
	"get_land_fp_production filters and cleans land_fp",
	{
	local_mocked_bindings(
	whep_read_file = function(...) {
	tibble::tribble(

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 44 to 53 in 1e57dab

	},
	add_area_code = function(data, name_column, code_column) {
	data[[code_column]] <- dplyr::if_else(
	data[[name_column]] == "Spain",
	203L,
	NA_integer_
	)
	data
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Line 55 in 1e57dab

result <- get_land_fp_production()

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 57 to 71 in 1e57dab

	testthat::expect_equal(nrow(result), 1)
	pointblank::expect_col_vals_in_set(
	result, impact,
	set = "Land"
	)
	pointblank::expect_col_vals_in_set(
	result, origin,
	set = "Production"
	)
	testthat::expect_type(result$year, "integer")
	testthat::expect_type(result$area_code, "integer")
	testthat::expect_type(result$item_cbs_code, "integer")
	testthat::expect_equal(result$area_code[[1]], 203L)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 71 to 82 in 1e57dab

	testthat::test_that(
	"build_io_model handles 2-country 2-item example",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(f$su, f$btd, f$cbs)
	testthat::expect_s3_class(result, "tbl_df")
	testthat::expect_equal(nrow(result), 1)
	pointblank::expect_col_exists(
	result,
	c("year", "Z", "Y", "X", "labels")
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 84 to 103 in 1e57dab

	z <- result$Z[[1]]
	y <- result$Y[[1]]
	x <- result$X[[1]]
	n <- 2 * 2
	testthat::expect_equal(dim(z), c(n, n))
	testthat::expect_equal(nrow(y), n)
	testthat::expect_equal(length(x), n)
	}
	)
	testthat::test_that(
	"build_io_model uses default input builders",
	{
	f <- io_two_country_fixture()
	local_mocked_bindings(
	build_supply_use = function(...) f$su,
	get_bilateral_trade = function(...) f$btd,
	get_wide_cbs = function(...) f$cbs
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Line 105 in 1e57dab

result <- build_io_model(years = 2000)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 107 to 111 in 1e57dab

	testthat::expect_s3_class(result, "tbl_df")
	testthat::expect_equal(nrow(result), 1)
	testthat::expect_equal(result$year[[1]], 2000)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Line 141 in 1e57dab

labels, c("area_code", "item_cbs_code")

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Line 144 in 1e57dab

nrow(labels), length(result$X[[1]])

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 148 to 153 in 1e57dab

	testthat::test_that(
	"build_io_model returns fd_labels with correct shape",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(f$su, f$btd, f$cbs)
	fd_labs <- result$fd_labels[[1]]

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 155 to 199 in 1e57dab

	pointblank::expect_col_exists(
	fd_labs, c("area_code", "fd_col")
	)
	# 2 areas * 2 fd_cols (food, other_uses) = 4 rows
	testthat::expect_equal(nrow(fd_labs), 4L)
	testthat::expect_equal(
	ncol(result$Y[[1]]), nrow(fd_labs)
	)
	pointblank::expect_col_vals_in_set(
	fd_labs, fd_col, set = c("food", "other_uses")
	)
	}
	)
	testthat::test_that(
	"build_io_model validates missing columns",
	{
	f <- io_two_country_fixture()
	bad_su <- dplyr::select(f$su, -value)
	testthat::expect_error(
	build_io_model(bad_su, f$btd, f$cbs),
	"missing columns"
	)
	}
	)
	testthat::test_that(
	"build_io_model with years = NULL computes all years",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(f$su, f$btd, f$cbs, years = NULL)
	testthat::expect_equal(nrow(result), 1)
	testthat::expect_equal(result$year[[1]], 2000)
	}
	)
	testthat::test_that(
	"build_io_model with years filters to specified years",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(
	f$su, f$btd, f$cbs,
	years = c(2000)
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 201 to 226 in 1e57dab

	testthat::expect_equal(nrow(result), 1)
	testthat::expect_equal(result$year[[1]], 2000)
	}
	)
	testthat::test_that(
	"build_io_model with invalid years raises error",
	{
	f <- io_two_country_fixture()
	testthat::expect_error(
	build_io_model(f$su, f$btd, f$cbs, years = c(2001)),
	"not available in data"
	)
	}
	)
	testthat::test_that(
	"build_io_model with non-numeric years raises error",
	{
	f <- io_two_country_fixture()
	testthat::expect_error(
	build_io_model(f$su, f$btd, f$cbs, years = "2000"),
	"must be numeric or NULL"
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 230 to 286 in 1e57dab

	testthat::test_that(
	".block_diag builds correct block-diagonal",
	{
	a <- matrix(1:4, 2, 2)
	b <- matrix(5:7, 1, 3)
	result <- .block_diag(list(a, b))
	testthat::expect_equal(dim(result), c(3, 5))
	testthat::expect_equal(
	as.matrix(result[1:2, 1:2]),
	a
	)
	testthat::expect_equal(
	as.numeric(result[3, 3:5]),
	as.vector(b)
	)
	testthat::expect_equal(sum(result[1:2, 3:5]), 0)
	testthat::expect_equal(sum(result[3, 1:2]), 0)
	}
	)
	testthat::test_that(
	".row_normalize normalises rows to sum 1",
	{
	m <- matrix(c(10, 20, 30, 60), nrow = 2)
	result <- .row_normalize(m)
	testthat::expect_equal(
	as.numeric(Matrix::rowSums(result)), c(1, 1)
	)
	}
	)
	testthat::test_that(
	".row_normalize handles zero rows gracefully",
	{
	m <- matrix(c(0, 5, 0, 10), nrow = 2)
	result <- .row_normalize(m)
	testthat::expect_equal(result[1, ], c(0, 0))
	testthat::expect_equal(sum(result[2, ]), 1)
	}
	)
	testthat::test_that(
	".build_shares_matrix produces correct shares",
	{
	shares <- list(
	"10" = matrix(
	c(0.9, 0.1, 0.05, 0.95),
	nrow = 2
	),
	"20" = diag(2)
	)
	mat <- .build_shares_matrix(
	shares, c(10, 20), 2, 2
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 288 to 316 in 1e57dab

	testthat::expect_equal(dim(mat), c(4, 2))
	# Row 1 = area 1, item 10 => shares[["10"]][1, ]
	testthat::expect_equal(
	mat[1, ], c(0.9, 0.05)
	)
	# Row 2 = area 1, item 20 => shares[["20"]][1, ]
	testthat::expect_equal(mat[2, ], c(1, 0))
	# Row 3 = area 2, item 10 => shares[["10"]][2, ]
	testthat::expect_equal(
	mat[3, ], c(0.1, 0.95)
	)
	}
	)
	testthat::test_that(
	".fix_negative_output returns both X and Y",
	{
	z <- matrix(c(5, 0, 0, 3), nrow = 2)
	y <- matrix(c(10, 20), ncol = 1)
	result <- .fix_negative_output(z, y)
	testthat::expect_true(is.list(result))
	testthat::expect_true("X" %in% names(result))
	testthat::expect_true("Y" %in% names(result))
	testthat::expect_equal(
	result$X, rowSums(z) + rowSums(y)
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 3 to 11 in 1e57dab

	testthat::test_that(
	"compute_leontief_inverse works for 2-sector model",
	{
	z <- matrix(
	c(10, 20, 15, 5),
	nrow = 2, byrow = TRUE
	)
	x <- c(100, 200)
	l_inv <- compute_leontief_inverse(z, x)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 13 to 17 in 1e57dab

	testthat::expect_true(is.matrix(l_inv))
	testthat::expect_equal(dim(l_inv), c(2, 2))
	testthat::expect_true(all(l_inv >= 0))
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 22 in 1e57dab

nrow = 2, byrow = TRUE

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 31 in 1e57dab

l_inv %*% (diag(2) - a), diag(2),

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 36 to 41 in 1e57dab

	testthat::test_that(
	"Leontief handles zero output sectors",
	{
	z <- matrix(c(0, 0, 5, 0), nrow = 2)
	x <- c(0, 100)
	l_inv <- compute_leontief_inverse(z, x)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 43 to 47 in 1e57dab

	testthat::expect_true(is.matrix(l_inv))
	testthat::expect_true(all(l_inv >= 0))
	testthat::expect_equal(l_inv[1, 1], 1)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 56 in 1e57dab

matrix(1, nrow = 2, ncol = 3), c(1, 2)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 62 in 1e57dab

matrix(0, 2, 2), c(1, 2, 3)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 68 to 80 in 1e57dab

	testthat::test_that(
	"compute_leontief_inverse aborts for large n",
	{
	z_big <- Matrix::sparseMatrix(
	i = 1:10, j = 1:10, x = rep(1, 10), dims = c(10, 10)
	)
	x_big <- rep(100, 10)
	testthat::expect_error(
	compute_leontief_inverse(z_big, x_big, max_n = 5),
	"System too large"
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 82 to 94 in 1e57dab

	testthat::test_that(
	"A column capping prevents singularity when inputs exceed output",
	{
	# z col 2 sums to 14 against x = 10, so A col 2 > 1
	z <- matrix(c(5, 6, 3, 8), nrow = 2, byrow = TRUE)
	x <- c(10, 10)
	l_inv <- NULL
	testthat::expect_warning(
	{
	l_inv <- compute_leontief_inverse(z, x)
	},
	"Capping"
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 96 to 99 in 1e57dab

	testthat::expect_true(is.matrix(l_inv))
	testthat::expect_true(all(l_inv >= 0))
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 101 to 109 in 1e57dab

	testthat::test_that(
	"3-sector model y can be recovered from L",
	{
	z <- matrix(
	c(5, 10, 0, 3, 2, 8, 1, 4, 6),
	nrow = 3, byrow = TRUE
	)
	y <- c(85, 87, 89)
	x <- rowSums(z) + y

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 111 to 112 in 1e57dab

	l_inv <- compute_leontief_inverse(z, x)
	x_recovered <- l_inv %*% y

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 114 to 119 in 1e57dab

	testthat::expect_equal(
	as.vector(x_recovered), x,
	tolerance = 1e-8
	)
	}
	)

[github-actions]

Remaining comments which cannot be posted as a review comment to avoid GitHub Rate Limit

air

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 233 to 239 in bbb1b89

	# fd_labels is present in io output
	pointblank::expect_col_exists(io, "fd_labels")
	fd_labs <- io$fd_labels[[1]]
	pointblank::expect_col_exists(
	fd_labs, c("area_code", "fd_col")
	)
	pointblank::expect_col_vals_not_null(fd_labs, fd_col)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 241 to 248 in bbb1b89

	# compute_footprint with fd_labels adds target_fd
	x <- io$X[[1]]
	ext <- rep(1, length(x))
	result <- compute_footprint(
	x_vec = x, y_mat = io$Y[[1]],
	extensions = ext, labels = io$labels[[1]],
	z_mat = io$Z[[1]], fd_labels = fd_labs
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint.R

Lines 250 to 262 in bbb1b89

	pointblank::expect_col_exists(result, "target_fd")
	pointblank::expect_col_vals_not_null(result, target_area)
	pointblank::expect_col_vals_not_null(result, target_item)
	pointblank::expect_col_vals_in_set(
	result, target_fd,
	set = c("food", "other_uses")
	)
	pointblank::expect_col_vals_in_set(
	result, target_item,
	set = io$labels[[1]]$item_cbs_code
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 1 to 4 in bbb1b89

	testthat::test_that(
	"get_land_fp_production example returns expected structure",
	{
	result <- get_land_fp_production(example = TRUE)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 6 to 19 in bbb1b89

	testthat::expect_s3_class(result, "tbl_df")
	pointblank::expect_col_exists(
	result,
	c(
	"year", "area_code", "item_cbs_code", "impact",
	"element", "origin", "group", "impact_u"
	)
	)
	testthat::expect_type(result$year, "integer")
	testthat::expect_type(result$area_code, "integer")
	testthat::expect_type(result$item_cbs_code, "integer")
	pointblank::expect_col_vals_in_set(
	result, impact,
	set = "Land"

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 21 to 26 in bbb1b89

	pointblank::expect_col_vals_in_set(
	result, origin,
	set = "Production"
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 29 to 34 in bbb1b89

	testthat::test_that(
	"get_land_fp_production filters and cleans land_fp",
	{
	local_mocked_bindings(
	whep_read_file = function(...) {
	tibble::tribble(

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 44 to 53 in bbb1b89

	},
	add_area_code = function(data, name_column, code_column) {
	data[[code_column]] <- dplyr::if_else(
	data[[name_column]] == "Spain",
	203L,
	NA_integer_
	)
	data
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Line 55 in bbb1b89

result <- get_land_fp_production()

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_footprint_inputs.R

Lines 57 to 71 in bbb1b89

	testthat::expect_equal(nrow(result), 1)
	pointblank::expect_col_vals_in_set(
	result, impact,
	set = "Land"
	)
	pointblank::expect_col_vals_in_set(
	result, origin,
	set = "Production"
	)
	testthat::expect_type(result$year, "integer")
	testthat::expect_type(result$area_code, "integer")
	testthat::expect_type(result$item_cbs_code, "integer")
	testthat::expect_equal(result$area_code[[1]], 203L)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 71 to 82 in bbb1b89

	testthat::test_that(
	"build_io_model handles 2-country 2-item example",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(f$su, f$btd, f$cbs)
	testthat::expect_s3_class(result, "tbl_df")
	testthat::expect_equal(nrow(result), 1)
	pointblank::expect_col_exists(
	result,
	c("year", "Z", "Y", "X", "labels")
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 84 to 103 in bbb1b89

	z <- result$Z[[1]]
	y <- result$Y[[1]]
	x <- result$X[[1]]
	n <- 2 * 2
	testthat::expect_equal(dim(z), c(n, n))
	testthat::expect_equal(nrow(y), n)
	testthat::expect_equal(length(x), n)
	}
	)
	testthat::test_that(
	"build_io_model uses default input builders",
	{
	f <- io_two_country_fixture()
	local_mocked_bindings(
	build_supply_use = function(...) f$su,
	get_bilateral_trade = function(...) f$btd,
	get_wide_cbs = function(...) f$cbs
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Line 105 in bbb1b89

result <- build_io_model(years = 2000)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 107 to 111 in bbb1b89

	testthat::expect_s3_class(result, "tbl_df")
	testthat::expect_equal(nrow(result), 1)
	testthat::expect_equal(result$year[[1]], 2000)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Line 141 in bbb1b89

labels, c("area_code", "item_cbs_code")

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Line 144 in bbb1b89

nrow(labels), length(result$X[[1]])

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 148 to 153 in bbb1b89

	testthat::test_that(
	"build_io_model returns fd_labels with correct shape",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(f$su, f$btd, f$cbs)
	fd_labs <- result$fd_labels[[1]]

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 155 to 199 in bbb1b89

	pointblank::expect_col_exists(
	fd_labs, c("area_code", "fd_col")
	)
	# 2 areas * 2 fd_cols (food, other_uses) = 4 rows
	testthat::expect_equal(nrow(fd_labs), 4L)
	testthat::expect_equal(
	ncol(result$Y[[1]]), nrow(fd_labs)
	)
	pointblank::expect_col_vals_in_set(
	fd_labs, fd_col, set = c("food", "other_uses")
	)
	}
	)
	testthat::test_that(
	"build_io_model validates missing columns",
	{
	f <- io_two_country_fixture()
	bad_su <- dplyr::select(f$su, -value)
	testthat::expect_error(
	build_io_model(bad_su, f$btd, f$cbs),
	"missing columns"
	)
	}
	)
	testthat::test_that(
	"build_io_model with years = NULL computes all years",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(f$su, f$btd, f$cbs, years = NULL)
	testthat::expect_equal(nrow(result), 1)
	testthat::expect_equal(result$year[[1]], 2000)
	}
	)
	testthat::test_that(
	"build_io_model with years filters to specified years",
	{
	f <- io_two_country_fixture()
	result <- build_io_model(
	f$su, f$btd, f$cbs,
	years = c(2000)
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 201 to 226 in bbb1b89

	testthat::expect_equal(nrow(result), 1)
	testthat::expect_equal(result$year[[1]], 2000)
	}
	)
	testthat::test_that(
	"build_io_model with invalid years raises error",
	{
	f <- io_two_country_fixture()
	testthat::expect_error(
	build_io_model(f$su, f$btd, f$cbs, years = c(2001)),
	"not available in data"
	)
	}
	)
	testthat::test_that(
	"build_io_model with non-numeric years raises error",
	{
	f <- io_two_country_fixture()
	testthat::expect_error(
	build_io_model(f$su, f$btd, f$cbs, years = "2000"),
	"must be numeric or NULL"
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 230 to 286 in bbb1b89

	testthat::test_that(
	".block_diag builds correct block-diagonal",
	{
	a <- matrix(1:4, 2, 2)
	b <- matrix(5:7, 1, 3)
	result <- .block_diag(list(a, b))
	testthat::expect_equal(dim(result), c(3, 5))
	testthat::expect_equal(
	as.matrix(result[1:2, 1:2]),
	a
	)
	testthat::expect_equal(
	as.numeric(result[3, 3:5]),
	as.vector(b)
	)
	testthat::expect_equal(sum(result[1:2, 3:5]), 0)
	testthat::expect_equal(sum(result[3, 1:2]), 0)
	}
	)
	testthat::test_that(
	".row_normalize normalises rows to sum 1",
	{
	m <- matrix(c(10, 20, 30, 60), nrow = 2)
	result <- .row_normalize(m)
	testthat::expect_equal(
	as.numeric(Matrix::rowSums(result)), c(1, 1)
	)
	}
	)
	testthat::test_that(
	".row_normalize handles zero rows gracefully",
	{
	m <- matrix(c(0, 5, 0, 10), nrow = 2)
	result <- .row_normalize(m)
	testthat::expect_equal(result[1, ], c(0, 0))
	testthat::expect_equal(sum(result[2, ]), 1)
	}
	)
	testthat::test_that(
	".build_shares_matrix produces correct shares",
	{
	shares <- list(
	"10" = matrix(
	c(0.9, 0.1, 0.05, 0.95),
	nrow = 2
	),
	"20" = diag(2)
	)
	mat <- .build_shares_matrix(
	shares, c(10, 20), 2, 2
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_io_model.R

Lines 288 to 316 in bbb1b89

	testthat::expect_equal(dim(mat), c(4, 2))
	# Row 1 = area 1, item 10 => shares[["10"]][1, ]
	testthat::expect_equal(
	mat[1, ], c(0.9, 0.05)
	)
	# Row 2 = area 1, item 20 => shares[["20"]][1, ]
	testthat::expect_equal(mat[2, ], c(1, 0))
	# Row 3 = area 2, item 10 => shares[["10"]][2, ]
	testthat::expect_equal(
	mat[3, ], c(0.1, 0.95)
	)
	}
	)
	testthat::test_that(
	".fix_negative_output returns both X and Y",
	{
	z <- matrix(c(5, 0, 0, 3), nrow = 2)
	y <- matrix(c(10, 20), ncol = 1)
	result <- .fix_negative_output(z, y)
	testthat::expect_true(is.list(result))
	testthat::expect_true("X" %in% names(result))
	testthat::expect_true("Y" %in% names(result))
	testthat::expect_equal(
	result$X, rowSums(z) + rowSums(y)
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 3 to 11 in bbb1b89

	testthat::test_that(
	"compute_leontief_inverse works for 2-sector model",
	{
	z <- matrix(
	c(10, 20, 15, 5),
	nrow = 2, byrow = TRUE
	)
	x <- c(100, 200)
	l_inv <- compute_leontief_inverse(z, x)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 13 to 17 in bbb1b89

	testthat::expect_true(is.matrix(l_inv))
	testthat::expect_equal(dim(l_inv), c(2, 2))
	testthat::expect_true(all(l_inv >= 0))
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 22 in bbb1b89

nrow = 2, byrow = TRUE

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 31 in bbb1b89

l_inv %*% (diag(2) - a), diag(2),

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 36 to 41 in bbb1b89

	testthat::test_that(
	"Leontief handles zero output sectors",
	{
	z <- matrix(c(0, 0, 5, 0), nrow = 2)
	x <- c(0, 100)
	l_inv <- compute_leontief_inverse(z, x)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 43 to 47 in bbb1b89

	testthat::expect_true(is.matrix(l_inv))
	testthat::expect_true(all(l_inv >= 0))
	testthat::expect_equal(l_inv[1, 1], 1)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 56 in bbb1b89

matrix(1, nrow = 2, ncol = 3), c(1, 2)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Line 62 in bbb1b89

matrix(0, 2, 2), c(1, 2, 3)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 68 to 80 in bbb1b89

	testthat::test_that(
	"compute_leontief_inverse aborts for large n",
	{
	z_big <- Matrix::sparseMatrix(
	i = 1:10, j = 1:10, x = rep(1, 10), dims = c(10, 10)
	)
	x_big <- rep(100, 10)
	testthat::expect_error(
	compute_leontief_inverse(z_big, x_big, max_n = 5),
	"System too large"
	)
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 82 to 94 in bbb1b89

	testthat::test_that(
	"A column capping prevents singularity when inputs exceed output",
	{
	# z col 2 sums to 14 against x = 10, so A col 2 > 1
	z <- matrix(c(5, 6, 3, 8), nrow = 2, byrow = TRUE)
	x <- c(10, 10)
	l_inv <- NULL
	testthat::expect_warning(
	{
	l_inv <- compute_leontief_inverse(z, x)
	},
	"Capping"
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 96 to 99 in bbb1b89

	testthat::expect_true(is.matrix(l_inv))
	testthat::expect_true(all(l_inv >= 0))
	}
	)

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 101 to 109 in bbb1b89

	testthat::test_that(
	"3-sector model y can be recovered from L",
	{
	z <- matrix(
	c(5, 10, 0, 3, 2, 8, 1, 4, 6),
	nrow = 3, byrow = TRUE
	)
	y <- c(85, 87, 89)
	x <- rowSums(z) + y

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 111 to 112 in bbb1b89

	l_inv <- compute_leontief_inverse(z, x)
	x_recovered <- l_inv %*% y

---

[air] _{reported by reviewdog 🐶}

whep/tests/testthat/test_leontief.R

Lines 114 to 119 in bbb1b89

	testthat::expect_equal(
	as.vector(x_recovered), x,
	tolerance = 1e-8
	)
	}
	)