export makePopulationArray, add population arg to .poststratify

gelman · May 1, 2014 · 25d0b71 · 25d0b71
1 parent 3d6b32f
commit 25d0b71
Show file tree

Hide file tree

Showing 5 changed files with 62 additions and 10 deletions.
diff --git a/mrp/NAMESPACE b/mrp/NAMESPACE
@@ -1,4 +1,5 @@
 export(is.NWayData)
+export(makePopulationArray)
 export(mrp)
 export(mrp.theme)
 exportMethods(getData)

diff --git a/mrp/R/mrp.R b/mrp/R/mrp.R
@@ -215,7 +215,7 @@ mrp <- function(formula.cell,
     if(is.data.frame(pop)) {
         cat("\nMatching poll data to population cells.\n")
         checkPopulationData(pop, population.varnames)
-        pop.array <- makePopulationArray(pop, pop.weights, population.varnames,
+        pop.array <- .makePopulationArray(pop, pop.weights, population.varnames,
                                          pop.margin=pop.margin)
 
 
@@ -315,7 +315,7 @@ checkResponse <- function(response, varname) {
 checkPoll <- function(poll){
     return(poll)
 }
-makePopulationArray <- function(pop, pop.weights, population.varnames,
+.makePopulationArray <- function(pop, pop.weights, population.varnames,
                                 pop.margin=pop.margin) {
 
     if (is.null(pop.weights)) {
@@ -329,7 +329,24 @@ makePopulationArray <- function(pop, pop.weights, population.varnames,
                             margin=pop.margin)
     pop.array
 }
-
+##' Make an array suitable for poststratification
+##'
+##'
+##' @param population A \code{data.frame} containing population (e.g. census)
+##' containing numeric weight and some factor variables for cross-classification
+##' @param pop.weights character. The column of the \code{population} data that
+##' contains frequencies or proportions (of the entire population) for the
+##' cells defined by population.varnames
+##' @param population.varnames character vector of names of columns describing
+##' the cells wanted in the array
+##' @return NWayData (array with some extra stuff)
+##' @export
+makePopulationArray <- function(population, pop.weights, population.varnames){
+    pop.array <- .makePopulationArray(population, pop.weights, list(inpop=population.varnames), pop.margin=NULL)
+    pop.array <- new("NWayData", pop.array, type="population",
+                     levels=dimnames(pop.array))
+    pop.array
+}
   ## For population array, if there are "ways" present in poll but constant
 ## in population, move those terms to the end. Will become constant (1s).
 reorder.popterms <- function(poll, pop){

diff --git a/mrp/R/poststratify.R b/mrp/R/poststratify.R
@@ -1,5 +1,5 @@
 
-.poststratify <- function (object, formula=NULL) {
+.poststratify <- function (object, formula=NULL, population=NULL) {
     spec <- formula
     if(is.null(object@population)) {
         warning("Object does not contain population data;\nestimates returned instead.")
@@ -11,9 +11,12 @@
     if(is.formula(spec)){
         spec <- attr(terms(spec),"term.labels")
     }
-    stopifnot (object@population != numeric(0))
+    if (is.null(population)) {
+      population <- object@population
+    }
+    stopifnot (population != numeric(0))
 
-    poststratified <- getThetaHat(object) * object@population
+    poststratified <- getThetaHat(object) * population
 
     if(!is.logical(spec)){
         groups <- match(spec,
@@ -22,10 +25,10 @@
         groups <- which (spec == TRUE)
     }
     if (length(groups) == 0) {
-        return (sum (poststratified, na.rm=TRUE) / sum (object@population))
+        return (sum (poststratified, na.rm=TRUE) / sum (population))
     } else {
         ans <- (apply (poststratified, groups, sum, na.rm=TRUE) /
-                apply(object@population, groups, sum))
+                apply(population, groups, sum))
         ans[is.nan(ans)] <- NA
         return(ans)
     }
@@ -49,6 +52,7 @@
 ##' variable names corresponding to the \dQuote{ways} in the population data by
 ##' which to poststratify.  The right-hand side can also be a character vector
 ##' of such names or a logical vector of length \dQuote{ways}.
+##' @param population An optional replacement population array
 ##'
 ##' See example in \code{\link{mrp}}.
 ##' @param fun The function (default=\emph{mean}) to summarize the collapsed
@@ -60,7 +64,7 @@
 ##' for other methods on the objects produced by \code{mrp()};
 ##' \code{\link{plotmrp}} for how to plot poststratified results onto maps.
 ##' @export
-setGeneric ("poststratify", function (object, formula=NULL, ...) { standardGeneric ("poststratify")})
+setGeneric ("poststratify", function (object, formula=NULL, population=NULL, ...) { standardGeneric ("poststratify")})
 setMethod (f="poststratify",
            signature=signature(object="mrp"),
            definition=.poststratify)

diff --git a/mrp/man/makePopulationArray.Rd b/mrp/man/makePopulationArray.Rd
@@ -0,0 +1,27 @@
+\name{makePopulationArray}
+\alias{makePopulationArray}
+\title{Make an array suitable for poststratification}
+\usage{
+  makePopulationArray(population, pop.weights,
+    population.varnames)
+}
+\arguments{
+  \item{population}{A \code{data.frame} containing
+  population (e.g. census) containing numeric weight and
+  some factor variables for cross-classification}
+
+  \item{pop.weights}{character. The column of the
+  \code{population} data that contains frequencies or
+  proportions (of the entire population) for the cells
+  defined by population.varnames}
+
+  \item{population.varnames}{character vector of names of
+  columns describing the cells wanted in the array}
+}
+\value{
+  NWayData (array with some extra stuff)
+}
+\description{
+  Make an array suitable for poststratification
+}
+
diff --git a/mrp/man/poststratify.Rd b/mrp/man/poststratify.Rd
@@ -16,7 +16,10 @@
   corresponding to the \dQuote{ways} in the population data
   by which to poststratify.  The right-hand side can also
   be a character vector of such names or a logical vector
-  of length \dQuote{ways}.
+  of length \dQuote{ways}.}
+
+  \item{population}{An optional replacement population
+  array
 
   See example in \code{\link{mrp}}.}