R/ApiData.R

In PxWebApiData: PX-Web Data by API

#' PX-Web Data by API
#' 
#' A function to read PX-Web data into R via API. The example code reads data from the three national statistical institutes, Statistics Norway, Statistics Sweden and Statistics Finland.
#' 
#' @encoding UTF8
#'
#' @param urlToData url to data or id of SSB data
#' @param ... specification of JSON query for each variable
#' @param getDataByGET When TRUE, readymade dataset by GET
#' @param returnMetaData When TRUE, metadata returned  
#' @param returnMetaValues When TRUE, values from metadata returned 
#' @param returnMetaFrames When TRUE, values and valueTexts from metadata returned as data frames 
#' @param returnApiQuery When TRUE, JSON query returned 
#' @param defaultJSONquery specification for variables not included in ...
#' @param verbosePrint When TRUE, printing to console
#' @param use_factors Parameter to \code{\link{fromJSONstat}} defining whether dimension categories should be factors or character objects.
#' @param urlType  Parameter defining how url is constructed from id number. Currently two Statistics Norway possibilities: "SSB" (Norwegian) or "SSBen" (English)
#' @param apiPackage Package used to capture json(-stat) data from API: \code{"httr"} (default) or \code{"pxweb"}
#' @param dataPackage Package used to transform json(-stat) data to data frame: \code{"rjstat"} (default) or \code{"pxweb"}
#' @param returnDataSet Possible non-NULL values are `1`, `2` and `12`. Then a single data set is returned as a data frame.
#' * **`1`:** The first data set
#' * **`2`:** The second data set 
#' * **`12`:** Both data sets combined
#' 
#'   
#' @param makeNAstatus When TRUE and when dataPackage is \code{"rjstat"} and when missing entries in `value`, 
#'                     the function tries to add an additional variable, named `NAstatus`, with status codes.
#' @param responseFormat  Response format to be used when `apiPackage` and `dataPackage` are defaults  (`"json-stat"` or `"json-stat2"`).
#' 
#' @details Each variable is specified by using the variable name as input parameter. The value can be specified as:  
#' TRUE (all), FALSE (eliminated), imaginary value (top), variable indices, 
#' original variable id's (values) or variable labels (valueTexts). 
#' Reversed indices can be specified as negative values. 
#' Indices outside the range are removed. Variables not specified is set to the value of defaultJSONquery 
#' whose default means the first and the two last elements. 
#' 
#' The value can also be specified as a (unnamed) two-element list corresponding to the two 
#' query elements, filter and values. In addition it possible with a single-element list.
#' Then filter is set to 'all'. See examples. 
#'
#' A comment attribute with elements `label`, `source` and `updated` is added to output as a named three-element character vector. 
#' Run \code{\link{comment}} to obtain this information. 
#'  
#' Functionality in the package \code{pxweb} can be utilized by making use of the parameters 
#' \code{apiPackage} and \code{dataPackage} 
#' as implemented as the wrappers \code{PxData} and \code{pxwebData}.
#' With data sets too large for ordinary downloads, \code{PxData} can solve the problem (multiple downloads).
#' When using \code{pxwebData}, data will be downloaded in px-json format instead of json-stat and the output data frame 
#' will be organized differently (ContentsCode categories as separate variables).
#' 
#'
#' @return list of two data sets (label and id)
#' @note See the package vignette for aggregations using filter \code{agg}.
#' @export
#' 
#' @importFrom jsonlite unbox read_json toJSON fromJSON
#' @importFrom rjstat fromJSONstat 
#' @importFrom httr GET POST verbose content
#' @importFrom utils head tail
#' @importFrom pxweb pxweb_get
#'
#' @examples
#' \donttest{
#' ##### Readymade dataset by GET.  Works for readymade datasets and "saved-JSON-stat-query-links".
#' x <- ApiData("https://data.ssb.no/api/v0/dataset/1066.json?lang=en", getDataByGET = TRUE)
#' x[[1]]  # The label version of the data set
#' x[[2]]  # The id version of the data set
#' names(x)
#' comment(x)
#' 
#' ##### As above with single data set output
#' url <- "https://data.ssb.no/api/v0/dataset/1066.json?lang=en"
#' x1 <- ApiData1(url, getDataByGET = TRUE) # as x[[1]]
#' x2 <- ApiData2(url, getDataByGET = TRUE) # as x[[2]]
#' ApiData12(url, getDataByGET = TRUE) # Combined
#' 
#' ##### Special output
#' ApiData("https://data.ssb.no/api/v0/en/table/11419", returnMetaData = TRUE)   # meta data
#' ApiData("https://data.ssb.no/api/v0/en/table/11419", returnMetaValues = TRUE) # meta data values
#' ApiData("https://data.ssb.no/api/v0/en/table/11419", returnMetaFrames = TRUE) # list of data frames
#' ApiData("https://data.ssb.no/api/v0/en/table/11419", returnApiQuery = TRUE)   # query using defaults
#' 
#' 
#' ##### Ordinary use     (makeNAstatus is in use in first two examples)
#' 
#' # NACE2007 as imaginary value (top 10), ContentsCode as TRUE (all), Tid is default
#' x <- ApiData("https://data.ssb.no/api/v0/en/table/11419", NACE2007 = 10i, ContentsCode = TRUE)
#' 
#' # Two specified and the last is default (as above) - in Norwegian change en to no in url
#' x <- ApiData("https://data.ssb.no/api/v0/no/table/11419", NACE2007 = 10i, ContentsCode = TRUE)
#' 
#' # Number of residents (bosatte) last year, each region
#' x <- ApiData("https://data.ssb.no/api/v0/en/table/04861", Region = TRUE, 
#'         ContentsCode = "Bosatte", Tid = 1i)
#' 
#' # Number of residents (bosatte) each year, total
#' ApiData("https://data.ssb.no/api/v0/en/table/04861", Region = FALSE, 
#'         ContentsCode = "Bosatte", Tid = TRUE)
#' 
#' # Some years
#' ApiData("https://data.ssb.no/api/v0/en/table/04861", Region = FALSE, 
#'         ContentsCode = "Bosatte", Tid = c(1, 5, -1))
#' 
#' # Two selected regions
#' ApiData("https://data.ssb.no/api/v0/en/table/04861", Region = c("1103", "0301"), 
#'         ContentsCode = 2, Tid = c(1, -1))
#' 
#' 
#' ##### Using id instead of url, unnamed input and verbosePrint
#' ApiData(4861, c("1103", "0301"), 1, c(1, -1)) # same as below 
#' ApiData(4861, Region = c("1103", "0301"), ContentsCode=2, Tid=c(1, -1)) 
#' names(ApiData(4861,returnMetaFrames = TRUE))  # these names from metadata assumed two lines above
#' ApiData("4861", c("1103", "0301"), 1, c(1, -1),  urlType="SSBen")
#' ApiData("01222", c("1103", "0301"), c(4, 9:11), 2i, verbosePrint = TRUE)
#' ApiData(1066, getDataByGET = TRUE,  urlType="SSB")
#' ApiData(1066, getDataByGET = TRUE,  urlType="SSBen")
#' 
#' }
#' ##### Advanced use using list. See details above. Try returnApiQuery=TRUE on the same examples. 
#' ApiData(4861, Region = list("03*"), ContentsCode = 1, Tid = 5i) # "all" can be dropped from the list
#' \donttest{ApiData(4861, Region = list("all", "03*"), ContentsCode = 1, Tid = 5i)  # same as above
#' ApiData(04861, Region = list("item", c("1103", "0301")), ContentsCode = 1, Tid = 5i)
#' 
#' 
#' ##### Using data from SCB to illustrate returnMetaFrames
#' urlSCB <- "https://api.scb.se/OV0104/v1/doris/sv/ssd/BE/BE0101/BE0101A/BefolkningNy"
#' mf <- ApiData(urlSCB, returnMetaFrames = TRUE)
#' names(mf)              # All the variable names
#' attr(mf, "text")       # Corresponding text information as attribute
#' mf$ContentsCode        # Data frame for the fifth variable (alternatively  mf[[5]])
#' attr(mf,"elimination") # Finding variables that can be eliminated
#' ApiData(urlSCB,        # Eliminating all variables that can be eliminated (line below)
#'         Region = FALSE, Civilstand = FALSE, Alder = FALSE,  Kon = FALSE,
#'         ContentsCode  = "BE0101N1", # Selecting a single ContentsCode by text input
#'         Tid = TRUE)                 # Choosing all possible values of Tid.
#'  
#'                
#' ##### Using data from Statfi to illustrate use of input by variable labels (valueTexts)
#' urlStatfi <- "https://pxdata.stat.fi/PXWeb/api/v1/en/StatFin/kuol/statfin_kuol_pxt_12au.px"
#' ApiData(urlStatfi, returnMetaFrames = TRUE)$Tiedot
#' ApiData(urlStatfi, Alue = FALSE, Vuosi = TRUE, Tiedot = "Population")  # same as Tiedot = 21
#' 
#' 
#' ##### Wrappers PxData and pxwebData
#' 
#' # Exact same output as ApiData
#' PxData(4861, Region = "0301", ContentsCode = TRUE, Tid = c(1, -1))
#' 
#' # Data organized differently
#' pxwebData(4861, Region = "0301", ContentsCode = TRUE, Tid = c(1, -1))
#' 
#' 
#' # Large query. ApiData will not work.
#' if(FALSE){ # This query is "commented out" 
#'   z <- PxData("https://api.scb.se/OV0104/v1/doris/sv/ssd/BE/BE0101/BE0101A/BefolkningNy", 
#'               Region = TRUE, Civilstand = TRUE, Alder = 1:10, Kon = FALSE, 
#'               ContentsCode = "BE0101N1", Tid = 1:10, verbosePrint = TRUE)
#' }
#' 
#' 
#' ##### Small example where makeNAstatus is in use
#' ApiData("04469", Tid = "2020", ContentsCode = 1, Alder = TRUE, Region = "3011")
#' 
#' }
#'
ApiData <- function(urlToData, ..., getDataByGET = FALSE, returnMetaData = FALSE, returnMetaValues = FALSE, 
                    returnMetaFrames = FALSE, returnApiQuery = FALSE, 
                    defaultJSONquery = c(1,-2, -1), verbosePrint = FALSE,
                    use_factors=FALSE, urlType="SSB", 
                    apiPackage = "httr",
                    dataPackage = "rjstat",
                    returnDataSet = NULL,
                    makeNAstatus = TRUE,  responseFormat = "json-stat2") {
  
  # if(!getDataByGET)     ## With this test_that("ApiData - SSB-data advanced use", fail
  #   apiPackage = "pxweb"
  
  if(apiPackage ==  "pxweb"){
    responseFormat = "json-stat"
  }
  
  #if (makeNAstatus) {
    fromJSONstat <- fromJSONstatExtra
  #}
  
  if(!is.null(returnDataSet)){
    if(!(returnDataSet %in% c(1, 2, 12)))
      stop("non-NULL returnDataSet must be in 1, 2, or 12.")
    
  } else {
    returnDataSet <- 0
  }
    
  
  integerUrl <- suppressWarnings(as.integer(urlToData))
  if (!is.na(integerUrl)) 
    urlToData <- MakeUrl(integerUrl, urlType = urlType, getDataByGET = getDataByGET) # SSBurl(integerUrl, getDataByGET)
  

  if(!(dataPackage %in% c("rjstat", "pxweb", "none"))){
    stop('dataPackage must be "rjstat" or "pxweb"')
  }
  
  if(apiPackage != "httr"){
    if(apiPackage != "pxweb"){
      stop('apiPackage must be "httr" or "pxweb"')
    }
  } else {
    if(dataPackage == "pxweb")
      stop('apiPackage  must be "pxweb" when dataPackage is pxweb')
  }
  
  if (getDataByGET){ 
    if((apiPackage != "httr" | dataPackage != "rjstat") & dataPackage != "none"){
      apiPackage = "httr"
      dataPackage = "rjstat"
      warning('Parameters "apiPackage" and "dataPackage" ignored when getDataByGET')
    }
      post <- Graceful(content, GET(urlToData), "text")
      if(is.null(post))
        return(NULL)
    } else {
      metaData <- Graceful(MetaData, urlToData)
      if(is.null(metaData))
        return(NULL)
      if (returnMetaData) 
        return(metaData)
      if (returnMetaValues) 
        return(VarMetaData(metaData))
      metaFrames <- MetaFrames(metaData)   
      if (returnMetaFrames) 
        return(metaFrames)
      if (verbosePrint){ 
        print(VarMetaData(metaData))
        cat("\n\n")
      }
 
      # responseFormat = "json-stat" 
      
      if(dataPackage == "pxweb")
        responseFormat = "json"
      sporr <- MakeApiQuery(metaFrames, ..., defaultJSONquery = defaultJSONquery, responseFormat = responseFormat)
      if (returnApiQuery) 
        return(sporr)
      if(apiPackage == "pxweb" ){
        post <-  Graceful(pxweb_get, url = urlToData, query = sporr, verbose = verbosePrint)
      } else {
        if (verbosePrint) 
          post <-  Graceful(content, POST(urlToData, body = sporr, encode = "json", verbose()), "text") 
        else 
          post <-  Graceful(content, POST(urlToData, body = sporr, encode = "json"), "text")
      }
      if(is.null(post))
        return(NULL)
    }

  if(dataPackage == "none" )
    return("post")
    
  if(dataPackage == "pxweb" ){
    if(returnDataSet %in% c(1,2)){
      if(returnDataSet == 1){
        z <- list(as.data.frame(post, column.name.type = "text", variable.value.type = "text"))
      } else {
        z <- list(as.data.frame(post, column.name.type = "code", variable.value.type = "code"))
      }
    } else {
      z <- list(as.data.frame(post, column.name.type = "text", variable.value.type = "text"),
                as.data.frame(post, column.name.type = "code", variable.value.type = "code"))
    }
    if(returnDataSet %in% c(1,2)){
      return(DataSet(z, 1))
    }
    if(returnDataSet %in% 12){
      return(DataSet12(z))
    }
    return(DataSetS(z))
  }

  if (length(post) > 1) {
    n <- length(post)
    for (i in seq_len(n)) {
      if(returnDataSet %in% c(1,2)){
        if(returnDataSet == 1){
          post[[i]] <- fromJSONstat(post[[i]], naming = "label", use_factors = use_factors)
        } else {
          post[[i]] <- fromJSONstat(post[[i]], naming = "id", use_factors = use_factors)
        }
      } else {
        post[[i]] <- c(fromJSONstat(post[[i]], naming = "label", use_factors = use_factors), 
                       fromJSONstat(post[[i]], naming = "id", use_factors = use_factors))
      }
    }
    post[[1]][[1]] <- eval(parse(text = paste("rbind(", paste("post[[", seq_len(n), "]][[1]],", collapse = ""), "deparse.level = 0)")))
    
    if(length(post[[1]])>1)
      post[[1]][[2]] <- eval(parse(text = paste("rbind(", paste("post[[", seq_len(n), "]][[2]],", collapse = ""), "deparse.level = 0)")))
    
    if(returnDataSet %in% c(1,2)){
      return(DataSet(post[[1]], 1))
    }
    
    if(returnDataSet %in% 12){
      return(DataSet12(post[[1]]))
    }
    
    return(DataSetS(post[[1]]))
  }
  
  
  if(returnDataSet %in% c(1,2)){
    if(returnDataSet == 1){
      z <- Graceful(fromJSONstat, post, naming = "label",use_factors=use_factors)
    } else {
      z <- Graceful(fromJSONstat, post, naming = "id",use_factors=use_factors)
    }
  } else {
    z <- Graceful(fromJSONstat, post, naming = "label",use_factors=use_factors)
    if(is.null(z))
      return(NULL)
    z <-  c(z, Graceful(fromJSONstat, post, naming = "id",use_factors=use_factors))
  }
  
  if(returnDataSet %in% c(1,2)){
    return(DataSet(z, 1))
  }
  
  if(returnDataSet %in% 12){
    return(DataSet12(z))
  }
  
  DataSetS(z)
}



#' @rdname ApiData
#' @export
GetApiData = function(..., getDataByGET = TRUE){
  ApiData(..., getDataByGET = getDataByGET)
}



#' @rdname ApiData
#' @export
pxwebData = function(..., apiPackage = "pxweb", dataPackage = "pxweb"){
  ApiData(..., apiPackage = apiPackage, dataPackage = dataPackage)
}

#' @rdname ApiData
#' @export
PxData = function(..., apiPackage = "pxweb", dataPackage = "rjstat"){
  ApiData(..., apiPackage = apiPackage, dataPackage = dataPackage)
}


#' @rdname ApiData
#' @export
ApiData1  <- function(..., returnDataSet = 1) {
  ApiData(..., returnDataSet = returnDataSet)
}

#' @rdname ApiData
#' @export
ApiData2  <- function(..., returnDataSet = 2) {
  ApiData(..., returnDataSet = returnDataSet)
}


#' @rdname ApiData
#' @export
#' 
ApiData12  <- function(..., returnDataSet = 12) {
  ApiData(..., returnDataSet = returnDataSet)
}

#' @rdname ApiData
#' @export
GetApiData1  <- function(..., returnDataSet = 1) {
  GetApiData(..., returnDataSet = returnDataSet)
}

#' @rdname ApiData
#' @export
GetApiData2  <- function(..., returnDataSet = 2) {
  GetApiData(..., returnDataSet = returnDataSet)
}


#' @rdname ApiData
#' @export
#' 
GetApiData12  <- function(..., returnDataSet = 12) {
  GetApiData(..., returnDataSet = returnDataSet)
}


#' @rdname ApiData
#' @export
pxwebData1  <- function(..., returnDataSet = 1) {
  pxwebData(..., returnDataSet = returnDataSet)
}

#' @rdname ApiData
#' @export
pxwebData2  <- function(..., returnDataSet = 2) {
  pxwebData(..., returnDataSet = returnDataSet)
}

#' @rdname ApiData
#' @export
pxwebData12  <- function(..., returnDataSet = 12) {
  pxwebData(..., returnDataSet = returnDataSet)
}


#' @rdname ApiData
#' @export
PxData1  <- function(..., returnDataSet = 1) {
  PxData(..., returnDataSet = returnDataSet)
}


#' @rdname ApiData
#' @export
PxData2  <- function(..., returnDataSet = 2) {
  PxData(..., returnDataSet = returnDataSet)
}

#' @rdname ApiData
#' @export
PxData12  <- function(..., returnDataSet = 12) {
  PxData(..., returnDataSet = returnDataSet)
}




#' Adding leading zeros
#'
#' @param n  numeric vector
#' @param width width
#'
#' @return Number as string
#' @keywords internal 
#'
Number = function(n,width=3){
  s = "s=sprintf('%0d',n)"
  s = gsub("0",as.character(width),s)
  eval(parse(text=s))
  s = gsub(" ","0",s)
  s
}


MetaData <- function(url) {
  z <- read_json(url)  # Same as fromJSON(content(GET(url),'text'),simplifyVector = FALSE)
  tit <- z[[1]]
  z <- z[[2]]
  for (i in seq_len(length(z))) {
    for (j in seq_len(length(z[[i]]))) z[[i]][[j]] <- unlist(z[[i]][[j]])
  }
  z
}

VarMetaData <- function(metaData) {
  n <- length(metaData)
  nam <- rep("", n)
  elimination <- rep(FALSE, n)
  for (i in 1:length(metaData)) {
    nam[i] <- metaData[[i]]$code
    if (!is.null(metaData[[i]]$elimination)) 
      elimination[i] <- metaData[[i]]$elimination
    metaData[[i]] <- metaData[[i]]$values
  }
  names(metaData) <- nam
  attr(metaData, "elimination") <- elimination
  metaData
}


MetaFrames <- function(metaData) {
  n <- length(metaData)
  nam <- rep("", n)
  text <- rep("", n)
  elimination <- rep(FALSE, n)
  time <- rep(FALSE, n)
  for (i in 1:length(metaData)) {
    nam[i] <- metaData[[i]]$code
    if (!is.null(metaData[[i]]$text)) 
      text[i] <- metaData[[i]]$text
    if (!is.null(metaData[[i]]$elimination)) 
      elimination[i] <- metaData[[i]]$elimination
    if (!is.null(metaData[[i]]$time)) 
      time[i] <- metaData[[i]]$time
    metaData[[i]] <- as.data.frame(metaData[[i]][c("values", "valueTexts")], stringsAsFactors = FALSE)
  }
  names(metaData) <- nam
  names(text) <- nam
  names(elimination) <- nam
  names(time) <- nam
  attr(metaData, "text") <- text
  attr(metaData, "elimination") <- elimination
  attr(metaData, "time") <- time
  metaData
}


# x is one element of metaFrames
MakeApiVar <- function(x, values = c(1, -2, -1)) {
  if (is.list(values)) {
    if (length(values) == 1) {
      filt <- "all"
      valu <- values[[1]]
    } else {
      filt <- values[[1]]
      valu <- values[[2]]
    }
  } else {
    if (is.logical(values)) {
      if (!values) 
        return(NULL) else {
          filt <- "all"
          valu <- "*"
        }
      
    } else if (is.complex(values)) {
      filt <- "top"
      valu <- as.character(Im(values))
    } else if (is.numeric(values)) {
      filt <- "item"
      nx <- length(x[[1]]$values)
      values <- values[abs(values) > 0 & abs(values) <= nx]  # Fix outside range
      values[values < 0] <- rev(seq_len(nx))[-values[values < 0]]  # Fix negative
      valu <- x[[1]]$values[unique(values)]
      if (!length(valu)) 
        stop(paste(names(x), "no indices in valid range"))
    } else {
      filt <- "item"
      noMatch <- !(values %in% x[[1]]$values)
      if (any(noMatch)) values[noMatch] <- x[[1]]$values[match(values[noMatch], x[[1]]$valueTexts)]
      if (any(!(values %in% x[[1]]$values)))
        stop(paste(names(x[1]), ": Text input must be in:", 
                   paste(c(HeadEnd(x[[1]]$values, 20), HeadEnd(x[[1]]$valueTexts, 8)), collapse = ", ")))
      valu <- values
    }
  }
  list(code = unbox(names(x)), selection = list(filter = unbox(filt), values = valu))
}


# Old version where x is one element of varMetaData 
MakeApiVarOld <- function(x, values = c(1, -2, -1)) {
  if (is.list(values)) {
    if (length(values) == 1) {
      filt <- "all"
      valu <- values[[1]]
    } else {
      filt <- values[[1]]
      valu <- values[[2]]
    }
  } else {
    if (is.logical(values)) {
      if (!values) 
        return(NULL) else {
          filt <- "all"
          valu <- "*"
        }
      
    } else if (is.complex(values)) {
      filt <- "top"
      valu <- as.character(Im(values))
    } else if (is.numeric(values)) {
      filt <- "item"
      nx <- length(x[[1]])
      values <- values[abs(values) > 0 & abs(values) <= nx]  # Fix outside range
      values[values < 0] <- rev(seq_len(nx))[-values[values < 0]]  # Fix negative
      valu <- x[[1]][unique(values)]
      if (!length(valu)) 
        stop(paste(names(x), "no indices in valid range"))
    } else {
      filt <- "item"
      if (any(!(values %in% x[[1]])))
        stop(paste(names(x[1]), ": Text input must be in:", paste(x[[1]], collapse = ", ")))
      valu <- values
    }
  }
  list(code = unbox(names(x)), selection = list(filter = unbox(filt), values = valu))
}



Pmatch <- function(x, y, CheckHandling = stop) {
  # as pmatch where NA set to remaing values in y
  a <- pmatch(x, y)
  naa <- is.na(a)
  if (any(naa)) {
    nax <- naa & !is.na(x)
    if (any(nax)) {
      CheckHandling(paste("Non-matching input:", paste(x[nax], collapse = ", "),
                          ",   Valid input parameters in addition to those in the function documentation are: ",
                          paste(y, collapse = ", ")))
    }
    if (!any(!naa)) 
      return(seq_len(length(y))[seq_len(length(x))])
    nna <- sum(naa)
    a[naa] <- seq_len(length(y))[-a[!naa]][seq_len(nna)]
  }
  a
}



SSBurl <- function(id, readyMade = FALSE) {
  if (readyMade) 
    url <- paste("https://data.ssb.no/api/v0/dataset/", Number(id, 1), ".json", sep = "") 
  else url <- paste("https://data.ssb.no/api/v0/no/table/", Number(id, 5), sep = "")
  url
}

SSBurlen <- function(id, readyMade = FALSE) {
  if (readyMade) 
    url <- paste("https://data.ssb.no/api/v0/dataset/", Number(id, 1), ".json?lang=en", sep = "") 
  else 
    url <- paste("https://data.ssb.no/api/v0/en/table/", Number(id, 5), sep = "")
  url
}


#' MakeUrl from id
#' 
#' @encoding UTF8
#'
#' @param id integer
#' @param urlType  Currently two possibilities: "SSB" (Norwegian) or "SSBen" (English)
#' @param getDataByGET As input to ApiData
#'
#' @return url as string
#' @export
#' @keywords internal
#'
#' @examples
#' MakeUrl(4861)
#' MakeUrl(4861, "SSBen")
#' MakeUrl(1066, getDataByGET = TRUE)
#' MakeUrl(1066, "SSBen", getDataByGET = TRUE)
MakeUrl <- function(id,urlType="SSB",getDataByGET = FALSE){
  if(urlType=="SSB")
    return(SSBurl(id,getDataByGET))
  if(urlType=="SSBen")
    return(SSBurlen(id,getDataByGET))
  stop('urlType must be "SSB" or "SSBen"')
}



MakeApiQuery <- function(metaFrames, ..., defaultJSONquery = c(1, -2, -1), returnThezList = FALSE, responseFormat) {
  x <- list(...)
  namesx <- names(x)
  if (is.null(namesx)) 
    namesx <- rep(NA, length(x)) else namesx[namesx == ""] <- NA
  z <- vector("list", length(metaFrames))
  a <- z
  names(z) <- names(metaFrames)
  pm <- Pmatch(namesx, names(metaFrames))
  for (i in seq_len(length(z))) z[[i]] <- defaultJSONquery
  z[pm] <- x
  elim <- attr(metaFrames, "elimination")
  emptya <- rep(FALSE, length(a))
  if (returnThezList) 
    return(z)
  for (i in seq_len(length(a))) {
    apiVar <- MakeApiVar(metaFrames[i], z[[i]])
    if (is.null(apiVar)) {
      if (!elim[i]){ 
        if(sum(elim) == 0) 
          ptext = "(no variables can in this table)"
        else
          ptext = paste("(these variables can:",paste(names(elim)[elim], collapse = ", "),")")
        stop(paste(names(z)[i], "cannot be eliminated", ptext))
      }
      emptya[i] <- TRUE
    } else a[[i]] <- apiVar
  }
  b <- list(query = a[!emptya], response = list(format = unbox(responseFormat)))
  toJSON(b, auto_unbox = FALSE, pretty = TRUE)
}


HeadEnd <- function(x, n = 8L) {
  x <- as.character(x)
  if (length(x) > (n + 2))
    x <- c(head(x, n = n), "...", tail(x, n = 1))
  x
}


DataSet12 <- function(x){
  z <- cbind(x[[1]][, !(names(x[[1]] ) %in% names(x[[2]])), drop=FALSE], x[[2]])
  comment_z <- comment(x[[1]])
  if (is.null(comment_z)) {
    comment_z <- names(x)
  }
  comment(z) <- comment_z
  z
}

DataSet <- function(x, i){
  z <- x[[i]]
  comment_z <- comment(x[[i]])
  if (is.null(comment_z)) {
    comment_z <- names(x)[i]
  }
  comment(z) <- comment_z
  z
}


DataSetS <- function(x){
  comment(x) <- comment(x[[1]])
  x
}








Graceful <- function(fun, ..., txt = "No internet connection or resource not available: ") {
  a <- suppressWarnings(try(fun(...), silent = TRUE))
  if (inherits(a, c("NULL", "try-error"))) {   # if (class(a)[1] %in% c("NULL", "try-error")) {
    message(paste0(txt, as.character(a)))
    return(NULL)
  }
  a
}