changed some functions to speed up parsing

DESCRIPTION

@@ -27,9 +27,9 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.2
+RoxygenNote: 7.3.2
 Imports: 
-    jsonlite,
+    rjson,
     httr,
     rlang,
     purrr,

R/xronos-api.R

@@ -88,29 +88,71 @@ xronos_query <- function(filter, values) {
 #' @noRd
 xronos_parse <- function(response) {
   content <- httr::content(response, as = "text")
-  result <- jsonlite::parse_json(content)
-
-  # Flatten nested attributes
-  result <- purrr::map_depth(result, 2,
-                             ~purrr::map_at(., c("measurement", "periods"),
-                                            ~list(unlist(., use.names = FALSE))))
-  result <- purrr::map_depth(result, 2,
-                             ~purrr::map_at(., c("measurement", "typochronological_units"),
-                                            ~list(unlist(., use.names = FALSE))))
-  result <- purrr::map_depth(result, 2,
-                             ~purrr::map_at(., c("measurement", "ecochronological_units"),
-                                            ~list(unlist(., use.names = FALSE))))
-
-  # Normalise & rectangle
-  result <- purrr::map(result, normalise_empty)
-  result <- purrr::map_dfr(result, "measurement")
-
-  result
+  result <- rjson::fromJSON(content)
+
+  measurements <- lapply(seq_along(result), function(i) {
+    process_measurement(result[[i]]$measurement)
+  })
+
+  # Combine list of named lists into a data frame and then convert to tibble
+  result_df <- dplyr::bind_rows(measurements)
+
+  result_df <- lapply(result_df, normalise_empty)
+
+  return(dplyr::as_tibble(result_df))
 }
 
 
 # Helpers -----------------------------------------------------------------
 
+#' XRONOS web address
+#'
+#' Helper function to process each measurement
+#'
+#' @param measurement An individual measurement from the response as JSON
+#'
+#' @return
+#' A row of parsed JSON for an individual measurement.
+#' @keywords internal
+#' @noRd
+process_measurement <- function(measurement) {
+
+  periods <- unlist(
+    lapply(
+      measurement$periods,
+      function(x) x$periode
+      ),
+    use.names = FALSE)
+
+  typochronological_units <- unlist(
+    lapply(
+      measurement$typochronological_units,
+      function(x) x$typochronological_unit
+      ),
+    use.names = FALSE
+    )
+
+  ecochronological_units <- unlist(
+    lapply(
+      measurement$ecochronological_units,
+      function(x) x$ecochronological_unit
+      ),
+    use.names = FALSE
+    )
+
+  reference <- lapply(
+    measurement$reference,
+    function(x) list(reference = x$reference)
+    )
+
+  measurement$periods <- list(periods)
+  measurement$typochronological_units <- list(typochronological_units)
+  measurement$ecochronological_units <- list(ecochronological_units)
+  measurement$reference <- reference
+
+  return(measurement)
+}
+
 #' XRONOS web address
 #'
 #' Returns the current base URL of XRONOS, or the address of the API version
@@ -175,9 +217,10 @@ xronos_assert_valid_filter <- function(x) {
 #' @noRd
 normalise_empty <- function(x) {
   if (is.list(x)) {
-    if (length(x) == 0) NA
-    else purrr::map(x, normalise_empty)
+    lapply(x, normalise_empty)
+  } else if (is.null(x)) {
+    NA
+  } else {
+    x
   }
-  else if (is.null(x)) NA
-  else x
 }

xronos.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: dde9acba-558b-41ef-ac0d-d54b8e2d9578
 
 RestoreWorkspace: Default
 SaveWorkspace: Default