R/pxweb_interactive.R

In pxweb: R Interface to PXWEB APIs

#' @title Find and download data interactively from a PXWEB API
#'
#' @description Wrapper function (for \link{pxweb_get}) to simply find and download data to the current R session. 
#' 
#' @param x The name or alias of the pxweb api to connect to, a \code{pxweb} object or an url.
#' 
#' @return 
#' The function returns a list with three slots:
#' \code{url}: The URL to the data
#' \code{query}: The query to access the data
#' \code{data}: The downloaded data (if chosen to download data)
#' 
#' @seealso
#' \code{\link{pxweb_get}}
#' @export
#' @examples
#' pxweb_api_catalogue() # List apis
#' 
#' ## The examples below can only be run in interactive mode
#' ##  x <- pxweb_interactive()
#' ##  x <- pxweb_interactive(x = "api.scb.se")
#' ##  x <- pxweb_interactive(x = "https://api.scb.se/OV0104/v1/doris/en/ssd/BE/BE0101/")
#' ##  x <- pxweb_interactive(x = "https://api.scb.se/OV0104/v1/doris/en/ssd/BE/BE0101/BE0101A/")
#' 
pxweb_interactive <- function(x = NULL){
  # Setup structure
  pxe <- pxweb_explorer(x)
  
  if (!pxe$show_history) { 
    cat("\014") 
  }
  
  # The main program - build up a query
  while(!pxe$quit) { 
    # Generate header    
    print(pxe)
    pxe <- pxweb_interactive_input(pxe)
    

    if (!pxe$show_history & !pxe$quit) { 
      cat("\014") 
    }
  }

  results <- list(url = pxe_data_url(pxe),
                  query = pxweb_query(pxe))
  dat <- pxe_interactive_get_data(pxe)

  if(!is.null(dat)){
    results$data <- dat
  }

  return(invisible(results))
}

#' @rdname pxweb_interactive
#' @export
interactive_pxweb <-function(x = NULL){
  pxweb_interactive(x)
}

#' Create a \code{pxweb_explorer} object.
#' @param x a \code{pxweb} object, a PXWEB url, \code{NULL} or an api in the api catalogue.
#' 
#' @description 
#' \code{position} the current position in the api, as a character vector from the root.
#' Note position is not alway a correct url. Metadata and other choices are part of position
#' 
#' \code{root} is the bottom path (as position) that the user can go. If length 0, user can essentially go to hostname.
#' 
#' paste(root_path + position, collapse = "/")  is used to construct the path to the position
#' in case of url.
#' 
#' @examples 
#' ## The functions below are internal generic functions
#' ## x <- pxweb_explorer()
#' ## url <- "api.scb.se"
#' ## x <- pxweb_explorer(x = url)
#' ## url <- "https://api.scb.se/OV0104/v1/doris/en/ssd/BE/BE0101/BE0101A/"
#' ## x <- pxweb_explorer(x = url)
#' ## url <- "https://api.scb.se/OV0104/v1/doris/en/ssd/BE/BE0101/BE0101A/BefolkningNy"
#' ## x <- pxweb_explorer(x = url)
#' 
#' @keywords internal
pxweb_explorer <- function(x = NULL){
  UseMethod("pxweb_explorer")
}

#' @rdname pxweb_explorer
#' @keywords internal
pxweb_explorer.NULL <- function(x){
  apis <- pxweb_api_catalogue()
  pxe <- list(pxweb = NULL,
              root = character(0))
  pxe$position <- character(0)
  pxe$variable_choice <- list()
  pxalist <- list()
  txt <- unname(unlist(lapply(apis, function(x) x$description)))
  for(i in seq_along(names(apis))){
    pxalist[[i]] <- list(id=names(apis)[i], type = "l", text = txt[i])
  }
  pxl <- pxweb_levels(pxalist)
  pxe$pxobjs <- list("/" = list(pxobj = pxl))
  class(pxe) <- c("pxweb_explorer", "list")
  pxe <- add_pxe_defaults(pxe)
  assert_pxweb_explorer(pxe)
  pxe
}

#' @rdname pxweb_explorer
#' @keywords internal
pxweb_explorer.character <- function(x){
  apis <- pxweb_api_catalogue()
  api_alias_tbl <- pxweb_api_catalogue_alias_table()
  px <- try(pxweb(x), silent = TRUE)
  if(inherits(px, "try-error")){
    pos_idx <- which(api_alias_tbl$alias %in% x)
    if(length(pos_idx) == 0){
      stop("'", x, "' is not a PXWEB API. See pxweb_api_catalogue() for available PXWEB APIs.", call. = FALSE)
    }
    px <- apis[[api_alias_tbl$idx[pos_idx]]]
  }
  pxweb_explorer(px)
}

#' @rdname pxweb_explorer
#' @keywords internal
pxweb_explorer.pxweb <- function(x){
  pxe <- list(pxweb = x)
  pxe$root <- pxweb_api_subpath(pxe$pxweb, as_vector = TRUE)
  pxe$position <- pxweb_api_path(pxe$pxweb, as_vector = TRUE)
  pxe$variable_choice <- list()
  class(pxe) <- c("pxweb_explorer", "list")
  pxe <- add_pxe_defaults(pxe)
  assert_pxweb_explorer(x = pxe)
  pxe_pxobj_at_position(pxe) <-
    pxweb_get(pxe_position_path(pxe, include_rootpath = TRUE))
  pxe
}

#' @rdname pxweb_explorer
#' @keywords internal
pxweb_explorer.pxweb_api_catalogue_entry <- function(x){
  pxe <- list(pxweb = pxweb(build_pxweb_url(x)))
  tot_pos <- pxweb_api_path(pxe$pxweb, as_vector = TRUE)
  pxe$root <- character(0)
  pxe$position <- character(0)
  pxe$variable_choice <- list()
  
  tot_pos <- strsplit(httr::parse_url(x$url)$path, split = "/")[[1]]
  ver_pos <- which(tot_pos == "[version]")
  lan_pos <- which(tot_pos == "[lang]")
  version_list <- list()
  for(i in seq_along(x$version)){
    version_list[[i]] <- list(id=gsub("\\[version\\]", paste(tot_pos[1:ver_pos], collapse = "/"), replacement = x$version[i]), 
                              type = "l", 
                              text = x$version[i])
  }
  pxe$pxobjs <- list("/" = list(pxobj = pxweb_levels(version_list)))

  language_list <- list()
  for(i in seq_along(x$version)){
    language_list[[i]] <- list()
    for(j in seq_along(x$lang)){
      lan_part <- gsub("\\[lang\\]", paste(tot_pos[(ver_pos+1):length(tot_pos)], collapse = "/"), replacement = x$lang[j])
      language_list[[i]][[j]] <- list(id=lan_part, 
                                      type = "l", 
                                      text = x$lang[j])
    }
    pxobj_nm <- paste0("/", version_list[[i]]$id)
    pxe$pxobjs[[pxobj_nm]] <- list(pxobj = pxweb_levels(language_list[[i]]), parent = "/")
  }
  class(pxe) <- c("pxweb_explorer", "list")
  pxe <- add_pxe_defaults(pxe)
  assert_pxweb_explorer(x = pxe)
  pxe
}

#' Add default values to pxe
#' @param pxe a \code{pxweb_explorer} object
#' @keywords internal
add_pxe_defaults <- function(pxe){
  checkmate::assert_class(pxe, "pxweb_explorer")
  pxe$show_history <- FALSE
  pxe$quit <- FALSE
  pxe$print_all_choices <- FALSE
  pxe$print_no_of_choices <- 4
  pxe$show_id <- FALSE
  pxe$metadata <- list(position = character(0),
                       choices = list())
  pxe
}


#' @rdname pxweb_explorer
#' @keywords internal
assert_pxweb_explorer <- function(x){
  checkmate::assert_class(x, "pxweb_explorer")
  checkmate::assert_character(x$root)
  checkmate::assert_character(x$position)
  checkmate::assert_subset(x = x$root, x$position)
  checkmate::assert_list(x$metadata)
  checkmate::assert_character(x$metadata$position)
  checkmate::assert_list(x$metadata$choices)
  checkmate::assert_list(x$variable_choice)
  checkmate::assert_flag(x$show_history)
  checkmate::assert_flag(x$print_all_choices)
  checkmate::assert_flag(x$quit)
  checkmate::assert_flag(x$show_id)
  checkmate::assert_int(x$print_no_of_choices, lower = 1)
  for(i in seq_along(x$pxobjs)){
    checkmate::assert_names(names(x$pxobjs[[i]]), must.include = "pxobj")
    is_pxlev <- inherits(x$pxobjs[[i]]$pxobj, "pxweb_levels")
    is_pxmd <- inherits(x$pxobjs[[i]]$pxobj, "pxweb_metadata")
    checkmate::assert_true(is_pxlev | is_pxmd)
    if(!is.null(x$pxobjs[[i]]$parent)){
      checkmate::assert_string(x$pxobjs[[i]]$parent)
      checkmate::assert_choice(x$pxobjs[[i]]$parent, names(x$pxobjs))
    }
  }
}


#' @param include_rootpath Should the rootpath be included? Default is FALSE
#' @rdname pxweb_api_name
#' @keywords internal
pxe_position_path <- function(x, init_slash = TRUE, as_vector = FALSE, include_rootpath = FALSE){
  checkmate::assert_class(x, "pxweb_explorer")
  checkmate::assert_flag(init_slash)
  checkmate::assert_flag(as_vector)
  checkmate::assert_flag(include_rootpath)
  
  if(is.null(x$pxweb)){
    if(init_slash){
      return("/")
    } else {
      return("")
    }
  } 
  if(as_vector){
    if(include_rootpath){
      return(c(pxweb_api_rootpath(x), x$position))
    } else {
      return(x$position)
    }
  }
  p <- paste(x$position, collapse = "/")
  if(include_rootpath){
    return(pxweb_fix_url(paste(pxweb_api_rootpath(x), p, sep = "/")))
  } else {
    if(init_slash){
      return(pxweb_fix_url(paste("/", p, sep = "")))
    }
  }
  return(pxweb_fix_url(p))
}

#' @rdname pxweb_api_name
#' @keywords internal
pxe_metadata_path <- function(x, as_vector = FALSE){
  checkmate::assert_class(x, "pxweb_explorer")
  checkmate::assert_flag(as_vector)
  if(as_vector){
    x$metadata$position
  } else {
    paste(x$metadata$position, collapse = "")
  }
}


#' @rdname pxweb_explorer
#' @keywords internal
print.pxweb_explorer <- function(x, ...){
  print_bar()  
  pxnm <- pxweb_api_name(x)
  if(pxnm == ""){
    cat(" R PXWEB API CATALOGUE:\n") 
  } else {
    cat(" R PXWEB: Content of '", pxweb_api_name(x), "'\n", sep="") 
  }

  sp <- pxe_position_path(x, init_slash = TRUE, include_rootpath = FALSE)
  if(nchar(sp) > 1) cat("          at '", sp, "'\n", sep="") 
  titl <- pxe_position_title(x)
  if(pxe_position_is_metadata(x)) {
    if(nchar(titl) > 1) cat("   TABLE: ", titl, "\n", sep="") 
    meta_pos <- length(pxe_metadata_path(x, as_vector = TRUE))
    mp <- pxe_metadata_variable_names(x)
    mp[meta_pos] <- paste("[[", mp[meta_pos], "]]", sep = "")
    mp <- paste(mp, collapse =", ")
    cat("VARIABLE: ", mp, "\n", sep="") 
  }
  print_bar()  
  pxe_print_choices(x)
  print_bar()  
}

#' Get the table title for the current position
#' @param x a \code{pxweb_explorer} object.
#' @keywords internal
pxe_position_title <- function(x){
  checkmate::assert_class(x, "pxweb_explorer")
  if(pxe_position_is_metadata(x)){
    obj <- pxe_pxobj_at_position(x)
    return(obj$title)
  } else {
    return("")    
  }
}

#' @rdname pxweb_explorer
#' @description print out a bar for separation purposes
#' @keywords internal
print_bar <- function(){
  cat(rep("=", round(getOption("width")*0.95)), "\n",sep="")
}

#' @rdname pxweb_explorer
#' @keywords internal
pxe_print_choices <- function(x){
  checkmate::assert_class(x, "pxweb_explorer")
  obj <- pxe_pxobj_at_position(x)
  show_no <- x$print_no_of_choices
  
  if(pxe_position_is_metadata(x)){
    mddims <- pxweb_metadata_dim(pxe_pxobj_at_position(x))
    md_pos <- pxe_metadata_path(x, as_vector = TRUE)
    no_rows_to_print <- unname(mddims[md_pos[length(md_pos)]])
    choices_idx <- 1:no_rows_to_print
  } else {
    choices_df <- pxweb_levels_choices_df(obj)
    no_rows_to_print <- nrow(choices_df)
    choices_idx <- choices_df$choice_idx
  }
  
  if(x$print_all_choices | no_rows_to_print <= show_no * 2){
    print_idx <- 1:no_rows_to_print
  } else {
    print_idx <- c(1:show_no, NA, (no_rows_to_print - show_no + 1):no_rows_to_print)
  }

  print_idx_char <- as.character(print_idx)
  choice_idx_char <- as.character(choices_idx)
  choice_idx_char_nmax <- max(nchar(choice_idx_char), na.rm = TRUE)
  choice_idx_char <- str_pad(choice_idx_char, choice_idx_char_nmax )
  
  for(i in seq_along(print_idx)){
    if(is.na(print_idx[i])) {
      cat("\n")
      next
    }
    
    if(pxe_position_is_metadata(x)){
      if(x$show_id){
        cat(" [", print_idx_char[i], " ] : ", obj$variables[[length(md_pos)]]$valueTexts[print_idx[i]], " (", obj$variables[[length(md_pos)]]$values[print_idx[i]] ,")", "\n", sep = "")    
      } else {
        cat(" [", print_idx_char[i], " ] : ", obj$variables[[length(md_pos)]]$valueTexts[print_idx[i]], "\n", sep = "")    
      }
    } else {
      if(obj[[print_idx[i]]]$type == "h") {
        txt <- paste("\n", paste(rep(" ", nchar(print_idx_char[i]) + 2 + 6), collapse = ""), collapse = "")
      } else {
        txt <- paste0(" [", choice_idx_char[print_idx[i]], " ] : ")
      }
      txt <- paste0(txt, obj[[print_idx[i]]]$text)
      if(x$show_id) txt <- paste0(txt, " (", obj[[print_idx[i]]]$id ,")")    
      txt <- paste0(txt, "\n")
      cat(txt)
    }
  }
}


#' Pad a string to a fixed size
#' @param x a character vector to pad
#' @param n final char width
#' @param pad pad symbol
#' @param type pad from 'left' or 'right'.
#' @keywords internal
str_pad <- function(txt, n = 5, pad = " ", type = "left"){
  checkmate::assert_character(txt)
  checkmate::assert_string(pad)
  checkmate::assert_true(nchar(pad)==1)
  checkmate::assert_int(n)
  checkmate::assert_choice(type, c("left", "right"))
  
  nch <- pmax((n - nchar(txt)), rep(0, length(txt)))
  nch[is.na(nch)] <- 2
  pads <- unlist(lapply(nch, function(x, pad) {paste(rep(pad, x), collapse="")}, pad))
  if(type == "left"){
    return(paste(pads, txt))
  } else {
    return(paste(txt, pads))
  }
}


#' Get input from user
#' @param pxe a \code{pxweb_explorer} object to get user input for.
#' @param test_input supplying a test input (for testing only).
#' @keywords internal
pxweb_interactive_input <- function(pxe, test_input = NULL){
  checkmate::assert_class(pxe, "pxweb_explorer")
  allowed_input <- pxe_allowed_input(pxe)
  user_input <- pxe_input(allowed_input, test_input = test_input)
  pxe <- pxe_handle_input(user_input, pxe)
  pxe
}

#' Handle a user input for a \code{pxweb_explorer} object.
#' @param pxe a \code{pxweb_explorer} object to get user input for.
#' @param user_input an (allowed) user input to handle.
#' @seealso pxe_allowed_input()
#' @keywords internal
pxe_handle_input <- function(user_input, pxe){
  checkmate::assert_class(pxe, "pxweb_explorer")
  UseMethod("pxe_handle_input")
}

#' @rdname pxe_handle_input
#' @keywords internal
pxe_handle_input.numeric <- function(user_input, pxe){
  obj <- pxe_pxobj_at_position(pxe)
  if(pxe_position_is_metadata(pxe)){
    pxe_metadata_choices(pxe) <- user_input
  } else if(pxe_position_is_api_catalogue(pxe)) {
    pxe <- pxweb_explorer(obj[[user_input]]$id)
  } else {
    cdf <- pxweb_levels_choices_df(obj)
    choice_input <- which(cdf$choice_idx == user_input)
    new_pos <- obj[[choice_input]]$id
    pxe <- pxe_add_position(pxe, new_pos)
  }
  assert_pxweb_explorer(pxe)
  pxe
}

#' @rdname pxe_handle_input
#' @keywords internal
pxe_handle_input.character <- function(user_input, pxe){
  
  user_input_ok <- FALSE
  if(user_input == "b"){
    pxe <- pxe_back_position(pxe)
    user_input_ok <- TRUE
  }
  
  if(user_input == "i"){
    pxe$show_id <- !pxe$show_id
    user_input_ok <- TRUE    
  }
  
  if(user_input == "a"){
    pxe$print_all_choices <- !pxe$print_all_choices
    user_input_ok <- TRUE    
  }
  
  if(user_input == "*"){
    user_input <- 1:pxe_position_choice_size(pxe)
    return(pxe_handle_input(user_input, pxe))
  }
  
  if(user_input == "e"){
    pxe_metadata_choices(pxe) <- "eliminate"
    user_input_ok <- TRUE    
  }

  if(!user_input_ok) stop("Not implemented choice!")
  
  assert_pxweb_explorer(pxe)
  pxe
}


#' Get and set pxe_metadata_coices
#' @param x a \code{pxweb_explorer} object
#' @param value an object to set as pxe_metadata_choice
#' @keywords internal
pxe_metadata_choices <- function(x){
  checkmate::assert_class(x, "pxweb_explorer")
  mdc <- x$metadata$choices
  mdcnm <- pxe_metadata_path(x, as_vector = TRUE)
  mdc <- mdc[1:length(mdcnm)]
  names(mdc) <- mdcnm
  mdc
}


#' @rdname pxe_metadata_choices
#' @keywords internal
`pxe_metadata_choices<-` <- function(x, value){
  checkmate::assert_class(x, "pxweb_explorer")
  checkmate::assert_true(pxe_position_is_metadata(x))
  x$print_all_choices <- FALSE
  mddims <- pxweb_metadata_dim(pxe_pxobj_at_position(x))
  md_pos <- pxe_metadata_path(x, as_vector = TRUE)
  x$metadata$choices[[length(md_pos)]] <- value
  if(length(mddims) > length(md_pos)){
    x$metadata$position <- names(mddims)[1:(length(md_pos)+1)]
  } else {
    x$quit <- TRUE
  }
  return(x)
}


#' Move in the \code{pxweb_explorer} position
#' 
#' @details \code{pxe_back_position} moves back one position and 
#' \code{pxe_add_position} moves forward, based on user choice.
#' 
#' @param pxe a \code{pxweb_explorer} object.
#' @param new_pos add a new position.
#' @keywords internal
pxe_back_position <- function(pxe){
  checkmate::assert_class(pxe, "pxweb_explorer")
  if(pxe_position_is_metadata(pxe) & length(pxe$metadata$position) > 1){
    pxe$metadata$position <- pxe$metadata$position[-length(pxe$metadata$position)]
    pxe$print_all_choices <- FALSE
    assert_pxweb_explorer(pxe)
    return(pxe)
  }
  pxe$position <- pxe$position[-length(pxe$position)]
  obj <- pxe_pxobj_at_position(pxe)
  if(is.null(obj)){
    pxe_pxobj_at_position(pxe) <- 
      pxweb_get(pxe_position_path(pxe, include_rootpath = TRUE))
  }
  pxe$print_all_choices <- FALSE
  assert_pxweb_explorer(pxe)
  pxe
}

#' @rdname pxe_back_position
#' @keywords internal
pxe_add_position <- function(pxe, new_pos){
  checkmate::assert_class(pxe, "pxweb_explorer")
  checkmate::assert_string(new_pos)
  pxe$position[length(pxe$position) + 1] <- new_pos
  if(length(pxe$root) == 0 & length(pxe$position) == 2){
    if(grepl("\\[lang\\]", x = pxe$position[1])){
      # Special handling of languages (see iceland for example)
      # If lang is also before version, swap that to lang
      pxe$position[1] <- gsub("\\[lang\\]", new_pos, x = pxe$position[1])
      pxe$root <- pxe$position
    }
  }
  obj <- pxe_pxobj_at_position(pxe)
  if(is.null(obj)){
    pxe_pxobj_at_position(pxe) <- 
      pxweb_get(pxe_position_path(pxe, include_rootpath = TRUE))
  }
  pxe$print_all_choices <- FALSE
  assert_pxweb_explorer(pxe)
  pxe
}


#' Get (allowed) inputs for a \code{pxweb_input_allowed} object.
#' 
#' @details 
#' It handles input and checks if the input is allowed.
#' 
#' @param allowed_input a \code{pxweb_input_allowed}.
#' @param title Print (using cat()) before ask for the allowed choices.
#' @param test_input supplying a test input (for testing only)
#' @keywords internal
pxe_input <- function(allowed_input, title = NULL, test_input = NULL){
  checkmate::assert_class(allowed_input, "pxweb_input_allowed")
  checkmate::assert_string(title, null.ok = TRUE)
  
  input_ok <- FALSE
  incorrect_choice_no <- 0
  
  while(!input_ok){
    if(!is.null(title)){
      cat(title)
    }
    print(allowed_input)
    if(is.null(test_input)){
      user_input <- scan(what=character(), multi.line = FALSE, quiet=TRUE, nlines=1, sep = "\n")
    } else {
      user_input <- test_input
    }
    user_input <- pxe_parse_input(user_input, allowed_input)
    input_ok <- user_input$ok
    
    # Handle too many incorrect choices
    incorrect_choice_no <- incorrect_choice_no + 1
    if(incorrect_choice_no > 10) {
      stop("Too many incorrect choices. Aborting.", call. = FALSE)
    }
  }
  class(user_input) <- c("pxweb_user_input", "list")
  user_input$input
}
  

#' @rdname pxe_input
#' @keywords internal
pxe_parse_input <- function(user_input, allowed_input){
  checkmate::assert_character(user_input)
  checkmate::assert_class(allowed_input, "pxweb_input_allowed")
  
  if(length(user_input) == 0){
    cat("Incorrect choice.\n")
    return(list(ok = FALSE))
  }
  
  ui <- str_trim(user_input)
  if(ui %in% allowed_input$keys$code[allowed_input$keys$allowed]){
    return(list(ok = TRUE, input = ui))
  }
  if(grepl(x = ui, pattern = "^[:,0-9 ]*$")){
    if(allowed_input$max_choice == 0){
      cat("Incorrect choice.\n")
      return(list(ok = FALSE))      
    }
    ui <- eval(parse(text=paste("c(", ui, ")")))
    ui <- ui[!duplicated(ui)]
    if(!all(ui %in% 1:allowed_input$max_choice)){
      cat("Incorrect choice.\n")
      return(list(ok = FALSE))
    }
    if(allowed_input$multiple_choice | length(ui) == 1){
      return(list(ok = TRUE, input = ui))
    }
  }
  cat("Incorrect choice.\n")
  return(list(ok = FALSE))
}


#' Defines allowed input for a position in a \code{pxweb_explorer} or character object.
#' 
#' @param x a object to get allowed input for.
#' @keywords internal
pxe_allowed_input <- function(x){
  UseMethod("pxe_allowed_input")
}

#' @rdname pxe_allowed_input
#' @keywords internal
pxe_allowed_input_df <- function(){
  input_df <- data.frame(code=c("esc", "b", "*", "a", "e", "i", "i", "y", "n"),
                         text=c("Quit", "Back", "Select all", "Show all", "Eliminate", "Show id", "Hide id", "Yes", "No"),
                         stringsAsFactors = FALSE)
  input_df$allowed <- FALSE
  input_df$allowed[1] <- TRUE
  input_df
}

#' @rdname pxe_allowed_input
#' @keywords internal
pxe_allowed_input.pxweb_explorer <- function(x){

  input_df <- pxe_allowed_input_df()
  
  input_df$allowed[input_df$code == "esc"] <- TRUE
    
  if(length(x$position) > length(x$root)){
    input_df$allowed[input_df$code == "b"] <- TRUE
  }
  
  if(pxe_position_is_metadata(x)){
    input_df$allowed[input_df$code == "*"] <- TRUE
    if(pxe_position_variable_can_be_eliminated(x)){
      input_df$allowed[input_df$code == "e"] <- TRUE
    }
  }
  
  if(!x$print_all_choices & pxe_position_print_size(x) > x$print_no_of_choices*2){
    input_df$allowed[input_df$code == "a"] <- TRUE
  }
  
  if(x$show_id){
    input_df$allowed[input_df$text == "Hide id"] <- TRUE
  } else {
    input_df$allowed[input_df$text == "Show id"] <- TRUE
  }
  
  res <- list(keys = input_df,
              multiple_choice = pxe_position_multiple_choice_allowed(x),
              max_choice = pxe_position_choice_size(x))
  class(res) <- c("pxweb_input_allowed", "list")
  assert_pxweb_input_allowed(res)
  res
}


#' @rdname pxe_allowed_input
#' @keywords internal
pxe_allowed_input.character <- function(x){
  input_df <- pxe_allowed_input_df()
  checkmate::assert_character(x)
  checkmate::assert_subset(x, input_df$code)
  
  input_df$allowed[input_df$code %in% x] <- TRUE
  
  res <- list(keys = input_df,
              multiple_choice = FALSE,
              max_choice = 0)
  class(res) <- c("pxweb_input_allowed", "list")
  assert_pxweb_input_allowed(res)
  res
}

#' @rdname pxe_allowed_input
#' @keywords internal
pxe_allowed_input.pxweb_explorer <- function(x){
  
  input_df <- pxe_allowed_input_df()
  
  input_df$allowed[input_df$code == "esc"] <- TRUE
  
  if(length(x$position) > length(x$root)){
    input_df$allowed[input_df$code == "b"] <- TRUE
  }
  
  if(pxe_position_is_metadata(x)){
    input_df$allowed[input_df$code == "*"] <- TRUE
    if(pxe_position_variable_can_be_eliminated(x)){
      input_df$allowed[input_df$code == "e"] <- TRUE
    }
  }
  
  if(!x$print_all_choices & pxe_position_choice_size(x) > x$print_no_of_choices*2){
    input_df$allowed[input_df$code == "a"] <- TRUE
  }
  
  if(x$show_id){
    input_df$allowed[input_df$text == "Hide id"] <- TRUE
  } else {
    input_df$allowed[input_df$text == "Show id"] <- TRUE
  }
  
  res <- list(keys = input_df,
              multiple_choice = pxe_position_multiple_choice_allowed(x),
              max_choice = pxe_position_choice_size(x))
  class(res) <- c("pxweb_input_allowed", "list")
  assert_pxweb_input_allowed(res)
  res
}


#' Assert a \code{pxweb_input_allowed} object
#' @param x an object to assert.
#' @keywords internal
assert_pxweb_input_allowed <- function(x){
  checkmate::assert_class(x, "pxweb_input_allowed")
  checkmate::assert_names(names(x), permutation.of = c("keys", "multiple_choice", "max_choice"))
  checkmate::assert_flag(x$multiple_choice)
  checkmate::assert_int(x$max_choice, lower = 0)
  checkmate::assert_class(x$key, "data.frame")
  checkmate::assert_character(x$key$text)
  checkmate::assert_character(x$key$code)
  checkmate::assert_logical(x$key$allowed)
}

#' @rdname assert_pxweb_input_allowed
#' @keywords internal
print.pxweb_input_allowed <- function(x, ...){
  if(!x$multiple_choice){
    cat("Enter your choice:\n")
  } else {
    cat("Enter one or more choices:\n")
    cat("Separate multiple choices by ',' and intervals of choices by ':'\n")
  }
  txt <- paste("(", paste(paste(paste("'", x$keys$code[x$keys$allowed], "'", sep = ""), "=", x$keys$text[x$keys$allowed]), collapse = ", "), ")", sep= "")
  cat(txt, "\n")
}

#' Return the pxweb object at the current position
#' @param x a \code{pxweb_explorer} object.
#' @keywords internal
pxe_pxobj_at_position <- function(x){
  checkmate::assert_class(x, "pxweb_explorer")
  x$pxobjs[[pxe_position_path(x)]]$pxobj
}

#' @rdname pxe_pxobj_at_position
#' @keywords internal
`pxe_pxobj_at_position<-` <- function(x, value){
  checkmate::assert_class(x, "pxweb_explorer")
  checkmate::assert_true(inherits(value, "pxweb_levels") | inherits(value, "pxweb_metadata"))
  x$pxobjs[[pxe_position_path(x)]]$pxobj <- value
  if(inherits(value, "pxweb_metadata")){
    x$metadata$position[1] <- value$variables[[1]]$code
  }
  assert_pxweb_explorer(x)
  x
}

#' Is the current position a metadata object?
#' @param x a \code{pxweb_explorer} object to check.
#' @keywords internal
pxe_position_is_metadata <- function(x) {
  inherits(pxe_pxobj_at_position(x), "pxweb_metadata")
}

#' Is the current position a full query (i.e. choices for all metadata variables)?
#' @param x a \code{pxweb_explorer} object to check.
#' @keywords internal
pxe_position_is_full_query <- function(x){
  if(!pxe_position_is_metadata(x)) {
    return(FALSE)
  }
  md_ch <- length(pxe_metadata_choices(x))
  md_pos <- length(pxe_metadata_path(x, as_vector = TRUE))
  md_vnm <- length(pxe_metadata_variable_names(x))
  
  md_vnm == md_ch && md_pos == md_ch
}

#' Is the current position an api_catalogue position?
#' @param x a \code{pxweb_explorer} object to check.
#' @keywords internal
pxe_position_is_api_catalogue <- function(x) {
  is.null(x$pxweb)
}

#' How many choices has the current position?
#' @param x a \code{pxweb_explorer} object to check.
#' @keywords internal
pxe_position_choice_size <- function(x) {
  if(pxe_position_is_metadata(x)){
    cs <- pxe_position_print_size(x)
  } else {
    obj <- pxe_pxobj_at_position(x)
    choices_df <- pxweb_levels_choices_df(obj)
    cs <- max(choices_df$choice_idx, na.rm = TRUE)
  }
  cs
}

#' @rdname pxe_position_choice_size
#' @keywords internal
pxe_position_print_size <- function(x) {
  if(pxe_position_is_metadata(x)){
    md <- pxe_pxobj_at_position(x)
    md <- pxweb_metadata_dim(md)
    mdpos <- length(pxe_metadata_path(x, as_vector = TRUE))
    cs <- unname(md[mdpos])
  } else {
    cs <- length(pxe_pxobj_at_position(x))
  }
  cs
}

#' Can the variable at the current position be eliminated?
#' @param x a \code{pxweb_explorer} object to check.
#' @keywords internal
pxe_position_variable_can_be_eliminated <- function(x) {
  res <- FALSE
  if(pxe_position_is_metadata(x)){
    md <- pxe_pxobj_at_position(x)
    mdpos <- length(pxe_metadata_path(x, as_vector = TRUE))
    res <- md$variables[[mdpos]]$elimination
  }
  res
}

#' Are multiple choices allowed?
#' @param x a \code{pxweb_explorer} object to check.
#' @keywords internal
pxe_position_multiple_choice_allowed <- function(x){
  pxe_position_is_metadata(x)
}

#' Taken from \code{trimws} for reasons of compatibility with previous R versios.
#' @keywords internal
#' @seealso trimws
#' @param x a string to trim.
#' @param which how to trim the string.
str_trim <- function (x, which = c("both", "left", "right")) 
{
  which <- match.arg(which)
  mysub <- function(re, x) sub(re, "", x, perl = TRUE)
  if (which == "left") 
    return(mysub("^[ \t\r\n]+", x))
  if (which == "right") 
    return(mysub("[ \t\r\n]+$", x))
  mysub("[ \t\r\n]+$", mysub("^[ \t\r\n]+", x))
}

#' Get the meta data variable names from a \code{pxweb_explorer} object.
#' @param x a \code{pxweb_explorer} object
#' @keywords internal
pxe_metadata_variable_names <- function(x){
  checkmate::assert_true(pxe_position_is_metadata(x))
  md <- pxe_pxobj_at_position(x)
  names(pxweb_metadata_dim(md))
}


#' Get the url to a table
#' @param x a \code{pxweb_explorer} object
#' @keywords internal
pxe_data_url <- function(x){
  checkmate::assert_true(pxe_position_is_metadata(x))
  pxe_position_path(x, include_rootpath = TRUE, as_vector = FALSE)
}



#' Ask to download and download data
#' 
#' @param pxe a \code{pxweb_explorer} object with full query
#' @param test_input a test input for testing the function. 
#' Since two question, supply a vector of length two.
#' @keywords internal
pxe_interactive_get_data <- function(pxe, test_input = NULL){
  checkmate::assert_true(pxe_position_is_full_query(pxe))
  checkmate::assert_character(test_input, null.ok = TRUE, min.len = 1)
  
  test_idx <- 1
  print_code <- pxe_input(allowed_input = pxe_allowed_input(c("y", "n")), 
                          "Do you want to print code to query and download data?\n",
                          test_input = test_input[test_idx]) == "y"
  if(print_code){
    test_idx <- test_idx + 1
    print_json <- pxe_input(allowed_input = pxe_allowed_input(c("y", "n")), 
                            "Do you want to print query in json format (otherwise query is printed as an R list)?\n",
                            test_input = test_input[test_idx]) == "y"
  }
  test_idx <- test_idx + 1
  download <- pxe_input(allowed_input = pxe_allowed_input(c("y", "n")), 
                        title = "Do you want to download the data?\n",
                        test_input = test_input[test_idx]) == "y"
  
  checkmate::assert_character(test_input, null.ok = TRUE, min.len = 2)
  return_df <- FALSE
  print_citation <- FALSE
  if(download){
    test_idx <- test_idx + 1
    return_df <- pxe_input(allowed_input = pxe_allowed_input(c("y", "n")), 
                           "Do you want to return a the data as a data.frame?\n",
                           test_input = test_input[test_idx]) == "y"
  
    test_idx <- test_idx + 1
    print_citation <- pxe_input(allowed_input = pxe_allowed_input(c("y", "n")), 
                                "Do you want to print citation for the data?\n",
                                test_input = test_input[test_idx]) == "y"
  
  }
  
  if(download){
    dat <- pxweb_get(url = pxe_data_url(pxe), query = pxweb_query(pxe))
  } else {
    dat <- NULL
  }
  
  if(print_code){
    if(print_json) {
      pxe_print_download_code(pxe, "json")
    } else {
      pxe_print_download_code(pxe, "r")
    }
  }
  if(print_citation){
    cat("############# CITATION #############")
    pxweb_cite(dat)
    cat("############# CITATION #############\n")
  }
  if(return_df){
    dat <- as.data.frame(dat)
  }
  dat
}

#' Print code to download query
#' @param pxe a \code{pxweb_query} object.
#' @param as \code{json} or \code{r}.
#' @keywords internal
pxe_print_download_code <- function(pxe, as){
  checkmate::assert_class(pxe, "pxweb_explorer")
  checkmate::assert_choice(as, choices = c("json", "r"))
  q <- pxweb_query(pxe)
  if(as == "json"){
    q_path <- "\"[path to jsonfile]\""
    cat("######## STORE AS JSON FILE ########\n")
    print(pxweb_query_as_json(q, pretty = TRUE))
    cat("######## STORE AS JSON FILE ########\n\n")
  }
  if(as == "r"){
    cat("# PXWEB query \n")
    q_path <- "pxweb_query_list"
    pxweb_query_as_rcode(q)
    cat("\n")
  }
  cat("# Download data \n",
      "px_data <- \n",
      "  pxweb_get(url = \"", pxe_data_url(pxe), "\",\n",
      "            query = ",q_path,")\n\n", sep ="")
  cat("# Convert to data.frame \n",
      "px_data_frame <- as.data.frame(px_data, column.name.type = \"text\", variable.value.type = \"text\")\n\n", sep ="")
  
  cat("# Get pxweb data comments \n",
      "px_data_comments <- pxweb_data_comments(px_data)\n",
      "px_data_comments_df <- as.data.frame(px_data_comments)\n\n", sep ="")
  
  cat("# Cite the data as \n",
      "pxweb_cite(px_data)\n\n", sep ="")
  
  return(invisible(NULL))
}