fixed poolEstimate and getEstimate and updated documentation (was col…

…lapsing columns incorrectly prior).
bogdanrau · Mar 10, 2016 · 68d3183 · 68d3183
1 parent 14c4283
commit 68d3183
Show file tree

Hide file tree

Showing 5 changed files with 43 additions and 36 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -12,8 +12,14 @@ Description: AskCHIS Neighborhood Edition (or AskCHIS NE) is a data discovery
 URL: https://github.com/bogdanrau/askchisne
 BugReports: https://github.com/bogdanrau/askchisne/issues
 Depends:
-    R (>= 2.10)
+    R (>= 2.10),
+    httr,
+    stringi,
+    plyr
 License: GPL (>= 2)
 LazyData: TRUE
 RoxygenNote: 5.0.1
-Imports: httr
+Imports:
+    stringi,
+    httr,
+    plyr
diff --git a/R/getEstimate.R b/R/getEstimate.R
@@ -62,57 +62,48 @@ getEstimate <- function(indicator, attributes = NULL, geoLevel = NULL, locations
                                                   geoIds = locationsList
                                                   ))),c)))
 
-  # Extract attribute types
-  # data.attributes <- data.frame(list(sapply(data$attributeTypes,c)))
-
   # Extract data from geographies
   data.geographies <- data.frame(t(sapply(data$geographies[[1]],c)))
   data.geographies$isSuppressed <- as.logical(data.geographies$isSuppressed)
+  data.geographies$geoId <- as.factor(unlist(data.geographies$geoId))
 
-  # Extract non-suppressed
-  data.geographies.nonsuppressed <- dplyr::filter(data.geographies, isSuppressed == FALSE)
-
-  # Extract suppressed
-  data.geographies.suppressed <- dplyr::filter(data.geographies, isSuppressed == TRUE)
-
-  # Extract attribute values
-  # For non-suppressed
-  if (length(attributes) > 1 | is.null(attributes)) {
-    data.values <- data.frame(t(sapply(data.geographies.nonsuppressed$attributes, c)))
-  } else {
-    data.values <- data.frame(unlist(data.geographies.nonsuppressed$attributes))
-  }
-
-  # For suppressed
-  if (length(attributes) > 1 | is.null(attributes)) {
-    data.values2 <- data.frame(t(sapply(data.geographies.suppressed$attributes, c)))
+  if (is.null(attributes)) {
+    suppressWarnings(
+      data.values <- data.frame(cbind(
+        unlist(data.geographies$geoId),
+        as.data.frame(matrix(as.numeric(t(sapply(data.geographies$attributes, stringi::stri_list2matrix))), ncol = 7))
+      ))
+    )
   } else {
-    data.values2 <- data.frame(unlist(data.geographies.suppressed$attributes))
-  }
-
+    suppressWarnings(
+      data.values <- data.frame(cbind(
+        unlist(data.geographies$geoId),
+        as.data.frame(matrix(as.numeric(t(sapply(data.geographies$attributes, stringi::stri_list2matrix))), ncol = length(attributes)))
+      ))
+    )
+  }
+
   # Extract data from nested lists
   # For non-suppressed
   for (i in 1:length(data.values)) {
     data.values[[i]] <- unlist(data.values[[i]])
   }
 
-  data.values <- rbind(data.values, data.values2)
-
-
   # Set column names to attributes
   characters <- list("geoName", "suppressionReason")
   factors <- list("geoId", "geoTypeId")
   booleans <- list("isSuppressed")
   numerics <- list("population", "estimate", "SE", "CI_LB95", "CI_UB95", "CV", "MSE")
 
   if (!is.null(attributes)) {
-  colnames(data.values) <- unlist(attributes)
+  colnames(data.values) <- c("geoId", unlist(attributes))
   } else {
-    colnames(data.values) <- unlist(numerics)
+    colnames(data.values) <- c("geoId", unlist(numerics))
   }
 
   # Create final dataset
-  finalData <- cbind(data.geographies, data.values)
+  finalData <- plyr::join(data.geographies, data.values, by = "geoId")
+
   finalData$attributes <- NULL
 
   # Convert columns to appropriate types

diff --git a/R/poolEstimate.R b/R/poolEstimate.R
@@ -60,7 +60,6 @@ poolEstimate <- function(indicator, attributes = NULL, locations, apiKey) {
                                                   attributes = attributeList,
                                                   geoIds = locationsList
                                                   ))),c)))
-
   # Extract attribute types
   data.attributes <- data.frame(t(sapply(data$attributeTypes,c)))
 
@@ -70,6 +69,17 @@ poolEstimate <- function(indicator, attributes = NULL, locations, apiKey) {
   # Extract attribute values
   data.values <- data.frame(t(sapply(data.geographies$attributes, c)))
 
+  # Convert to numeric
+  if (is.null(attributes)) {
+    for (i in 1:7) {
+      data.values[,i] <- as.numeric(data.values[,i])
+    }
+  } else {
+    for (i in 1:length(attributes)) {
+      data.values[,i] <- as.numeric(data.values[,i])
+    }
+  }
+
   # Set column names to attributes
   colnames(data.values) <- unlist(data.attributes)
 
@@ -96,8 +106,8 @@ poolEstimate <- function(indicator, attributes = NULL, locations, apiKey) {
   }
 
   suppressWarnings(
-    for (l in numerics) {
-      finalData[[l]] <- as.numeric(as.character(finalData[[l]]))
+    for (l in attributes) {
+      finalData[[l]]<- as.numeric(as.character(finalData[[l]]))
     }
   )
 

diff --git a/README.Rmd b/README.Rmd
@@ -80,7 +80,7 @@ a legislative district (ASSEMBLY, CONGRESS, SENATE), or the state (STATE).
 > `getEstimate()` function retrieves estimates as well as additional statistical attributes for one or more
 requested locations:
 ```R
-geoSearch(indicator = 'INDICATOR NAME', attributes = NULL, geoLevel = NULL, locations = NULL, apiKey = '<YOUR API KEY>')
+getEstimate(indicator = 'INDICATOR NAME', attributes = NULL, geoLevel = NULL, locations = NULL, apiKey = '<YOUR API KEY>')
 ```
 
 Parameter         | Description

diff --git a/README.md b/README.md
@@ -100,7 +100,7 @@ The resulting data frame will contain:
 > `getEstimate()` function retrieves estimates as well as additional statistical attributes for one or more requested locations:
 
 ``` r
-geoSearch(indicator = 'INDICATOR NAME', attributes = NULL, geoLevel = NULL, locations = NULL, apiKey = '<YOUR API KEY>')
+getEstimate(indicator = 'INDICATOR NAME', attributes = NULL, geoLevel = NULL, locations = NULL, apiKey = '<YOUR API KEY>')
 ```
 
 <table style="width:56%;">