Skip to content

Commit b898faf

Browse files
wburke24wburke24
committed
minor bug fixes
1 parent 06d309d commit b898faf

4 files changed

Lines changed: 79 additions & 46 deletions

File tree

‎R/CreateFlownet.R‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -89,9 +89,11 @@ CreateFlownet = function(flownet_name,
8989
if (!is.null(roofs)) {cfmaps[cfmaps[,1] == "roofs",2] = roofs}
9090

9191
# remove tif and tiff extensions for simplicity
92-
if ( any(endsWith(cfmaps[,2],".tif") | endsWith(cfmaps[,2],".tiff")) ) {
93-
cfmaps[,2] = gsub(".tif$","",cfmaps[,2])
94-
cfmaps[,2] = gsub(".tiff$","",cfmaps[,2])
92+
if (all(!is.na(cfmaps[,2]))) {
93+
if ( any(endsWith(cfmaps[,2],".tif") | endsWith(cfmaps[,2],".tiff")) ) {
94+
cfmaps[,2] = gsub(".tif$","",cfmaps[,2])
95+
cfmaps[,2] = gsub(".tiff$","",cfmaps[,2])
96+
}
9597
}
9698

9799
# check inpputs are maps or values

‎R/update_world.R‎

Lines changed: 68 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1,96 +1,126 @@
11
#' update_world
2-
#'
2+
#'
33
#' Read and modify an existing worldfile. Optimized somewhat (for R) but awk may still be faster.
44
#' @param worldfile Name and path of worldfile to be created.
55
#' @param vars State variable(s) from the worldfile to be modified
6-
#' @param values Values to replace for `vars`, or coefficients to multiply by. N args must equal that of vars or be 1 (will be used for all vars).
6+
#' @param values Values to replace for `vars`, or coefficients to multiply by. N args must equal that of vars or be 1 (will be used for all vars).
77
#' or can be a list of values where number of list elements = n vars
8-
#' @param level_names The level for which a given state variable will have it's value changed or replaced. Can be a single character string or vector
8+
#' @param level_names The level for which a given state variable will have it's value changed or replaced. Can be a single character string or vector
99
#' of character strings. Valid arguments are: world, basin, hillslope, zone, patch, canopy_strata.
10-
#' @param level_IDs The IDs of the correstponding `level_names` for which a given state variable will have it's value changed or replaced. Set to NULL or "all"
10+
#' @param level_IDs The IDs of the correstponding `level_names` for which a given state variable will have it's value changed or replaced. Set to NULL or "all"
1111
#' to change a value across all of a given level (e.g. for all patches). This can be a vector same length as names, or a list, with IDs for each named level in names
1212
#' @param out_file Destination file to write new worldfile
1313
#' @param overwrite TRUE/FALSE if input worldfile should be overwritten
1414
#' @author Will Burke
1515
#' @export
1616

17-
update_world = function(worldfile, out_file, vars, values,level_names = NULL, level_IDs = NULL, overwrite = FALSE) {
18-
17+
update_world = function(worldfile, out_file = NULL, vars, values, veg_parm_ID = NULL, level_names = NULL, level_IDs = NULL, overwrite = FALSE) {
18+
19+
options(scipen = 999)
20+
1921
# NOTES
2022
# - vdouble check all the list options work and check var lengths/numbers when needed
21-
23+
2224
# ---------- Check Aguments ----------
2325
if (is.null(out_file) & !overwrite) {stop(noquote("No destination file set by 'out_file' and 'overwrite' is FALSE"))}
2426
if ( file.exists(out_file) & overwrite == FALSE) {stop(noquote(paste0("File '",out_file,"' already exists and 'overwrite' argument is FALSE")))}
25-
if (length(vars) != length(values) & length(values) != 1 & !is.list(values))
26-
27-
if (!is.list(values)) {
28-
if (!is.character(values)) {
29-
values = as.character(values)
30-
}
31-
}
32-
27+
#if (length(vars) != length(values) & length(values) != 1 & !is.list(values)) {}
28+
29+
# if (!is.list(values)) {
30+
# if (!is.character(values)) {
31+
# values = as.character(values)
32+
# }
33+
# }
34+
3335
# for (i in length(vars)) {
3436
# if (level_names[i] == "all") {level_names[i] = c("world", "basin", "hillslope", "zone", "patch", "canopy_strata")}
3537
# }
36-
#
38+
#
3739
# if (level_IDs == "all") {}
38-
40+
3941
# ---------- Parse Worldfile ----------
40-
options(scipen = 999)
4142
# parsing the values as characters to retain the exact value/precision
4243
read_world = readLines(worldfile)
4344
world = strsplit(trimws(read_world), "\t+")
4445
world = data.frame(matrix(unlist(world), nrow=length(world), byrow=T),stringsAsFactors = FALSE)
4546
names(world) = c("values","vars")
46-
47+
4748
# ---------- Find Levels----------
48-
index_all = which(world[,2] == "world_ID" | world[,2] == "basin_ID" | world[,2] == "hillslope_ID" |
49+
index_all = which(world[,2] == "world_ID" | world[,2] == "basin_ID" | world[,2] == "hillslope_ID" |
4950
world[,2] == "zone_ID" | world[,2] == "patch_ID" | world[,2] == "canopy_strata_ID")
5051
index_names = gsub("_ID", "", x = world$vars[index_all])
5152
index_max = c(index_all[2:length(index_all)]-1, length(read_world))
5253
world$level = unname(unlist(mapply(rep,index_names, (index_max - index_all) + 1 )))
5354
world$ID = unname(unlist(mapply(rep, world$values[index_all], (index_max - index_all) + 1 )))
54-
55+
56+
world$unique = 1
57+
for (i in 2:length(world$unique)) {
58+
if (world$level[i] != world$level[i - 1] | world$ID[i] != world$ID[i - 1]) {
59+
world$unique[i] = world$unique[i - 1] + 1
60+
} else {
61+
world$unique[i] = world$unique[i - 1]
62+
}
63+
}
64+
5565
# ---------- Find and Replace Vars ----------
56-
for (i in length(vars)){
57-
66+
if (!is.null(level_names)) {
67+
if (length(level_names) == 1 & length(vars) != 1) {level_names = rep.int(level_names, length(vars))}
68+
}
69+
if (!is.null(level_IDs)) {
70+
if (length(level_IDs) == 1 & length(vars) != 1) {level_IDs = rep.int(level_IDs, length(vars))}
71+
}
72+
if (!is.null(veg_parm_ID)) {
73+
if (length(veg_parm_ID) == 1 & length(vars) != 1) {veg_parm_ID = rep.int(veg_parm_ID, length(vars))}
74+
}
75+
76+
for (i in 1:length(vars)){
77+
5878
if (!is.null(level_names[i])) {
5979
find_index = world$level == level_names[i]
80+
if (sum(find_index) == 0) {stop("no levels matched input level_name")}
6081
} else {
6182
find_index = rep(TRUE,length(world$level))
6283
}
6384
if (!is.null(level_IDs[i])) {
6485
find_index = find_index & world$ID == level_IDs[i]
86+
if (sum(find_index) == 0) {stop("no level IDs in the named levels matched input level_ID")}
87+
}
88+
if (!is.null(veg_parm_ID[i])) {
89+
veg_parm_unique = world$unique[world$vars == "veg_parm_ID" & world$values == veg_parm_ID[i]]
90+
find_index = find_index & world$unique %in% veg_parm_unique
91+
if (sum(find_index) == 0) {stop("no matched veg_parm_IDs")}
6592
}
6693
replace_index = which(world$vars == vars[i] & find_index)
67-
94+
6895
# if unique values for every instance of var to be replaces were given, do nothing, otherwise repeat to get enough replacement values
6996
current_value = world$values[replace_index]
7097
if (length(values[i]) != length(replace_index)) {
7198
new_value = rep(values[i], length(replace_index)/length(values[i]))
7299
} else {
73100
new_value = values[i]
74101
}
75-
76-
if (any(startsWith(new_value,"*"))) {
77-
new_value = as.numeric(trimws(substr(new_value[startsWith(new_value,"*")],2,nchar(new_value[startsWith(new_value,"*")]))))
78-
new_value = new_value * as.numeric(current_value)
79-
} else {
80-
new_value = as.numeric(trimws(new_value))
102+
103+
if (is.character(new_value)) {
104+
if (any(startsWith(new_value,"*"))) {
105+
new_value = as.numeric(trimws(substr(new_value[startsWith(new_value,"*")],2,nchar(new_value[startsWith(new_value,"*")]))))
106+
new_value = new_value * as.numeric(current_value)
107+
} else {
108+
new_value = as.numeric(trimws(new_value))
109+
}
81110
}
82-
111+
112+
83113
# generic sub/gsub
84114
#sub("\\d+[[:blank:]]",XXX"\t", read_world)
85-
115+
86116
read_world[replace_index] = unname(mapply(sub,paste0(current_value,"[[:blank:]]"),paste0(new_value,"\t"),read_world[replace_index]))
87-
117+
88118
}
89-
119+
90120
# ---------- Write file ----------
91121
writeLines(text = read_world,out_file)
92-
93-
print(noquote(paste("Successfully rote updated worldfile to",out_file)))
94122

95-
96-
}
123+
print(noquote(paste("Successfully wrote updated worldfile to",out_file)))
124+
125+
126+
}

‎R/world_gen.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -361,7 +361,7 @@ world_gen = function(template,
361361
# if template has 2 and asp rules only has 1 strata, missing values will use only the 1st strata of the template
362362
if (length(stratum) == 1 & asp_strata_ct == 2 & s == 2) {s2 = 1} else {s2 = s}
363363

364-
asp_s_vars = which(!rulevars[[ruleid]]$strata_level_vars[[s]][,1] %in% var_names[var_index]) # get vars from aspatial not included in template
364+
asp_s_vars = which(!rulevars[[ruleid]]$strata_level_vars[[asp]][,1] %in% var_names[var_index]) # get vars from aspatial not included in template
365365
for (i in asp_s_vars) {
366366
var = as.numeric(rulevars[[ruleid]]$strata_level_vars[[asp]][i, s + 1])
367367
varname = rulevars[[ruleid]]$strata_level_vars[[asp]][i, 1]

‎man/update_world.Rd‎

Lines changed: 5 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)