Skip to content

Commit

Permalink
Add section to read_selector() basic/time/water
Browse files Browse the repository at this point in the history 
flow and solute. Other sections cannot be read currently!

to do:
start with write_selector()
  • Loading branch information
@mrustl
mrustl committed Jul 14, 2024
1 parent 3a46b45 commit fb2af1b
Show file tree
Hide file tree
Showing 3 changed files with 91 additions and 30 deletions.
15 changes: 5 additions & 10 deletions R/extend_soil_profile.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,11 +11,8 @@
#'
extend_soil_profile <- function(df, x_end) {

shorten_profile <- FALSE

if (x_end > min(df$x)) {
if (any(x_end == df$x)) {
shorten_profile <- TRUE
return(df[which(x_end <= df$x), ])
}
} else {
Expand Down Expand Up @@ -44,13 +41,11 @@ extend_soil_profile <- function(df, x_end) {
}

# Kombinieren und Sortieren der Dataframes
combined_df <- if(shorten_profile) {
dplyr::bind_rows(df, new_df)
} else {
new_df <- new_df[-1,]
new_df$node_id <- new_df$node_id - 1
dplyr::bind_rows(df, new_df[-1,])
}
new_df <- new_df[-1,]
new_df$node_id <- new_df$node_id - 1

combined_df <- dplyr::bind_rows(df, new_df)

sorted_df <- dplyr::arrange(combined_df, node_id)

return(sorted_df)
Expand Down
104 changes: 85 additions & 19 deletions R/read_selector.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@ read_selector <- function(path) {
is_num_val <- !is.na(suppressWarnings(as.numeric(value)))
if(is_num_val) {
as.numeric(value)
} else if (value %in% c("f", "t") ) {
to_r_truefalse(value)
} else {
value
}
Expand Down Expand Up @@ -49,16 +51,69 @@ read_selector <- function(path) {
end_ix = blocks_idx_end)


"Pcp_File_Version=4"
block_basic <- blocks[blocks$name_clean == "A_BASIC",]
block_basic_txt <- lines[block_basic$start_idx:block_basic$end_ix]

i1 <-grep("Heading", block_basic_txt)

i2 <- grep("LUnit TUnit MUnit", block_basic_txt)

i3 <- grep("^lWat|^lSnow|^NMat", block_basic_txt)


config_basic <- c(header_values_to_list(headers = block_basic_txt[i1],
values = paste(block_basic_txt[i1 + 1], collapse = "")),
header_values_to_list(headers = block_basic_txt[i2] %>% stringr::str_remove_all("\\s+?\\(.*") %>%
stringr::str_split("\\s{1,10}", simplify = TRUE) %>%
as.vector(),
values = block_basic_txt[(i2+1):(i2+3)]),
lapply(i3, function(i) {

header_values_to_list(headers = clean_line(block_basic_txt[i]),
values = clean_line(block_basic_txt[i + 1]))
}) %>%
unlist() %>%
as.list()
)



block_water <- blocks[blocks$name_clean == "B_WATERFLOW",]
block_water_txt <- lines[block_water$start_idx:block_water$end_ix]

i1 <-grep("MaxIt", block_water_txt)
block_water_txt[i1] <- stringr::str_remove(block_water_txt[i1], "\\s+?\\(.*")

i2 <- grep("TopInf|BotInf|hTab1|Model", block_water_txt)

i3 <- grep("thr", block_water_txt)

soil_dat <- block_water_txt[i3:length(block_water_txt)] %>%
stringr::str_trim() %>%
stringr::str_replace_all("\\s+", ",") %>%
stringr::str_split_fixed(pattern = ",", n = 6)

soil <- tibble::as_tibble(soil_dat[2:nrow(soil_dat),]) %>%
dplyr::mutate(dplyr::across(tidyselect::everything(), .fns = as.numeric))

names(soil) <- soil_dat[1,]

config_water <- c(
lapply(c(i1, i2), function(i) {
header_values_to_list(headers = clean_line(block_water_txt[i]),
values = clean_line(block_water_txt[i + 1]))
}) %>% unlist() %>% as.list(),
list(soil = soil))


block_time <- blocks[blocks$name_clean == "C_TIME",]
block_time_txt <- lines[block_time$start_idx:block_time$end_ix]

time <- c(
general = list(lapply(c(1,3,5), function(i) {
config_time <- c(
lapply(c(1,3,5), function(i) {
header_values_to_list(headers = clean_line(block_time_txt[i]),
values = clean_line(block_time_txt[i + 1]))
})),
}) %>% unlist() %>% as.list(),
"TPrint" = list(lapply((grep("TPrint", block_time_txt)+1):length(block_time_txt),
function(i) {
clean_line(block_time_txt[i])
Expand All @@ -82,16 +137,17 @@ solute_transport <- list(transport =
}) %>% dplyr::bind_rows())


solute_reaction <- list(reaction = stats::setNames(lapply(solute_reaction_idx, function(reac_idx) {
solute_reaction <- stats::setNames(lapply(solute_reaction_idx, function(reac_idx) {
reac_max_idx <- if(reac_idx == max(solute_reaction_idx)) {
grep("kTopSolute", block_solute_txt) - 1
} else {
solute_reaction_idx[which(solute_reaction_idx == reac_idx)+1]-1
}

list(header_values_to_list(headers = clean_line(block_solute_txt[reac_idx])[1:2],
values = clean_line(block_solute_txt[reac_idx+1])),
lapply((reac_idx+3):reac_max_idx, function(i) {
list(diffusion = header_values_to_list(headers = clean_line(block_solute_txt[reac_idx])[1:2],
values = clean_line(block_solute_txt[reac_idx+1])) %>%
unlist() %>% t() %>% tibble::as_tibble(),
reaction = lapply((reac_idx+3):reac_max_idx, function(i) {
vec <- clean_line(block_solute_txt[i],
pattern = "\\s{2,}") %>%
as.numeric()
Expand All @@ -103,24 +159,34 @@ solute_reaction <- list(reaction = stats::setNames(lapply(solute_reaction_idx, f
)}),
nm = sprintf("solute_%d", seq_along(solute_reaction_idx))
)
)

general_1 = lapply(header_val_idx[1:2], function(i) {
header_values_to_list(headers = clean_line(block_solute_txt[i]),
values = clean_line(block_solute_txt[i + 1]))
}) %>% unlist() %>% as.list()


general_2 = lapply(header_val_idx[3:4], function(i) {
header_values_to_list(headers = clean_line(block_solute_txt[i]),
values = clean_line(block_solute_txt[i + 1]))
}) %>% unlist() %>% as.list()

solute <- c(general_1 = list(lapply(header_val_idx[1:2], function(i) {
header_values_to_list(headers = clean_line(block_solute_txt[i]),
values = clean_line(block_solute_txt[i + 1]))
})),

gen2_is_na <- is.na(names(general_2))

names(general_2)[gen2_is_na] <- sprintf("unknown%02d", seq_len(sum(gen2_is_na)))


config_solute <- c(general_1,
solute_transport,
solute_reaction,
general_2 = list(lapply(header_val_idx[3:4], function(i) {
header_values_to_list(headers = clean_line(block_solute_txt[i]),
values = clean_line(block_solute_txt[i + 1]))
})))
general_2
)

list(time = time,
solute = solute)
list(basic = config_basic,
time = config_time,
waterflow = config_water,
solute = config_solute)

}

2 changes: 1 addition & 1 deletion R/utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ to_r_truefalse <- function(txt) {

txt <- stringr::str_replace_all(txt, pattern = "^t$", replacement = "TRUE")
txt <- stringr::str_replace_all(txt, pattern = "^f$", replacement = "FALSE")
txt
as.logical(txt)
}

to_fortran_truefalse <- function(txt) {
Expand Down

0 comments on commit fb2af1b

Please sign in to comment.