Merge pull request #74 from adibender/devel

Pooling extension +  vignette + prepare CRAN release/JOSS submission

.Rbuildignore

@@ -1,6 +1,5 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
-data/electionDE2012.RData
 ^\.dropbox\.attr$
 ^data/\.dropbox\.attr$
 ^tests/\.dropbox\.attr$
@@ -14,6 +13,7 @@ data/electionDE2012.RData
 ^docs$
 ^CODE_OF_CONDUCT\.md$
 ^README\.Rmd$
-^vignettes/KOALA\.Rmd$
 ^_pkgdown\.yml$
-^vignettes/austria\.Rmd$
+^vignettes/$
+^LICENSE\.md$
+^paper/$

.gitignore

@@ -1,9 +1,9 @@
 #################
-## Sublime 
+## Sublime
 *.sublime-project
 *.sublime-workspace
 
-## folders 
+## folders
 sandbox/
 cache/
 figure/

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: coalitions
 Type: Package
 Title: Coalition Probabilities in Multi-party Democracies
-Version: 0.5.8
+Version: 0.6.0
 Authors@R: c(
     person("Andreas", "Bender", , "andreas.bender@stat.uni-muenchen.de", role = c("aut", "cre"), comment=c(ORCID = "0000-0001-5628-8611")),
-    person("Alexander", "Bauer", , "alexander.bauer@stat.uni-muenchen.de", role=c("ctb"), comment=c(ORCID = "0000-0003-3495-5131"))
+    person("Alexander", "Bauer", , "alexander.bauer@stat.uni-muenchen.de", role=c("aut"), comment=c(ORCID = "0000-0003-3495-5131"))
     )
 Maintainer: Andreas Bender <andreas.bender@stat.uni-muenchen.de>
 Description: An Implementation of a MCMC method to calculate

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2016-2018 Andreas Bender
+
+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.

NEWS.md

@@ -1,15 +1,20 @@
-# coalitions 0.0.1
+## coalitions 0.6.0 (2018-03)
 
-- first clean version with basic functionality
+- Added vignette on [*pooling*](../articles/pooling.html)
+
+<hr width="1" size="500" display:inline-block>
+
+## coalitions 0.5.7 (2017-12)
+
+- Added federal Bavarian election scrappers
 
-# coalitions 0.5.1
+## coalitions 0.5.1 (2017-03)
 
 - Major overhaul
 - More robust functions, more tests
-- Most functionscomply with *tidyverse*
-- Imroved documentation, added vignettes, created homepage (via `pkgdown`)
-
+- Most functions comply with *tidyverse*
+- Improved documentation, added vignettes, created homepage (via `pkgdown`)
 
-# coalitions 0.5.7
+## coalitions 0.0.1 (2013-12)
 
-- Added federal Bavarian election scrappers
+- first clean version with basic functionality

R/pooling.R

@@ -70,22 +70,35 @@ effective_samplesize <- function(
 #' \code{last_date} - period will be considered for each pollster. Defaults
 #' to current date.
 #' @param period See \code{last_date} argument.
+#' @param period_extended Optional. If specified, all surveys in the time-window
+#' from \code{last_date} - period_extended to \code{last_date} - period will
+#' also be considered for each pollster, but only after downweighting them by
+#' halving their true sample size.
 #' @import dplyr checkmate
 #' @keywords internal
 get_eligible <- function(
   surveys,
   pollsters,
-  last_date = Sys.Date(),
-  period    = 14) {
+  last_date       = Sys.Date(),
+  period          = 14,
+  period_extended = NA) {
 
   assert_data_frame(surveys, min.rows = 2, min.cols = 2)
   assert_date(last_date)
   assert_character(pollsters, null.ok = TRUE)
   assert_number(period, lower = 1, finite = TRUE)
+  assert_number(period_extended, lower = 1, finite = TRUE, na.ok = TRUE)
+  assert_true(period < period_extended, na.ok = TRUE)
+
+  first_date <- last_date - ifelse(!is.na(period_extended), period_extended, period)
 
   surveys %>% filter(.data$pollster %in% pollsters) %>%
     unnest(surveys) %>%
-    filter(date >= last_date - period & date <= last_date) %>%
+    filter(date >= first_date & date <= last_date) %>%
+    unnest() %>%
+    mutate(respondents = .data$respondents * ifelse(date >= last_date - period, 1, 0.5),
+           votes = .data$votes * ifelse(date >= last_date - period, 1, 0.5)) %>%
+    nest(-one_of("pollster", "date", "start", "end", "respondents")) %>%
     group_by(.data$pollster) %>%
     filter(date == max(date)) %>%
     filter(row_number() == 1)
@@ -105,26 +118,30 @@ get_eligible <- function(
 #' @keywords internal
 get_pooled <- function(
   surveys,
-  last_date  = Sys.Date(),
-  pollsters = c("allensbach", "emnid", "forsa", "fgw", "gms", "infratest",
-    "dimap", "infratestdimap", "insa"),
-  period     = 14,
-  corr       = 0.5,
-  weights    = NULL) {
+  last_date       = Sys.Date(),
+  pollsters       = c("allensbach", "emnid", "forsa", "fgw", "gms",
+    "infratest", "dimap", "infratestdimap", "insa"),
+  period          = 14,
+  period_extended = NA,
+  corr            = 0.5,
+  weights         = NULL) {
 
   assert_data_frame(surveys, min.rows = 2, min.cols = 2)
   assert_date(last_date)
   assert_character(pollsters, any.missing = FALSE)
   assert_number(period, lower = 1, finite = TRUE)
+  assert_number(period_extended, lower = 1, finite = TRUE, na.ok = TRUE)
+  assert_true(period < period_extended, na.ok = TRUE)
   assert_number(corr, lower = -1, upper = 1)
   assert_numeric(weights, finite = TRUE, null.ok = TRUE)
 
 
   elg_udf <- surveys %>%
     get_eligible(
-      pollsters = pollsters,
-      last_date  = last_date,
-      period     = period) %>%
+      pollsters       = pollsters,
+      last_date       = last_date,
+      period          = period,
+      period_extended = period_extended) %>%
     unnest()
 
   elg_udf %>%
@@ -160,27 +177,32 @@ get_pooled <- function(
 #' @export
 pool_surveys <- function(
   surveys,
-  last_date  = Sys.Date(),
-  pollsters = c("allensbach", "emnid", "forsa", "fgw", "gms", "infratest",
-    "dimap", "infratestdimap", "insa"),
-  period     = 14,
-  corr       = 0.5,
-  weights    = NULL) {
+  last_date       = Sys.Date(),
+  pollsters       = c("allensbach", "emnid", "forsa", "fgw", "gms",
+    "infratest", "dimap", "infratestdimap", "insa"),
+  period          = 14,
+  period_extended = NA,
+  corr            = 0.5,
+  weights         = NULL) {
 
   assert_data_frame(surveys, min.rows = 2, min.cols = 2)
   assert_date(last_date)
   assert_character(pollsters, any.missing = FALSE)
   assert_number(period, lower = 1, finite = TRUE)
+  assert_number(period_extended, lower = 1, finite = TRUE, na.ok = TRUE)
+  assert_true(period < period_extended, na.ok = TRUE)
   assert_number(corr, lower = -1, upper = 1)
   assert_numeric(weights, finite = TRUE, null.ok = TRUE)
 
-  pooled_df <- get_pooled(surveys, last_date, pollsters, period, corr, weights)
+  pooled_df <- get_pooled(surveys, last_date, pollsters, period,
+                          period_extended, corr, weights)
 
   elg_udf <- surveys %>%
     get_eligible(
-      pollsters = pollsters,
-      last_date = last_date,
-      period    = period) %>%
+      pollsters       = pollsters,
+      last_date       = last_date,
+      period          = period,
+      period_extended = period_extended) %>%
     unnest() %>%
     filter(!is.na(.data$percent))
   nall <- get_n(elg_udf)

README.Rmd

@@ -7,7 +7,7 @@ library(knitr)
 opts_chunk$set(warning=FALSE)
 ```
 
-# coalitions
+# coalitions <img src="man/figures/logo.png" align="right" />
 
 [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active)
 [![Travis-CI Build Status](https://travis-ci.org/adibender/coalitions.svg?branch=master)](https://travis-ci.org/adibender/coalitions)
@@ -23,6 +23,9 @@ opts_chunk$set(warning=FALSE)
 The package offers functions that calculate coalition probabilities
 in multi-party elections, based on a survey results:
 
+  - See our [talk](https://adibender.netlify.com/talk/appliedr-meetup/) at the
+[Munich AppliedR MeetUp](https://www.meetup.com/de-DE/Applied-R-Munich/)
+
   - Check out our [interactive shiny app on German elections](http://koala.stat.uni-muenchen.de/)!
 
   - To get started, see our [workflow vignette](https://adibender.github.io/coalitions/articles/workflow.html)
@@ -31,15 +34,15 @@ in multi-party elections, based on a survey results:
 
 Install from GitHub using:
 ```{r, eval=FALSE}
-devtools::install_github("adibender/coalitions", build_vignettes=TRUE)
+devtools::install_github("adibender/coalitions")
 ```
 
 
 ## Usage
 
-Detailed [workflow](https://adibender.github.io/coalitions/articles/workflow.html)
-is outlined in the vignettes enclosed in the package
-(see `browseVignettes(package="coalitions")`).
+Detailed workflow is outlined in the
+[workflow](https://adibender.github.io/coalitions/articles/workflow.html)
+vignette.
 
 A short overview is presented below.
 
@@ -56,7 +59,8 @@ surveys <- get_surveys()
 surveys
 ```
 
-Each row represents a survey insitute and each row in the `surveys` column again contains a nested `tibble` with survey results from different time-points:
+Each row represents a polling agency and each row in the `surveys` column again
+contains a nested `tibble` with survey results from different time-points:
 
 ```{r}
 surveys %>%