R/gen_objects2var.R

Defines functions gen_objects2var

Documented in gen_objects2var

#' gen_objects2var
#'
#' @description Function to find objects related to a variable
#'
#' @param code Character string with a maximum length of 15 characters. Code from a GENESIS, Zensus 2022 or regionalstatistik.de object. Only one code per iteration.
#' @param database Character string. Indicator if the GENESIS ('genesis'), Zensus 2022 ('zensus') or regionalstatistik.de ('regio') database is called. Default option is 'all'.
#' @param category Character string. Specify specific GENESIS/regionalstatistik.de object types ('tables', 'statistics' and 'cubes') and specific Zensus 2022 object types ('tables' and 'statistics'). All types that are specific for one database can be used together. Default option is to use all types that are possible for the specific database.
#' @param area Character string. Indicator from which area of the database the results are called. In general, 'all' is the appropriate solution. Default option is 'all'. Not used for 'statistics'.
#' @param detailed Boolean. Indicator if the function should return the detailed output of the iteration including all object-related information or only a shortened output including only code and object title. Default option is 'FALSE'.
#' @param sortcriterion Character string. Indicator if the output should be sorted by 'code' or 'content'. This is a parameter of the API call itself. The default is 'code'.
#' @param pagelength Integer. Maximum length of results or objects (e.g., number of tables). Defaults to 500. Maximum of the databases is 25,000 objects.
#' @param error.ignore Boolean. Indicator if the function should stop if an error occurs or no object for the request is found or if it should produce a token as response. Default option is 'FALSE'. Important note: This does not apply to errors generated by the API call itself (especially server or client errors with status codes 5xx or 4xx). In this case, the function call will error even if error.ignore is set to TRUE.
#' @param verbose Boolean. Indicator if the output of the function should include detailed messages and warnings. Default option is 'TRUE'. Set the parameter to 'FALSE' to suppress additional messages and warnings.
#' @param ... Additional parameters for the API call. These parameters are only affecting the call itself, no further processing. For more details see `vignette("additional_parameter")`.
#'
#' @return A list with all recalled elements from the API. Based on the 'detailed' parameter it contains more or less information, but always includes the code of the object, the title, and the type of the object. This is done to facilitate further processing with the data. Attributes are added to the data.frame describing the search configuration for the returned output.
#' @export
#'
#' @examples
#' \dontrun{
#' # Find Tables for Variable "Kreise" and return detailed output
#' object <- gen_objects2var(code = "Kreise", category = "tables", detailed = T)
#'
#' # Find everything for Variable "GES"
#' object <- gen_objects2var(code = "GES")
#' # Default of detailed-parameter is FALSE, and default of the
#' # category-parameter is to include all object types.
#' }
#'
gen_objects2var <- function(code = NULL,
                            database = c("all", "genesis", "zensus", "regio"),
                            category = c("tables", "statistics", "cubes"),
                            area = c("all", "public", "user"),
                            detailed = FALSE,
                            sortcriterion = c("code", "content"),
                            pagelength = 500,
                            error.ignore = FALSE,
                            verbose = TRUE,
                            ...) {

  caller <- as.character(match.call()[1])

  check_function_input(code = code,
                       category = category,
                       detailed = detailed,
                       error.ignore = error.ignore,
                       pagelength = pagelength,
                       database = database,
                       sortcriterion = sortcriterion,
                       caller = caller,
                       verbose = verbose)

  # database_vector will hold a vector of the specified databases to query
  database_vector <- test_database_function(input = database,
                                            error.input = error.ignore,
                                            text = verbose)

  area <- match.arg(area)

  area <- switch(area, all = "all", public = "\u00F6ffentlich", user = "benutzer")

  sortcriterion <- match.arg(sortcriterion)

  #-----------------------------------------------------------------------------

  res <- lapply(database_vector, function(db){

    if (isTRUE(verbose)) {

      info <- paste("Started the processing of", db, "database.")

      message(info)

    }

    #---------------------------------------------------------------------------

    if ("tables" %in% category) {

      results_raw <- gen_api(endpoint = "catalogue/tables2variable",
                             database = db,
                             username = gen_auth_get(database = db)$username,
                             password = gen_auth_get(database = db)$password,
                             name = code,
                             area = area,
                             sortcriterion = sortcriterion,
                             pagelength = pagelength,
                             ...)

      results_json <- test_if_json(results_raw)

      empty_object <- test_if_error(results_json, para = error.ignore, verbose = verbose)

      if (isTRUE(empty_object)) {

        df_tables <- "No 'tables' object found for your request."

      } else if (isFALSE(empty_object)) {

        df_tables <- results_json$Status$Content

      } else if (empty_object == "DONE") {

        if (isTRUE(detailed)) {

          df_tables <- binding_lapply(results_json$List,
                                      characteristics = c("Code",
                                                          "Content",
                                                          "Time"))

        } else {

          df_tables <- binding_lapply(results_json$List,
                                      characteristics = c("Code",
                                                          "Content"))

        }

        df_tables$Object_Type <- "Table"

        df_tables <- tibble::as_tibble(df_tables)

      }

    }

    #---------------------------------------------------------------------------

    if ("statistics" %in% category) {

      results_raw <- gen_api(endpoint = "catalogue/statistics2variable",
                             database = db,
                             username = gen_auth_get(database = db)$username,
                             password = gen_auth_get(database = db)$password,
                             name = code,
                             area = area,
                             sortcriterion = sortcriterion,
                             pagelength = pagelength,
                             ...)

      results_json <- test_if_json(results_raw)

      empty_object <- test_if_error(results_json, para = error.ignore, verbose = verbose)

      if (isTRUE(empty_object)) {

        df_statistics <- "No 'statistics' object found for your request."

      } else if (isFALSE(empty_object)) {

        df_statistics <- results_json$Status$Content

      } else if (empty_object == "DONE") {

        if (isTRUE(detailed)) {

          df_statistics <- binding_lapply(results_json$List,
                                          characteristics = c("Code",
                                                              "Content",
                                                              "Cubes",
                                                              "Information"))

        } else {

          df_statistics <- binding_lapply(results_json$List,
                                          characteristics = c("Code",
                                                              "Content"))

        }

        df_statistics$Object_Type <- "Statistic"

        df_statistics <- tibble::as_tibble(df_statistics)

      }

    }

    #---------------------------------------------------------------------------

    if ("cubes" %in% category && db == "zensus") {

      df_cubes <- "There are generally no 'cubes' objects available for the 'zensus' database."

    } else if ("cubes" %in% category && (db == "genesis" || db == "regio")) {

      results_raw <- gen_api(endpoint = "catalogue/timeseries2variable",
                             database = db,
                             username = gen_auth_get(database = db)$username,
                             password = gen_auth_get(database = db)$password,
                             name = code,
                             area = area,
                             sortcriterion = sortcriterion,
                             pagelength = pagelength,
                             ...)

      results_json <- test_if_json(results_raw)

      empty_object <- test_if_error(results_json, para = error.ignore, verbose = verbose)

      if (isTRUE(empty_object)) {

        df_cubes <- "No 'cubes' object found for your request."

      } else if (isFALSE(empty_object)) {

        df_cubes <- results_json$Status$Content

      } else if (empty_object == "DONE") {

        if (isTRUE(detailed)) {

          df_cubes <- binding_lapply(results_json$List,
                                     characteristics = c("Code",
                                                         "Content",
                                                         "Time",
                                                         "State",
                                                         "LatestUpdate",
                                                         "Information"))

        } else {

          df_cubes <- binding_lapply(results_json$List,
                                     characteristics = c("Code",
                                                         "Content"))

        }

        df_cubes$Object_Type <- "Cube"

        df_cubes <- tibble::as_tibble(df_cubes)

      }

    }

    #---------------------------------------------------------------------------
    # Summary #

    if (all(c("tables", "statistics", "cubes") %in% category)) {

      list_resp <- list("Tables" = df_tables,
                        "Statistics" = df_statistics,
                        "Cubes" = df_cubes)

    } else if (category == "tables") {

      list_resp <- df_tables

    } else if (category == "statistics") {

      list_resp <- df_statistics

    } else if (category == "cubes") {

      list_resp <- df_cubes

    }

    attr(list_resp, "Code") <- results_json$Parameter$term
    attr(list_resp, "Database") <- db
    attr(list_resp, "Category") <- category
    attr(list_resp, "Language") <- results_json$Parameter$language
    attr(list_resp, "Pagelength") <- results_json$Parameter$pagelength
    attr(list_resp, "Copyright") <- results_json$Copyright

    return(list_resp)

  })

  #-----------------------------------------------------------------------------

  res <- check_results(res)

  return(res)

}

Try the restatis package in your browser

Any scripts or data that you put into this service are public.

restatis documentation built on April 12, 2025, 1:28 a.m.