Skip to content

Commit 5729380

Browse files
ctoneyctoney
committed
process_tree_data(): improve NA handling and progress reporting
1 parent ce258bb commit 5729380

3 files changed

Lines changed: 63 additions & 36 deletions

File tree

‎R/calc_ht_metrics.R‎

Lines changed: 37 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -71,62 +71,72 @@ calc_ht_metrics <- function(tree_list, digits = 1) {
7171
}
7272

7373
tree_ht <- pmin(trees_in$HT, trees_in$ACTUALHT, na.rm = TRUE)
74-
if (any(is.na(tree_ht)))
75-
warning("one or more tree heights are missing", call. = FALSE)
74+
if (any(is.na(tree_ht))) {
75+
warning("one or more tree heights are missing, NAs returned",
76+
call. = FALSE)
77+
}
7678

7779
sapling_ht <- pmin(saplings_in$HT, saplings_in$ACTUALHT, na.rm = TRUE)
78-
if (any(is.na(sapling_ht)))
79-
warning("one or more sapling heights are missing", call. = FALSE)
80+
if (any(is.na(sapling_ht))) {
81+
warning("one or more sapling heights are missing, NAs returned",
82+
call. = FALSE)
83+
}
8084

8185
ht_metrics <- vector(mode = "list", length = 10)
82-
ht_metrics[1:length(ht_metrics)] <- 0 # by definition
86+
ht_metrics[seq_along(ht_metrics)] <- 0 # by definition
87+
8388
names(ht_metrics) <- c("numTrees", "meanTreeHt", "meanTreeHtBAW",
8489
"meanTreeHtDom", "meanTreeHtDomBAW", "maxTreeHt",
8590
"predomTreeHt", "numSaplings", "meanSapHt",
8691
"maxSapHt")
8792

8893
ht_metrics$numTrees <- nrow(trees_in)
8994
if (nrow(trees_in) > 0) {
90-
basal_area <- pi * (trees_in$DIA / 2)^2
9195
ht_metrics$meanTreeHt <-
92-
round(mean(tree_ht, na.rm = TRUE), digits)
96+
round(mean(tree_ht), digits)
97+
98+
basal_area <- pi * (trees_in$DIA / 2)^2
9399

94100
ht_metrics$meanTreeHtBAW <-
95-
round(stats::weighted.mean(tree_ht, basal_area, na.rm = TRUE),
96-
digits)
101+
round(stats::weighted.mean(tree_ht, basal_area), digits)
97102

98103
tree_ht_doms <- tree_ht[trees_in$CCLCD %in% c(1, 2, 3)]
99104
basal_area_doms <- basal_area[trees_in$CCLCD %in% c(1, 2, 3)]
105+
100106
ht_metrics$meanTreeHtDom <-
101-
round(mean(tree_ht_doms, na.rm = TRUE), digits)
107+
round(mean(tree_ht_doms), digits)
102108

103109
ht_metrics$meanTreeHtDomBAW <-
104-
round(stats::weighted.mean(tree_ht_doms, basal_area_doms,
105-
na.rm = TRUE),
110+
round(stats::weighted.mean(tree_ht_doms, basal_area_doms),
106111
digits = digits)
107112

108-
ht_metrics$maxTreeHt <- max(tree_ht, na.rm = TRUE)
109-
110-
tree_ht_tpa <-
111-
data.frame(tree_ht, trees_in$TPA_UNADJ, check.names = FALSE)
112-
tree_ht_tpa <- tree_ht_tpa[order(tree_ht, decreasing = TRUE), ]
113-
tpa <- sum_ht <- n <- 0
114-
for (i in seq_len(nrow(tree_ht_tpa))) {
115-
sum_ht <- sum_ht + tree_ht_tpa[i, 1]
116-
tpa <- tpa + tree_ht_tpa[i, 2]
117-
n <- n + 1
118-
if (tpa > 16)
119-
break
113+
ht_metrics$maxTreeHt <- max(tree_ht)
114+
115+
if (any(is.na(tree_ht)) || any(is.na(trees_in$TPA_UNADJ))) {
116+
ht_metrics$predomTreeHt <- NA_real_
117+
} else {
118+
tree_ht_tpa <-
119+
data.frame(tree_ht, trees_in$TPA_UNADJ, check.names = FALSE)
120+
121+
tree_ht_tpa <- tree_ht_tpa[order(tree_ht, decreasing = TRUE), ]
122+
tpa <- sum_ht <- n <- 0
123+
for (i in seq_len(nrow(tree_ht_tpa))) {
124+
sum_ht <- sum_ht + tree_ht_tpa[i, 1]
125+
tpa <- tpa + tree_ht_tpa[i, 2]
126+
n <- n + 1
127+
if (tpa > 16)
128+
break
129+
}
130+
ht_metrics$predomTreeHt <- round(sum_ht / n, digits)
120131
}
121-
ht_metrics$predomTreeHt <- round(sum_ht / n, digits)
122132
}
123133

124134
ht_metrics$numSaplings <- nrow(saplings_in)
125135
if (nrow(saplings_in) > 0) {
126136
ht_metrics$meanSapHt <-
127-
round(mean(sapling_ht, na.rm = TRUE), digits)
137+
round(mean(sapling_ht), digits)
128138

129-
ht_metrics$maxSapHt <- max(sapling_ht, na.rm = TRUE)
139+
ht_metrics$maxSapHt <- max(sapling_ht)
130140
}
131141

132142
return(ht_metrics)

‎R/process_tree_data.R‎

Lines changed: 22 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,14 @@ process_tree_data <- function(tree_table, stem_map = TRUE, full_output = TRUE,
5454
call. = FALSE)
5555
}
5656

57+
if (!("CRWIDTH" %in% colnames(tree_table))) {
58+
if (!("DIA" %in% colnames(tree_table)))
59+
stop("'tree_table' is missing 'DIA'", call. = FALSE)
60+
61+
if (any(is.na(tree_table$DIA[tree_table$STATUSCD == 1])))
62+
stop("'DIA' has missing values for live trees", call. = FALSE)
63+
}
64+
5765
if (!(is.logical(stem_map) && length(stem_map) == 1))
5866
stop("'stem_map' must be a single logical value", call. = FALSE)
5967

@@ -64,7 +72,9 @@ process_tree_data <- function(tree_table, stem_map = TRUE, full_output = TRUE,
6472
digits <- 1
6573

6674
plot_id_dt <- storage.mode(tree_table$PLT_CN)
67-
if (!(plot_id_dt %in% c("character", "double", "integer", "integer64"))) {
75+
if (bit64::is.integer64(tree_table$PLT_CN)) {
76+
plot_id_dt <- "integer64"
77+
} else if (!(plot_id_dt %in% c("character", "double", "integer"))) {
6878
stop("'PLT_CN' must be character, double, integer or integer64",
6979
call. = FALSE)
7080
}
@@ -85,20 +95,24 @@ process_tree_data <- function(tree_table, stem_map = TRUE, full_output = TRUE,
8595
if (plot_id_dt == "character")
8696
out$PLT_CN <- character(num_plots)
8797
else if (plot_id_dt == "numeric")
88-
out$PLT_CN <- rep(NA_real_, num_plots)
98+
out$PLT_CN <- rep_len(NA_real_, num_plots)
8999
else if (plot_id_dt == "integer")
90-
out$PLT_CN <- rep(NA_integer_, num_plots)
100+
out$PLT_CN <- rep_len(NA_integer_, num_plots)
91101
else if (plot_id_dt == "integer64")
92-
out$PLT_CN <- rep(bit64::NA_integer64_, num_plots)
102+
out$PLT_CN <- rep_len(bit64::NA_integer64_, num_plots)
93103

104+
# all computed values are currently integer or double
94105
for (j in 2:length(out)) {
95106
if (storage.mode(x[[j - 1]]) == "integer")
96-
out[[j]] <- rep(NA_integer_, num_plots)
107+
out[[j]] <- rep_len(NA_integer_, num_plots)
97108
else
98-
out[[j]] <- rep(NA_real_, num_plots)
109+
out[[j]] <- rep_len(NA_real_, num_plots)
99110
}
100111

101-
cli::cli_progress_bar("Processing tree data", total = num_plots)
112+
cli::cli_alert_info(
113+
"The input table contains tree data for {.val {num_plots}} plots.")
114+
115+
cli::cli_progress_bar("Processing...", total = num_plots)
102116
for (i in seq_along(plot_ids)) {
103117
tree_list <- tree_table[tree_table$PLT_CN == plot_ids[i], ]
104118
x <- calc_tcc_metrics(tree_list, stem_map, full_output, digits,
@@ -110,6 +124,7 @@ process_tree_data <- function(tree_table, stem_map = TRUE, full_output = TRUE,
110124
cli::cli_progress_update()
111125
}
112126
cli::cli_progress_done()
127+
cli::cli_alert_info("Done.")
113128

114129
as.data.frame(out)
115130
}

‎README.md‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -298,11 +298,11 @@ calc_tcc_metrics(plantation, stem_map = FALSE, full_output = FALSE)
298298
# Lolo NF, single-condition forest plots, INVYR 2022, from public FIADB
299299
f <- system.file("extdata/mt_lnf_2022_1cond_tree.csv", package="FIAstemmap")
300300
tree_table <- load_tree_data(f)
301-
#> ! The data source does not have DIST and/or AZIMUTH
301+
#> ! the data source does not have DIST and/or AZIMUTH
302302
#> ℹ Fetching tree data...
303303
#> ✔ Fetching tree data... [14ms]
304304
#>
305-
#> ℹ 910 tree records returned
305+
#> ℹ 910 tree records returned.
306306

307307
head(tree_table)
308308
#> PLT_CN SUBP TREE STATUSCD SPCD DIA HT ACTUALHT CCLCD TPA_UNADJ
@@ -314,6 +314,8 @@ head(tree_table)
314314
#> 6 670951075126144 2 4 2 108 NA NA NA NA NA
315315

316316
process_tree_data(tree_table, stem_map = FALSE, full_output = TRUE)
317+
#> ℹ The input table contains tree data for 22 plots.
318+
#> ℹ Done.
317319
#> PLT_CN model_tcc numTrees meanTreeHt meanTreeHtBAW meanTreeHtDom
318320
#> 1 670951075126144 1.2 0 0.0 0.0 0.0
319321
#> 2 670950940126144 38.4 24 61.4 66.4 64.5

0 commit comments

Comments
 (0)