🎨 fix #65

ropensci · Nov 1, 2021 · 8ea4fd0 · 8ea4fd0
1 parent 9974af0
commit 8ea4fd0
Show file tree

Hide file tree

Showing 4 changed files with 50 additions and 33 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,9 +1,11 @@
 # rcites (devel) 
 
-* encode parts of URLs using `utils::URLencode(x, reserved = TRUE)` (see #63)
+* review porcessing 
+* test print methods (see #57).
+* encode parts of URLs using `utils::URLencode(x, reserved = TRUE)` (see #63).
 * consistently use `message()` for console (see #60).
 * vignettes are precomputed (see #58).
-* tests now uses vcr (now listed in Suggests) (see #56).
+* tests now uses vcr (now listed in Suggests, see #56).
 * classes are now tested properly (see #54).
 * internal `rcites_res()` gains arguments `verbose` and `raw` (see #43 and #62).
 * request status now are reported by `warn_for_status()` rather than by `stop_for_status()`, this prevents fast-failing in batch mode (see #62).

diff --git a/R/zzz.R b/R/zzz.R
@@ -239,6 +239,21 @@ rcites_to_logical <- function(x) {
     x
 }
 
+# convert list element to data frame 
+rcites_list_to_df <- function(x, name) {
+  # data.frame(
+    do.call(
+      rbind, 
+      lapply(
+        x, 
+        function(y) do.call(
+          rbind, 
+          lapply(y[[name]], as.data.frame)
+        )
+      )
+    )
+}
+
 # assign class and reset rownames
 rcites_assign_class <- function(x) {
     row.names(x) <- NULL
@@ -392,8 +407,10 @@ rcites_taxonconcept_allentries <- function(x, sp_nm) {
 }
 
 rcites_taxonconcept_higher_taxa <- function(x, identifier) {
-    tmp <- lapply(lapply(x, rcites_null_to_na),
-      function(y) unlist(y$higher_taxa))
+    tmp <- lapply(
+      lapply(x, rcites_null_to_na),
+      function(y) unlist(y$higher_taxa)
+    )
     wch <- which(lapply(tmp, length) > 0)
     #
     out <- data.frame(id = identifier[wch], do.call(rbind, tmp[wch]),
@@ -402,17 +419,18 @@ rcites_taxonconcept_higher_taxa <- function(x, identifier) {
     out
 }
 
+
 rcites_taxonconcept_names <- function(x, name, identifier) {
-    tmp <- lapply(x, function(y) if (!is.null(y[[name]]))
-        do.call(rbind, y[[name]]))
-    wch <- which(unlist(lapply(tmp, length)) > 0)
-    #
-    if (length(wch)) {
-        out <- cbind(id = rep(identifier[wch], unlist(lapply(tmp[wch],
-            nrow))), data.frame(apply(do.call(rbind, tmp[wch]), 2, unlist),
-            stringsAsFactors = FALSE))
+    out <- rcites_list_to_df(x, name)
+    if (!is.null(out)) {
+      if (! "id" %in% names(out)) {
+          nbr <- unlist(lapply(x, function(y) length(y[[name]])))
+          ids <- unlist(lapply(x, function(y) y$id))
+          # NB sometimes several synonyms are given seprated by a virgule, 
+          # sometimes the d is repeasted
+          out <- cbind(id = rep.int(ids, nbr), out)
+      }
     } else out <- data.frame()
-    #
     out <- rcites_assign_class(out)
     out
 }

diff --git a/README.md b/README.md
@@ -1,6 +1,6 @@
 # rcites <img src="man/figures/rcites_logo.png" width="130" height="150" align="right"/>
 
-[![R-CMD-check](https://github.com/ropensci/rcites/workflows/R-CMD-check/badge.svg)](https://github.com/ropensci/rcites/actions/workflows/R-CMD-check.yaml)
+[![R CMD Check](https://github.com/ropensci/rcites/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/ropensci/rcites/actions/workflows/R-CMD-check.yaml)
 [![codecov](https://codecov.io/gh/ropensci/rcites/branch/master/graph/badge.svg)](https://app.codecov.io/gh/ropensci/rcites)
 [![status](https://tinyverse.netlify.com/badge/rcites)](https://CRAN.R-project.org/package=rcites)
 [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)

diff --git a/tests/testthat/_snaps/taxonconcept.md b/tests/testthat/_snaps/taxonconcept.md
@@ -18,28 +18,25 @@
       1 4521  Animalia Chordata Mammalia Proboscidea Elephantidae
       
       -- Synonyms ($synonyms): -------------------------------------------------------
-      # A tibble: 4 x 2
-        id    apply.do.call.rbind..tmp.wch....2..unlist.
-        <chr> <chr>                                     
-      1 4521  37069                                     
-      2 4521  Loxodonta cyclotis                        
-      3 4521  (Matschie, 1900)                          
-      4 4521  SPECIES                                   
+      # A tibble: 1 x 4
+           id full_name          author_year      rank   
+        <int> <chr>              <chr>            <chr>  
+      1 37069 Loxodonta cyclotis (Matschie, 1900) SPECIES
       
       -- Common names ($common_names): -----------------------------------------------
       # A tibble: 37 x 3
-         id    name               language
-         <chr> <chr>              <chr>   
-       1 4521  Ndovo              SW      
-       2 4521  Tembo              SW      
-       3 4521  Haathi             UR      
-       4 4521  Elefante           PT      
-       5 4521  Slon               RU      
-       6 4521  Elefant            NO      
-       7 4521  Olifant            NL      
-       8 4521  Afrikaanse olifant NL      
-       9 4521  Elefante africano  ES      
-      10 4521  afrikansk elefant  SV      
+            id name               language
+         <int> <chr>              <chr>   
+       1  4521 Ndovo              SW      
+       2  4521 Tembo              SW      
+       3  4521 Haathi             UR      
+       4  4521 Elefante           PT      
+       5  4521 Slon               RU      
+       6  4521 Elefant            NO      
+       7  4521 Olifant            NL      
+       8  4521 Afrikaanse olifant NL      
+       9  4521 Elefante africano  ES      
+      10  4521 afrikansk elefant  SV      
       # ... with 27 more rows
       
       Information available: $all_id, $general, $higher_taxa, $accepted_names, $common_names, $synonyms, $cites_listings