Fixed a bug in function nhanesSearch. Simplified a section of the vig…

…nette.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: nhanesA
-Version: 0.6.5.2
-Date: 2021-01-24
+Version: 0.6.5.3
+Date: 2021-01-30
 Title: NHANES Data Retrieval
 Author: Christopher J. Endres
 Maintainer: Christopher J. Endres <cjendres1@gmail.com>

R/nhanes.R

@@ -56,6 +56,8 @@ nh_years['2017'] <- "2017-2018"
 nh_years['2018'] <- "2017-2018"
 nh_years['2019'] <- "2019-2020"
 nh_years['2020'] <- "2019-2020"
+nh_years['2021'] <- "2021-2022"
+nh_years['2022'] <- "2021-2022"
 
 # Continuous NHANES table names have a letter suffix that indicates the collection interval
 data_idx <- list()
@@ -73,6 +75,7 @@ data_idx["H"] <- '2013-2014'
 data_idx["I"] <- '2015-2016'
 data_idx["J"] <- '2017-2018'
 data_idx["K"] <- '2019-2020'
+data_idx["L"] <- '2021-2022'
 
 anomalytables2005 <- c('CHLMD_DR', 'SSUECD_R', 'HSV_DR')
 
@@ -441,6 +444,10 @@ nhanesAttr <- function(nh_table) {
 nhanesSearch <- function(search_terms=NULL, exclude_terms=NULL, data_group=NULL, ignore.case=FALSE, 
                          ystart=NULL, ystop=NULL, includerdc=FALSE, nchar=100, namesonly=FALSE) {
 
+  if(is.null(search_terms)) {
+    stop("Search term is missing")
+  }
+
 # Need to loop over url's
 
   df_initialized = FALSE
@@ -457,7 +464,7 @@ nhanesSearch <- function(search_terms=NULL, exclude_terms=NULL, data_group=NULL,
     if(length(vnodes) > 0){
       if(!df_initialized) {
         df <- t(sapply(lapply(vnodes,xml_children),xml_text)) %>% as.data.frame(stringsAsFactors=FALSE)
-        df_intialized = TRUE
+        df_initialized = TRUE
       } else {
         dfadd <- t(sapply(lapply(vnodes,xml_children),xml_text)) %>% as.data.frame(stringsAsFactors=FALSE)
         df <- rbind(df, dfadd)
@@ -471,14 +478,19 @@ nhanesSearch <- function(search_terms=NULL, exclude_terms=NULL, data_group=NULL,
   }
   names(df) <- vmcols
 
-  if(!is.null(search_terms)) {
-    idx <- grep(paste(search_terms,collapse="|"), df[['Variable.Description']], ignore.case=ignore.case, value=FALSE)
-    if(length(idx) > 0) {df <- df[idx,]}
-  }
-
+  # Remove rdc tables if desired
   if(includerdc == FALSE){
     df <- df[(df$Use.Constraints != "RDC Only"),]
   }
+
+  # 
+  if(!is.null(search_terms)) {
+    idx <- grep(paste(search_terms,collapse="|"), df[['Variable.Description']], ignore.case=ignore.case, value=FALSE)
+    if(length(idx) > 0) {df <- df[idx,]} else {
+      message("No matches found")
+      return(NULL)
+    }
+  }
 
   if(!is.null(data_group)){ # Restrict search to specific data group(s) e.g. 'EXAM' or 'LAB'
     sgroups <- list()

vignettes/Introducing_nhanesA.R

@@ -1,43 +1,44 @@
-## ----nhanestables--------------------------------------------------------
+## ----nhanestables-------------------------------------------------------------
 library(nhanesA)
 nhanesTables('EXAM', 2005)
 
-## ----nhanestablevars-----------------------------------------------------
+## ----nhanestablevars----------------------------------------------------------
 nhanesTableVars('EXAM', 'BMX_D')
 
-## ----nhanes--------------------------------------------------------------
+## ----nhanes-------------------------------------------------------------------
 bmx_d  <- nhanes('BMX_D')
 demo_d <- nhanes('DEMO_D')
 
-## ----bmx1----------------------------------------------------------------
+## ----bmx1---------------------------------------------------------------------
 bmx_demo <- merge(demo_d, bmx_d)
 options(digits=4)
-aggregate(cbind(BMXHT, BMXWT, BMXLEG, BMXCALF, BMXTHICR) ~ RIAGENDR, bmx_demo,mean)
+select_cols <- c('RIAGENDR', 'BMXHT', 'BMXWT', 'BMXLEG', 'BMXCALF', 'BMXTHICR')
+print(bmx_demo[5:8,select_cols], row.names=FALSE)
 
-## ----nhanestranslate-----------------------------------------------------
+## ----nhanestranslate----------------------------------------------------------
 nhanesTranslate('DEMO_D', 'RIAGENDR')
 
-## ----bmx2----------------------------------------------------------------
-levels(as.factor(demo_d$RIAGENDR))
+## ----bmx2---------------------------------------------------------------------
 demo_d <- nhanesTranslate('DEMO_D', 'RIAGENDR', data=demo_d)
-levels(demo_d$RIAGENDR)
 bmx_demo <- merge(demo_d, bmx_d)
-aggregate(cbind(BMXHT, BMXWT, BMXLEG, BMXCALF, BMXTHICR)~RIAGENDR, bmx_demo, mean)
 
-## ----nhanestranslate2----------------------------------------------------
+## ----bmx_final_result---------------------------------------------------------
+print(bmx_demo[5:8,select_cols], row.names=FALSE)
+
+## ----nhanestranslate2---------------------------------------------------------
 bpx_d <- nhanes('BPX_D')
 head(bpx_d[,6:11])
 bpx_d_vars  <- nhanesTableVars('EXAM', 'BPX_D', namesonly=TRUE)
 #Alternatively may use bpx_d_vars = names(bpx_d)
 bpx_d <- suppressWarnings(nhanesTranslate('BPX_D', bpx_d_vars, data=bpx_d))
 head(bpx_d[,6:11])
 
-## ----nhaneslapplytables, eval=FALSE--------------------------------------
+## ----nhaneslapplytables, eval=FALSE-------------------------------------------
 #  q2007names  <- nhanesTables('Q', 2007, namesonly=TRUE)
 #  q2007tables <- lapply(q2007names, nhanes)
 #  names(q2007tables) <- q2007names
 
-## ----nhanesdxa, eval=FALSE-----------------------------------------------
+## ----nhanesdxa, eval=FALSE----------------------------------------------------
 #  #Import into R
 #  dxx_b <- nhanesDXA(2001)
 #  #Save to file
@@ -48,7 +49,7 @@ head(bpx_d[,6:11])
 #  dxalist <- c('DXAEXSTS', 'DXITOT', 'DXIHE')
 #  dxx_b <- nhanesTranslate(colnames=dxalist, data=dxx_b, dxa=TRUE)
 
-## ----nhanessearch, eval=FALSE--------------------------------------------
+## ----nhanessearch, eval=FALSE-------------------------------------------------
 #  # nhanesSearch use examples
 #  #
 #  # Search on the word bladder, restrict to the 2001-2008 surveys,
@@ -70,13 +71,13 @@ head(bpx_d[,6:11])
 #  # Search for variables where the variable description begins with "Tooth"
 #  nhanesSearch("^Tooth")
 
-## ----nhanessearchvarname-------------------------------------------------
+## ----nhanessearchvarname------------------------------------------------------
 #nhanesSearchVarName use examples
 
 nhanesSearchVarName('BPXPULS')
 nhanesSearchVarName('CSQ260i', includerdc=TRUE, nchar=38, namesonly=FALSE)
 
-## ----nhanessearchtablenames----------------------------------------------
+## ----nhanessearchtablenames---------------------------------------------------
 # nhanesSearchTableNames use examples
 nhanesSearchTableNames('BMX')
 nhanesSearchTableNames('HPVS', includerdc=TRUE, nchar=42, details=TRUE)

vignettes/Introducing_nhanesA.Rmd

@@ -59,11 +59,12 @@ bmx_d  <- nhanes('BMX_D')
 demo_d <- nhanes('DEMO_D')
 ```
 
-We then merge the tables and compute average values by gender for several variables: 
+We merge the tables and display several variables: 
 ```{r bmx1}
 bmx_demo <- merge(demo_d, bmx_d)
 options(digits=4)
-aggregate(cbind(BMXHT, BMXWT, BMXLEG, BMXCALF, BMXTHICR) ~ RIAGENDR, bmx_demo,mean)
+select_cols <- c('RIAGENDR', 'BMXHT', 'BMXWT', 'BMXLEG', 'BMXCALF', 'BMXTHICR')
+print(bmx_demo[5:8,select_cols], row.names=FALSE)
 ```
 
 ### Translation of Coded Values
@@ -73,13 +74,15 @@ NHANES uses coded values for many fields. In the preceding example, gender is co
 nhanesTranslate('DEMO_D', 'RIAGENDR')
 ```
 
-If desired, we can use nhanesTranslate to apply the code translation to demo\_d directly by assigning data=demo\_d. 
+If desired, we can use nhanesTranslate to apply the code translation to demo\_d directly by assigning data=demo\_d.
 ```{r bmx2}
-levels(as.factor(demo_d$RIAGENDR))
 demo_d <- nhanesTranslate('DEMO_D', 'RIAGENDR', data=demo_d)
-levels(demo_d$RIAGENDR)
 bmx_demo <- merge(demo_d, bmx_d)
-aggregate(cbind(BMXHT, BMXWT, BMXLEG, BMXCALF, BMXTHICR)~RIAGENDR, bmx_demo, mean)
+```
+
+The RIAGENDR field is now recoded as Male, Female instead of 1,2.
+```{r bmx_final_result}
+print(bmx_demo[5:8,select_cols], row.names=FALSE)
 ```
 
 ### Apply All Possible Code Translations to a Table