[feature] .vtu tibble creation is more flexible now

R/vtu.R

@@ -106,9 +106,6 @@ OGS6_pvd <- R6::R6Class(
             # For each .vtu file referenced in pvd_path...
             for(i in seq_len(length(relevant_vtus))){
 
-                new_row <- list()
-                timestep_name <- paste0("t", i)
-
                 # ... get all rows of PointData or get rows by Name
                 if(missing(Names)){
                     Names <- names(relevant_vtus[[i]]$point_data)
@@ -116,21 +113,23 @@ OGS6_pvd <- R6::R6Class(
 
                 assertthat::assert_that(is.character(Names))
 
-                for (j in seq_len(length(point_ids))) {
-                    point_data <-
-                        relevant_vtus[[i]]$get_data_for_point(
-                            point_ids[[j]],
-                            Names)
-
-                    new_row <- c(new_row,
-                                 list(list(point_data)))
-                    names(new_row[[length(new_row)]]) <- timestep_name
-                    names(new_row)[[length(new_row)]] <- paste0("p", (j - 1))
+                point_data <-
+                    relevant_vtus[[i]]$get_data_for_points(point_ids,
+                                                           Names)
+
+                point_data_row <- list()
+
+                for(j in seq_len(length(point_data))){
+                    wrapped_point_data <- list(point_data[[j]])
+                    names(wrapped_point_data) <- names(point_data)[[j]]
+                    point_data_row <- c(point_data_row,
+                                        list(wrapped_point_data))
+                    names(point_data_row)[[length(point_data_row)]] <-
+                        names(point_data)[[j]]
                 }
 
                 time_list <- c(time_list,
-                               list(tibble::as_tibble_row(new_row)))
-                names(time_list)[[length(time_list)]] <- timestep_name
+                               list(tibble::as_tibble_row(point_data_row)))
             }
 
             # Combine into tibble
@@ -238,14 +237,20 @@ OGS6_vtu <- R6::R6Class(
         },
 
         #'@description
-        #'Gets PointData for point with ID `point_id`
-        #'@param point_id number: Point ID
+        #'Gets PointData for points with IDs in `point_ids`. If called without
+        #' arguments, this is equivalent to `OGS6_vtu$point_data`.
+        #'@param point_ids numeric: Optional: Point IDs, defaults to all
         #'@param Names character: Optional: `Name` attributes of `DataArray`
         #' elements, defaults to all in `PointData`
-        get_data_for_point = function(point_id,
-                                      Names){
+        get_data_for_points = function(point_ids,
+                                       Names){
 
-            assertthat::assert_that(assertthat::is.number(point_id))
+            if(missing(point_ids)){
+                max_point_id <- self$get_number_of_points() - 1
+                point_ids <- seq(0, max_point_id)
+            }
+
+            assertthat::assert_that(is.numeric(point_ids))
 
             if(missing(Names)){
                 Names <- names(self$point_data)
@@ -255,11 +260,22 @@ OGS6_vtu <- R6::R6Class(
 
             point_data <- list()
 
-            for(i in seq_len(length(Names))){
-                point_data <-
-                    c(point_data,
-                      list(self$point_data[[Names[[i]]]][[(point_id + 1)]]))
-                names(point_data)[[length(point_data)]] <- Names[[i]]
+            for(i in seq_len(length(point_ids))){
+
+                point_name <- paste0("p", point_ids[[i]])
+                single_point_data <- list()
+
+                for(j in seq_len(length(Names))){
+                    single_point_data <-
+                        c(single_point_data,
+                          list(self$point_data[[Names[[j]]]]
+                               [[(point_ids[[i]] + 1)]]))
+                    names(single_point_data)[[length(single_point_data)]] <-
+                        Names[[j]]
+                }
+
+                point_data <- c(point_data, list(single_point_data))
+                names(point_data)[[length(point_data)]] <- point_name
             }
 
             return(point_data)

tests/testthat/test-vtu.R

@@ -63,6 +63,7 @@ test_that("OGS6_pvd$get_PointData_time_tibble works", {
 
     time_tibble <- ogs6_pvd$get_PointData_time_tibble(Names = Names)
     expect_equal(length(time_tibble), 341)
+    expect_equal(length(time_tibble[[1]]), 2)
 })
 
 
@@ -76,12 +77,12 @@ test_that("OGS6_pvd$get_PointData_at_timestep works", {
 
     ogs6_pvd <- OGS6_pvd$new(pvd_path)
 
-    point_data <- ogs6_pvd$get_PointData_at_timestep(point_ids = 0,
+    point_data <- ogs6_pvd$get_PointData_at_timestep(point_ids = c(0, 1, 2),
                                                      Names = "HydraulicFlow",
                                                      timestep = 0)
 
-    expect_equal(length(point_data), 1)
-    expect_equal(names(point_data), "p0")
+    expect_equal(length(point_data),3)
+    expect_equal(names(point_data), c("p0", "p1", "p2"))
 })
 
 
@@ -101,6 +102,19 @@ test_that("OGS6_vtu initialization works", {
 })
 
 
+test_that("OGS6_vtu$get_data_for_points works", {
+
+    vtu_path <- system.file("extdata/benchmarks/flow_no_strain",
+                            "flow_no_strain_ts_1000_t_100.000000.vtu",
+                            package = "r2ogs6")
+
+    vtu_obj <- OGS6_vtu$new(vtu_path = vtu_path)
+
+    point_data <- vtu_obj$get_data_for_points(c(0, 1, 2), "HydraulicFlow")
+    expect_equal(length(point_data), 3)
+})
+
+
 #===== generate_structured_mesh =====