diff --git a/R/.write_profile.R b/R/.write_profile.R new file mode 100644 index 0000000..11c8016 --- /dev/null +++ b/R/.write_profile.R @@ -0,0 +1,109 @@ +write_formatted_materials <- function(df) { + # Hilfsfunktion zum Formatieren einer Zahl in wissenschaftlicher Notation + format_number <- function(x) { + sprintf("% .6e", x) + } + + # Hilfsfunktion zum Formatieren einer Integer-Zahl mit fixer Länge von 5 Zeichen + format_integer <- function(x) { + sprintf("%5d", x) + } + + # Data Frame konvertieren und formatieren + formatted_df <- df + formatted_df[] <- lapply(seq_along(df), function(i) { + col <- df[[i]] + if (is.numeric(col) && i == 1) { + sapply(col, format_integer) # Erste Spalte als Integer formatieren + } else if (is.numeric(col)) { + sapply(col, format_number) # Restliche Spalten in wissenschaftlicher Notation formatieren + } else { + col + } + }) + + # Formatierte Zeilen erstellen + apply(formatted_df, 1, function(row) { + paste(row, collapse = " ") + }) + +} + + +write_formatted_profile <- function(df) { + # Hilfsfunktion zum Formatieren einer Zahl in wissenschaftlicher Notation + format_number <- function(x) { + sprintf("% .13e", x) + } + + # Hilfsfunktion zum Formatieren einer Integer-Zahl mit fixer Länge von 5 Zeichen + format_integer <- function(x) { + sprintf("%5d", x) + } + + # Data Frame konvertieren und formatieren + formatted_df <- df + formatted_df[] <- lapply(seq_along(df), function(i) { + col <- df[[i]] + if (is.numeric(col) && i %in% c(1,4,5)) { + sapply(col, format_integer) # Erste Spalte als Integer formatieren + } else if (is.numeric(col)) { + sapply(col, format_number) # Restliche Spalten in wissenschaftlicher Notation formatieren + } else { + col + } + }) + + # Formatierte Zeilen erstellen + apply(formatted_df, 1, function(row) { + paste(row, collapse = " ") + }) + +} + + + +write_profile <- function(profile, + path) { + + + n_materials <- nrow(profile$mat_props) + + + + obsnodes <- stringr::str_pad(profile$obsnodes$n,width = 5,side = "left") + + if(profile$obsnodes$n > 0) { + obsnodes <- c(obsnodes, + paste0(stringr::str_pad(profile$obsnodes$ids,width = 5,side = "left"), + collapse = "")) + } + + paste0(stringr::str_pad(c(max(profile$profile$node_id), + 1, + sum(stringr::str_detect(names(profile$profile),"conc")), + 1), + width = 5, + side = "left"), + " x", + headers_profile <- names(profile$profile)[!names(profile$profile) %in% c("x", "node_id")] + + is_conc <- stringr::str_detect(headers_profile, "conc") + + if(sum(is_conc) > 1) { + headers_profile <- c(headers_profile[!is_conc], "conc") + } + + headers_profile <- c(headers_profile[1], + stringr::str_to_title(headers_profile[-1])) + + c("Pcp_File_Version=4", + stringr::str_pad(n_materials,width = 5, side = "left"), + write_formatted_materials(profile$mat_props), + "headers", + write_formatted_profile(profile$profile), + obsnodes + ) + + +} diff --git a/R/read_profile.R b/R/read_profile.R index 0ac626f..68f973b 100644 --- a/R/read_profile.R +++ b/R/read_profile.R @@ -10,8 +10,22 @@ read_profile <- function(path) { lines <- readLines(path) + pcp_idx <- grep("Pcp_File_Version", lines) + header_idx <- grep("x", lines) + number_of_materials <- as.integer(lines[pcp_idx+1]) + + mat_props <- lines[(pcp_idx+2):(header_idx-1)] %>% + stringr::str_trim() %>% + stringr::str_replace_all("\\s{1,20}", ",") %>% + stringr::str_split(",", simplify = TRUE) %>% + as.data.frame() + + mat_props <- lapply(mat_props, as.numeric) %>% dplyr::bind_rows() + names(mat_props) <- c("mat_id", "mat_depth", "mat_prop3", "mat_pro4") + + dat <- lines[(header_idx+1):length(lines)] %>% stringr::str_trim() %>% stringr::str_replace_all("\\s+", ",") @@ -41,9 +55,33 @@ read_profile <- function(path) { path_profile <- file.path(tempdir(), "profile.csv") + + obsnodes <- list(n = 0, + ids = NULL) + + if (which(ncols == 2) > 0) { + idx_obsnodes <- which(ncols == 2) + if(idx_obsnodes != length(ncols)) { + + n_obsnodes <- as.integer(dat[idx_obsnodes]) + obs_node_ids <- stringr::str_split(dat[length(dat)], + pattern = ",", + simplify = TRUE) %>% + as.integer() + + obsnodes <- list(n = n_obsnodes, + ids = obs_node_ids) + } + } + c(paste0(header_clean, collapse = ","), dat[ncols == median(ncols)]) %>% writeLines(path_profile) - readr::read_csv(path_profile) + list(mat_props = mat_props, + profile = readr::read_csv(path_profile), + obsnodes = obsnodes) + + } +