R/combine_make_geo.R

In sdaza/acsr: Wrapped functions to manage data from the US Census American Community Survey (ACS)

#' @title Combine geographic sets using the ACS geo.make function
#' @description Combine geographic objects created by the ACS package. Auxiliary function to combine geographic levels.
#' @param level A character or vector of characters specifying the geographic
#'   level of the data. It may be necessary to specificy values to the
#'   corresponding levels. For instance, when \code{level = "county"}, you have
#'   to specify a state (e.g., \code{state = "WI"}, the default state in this
#'   package). You can also use a wildcard method (\code{state = "*"}) to
#'   include all the states. Below, you can see the required combinations of
#'   different summary levels.
#'
#'   \cr 010 us \cr 020 region \cr 030 division \cr 040 state \cr 050 state,
#'   county \cr 060 state, county, county.subdivision \cr 140 state, county,
#'   tract \cr 150 state, county, tract, block.group \cr 160 state, place \cr
#'   250 american.indian.area \cr 320 state, msa \cr 340 state, csa \cr 350
#'   necta \cr 400 urban.area \cr 500 state, congressional.district \cr 610
#'   state, state.legislative.district.upper \cr 620 state,
#'   state.legislative.district.lower \cr 795 state, puma \cr 860 zip.code \cr
#'   950 state, school.district.elementary \cr 960 state,
#'   school.district.secondary \cr 970 state, school.district.unified \cr
#'
#' @param combine.name Label for the aggregate geography when data are combined. The default value is \code{aggregate}.
#' @param print.levels Boolean that print levels generated by the \code{geo.make} function.
#' @return Returns a combined \code{geo.make} object used to extract data.
combine.make.geo <- function(
  level,
  combine.name = "aggregate",
  print.levels = TRUE,
  region = "*",
  division = "*",
  state = "*",
  county = "*",
  county.subdivision ="*",
  place ="*",
  tract = "*",
  block.group = "*",
  msa = "*",
  csa = "*",
  necta = "*",
  urban.area = "*",
  congressional.district = "*",
  state.legislative.district.upper = "*",
  state.legislative.district.lower = "*",
  puma = "*",
  zip.code = "*",
  american.indian.area = "*",
  school.district.elementary = "*",
  school.district.secondary = "*",
  school.district.unified = "*"
) {

  # setting level variables

  if ( any(level %in% "region") ) {
  if (!is.list(region)) { stop("region has to be a list when combining data!") }
  if (length(level) == 1 &  length(region) > 1 ) {
  level <- rep(level, length(region))
  }}

  if ( any(level %in% "division")) {
  if (!is.list(division)) { stop("division has to be a list when combining data!") }
  if ( length(level) == 1 &  length(division) > 1 ) {
  level <- rep(level, length(division))
  }}


  if ( any(level %in% "necta")) {
  if (!is.list(necta)) { stop("necta has to be a list when combining data!") }
  if ( length(level) == 1 &  length(necta) > 1 ) {
  level <- rep(level, length(necta))
  }}

  if ( any(level %in% "urban.area") ) {
  if (!is.list(urban.area)) { stop("urban.area has to be a list when combining data!") }
  if ( length(level) == 1 &  length(urban.area) > 1 ) {
  level <- rep(level, length(urban.area))
  }}

  if ( any(level %in% "zip.code") ) {
  if (!is.list(zip.code)) { stop("zip.code has to be a list when combining data!") }
  if (length(level) == 1 &  length(zip.code) > 1 ) {
  level <- rep(level, length(zip.code))
  }}

  if ( any(level %in% "american.indian.area") ) {
  if (!is.list(american.indian.area)) { stop("american.indian.area has to be a list when combining data!") }
  if (length(level) == 1 &  length(american.indian.area) > 1 ) {
  level <- rep(level, length(american.indian.area))
  }}

  if ( any(level %in% "state") ) {
  if (!is.list(state)) { stop("state has to be a list when combining data!") }
  if ( length(level) == 1 &  length(state) > 1 ) {
  level <- rep(level, length(state))
  }}

  if ( any(level %in% "county") ) {
  if (!is.list(county)) { stop("county has to be a list when combining data!") }
  if (length(level) == 1 & length(state) == 1 &  length(county) > 1 ) {
  level <- rep(level, length(county))
  state <- rep(state, length(county))
  }}

  if ( any(level %in% "county.subdivision") ) {
  if (!is.list(county.subdivision)) { stop("county.subdivision has to be a list when combining data!") }

  if (length(level) == 1 &  length(county.subdivision) > 1 ) {
  level <- rep(level, length(county.subdivision))
  if ( length(state) == 1 ) { state <- rep(state, length(county.subdivision)) }
  if ( length(county) == 1 ) { county <- rep(state, length(county.subdivision)) }
  }}

  if ( any(level %in% "tract") ) {
  if (!is.list(tract)) { stop("tract has to be a list when combining data!") }

  if (length(level) == 1 &  length(tract) > 1 ) {
  level <- rep(level, length(tract))
  if ( length(state) == 1 ) { state <- rep(state, length(tract)) }
  if ( length(county) == 1 ) { county <- rep(state, length(tract)) }
  }}

  if ( any(level %in% "block.group") ) {
  if (!is.list(block.group)) { stop("block.group has to be a list when combining data!") }

  if (  length(level) == 1 & length(block.group) > 1 ) {
  level <- rep(level, length(block.group))
  if ( length(state) == 1 ) { state <- rep(state, length(county)) }
  if ( length(county) == 1 ) { county <- rep(county, length(county)) }
  if ( length(tract) == 1 ) { tract <- rep(tract, length(county)) }
  }}

  if ( any(level %in% "place") ) {
  if (!is.list(place)) { stop("place has to be a list when combining data!") }
  if (length(level) == 1 & length(state) == 1 &  length(place) > 1 ) {
  level <- rep(level, length(place))
  state <- rep(state, length(place))
  }}

  if ( any(level %in% "msa") ) {
  if (!is.list(msa)) { stop("msa has to be a list when combining data!") }
  if ( length(level) == 1 & length(state) == 1 &  length(msa) > 1 ) {
  level <- rep(level, length(msa))
  state <- rep(state, length(msa))
  }}

  if ( any(level %in% "csa") ) {
  if (!is.list(csa)) { stop("csa has to be a list when combining data!") }
  if  (length(level) == 1 & length(state) == 1 &  length(csa) > 1 ) {
  level <- rep(level, length(csa))
  state <- rep(state, length(csa))
  }}

  if ( any(level %in% "puma") ) {
  if (!is.list(puma)) { stop("puma has to be a list when combining data!") }
  if (length(level) == 1 & length(state) == 1 &  length(puma) > 1 ) {
  level <- rep(level, length(puma))
  state <- rep(state, length(puma))
  }}

  if ( any(level %in% "congressional.district") ) {
  if (!is.list(congressional.district)) { stop("congressional.district has to be a list when combining data!") }
  if ( length(level) == 1 & length(state) == 1 &  length(congressional.district) > 1 ) {
  level <- rep(level, length(congressional.district))
  state <- rep(state, length(congressional.district))
  }}

  if ( any(level %in% "state.legislative.district.lower") ) {
  if (!is.list(state.legislative.district.lower)) { stop("state.legislative.district.lower has to be a list when combining data!") }
  if ( length(level) == 1 & length(state) == 1 &  length(state.legislative.district.lower) > 1 ) {
  level <- rep(level, length(state.legislative.district.lower))
  state <- rep(state, length(state.legislative.district.lower))
  }}

  if ( any(level %in% "state.legislative.district.upper") ) {
  if (!is.list(state.legislative.district.upper)) { stop("state.legislative.district.upper has to be a list when combining data!") }
   if ( length(level) == 1 & length(state) == 1 &  length(state.legislative.district.upper) > 1 ) {
  level <- rep(level, length(state.legislative.district.upper))
  state <- rep(state, length(state.legislative.district.upper))
  }}

  if ( any(level %in% "school.district.elementary") ) {
  if (!is.list(school.district.elementary)) { stop("school.district.elementary has to be a list when combining data!") }
  if ( length(level) == 1 & length(state) == 1 &  length(school.district.elementary) > 1 ) {
  level <- rep(level, length(school.district.elementary))
  state <- rep(state, length(school.district.elementary))
  }}

  if ( any(level %in% "school.district.secondary") ) {
    if (!is.list(school.district.secondary)) { stop("school.district.secondary has to be a list when combining data!") }
  if ( length(level) == 1 & length(state) == 1 &  length(school.district.secondary) > 1 ) {
  level <- rep(level, length(school.district.secondary))
  state <- rep(state, length(school.district.secondary))
  }}

# end setting level variables

  # level output list
  geolist <- list()

  # level loop

  for ( l in seq_along(level) ) {

    # region

    if (level[l] == "region" ) {

       geolist[[l]] <- geo.make(region = region[[l]])
       }

    # division

    if (level[l] == "division" ) {

       geolist[[l]] <- geo.make(division = division[[l]])

       }


    # state

    if (level[l] == "state" ) {

       geolist[[l]] <- geo.make(state = state[[l]])

       }

    # county

    if (level[l] == "county" ) {

       geolist[[l]] <- geo.make(state = state[[l]], county = county[[l]])

       }

    # county.subdivision

    if (level[l] == "county.subdivision" ) {

       geolist[[l]] <- geo.make(state = state[[l]], county = county[[l]], county.subdivision = county.subdivision[[l]])

       }

    # tract

    if (level[l] == "tract" ) {

       geolist[[l]] <- geo.make(state = state[[l]], county = county[[l]], tract = tract[[l]])

       }

    # block.group

    if (level[l] == "block.group" ) {

       geolist[[l]] <- geo.make(state = state[[l]], county = county[[l]], tract = tract[[l]], block.group = block.group[[l]])

       }

    # place

    if (level[l] == "place" ) {

       geolist[[l]] <- geo.make(state = state[[l]], place = place[[l]])

       }

    # american.indian.area

    if (level[l] == "american.indian.area" ) {

       geolist[[l]] <- geo.make(american.indian.area = american.indian.area[[l]])

       }

    # congressional.district

    if (level[l] == "puma" ) {

       geolist[[l]] <- geo.make(state = state[[l]], puma = puma[[l]])

       }

    # csa

    if (level[l] == "csa" ) {

       geolist[[l]] <- geo.make(state = state[[l]], csa = csa[[l]])

       }

    # msa

    if (level[l] == "msa" ) {

       geolist[[l]] <- geo.make(state = state[[l]], msa = msa[[l]])

       }

    # necta

    if (level[l] == "necta" ) {

       geolist[[l]] <- geo.make(necta = necta[[l]])

       }

    # urban.area

    if (level[l] == "urban.area" ) {

       geolist[[l]] <- geo.make(urban.area = urban.area[[l]])

       }

    # zip.code

    if (level[l] == "zip.code" ) {

       geolist[[l]] <- geo.make(zip.code = zip.code[[l]])

       }

    # congressional.district

    if (level[l] == "congressional.district" ) {

       geolist[[l]] <- geo.make(state = state[[l]], congressional.district = congressional.district[[l]])

       }

    # state.legislative.district.lower

    if (level[l] == "state.legislative.district.lower" ) {

       geolist[[l]] <- geo.make(state = state[[l]], state.legislative.district.lower = state.legislative.district.lower[[l]])

       }

    # state.legislative.district.upper

    if (level[l] == "state.legislative.district.upper" ) {

       geolist[[l]] <- geo.make(state = state[[l]], state.legislative.district.upper = state.legislative.district.upper[[l]])

       }

    # school.district.elementary

    if (level[l] == "school.district.elementary" ) {

       geolist[[l]] <- geo.make(state = state[[l]], school.district.elementary = school.district.elementary[[l]])

       }

     # school.district.secondary

    if (level[l] == "school.district.secondary" ) {

       geolist[[l]] <- geo.make(state = state[[l]], school.district.secondary = school.district.secondary[[l]])

       }


     } # end level loop

 tt <- Reduce("+", geolist)
 acs::combine(tt) <- TRUE
 acs::combine.term(tt) <- combine.name

 if ( print.levels ) {
 print(". . . . . .  Printing geographic levels")
 print(tt@geo.list)
 print(". . . . . .  .  .  .  .  .  .  .  .  .  .")
}

  return(tt)

    } # end function