Merge pull request #232 from rOpenGov/development

Development
rOpenGov · Oct 9, 2021 · dcc058a · dcc058a
2 parents 6cfcdda + dbe7ff1
commit dcc058a
Show file tree

Hide file tree

Showing 12 changed files with 61 additions and 95 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,16 +1,14 @@
 Package: pxweb
 Type: Package
 Title: R Interface to PXWEB APIs
-Version: 0.11.0
-Date: 2021-07-07
+Version: 0.12.0
+Date: 2021-10-09
 Encoding: UTF-8
 Authors@R: c(
   person("Mans", "Magnusson", email = "[email protected]", role = c("aut", "cre")),
 	person("Markus", "Kainu", role = "aut"),
 	person("Janne", "Huovari", role = "aut"),  	
 	person("Leo", "Lahti", role = "aut", comment = c(ORCID = "0000-0001-5537-637X")),
-	person("Jan", "Bruusgaard", role = "ctb"),
-	person("Øyvind", "Langsrud", role = "ctb"),	
 	person("Love" , "Hansson", role = "ctb"),	
 	person("Eydun", "Nielsen", role = "ctb"),
 	person("Bo", "Werth", role = "ctb"),

diff --git a/NAMESPACE b/NAMESPACE
@@ -20,8 +20,6 @@ S3method(pxweb_query,json)
 S3method(pxweb_query,list)
 S3method(pxweb_query,pxweb_explorer)
 S3method(pxweb_query,pxweb_query)
-export(ApiData)
-export(MakeUrl)
 export(api_catalogue)
 export(api_parameters)
 export(base_url)

diff --git a/R/defunct_functions.R b/R/defunct_functions.R
@@ -5,18 +5,7 @@
 #' Call the functions to get information on new functions to use.
 #' 
 #' @param url Defunct argument.
-#' @param urlToData Defunct argument.
 #' @param ... Defunct argument.
-#' @param getDataByGET Defunct argument.
-#' @param returnMetaData Defunct argument.
-#' @param returnMetaValues Defunct argument.
-#' @param returnMetaFrames Defunct argument.
-#' @param returnApiQuery Defunct argument.
-#' @param defaultJSONquery Defunct argument.
-#' @param verbosePrint Defunct argument.
-#' @param use_factors Defunct argument.
-#' @param urlType Defunct argument.
-#' @param id Defunct argument.
 #' @param api Defunct argument.
 #' @param version Defunct argument.
 #' @param language Defunct argument.
@@ -48,20 +37,6 @@ api_parameters <- function(url = NULL) {
   .Defunct(new = "pxweb_api_catalogue")
 }
 
-#' @rdname api_catalogue
-#' @export
-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") {
-  .Defunct(new = "pxweb_advanced_get")
-}
-
-#' @rdname api_catalogue
-#' @export
-MakeUrl <- function(id,urlType="SSB",getDataByGET = FALSE){
-  .Defunct(new = "pxweb")
-}
 
 #' @rdname api_catalogue
 #' @export

diff --git a/R/pxweb_as_data_frame.R b/R/pxweb_as_data_frame.R
@@ -99,8 +99,8 @@ pxweb_as_data_frame.pxweb_levels <- function(x, optional = FALSE, ..., stringsAs
 
   df <- list()
   for(i in seq_along(x)){
-    df[[i]] <- as.data.frame(x[[i]], optional = optional, ..., stringsAsFactors = FALSE)
-    if(x[[i]]$type == "l") {
+    df[[i]] <- as.data.frame(x[[i]], optional = optional, stringsAsFactors = FALSE)
+    if(x[[i]]$type %in% c("l", "h")) {
       df[[i]]$updated <- NA
     }
   }

diff --git a/R/pxweb_interactive.R b/R/pxweb_interactive.R
@@ -318,44 +318,54 @@ print_bar <- function(){
 #' @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_choices <- unname(mddims[md_pos[length(md_pos)]])
+    no_rows_to_print <- unname(mddims[md_pos[length(md_pos)]])
+    choices_idx <- 1:no_rows_to_print
   } else {
-    no_choices <- length(obj)
+    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_choices <= show_no * 2){
-    print_idx <- 1:no_choices
+  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_choices - show_no + 1):no_choices)
+    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)
-  print_idx_char_nmax <- max(nchar(print_idx_char), na.rm = TRUE)
-  print_idx_char <- str_pad(print_idx_char, print_idx_char_nmax )
+  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(x$show_id){
-        cat(" [", print_idx_char[i], " ] : ", obj[[print_idx[i]]]$text, " (", obj[[print_idx[i]]]$id ,")", "\n", sep = "")    
+      if(obj[[print_idx[i]]]$type == "h") {
+        txt <- paste("\n", paste(rep(" ", nchar(print_idx_char[i]) + 2 + 6), collapse = ""), collapse = "")
       } else {
-        cat(" [", print_idx_char[i], " ] : ", obj[[print_idx[i]]]$text, " \n", sep = "")
+        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)
     }
   }
 }
@@ -416,7 +426,9 @@ pxe_handle_input.numeric <- function(user_input, pxe){
   } else if(pxe_position_is_api_catalogue(pxe)) {
     pxe <- pxweb_explorer(obj[[user_input]]$id)
   } else {
-    new_pos <- obj[[user_input]]$id
+    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)
@@ -657,7 +669,7 @@ pxe_allowed_input.pxweb_explorer <- function(x){
     }
   }
 
-  if(!x$print_all_choices & pxe_position_choice_size(x) > x$print_no_of_choices*2){
+  if(!x$print_all_choices & pxe_position_print_size(x) > x$print_no_of_choices*2){
     input_df$allowed[input_df$code == "a"] <- TRUE
   }
 
@@ -811,13 +823,26 @@ pxe_position_is_api_catalogue <- function(x) {
 #' @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 <- length(pxe_pxobj_at_position(x))
   }
   cs
 }

diff --git a/R/pxweb_levels.R b/R/pxweb_levels.R
@@ -25,7 +25,7 @@ assert_pxweb_levels <- function(x){
   for(i in seq_along(x)){
     checkmate::assert_names(names(x[[i]]), must.include = c("id", "type", "text"), .var.name = paste0("names(x[[", i, "]])"))
     checkmate::assert_string(x[[i]]$id, .var.name = paste0("x[[", i, "]]$id"))
-    checkmate::assert_choice(x[[i]]$type, choices = c("l", "t"), .var.name = paste0("x[[", i, "]]$type"))
+    checkmate::assert_choice(x[[i]]$type, choices = c("l", "t", "h"), .var.name = paste0("x[[", i, "]]$type"))
     checkmate::assert_string(x[[i]]$text, .var.name = paste0("x[[", i, "]]$id"))    
   }
 }
@@ -39,3 +39,12 @@ print.pxweb_levels <- function(x, ...){
   }
 }
 
+#' @keywords internal
+pxweb_levels_choices_df <- function(x){
+  checkmate::assert_class(x, "pxweb_levels")
+  df <- pxweb_as_data_frame.pxweb_levels(x)
+  df$is_choice <- ifelse(df$type %in% c("t", "l"), yes = TRUE, no = FALSE)
+  df$choice_idx <- cumsum(df$is_choice)
+  df$choice_idx[!df$is_choice] <- NA
+  df
+}
diff --git a/README.Rmd b/README.Rmd
@@ -85,7 +85,7 @@ See [TROUBLESHOOTING.md](https://github.com/rOpenGov/pxweb/blob/master/TROUBLESH
 You are welcome to contact us:
 
   * [Submit suggestions and bug reports](https://github.com/ropengov/pxweb/issues) (provide the output of `sessionInfo()` and `packageVersion("pxweb")`)
-  * [Send a pull request](https://github.com/ropengov/pxweb/)
+  * [Send a pull request](https://github.com/ropengov/pxweb)
   * [Star us on the Github page](https://github.com/ropengov/pxweb)
   * [Join the discussion in Gitter](https://gitter.im/rOpenGov/pxweb)  
 

diff --git a/README.md b/README.md
@@ -75,7 +75,7 @@ You are welcome to contact us:
 -   [Submit suggestions and bug
     reports](https://github.com/ropengov/pxweb/issues) (provide the
     output of `sessionInfo()` and `packageVersion("pxweb")`)
--   [Send a pull request](https://github.com/ropengov/pxweb/)
+-   [Send a pull request](https://github.com/ropengov/pxweb)
 -   [Star us on the Github page](https://github.com/ropengov/pxweb)
 -   [Join the discussion in Gitter](https://gitter.im/rOpenGov/pxweb)
 

diff --git a/inst/extdata/api.json b/inst/extdata/api.json
@@ -244,7 +244,7 @@
       "citation" : {
           "organization" : "State Statistical Office of the Republic of Macedonia",
           "address" : "Skopje, Macedonia"},
-      "url" : "http://makstat.stat.gov.mk/PXWeb/api/[version]/[lang]/MakStat/",
+      "url" : "https://makstat.stat.gov.mk/PXWeb/api/[version]/[lang]/MakStat/",
       "version": ["v1"], 
       "lang": ["en", "mk"],
       "calls_per_period": 30,
@@ -333,7 +333,7 @@
       "lang": ["en"],
       "calls_per_period": 10,
       "period_in_seconds": 10,
-      "max_values_to_download" : 1000
+      "max_values_to_download" : 100000
     },
 
     "www.grande-region.lu": {

diff --git a/man/api_catalogue.Rd b/man/api_catalogue.Rd
diff --git a/man/pxe_position_choice_size.Rd b/man/pxe_position_choice_size.Rd
diff --git a/tests/testthat/test-defunct.R b/tests/testthat/test-defunct.R
@@ -11,8 +11,6 @@ test_that(desc="Assert defunct errors",{
   expect_error(api_catalogue(), class = "defunctError")
   expect_error(update_pxweb_apis(), class = "defunctError")
   expect_error(api_parameters(), class = "defunctError")
-  expect_error(ApiData(), class = "defunctError")  
-  expect_error(MakeUrl(), class = "defunctError") 
   expect_error(base_url(), class = "defunctError") 
   expect_error(get_pxweb_data(), class = "defunctError")   
   expect_error(get_pxweb_dims(), class = "defunctError")