R/get_req_data.R

In adobeanalyticsr: R Client for 'Adobe Analytics' API 2.0

#' Get request data recursively
#'
#' This modified version of `get_req_data` utilizes a query spec and an index
#' to manage the recursive queries. Any query is defined by the query spec
#' (stateless information), the index (current breakdown depth, 1-indexed),
#' and the dimension item IDs used to filter the metrics.
#'
#' @param qs Query specification, generated by `make_query_spec()`
#' @param index Current breakdown level, starting from 1.
#' @param item_ids Dimension item IDs to include as filters for the metrics
#' @param debug Logical, whether to show all debug information about the queries
#' as they run
#'
#' @noRd
get_req_data <- function(
  qs,
  index,
  item_ids,
  debug
) {
  mc <- metric_container(
    metrics = qs_metrics(qs),
    sort = qs_sort(qs),
    dimensions = if (index == 1) NULL else qs_dimensions(qs, seq_len(index - 1)),
    itemIds = item_ids
  )

  settings <- req_settings(
    limit = qs_top(qs, index),
    page = qs_page(qs, index),
    nonesBehavior = qs_nones_behavior(qs),
    dimensionSort = qs_dimension_sort(qs)
  )
  search_field <- list(clause = qs_search(qs, index) %||% NA)


  req <- make_request(
    rsid = qs_rsid(qs),
    global_filter = qs_global_filter(qs),
    dimension = paste("variables", qs_dimensions(qs, index), sep = "/"),
    settings = settings,
    metric_container = mc,
    search = search_field
  )


  data <- jsonlite::fromJSON(aw_call_api(
    req_path = "reports/ranked",
    body = req,
    debug = debug,
    company_id = qs_company_id(qs)
  ))


  # Increment progress bar
  increment_global_counter()


  # Base case
  if (index == length(qs_dimensions(qs))) {
    # If no data is returned, data$rows is an empty list, so handle that
    output_data <- fix_missing_metrics(data$rows,
                                       n_metrics = length(qs_metrics(qs)))

    output_data <- output_data %>%
      # Rename column with current dimension name
      dplyr::rename(!!qs_dimensions(qs, index) := value) %>%
      unpack_metrics(qs_metrics(qs))
  }
  # Recursive case
  else {
    # Abort recursion if response is empty
    if (identical(data$rows, list())) {
      output_data <- fix_missing_metrics(
        data$rows,
        n_metrics = length(qs_metrics(qs)),
        dimensions = qs_dimensions(qs, index:length(qs_dimensions(qs)))
      ) %>%
        unpack_metrics(qs_metrics(qs))

      return(output_data)
    }

    next_dim <- qs_dimensions(qs, index + 1)
    dim_items <- data$rows[, c("itemId", "value")]
    dim_items$recent_dim <- qs_dimensions(qs, index)
    if (is.null(item_ids)) item_ids <- character()


    output_data <- purrr::pmap_dfr(dim_items, function(itemId, value, recent_dim) {
      get_req_data(qs = qs,
                    index = index + 1,
                    item_ids = c(item_ids, itemId),
                    debug = debug) %>%
        dplyr::mutate(!!recent_dim := value)
    })
  }

  output_data %>%
    select(
      # This first selection contains the current dimension and any dimensions
      # that have been returned by lower levels of recursion
      all_of(qs_dimensions(qs, index:length(qs_dimensions(qs)))),
      all_of(qs_metrics(qs)))
}


#' Unpacks metric column
#'
#' @param df Data frame possibly containing a list column called `data`
#' @param metric_names Metric names in the order they appear in the list column
#'
#' @return `df` with list column unpacked
#'
#' @importFrom purrr flatten_dbl
#' @importFrom purrr transpose
#' @noRd
unpack_metrics <- function(df, metric_names) {
  if (identical(df, data.frame())) {
    return(df)
  } else {
    if (is.list(df$data)) {
      data_list <- data_list <- lapply(df$data, as.numeric)
      df$data <- NULL

      data_df <- lapply(purrr::transpose(data_list), purrr::flatten_dbl) %>%
        stats::setNames(metric_names) %>%
        as.data.frame()

      df <- cbind(df, data_df)
    }
  }


  df
}


#' Expand missing metric data with NAs
#'
#'
#' @param df Data frame
#' @param n_metrics Number of metrics in request
#' @param dimensions Dimension columns to create. Defaults to `value`, which is
#'   what gets returned in the base case (leaf nodes) of recursive function. For
#'   recursive cases where no data is returned, `dimensions` should be the
#'   current dimension and all remaining dimensions.
#'
#' @return If `df` is a data frame, nothing is done to it. If it is an empty
#'   list, creates a data frame that imitates the response from the API, with
#'   a dimension column given by `dimensions` and a list column of metrics,
#'   where each row has length `n_metrics`.
#' @noRd
#' @examples
#' # Nothing done to data frames
#' fix_missing_metrics(data.frame(x = 1:10))
#'
#' # If no rows are returned, first argument will be empty list
#' # Uses 'value' by default, for the leaf node cases
#' fix_missing_metrics(list(), 1)
#'
#' # You can override dimensions that get created with 'dimensions'
#' fix_missing_metrics(list(), 2, c("one", "two"))
fix_missing_metrics <- function(df, n_metrics, dimensions = "value") {
  if (identical(df, list())) {
    warning("Response contained no data; filling with NA", call. = FALSE)
    df <- as.list(rep(NA, length(dimensions)))
    df <- as.data.frame(df, col.names = dimensions)

    metric_list_col <- list(rep(NA, n_metrics))
    df$data <- metric_list_col
  }

  as.data.frame(df)
}