Initial working visualizations

.Rbuildignore

@@ -0,0 +1,5 @@
+^ext-data$
+^_ignore$
+^scripts$
+^docs$
+^LICENSE\.md$

DESCRIPTION

@@ -1,17 +1,26 @@
-Package: ipumsvis
-Title: What the Package Does (One Line, Title Case)
+Package: idhs
+Title: Tools to process and visualize IPUMS DHS data
 Version: 0.0.0.9000
 Authors@R: 
-    person("First", "Last", , "first.last@example.com", role = c("aut", "cre"),
+    person("Ryan", "Hafen", , "rhafen@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "YOUR-ORCID-ID"))
-Description: What the package does (one paragraph).
-License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
-    license
+Description: Tools to process and visualize IPUMS DHS data.
+License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.2
 Imports: 
+    DescTools,
     dplyr,
     DT,
+    forcats,
+    htmltools,
     ipumsr,
-    mapboxer
+    jsonlite,
+    mapboxer,
+    plotly,
+    rmapshaper,
+    safer,
+    sf,
+    tidyr,
+    viridisLite

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2022
+COPYRIGHT HOLDER: ipumsvis authors

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2022 ipumsvis authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -1,18 +1,52 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(print,idhs_map_vis)
 export(calc_rates)
+export(geo_scatter_vis)
 export(preprocess_geo)
 export(preprocess_ipums)
+export(scatter_vis_all)
 export(view_var_descs)
 importFrom(DT,datatable)
+importFrom(DescTools,BinomCI)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
+importFrom(dplyr,all_of)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
+importFrom(dplyr,mutate)
+importFrom(dplyr,n)
+importFrom(dplyr,recode)
 importFrom(dplyr,rename_all)
+importFrom(dplyr,select)
+importFrom(dplyr,summarise)
 importFrom(dplyr,tibble)
+importFrom(dplyr,ungroup)
+importFrom(forcats,fct_reorder)
+importFrom(htmltools,HTML)
+importFrom(htmltools,browsable)
+importFrom(htmltools,tagList)
+importFrom(htmltools,tags)
 importFrom(ipumsr,as_factor)
 importFrom(ipumsr,lbl_clean)
 importFrom(ipumsr,read_ipums_ddi)
 importFrom(ipumsr,read_ipums_micro)
+importFrom(ipumsr,read_ipums_sf)
+importFrom(ipumsr,zap_labels)
+importFrom(jsonlite,toJSON)
+importFrom(mapboxer,add_fill_layer)
+importFrom(mapboxer,add_line_layer)
+importFrom(mapboxer,add_tooltips)
+importFrom(mapboxer,as_mapbox_source)
+importFrom(mapboxer,mapboxer)
+importFrom(plotly,add_trace)
+importFrom(plotly,layout)
+importFrom(plotly,plot_ly)
+importFrom(plotly,subplot)
+importFrom(rmapshaper,ms_simplify)
+importFrom(sf,st_bbox)
+importFrom(sf,st_sfc)
+importFrom(tidyr,nest)
 importFrom(utils,download.file)
+importFrom(viridisLite,viridis)

R/calc.R

@@ -1,16 +1,33 @@
+#' Calculate rates from IPUMS DHS data
+#' @param x TODO
+#' @param geo_dir TODO
+#' @param num_var TODO
+#' @param num_cond TODO
+#' @param denom_var TODO
+#' @param denom_cond TODO
 #' Calculate rates from ipums data and associated geography
 #' @examples
 #' \dontrun{
 #' calc_rates(dd, geo_dir = "ext-data/idhs/geo")
 #' }
-#' @importFrom %>% dplyr group_by ungroup rename_all filter summarise n
+#' @importFrom dplyr %>% group_by ungroup rename_all filter summarise n
 #' select all_of mutate
 #' @importFrom ipumsr read_ipums_sf as_factor lbl_clean zap_labels
 #' @export
-calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
+calc_rates <- function(
+  x, geo_dir, num_var, num_cond, denom_var = NULL, denom_cond = NULL
+) {
   check_ipums_data(x, "x")
   x$country2 <- ipumsr::as_factor(ipumsr::lbl_clean(x$country))
 
+  if (is.null(denom_var)) {
+    x[["___denom___"]] <- 1
+    denom_var <- "___denom___"
+  }
+  if (is.null(denom_cond)) {
+    denom_cond <- unique(x[[denom_var]])
+  }
+
   if (!dir.exists(geo_dir))
     stop("directory '", geo_dir, "' doesn't exist")
 
@@ -33,8 +50,8 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
   # (could add an option later to do latest start and end date)
   ftbl <- ftbl %>%
     dplyr::group_by(.data$country) %>%
-    dplyr::filter(end_yr == max(end_yr)) %>%
-    dplyr::filter(start_yr == max(start_yr)) %>%
+    dplyr::filter(.data$end_yr == max(.data$end_yr)) %>%
+    dplyr::filter(.data$start_yr == max(.data$start_yr)) %>%
     dplyr::ungroup()
   ff <- ftbl$f
 
@@ -49,6 +66,9 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
     cur_var <- gsub(".*(geo_.*).zip", "\\1", f)
     cur_cntry <- geodf$cntry_name[1]
     message(cur_cntry, ": ", cur_var)
+    if (cur_cntry == "South Africa") {
+      geodf <- fix_south_africa_geo(geodf)
+    }
 
     if (!cur_var %in% xnms) {
       message("  not found...")
@@ -66,7 +86,7 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
         n = dplyr::n(),
         nna = length(which(is.na(.data[[num_var]])))
       ) %>%
-      dplyr::filter(.data$n == nna)
+      dplyr::filter(.data$n == .data$nna)
     tmp <- tmp %>%
       dplyr::filter(!.data$year %in% tmp2$year, ) %>%
       dplyr::select(all_of(c(cur_var, vars))) %>%
@@ -100,9 +120,9 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
       dplyr::group_by(.data$year, .data$dhscode, .data$region) %>%
       dplyr::summarise(
         n = sum(.data$perweight),
-        n2 = dplyr::n(), # length(which(.data[[num_var]] %in% num_cond)),
-        nsti = sum((.data[[num_var]] == 1) * .data$perweight),
-        nsti2 = length(which(.data[[num_var]] == 1)),
+        n2 = dplyr::n(),
+        nsti = sum((.data[[num_var]] %in% num_cond) * .data$perweight),
+        nsti2 = length(which(.data[[num_var]] %in% num_cond)),
         pct = 100 * .data$nsti / .data$n,
         .groups = "drop") %>%
       dplyr::mutate(country = cur_cntry, geo_var = cur_var)
@@ -112,9 +132,9 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
       dplyr::group_by(.data$dhscode, .data$region) %>%
       dplyr::summarise(
         n = sum(.data$perweight),
-        n2 = dplyr::n(), # length(which(.data[[num_var]] %in% num_cond)),
-        nsti = sum((.data[[num_var]] == 1) * .data$perweight),
-        nsti2 = length(which(.data[[num_var]] == 1)),
+        n2 = dplyr::n(),
+        nsti = sum((.data[[num_var]] %in% num_cond) * .data$perweight),
+        nsti2 = length(which(.data[[num_var]] %in% num_cond)),
         pct = 100 * .data$nsti / .data$n,
         .groups = "drop") %>%
       dplyr::mutate(country = cur_cntry, geo_var = cur_var)
@@ -125,8 +145,8 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
       dplyr::summarise(
         n = sum(.data$perweight),
         n2 = dplyr::n(), # length(which(.data[[num_var]] %in% num_cond)),
-        nsti = sum((.data[[num_var]] == 1) * .data$perweight),
-        nsti2 = length(which(.data[[num_var]] == 1)),
+        nsti = sum((.data[[num_var]] %in% num_cond) * .data$perweight),
+        nsti2 = length(which(.data[[num_var]] %in% num_cond)),
         pct = 100 * .data$nsti / .data$n) %>%
       dplyr::mutate(country = cur_cntry, geo_var = cur_var)
 
@@ -135,8 +155,8 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
       dplyr::summarise(
         n = sum(.data$perweight),
         n2 = length(which(.data[[num_var]] %in% num_cond)),
-        nsti = sum((.data[[num_var]] == 1) * .data$perweight),
-        nsti2 = length(which(.data[[num_var]] == 1)),
+        nsti = sum((.data[[num_var]] %in% num_cond) * .data$perweight),
+        nsti2 = length(which(.data[[num_var]] %in% num_cond)),
         pct = 100 * .data$nsti / .data$n) %>%
       dplyr::mutate(country = cur_cntry, geo_var = cur_var)
 
@@ -153,3 +173,17 @@ calc_rates <- function(x, geo_dir, num_var, denom_var, num_cond, denom_cond) {
   class(res) <- c("list", "ipums-rates")
   res
 }
+
+#' @importFrom sf st_sfc
+fix_south_africa_geo <- function(a) {
+  idx <- which(a$admin_name == "Western Cape")
+  if (length(idx) == 1) {
+    bb <- a$geometry[[idx]]
+    bb <- bb[-c(1:8)]
+    a$geometry[[idx]] <- sf::st_multipolygon(bb)
+    attr(a$geometry, "bbox") <- NULL
+    a$geometry <- sf::st_sfc(a$geometry)
+  }
+  a
+}
+# ipumsr::read_ipums_sf("ext-data/idhs/geo/geo_za1998_2016.zip")

R/misc.R

@@ -1,11 +1,13 @@
 #' View html table of IPUMS extract variable descriptions
+#' @param x TODO
+#' @param include_geo TODO
 #' @importFrom DT datatable
 #' @importFrom dplyr filter tibble .data
 #' @export
-view_var_descs <- function(dd, include_geo = FALSE) {
+view_var_descs <- function(x, include_geo = FALSE) {
   check_ipums_data(x, "x")
 
-  descs <- sapply(dd, function(x) attr(x, "var_desc"))
+  descs <- sapply(x, function(x) attr(x, "var_desc"))
   descs <- dplyr::tibble(
     name = names(descs),
     desc = unname(descs)
@@ -16,3 +18,23 @@ view_var_descs <- function(dd, include_geo = FALSE) {
 
   DT::datatable(descs, options = list(paging = FALSE))
 }
+
+get_tkn <- function() {
+  if (Sys.getenv("IDHS_DEV_MODE") == "true") {
+    Sys.getenv("MAPBOX_API_KEY")
+  } else {
+    safer::decrypt_string("XLNDMUY6HdUjQ34+47BLmKf42KyqrWRmvL0QwGolHdOUAXEQqtp+SGd3/z1/4GweGP5vk0P7TLkJdI/e3iqekM5cgDq2riRySW1Vo1Tca3AtngJ0rVildwtkjwi9GMl75iOmrLDkGSI=", "idhs")
+  }
+}
+
+dev_mode <- function(bool = FALSE) {
+  if (bool) {
+    Sys.setenv(IDHS_DEV_MODE = "true")
+  } else {
+    Sys.setenv(IDHS_DEV_MODE = "")
+  }
+}
+
+
+# ‘DescTools’ ‘forcats’ ‘htmltools’ ‘jsonlite’ ‘plotly’ ‘rmapshaper’
+#     ‘sf’ ‘tidyr’ ‘viridisLite’

R/preprocess.R

@@ -1,4 +1,6 @@
 #' Preprocess IPUMS extract
+#' @param input_xml TODO
+#' @param output_file TODO
 #' @importFrom ipumsr read_ipums_ddi read_ipums_micro as_factor lbl_clean
 #' @importFrom dplyr rename_all
 #' @examples
@@ -26,6 +28,8 @@ preprocess_ipums <- function(input_xml, output_file) {
 # https://www.idhsdata.org/idhs/gis.shtml
 
 #' Preprocess (download) shapfiles associated with an IPUMS extract
+#' @param x TODO
+#' @param output_dir TODO
 #' @examples
 #' \dontrun{
 #' dd <- preprocess_ipums(