R/gen_catalogue.R

Defines functions gen_catalogue

Documented in gen_catalogue

#' Search for tables, statistics and cubes
#'
#' @description Function to search for tables, statistics and cubes from GENESIS, Zensus 2022 or regionalstatistik.de. Additionally, it structures the output based on the internal tree structure based on the EVAS numbers. Time-series are represented as cubes with a specified time span. Important note: To be useful in searching for objects it is highly recommended to work with "*" placeholders (see examples). The placeholder can be placed before and/or after the search term.
#'
#' @param code String with a maximum length of 15 characters for a database object (GENESIS and regionalstatistik.de) and 15 characters for a Zensus 2022 object. Only one code per iteration. "*" notations are possible.
#' @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{
#' # Scroll through objects under the topic "12*"
#' # which is "Bevoelkerung" in GENESIS from all categories and
#' # with a detailed output
#' object <- gen_catalogue(code = "12*", detailed = TRUE)
#'
#' # Search tables under the topic "12*" which is "Bevoelkerung"
#' # without a detailed output
#' object <- gen_catalogue(code = "12*", category = "tables")
#' }
#'
gen_catalogue <- 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,
                          ...) {

  # Determine calling function; important for checking parameter values
  caller <- as.character(match.call()[1])

  # Check parameter values
  check_function_input(code = code,
                       category = category,
                       detailed = detailed,
                       error.ignore = error.ignore,
                       database = database,
                       sortcriterion = sortcriterion,
                       pagelength = pagelength,
                       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)

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

  # Loop over databases in database_vector and make respective API calls
  res <- lapply(database_vector, function(db){

    if (isTRUE(verbose)) {

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

      message(info)

    }

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

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

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

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

      # Make API call
      results_raw <- gen_api(endpoint = "catalogue/cubes",
                             database = db,
                             username = gen_auth_get(database = db)$username,
                             password = gen_auth_get(database = db)$password,
                             selection = code,
                             sortcriterion = sortcriterion,
                             area = area,
                             pagelength = pagelength,
                             ...)

      # Test validity of JSON results
      results_json <- test_if_json(results_raw)

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

      if (isTRUE(empty_object)){

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

      } else if (isFALSE(empty_object)){

        list_of_cubes <- results_json$Status$Content

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

        if (isTRUE(detailed)) {

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

        } else {

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

        }

        list_of_cubes$Object_Type <- "cube"

        list_of_cubes <- tibble::as_tibble(list_of_cubes)

      }

    }

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

    if ("statistics" %in% category) {

      # Make API call
      results_raw <- gen_api(endpoint = "catalogue/statistics",
                             database = db,
                             username = gen_auth_get(database = db)$username,
                             password = gen_auth_get(database = db)$password,
                             selection = code,
                             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)){

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

      } else if (isFALSE(empty_object)){

        list_of_stats <- results_json$Status$Content

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

        if (isTRUE(detailed)) {

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

        } else {

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

        list_of_stats$Object_Type <- "statistic"

        list_of_stats <- tibble::as_tibble(list_of_stats)

      }

    }

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

    if ("tables" %in% category) {

      # Make API call
      results_raw <- gen_api(endpoint = "catalogue/tables",
                             database = db,
                             username = gen_auth_get(database = db)$username,
                             password = gen_auth_get(database = db)$password,
                             selection = 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)){

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

      } else if (isFALSE(empty_object)){

        list_of_tabs <- results_json$Status$Content

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

        if (isTRUE(detailed)) {

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

        } else {

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


        }

        list_of_tabs$Object_Type <- "table"

        list_of_tabs <- tibble::as_tibble(list_of_tabs)

      }

    }

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

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

      list_resp <- list("Cubes" = if(length(list_of_cubes) == 1){tibble::as_tibble(list_of_cubes)} else {forming_evas(list_of_cubes)},
                        "Statistics" = if(length(list_of_stats) == 1){tibble::as_tibble(list_of_stats)} else {forming_evas(list_of_stats)},
                        "Tables" = if(length(list_of_tabs) == 1){tibble::as_tibble(list_of_tabs)} else {forming_evas(list_of_tabs)})


    #---------------------------------------------------------------------------
    } else if ("cubes" %in% category) {

      if (length(list_of_cubes) == 1 && db == "zensus"){

        list_resp <- list_of_cubes

      } else if (length(list_of_cubes) == 1 ){

        list_resp <- list("Cubes" = tibble::as_tibble(list_of_cubes))

      } else {

        list_resp <- list("Cubes" = forming_evas(list_of_cubes))

      }

    #---------------------------------------------------------------------------
    } else if ("statistics" %in% category) {

      if (length(list_of_stats) == 1 ){

        list_resp <- list("Statistics" = tibble::as_tibble(list_of_stats))

      } else {

        list_resp <- list("Statistics" = forming_evas(list_of_stats))

      }


    #---------------------------------------------------------------------------
    } else if ("tables" %in% category) {

      if(length(list_of_tabs) == 1 ){

        list_resp <- list("Tables" = tibble::as_tibble(list_of_tabs))

      } else {

        list_resp <- list("Tables" = forming_evas(list_of_tabs))

      }

    }

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

    # Append attributes to the result object(s)
    attr(list_resp, "Code") <- code
    attr(list_resp, "Database") <- db
    attr(list_resp, "Category") <- category

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

      attr(list_resp, "Info") <- "No API call has been executed."

    } else {

      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)

  })

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

  # Check validity of results
  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.