Improve read_profile and start on write_profile

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
+  )
+
+
+}

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)
+
+
 }
+