6 |
67 |
68 | $for(include-after)$
69 | $include-after$
70 | $endfor$
--------------------------------------------------------------------------------
/pkgdown/templates/footer.html:
--------------------------------------------------------------------------------
1 |
7 |
49 |
50 |
65 |
66 |
8 |
$endif$ 18 | $if(author.email)$ 19 | $author.email$ 20 | 21 | $endif$ 22 | $else$ 23 |
33 |
34 |
35 |
36 | $for(include-before)$
37 | $include-before$
38 | $endfor$
39 |
40 | $if(abstract)$
41 | $title$
9 | $if(subtitle)$ 10 |$subtitle$
11 | $endif$ 12 | $for(author)$ 13 | $if(author.name)$ 14 |$author.name$
15 | $if(author.affiliation)$ 16 | 17 | $author.affiliation$$endif$ 18 | $if(author.email)$ 19 | $author.email$ 20 | 21 | $endif$ 22 | $else$ 23 |
$author$
24 | $endif$ 25 | $endfor$ 26 | 27 | $if(date)$ 28 |$date$
29 | $endif$ 30 | 31 | {{#source}}{{{.}}}{{/source}} 32 |{{filename}}
42 |
45 | $endif$
46 |
47 | $body$
48 | Abstract
43 | $abstract$ 44 |
2 |
4 |
5 | {{#package}}Developed by {{{authors}}}.{{/package}}
3 |
Buy me a coffee
6 |
7 |
8 |
--------------------------------------------------------------------------------
/man/get_cantonalvotes.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/get_cantonalvotes.R
3 | \name{get_cantonalvotes}
4 | \alias{get_cantonalvotes}
5 | \title{Get cantonal results and counting status in real time or for selected dates or a time range in the past}
6 | \usage{
7 | get_cantonalvotes(
8 | geolevel = "municipality",
9 | votedates = NULL,
10 | from_date = NULL,
11 | to_date = NULL
12 | )
13 | }
14 | \arguments{
15 | \item{geolevel}{geographical level for which the results should be loaded. Options: "canton", "district", "municipality" or "zh_counting_districts".}
16 |
17 | \item{votedates}{dates of the ballots to be selected. Default: most recent ballot available. Format: "YYYY-MM-DD".}
18 |
19 | \item{from_date}{starting point in time from which vote results should be retrieved. Format: "YYYY-MM-DD".}
20 |
21 | \item{to_date}{end point in time to which vote results should be retrieved. Format: "YYYY-MM-DD".}
22 | }
23 | \value{
24 | a tibble containing the results
25 | }
26 | \description{
27 | \code{get_cantonalvotes} is one of the two main functions of swissvote package. It allows to retrieve the results and the counting status for national ballots.
28 | }
29 | \details{
30 | get_cantonalvotes - retrieve vote results for cantonal ballots at district- or municipality level for selected dates or a given date range.
31 | }
32 | \examples{
33 |
34 | # Select by range
35 | results <- get_cantonalvotes(
36 | geolevel = "district",
37 | from_date = "2019-01-01",
38 | to_date = "2019-12-31"
39 | )
40 |
41 | # Select specific votedate(s)
42 | get_cantonalvotes(votedates = "2019-02-10")
43 |
44 | # get the results at counting district level
45 | # yields the same result as the municipality level, with the
46 | # exception of Winterthur and Zurich,
47 | # where detailed counting district results are returned instead.
48 |
49 | get_cantonalvotes(votedate = "2019-09-22", geolevel = "zh_counting_districts")
50 |
51 | }
52 |
--------------------------------------------------------------------------------
/man/plot_nationalvotes.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/plot_nationalvotes.R
3 | \name{plot_nationalvotes}
4 | \alias{plot_nationalvotes}
5 | \title{Plot National Votes}
6 | \usage{
7 | plot_nationalvotes(
8 | votedate = NULL,
9 | vote_id = NULL,
10 | geolevel = "municipality",
11 | measure = "result",
12 | standardize = T,
13 | lakes = T,
14 | language = "DE",
15 | theme = "srf"
16 | )
17 | }
18 | \arguments{
19 | \item{votedate}{date of the ballot. Default: most recent ballot available.}
20 |
21 | \item{vote_id}{id of the vote. Default: first id mentioned in the data set.}
22 |
23 | \item{geolevel}{geographical level. Options: "canton", "district", "municipality" or "zh_counting_districts".}
24 |
25 | \item{measure}{measure to color the administrative units. Options: "result" for the yes vote share or "turnout"
26 | for the voter turnout of a given vote.}
27 |
28 | \item{standardize}{if \code{TRUE}, the scale of the measure ranges from 0 to 100 percent. Recommended for comparisons
29 | between votes.}
30 |
31 | \item{lakes}{if \code{TRUE}, the largest Swiss lakes are shown in color on the map.}
32 |
33 | \item{language}{defines the language. Options: "DE" for German, "FR" for French, "IT" for Italian or "RM" for Romansh.}
34 |
35 | \item{theme}{defines basic appearance of the map. Five options are available: "srf" for a theme inspired by the
36 | plots of Swiss Radio and Television, and "A" to "E" for the viridis color scales magma, inferno, plasma, viridis and cividis.}
37 | }
38 | \value{
39 | a ggplot object
40 | }
41 | \description{
42 | \code{plot_nationalvotes} plots the results of national votes in a choropleth map using ggplot2.
43 | }
44 | \examples{
45 |
46 | # Plot the most recent national vote
47 | plot_nationalvotes()
48 | \donttest{
49 | # Plot a specific national vote at cantonal level
50 | plot_nationalvotes(
51 | votedate = "2014-02-09",
52 | vote_id = 5800,
53 | geolevel = "canton"
54 | )
55 | }
56 | }
57 |
--------------------------------------------------------------------------------
/man/get_nationalvotes.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/get_nationalvotes.R
3 | \name{get_nationalvotes}
4 | \alias{get_nationalvotes}
5 | \title{Get national results and counting status in real time or for selected dates or a time range in the past}
6 | \usage{
7 | get_nationalvotes(
8 | geolevel = "municipality",
9 | votedates = NULL,
10 | from_date = NULL,
11 | to_date = NULL,
12 | language = "DE"
13 | )
14 | }
15 | \arguments{
16 | \item{geolevel}{geographical level for which the results should be loaded. Options: "national", "canton", "district", "municipality" or "zh_counting_districts".#' @param votedates dates of the ballots to be selected. Default: most recent ballot available. Format: "YYYY-MM-DD".}
17 |
18 | \item{votedates}{dates of the ballots to be selected. Default: most recent ballot available. Format: "YYYY-MM-DD".}
19 |
20 | \item{from_date}{starting point in time from which vote results should be retrieved. Format: "YYYY-MM-DD".}
21 |
22 | \item{to_date}{end point in time to which vote results should be retrieved. Format: "YYYY-MM-DD".}
23 |
24 | \item{language}{defines the language of the vote title. Options: "DE" for German, "FR" for French, "IT" for Italian or "RM" for Romansh.}
25 | }
26 | \value{
27 | a tibble containing the results
28 | }
29 | \description{
30 | \code{get_nationalvotes} is one of the two main functions of swissvote package. It allows to retrieve the results and the counting status for national ballots.
31 | }
32 | \details{
33 | get_nationalvotes - retrieve vote results for national ballots at district- or municipality level for selected dates or a given date range.
34 | }
35 | \examples{
36 | \donttest{
37 | # Selection by range
38 | results <- get_nationalvotes(
39 | geolevel = "district",
40 | from_date = "2018-01-01",
41 | to_date = "2018-12-31"
42 | )
43 |
44 | # Selection by end date only
45 | get_nationalvotes(to_date = "1983-12-04")
46 | }
47 | # Selection of a specific vote date
48 | get_nationalvotes(votedates = "2014-02-09")
49 |
50 | }
51 |
--------------------------------------------------------------------------------
/docs/bootstrap-toc.css:
--------------------------------------------------------------------------------
1 | /*!
2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/)
3 | * Copyright 2015 Aidan Feldman
4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */
5 |
6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */
7 |
8 | /* All levels of nav */
9 | nav[data-toggle='toc'] .nav > li > a {
10 | display: block;
11 | padding: 4px 20px;
12 | font-size: 13px;
13 | font-weight: 500;
14 | color: #767676;
15 | }
16 | nav[data-toggle='toc'] .nav > li > a:hover,
17 | nav[data-toggle='toc'] .nav > li > a:focus {
18 | padding-left: 19px;
19 | color: #563d7c;
20 | text-decoration: none;
21 | background-color: transparent;
22 | border-left: 1px solid #563d7c;
23 | }
24 | nav[data-toggle='toc'] .nav > .active > a,
25 | nav[data-toggle='toc'] .nav > .active:hover > a,
26 | nav[data-toggle='toc'] .nav > .active:focus > a {
27 | padding-left: 18px;
28 | font-weight: bold;
29 | color: #563d7c;
30 | background-color: transparent;
31 | border-left: 2px solid #563d7c;
32 | }
33 |
34 | /* Nav: second level (shown on .active) */
35 | nav[data-toggle='toc'] .nav .nav {
36 | display: none; /* Hide by default, but at >768px, show it */
37 | padding-bottom: 10px;
38 | }
39 | nav[data-toggle='toc'] .nav .nav > li > a {
40 | padding-top: 1px;
41 | padding-bottom: 1px;
42 | padding-left: 30px;
43 | font-size: 12px;
44 | font-weight: normal;
45 | }
46 | nav[data-toggle='toc'] .nav .nav > li > a:hover,
47 | nav[data-toggle='toc'] .nav .nav > li > a:focus {
48 | padding-left: 29px;
49 | }
50 | nav[data-toggle='toc'] .nav .nav > .active > a,
51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a,
52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a {
53 | padding-left: 28px;
54 | font-weight: 500;
55 | }
56 |
57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */
58 | nav[data-toggle='toc'] .nav > .active > ul {
59 | display: block;
60 | }
61 |
--------------------------------------------------------------------------------
/docs/docsearch.js:
--------------------------------------------------------------------------------
1 | $(function() {
2 |
3 | // register a handler to move the focus to the search bar
4 | // upon pressing shift + "/" (i.e. "?")
5 | $(document).on('keydown', function(e) {
6 | if (e.shiftKey && e.keyCode == 191) {
7 | e.preventDefault();
8 | $("#search-input").focus();
9 | }
10 | });
11 |
12 | $(document).ready(function() {
13 | // do keyword highlighting
14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */
15 | var mark = function() {
16 |
17 | var referrer = document.URL ;
18 | var paramKey = "q" ;
19 |
20 | if (referrer.indexOf("?") !== -1) {
21 | var qs = referrer.substr(referrer.indexOf('?') + 1);
22 | var qs_noanchor = qs.split('#')[0];
23 | var qsa = qs_noanchor.split('&');
24 | var keyword = "";
25 |
26 | for (var i = 0; i < qsa.length; i++) {
27 | var currentParam = qsa[i].split('=');
28 |
29 | if (currentParam.length !== 2) {
30 | continue;
31 | }
32 |
33 | if (currentParam[0] == paramKey) {
34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20"));
35 | }
36 | }
37 |
38 | if (keyword !== "") {
39 | $(".contents").unmark({
40 | done: function() {
41 | $(".contents").mark(keyword);
42 | }
43 | });
44 | }
45 | }
46 | };
47 |
48 | mark();
49 | });
50 | });
51 |
52 | /* Search term highlighting ------------------------------*/
53 |
54 | function matchedWords(hit) {
55 | var words = [];
56 |
57 | var hierarchy = hit._highlightResult.hierarchy;
58 | // loop to fetch from lvl0, lvl1, etc.
59 | for (var idx in hierarchy) {
60 | words = words.concat(hierarchy[idx].matchedWords);
61 | }
62 |
63 | var content = hit._highlightResult.content;
64 | if (content) {
65 | words = words.concat(content.matchedWords);
66 | }
67 |
68 | // return unique words
69 | var words_uniq = [...new Set(words)];
70 | return words_uniq;
71 | }
72 |
73 | function updateHitURL(hit) {
74 |
75 | var words = matchedWords(hit);
76 | var url = "";
77 |
78 | if (hit.anchor) {
79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor;
80 | } else {
81 | url = hit.url + '?q=' + escape(words.join(" "));
82 | }
83 |
84 | return url;
85 | }
86 |
--------------------------------------------------------------------------------
/NEWS.md:
--------------------------------------------------------------------------------
1 |
2 | # swissdd 1.1.5
3 |
4 | * fix for `get_geodata(geolevel="canton")` added
5 |
6 | # swissdd 1.1.4.999
7 |
8 |
9 | * fix for `get_geodata(geolevel="zh_counting_districts")` and additional checks to ensure functions fail gracefully in case of availability and connection problems.
10 |
11 | # swissdd 1.1.3
12 |
13 | * fix for `get_geodata() / plot_nationalvotes()`
14 |
15 | * gentle failure of the swissdd-function in case of errors in the data source / problems with the API
16 |
17 | * bug fixes for get_geodata() / plot_nationalvotes()
18 |
19 | # swissdd 1.1.1
20 |
21 | * minor modification to the 'plot_cantonalvotes()'-function to ensure that the function works even when there are no results yet for an upcoming vote.
22 |
23 | # swissdd 1.1.0
24 |
25 | * major update : new functions to retrieve geodata of voting districts and plot vote results maps have been added by [David Zumbach](https://github.com/zumbov2) (Thanks a thousand David!)
26 |
27 | # swissdd 1.0.4
28 |
29 | * the `canton_json_to_dfr` has been adapted to work with the altered data structure of the json files provided via opendata.swiss containing the cantonal vote results.
30 |
31 | # swissdd 1.0.3
32 |
33 | * broken examples fixed
34 |
35 | # swissdd 1.0.2
36 |
37 | * Functions renamed (_*breaking change*_): to retrieve real time or archive results data via opendata.swiss, the function `get_nationalvotes` must be used. `get_swissvotes` is turned into the function that allows to get Swissvotes-Data.
38 |
39 | * New function that allows to retrieve Swissvotes-Data added (`get_swissvotes`)
40 |
41 | * option to retrieve counting district level data with the `get_nationalvotes()`- and `get_cantonalvotes()`-functions added (affects Zurich and Winterthur only)
42 |
43 | * functions adapted to new tidyr API, the package now depends on tidyr >= 1.0.0.
44 |
45 | # swissdd 1.0.1
46 |
47 | * Added parent level ids to district and municipality level results (canton / district)
48 | * New function that calculates correlations between votes added: `similar_votes()`
49 | * Better error handling with fallback if votedate information provided on opendata.swiss is corrupt
50 | * Improved speed of data-retrieval. Comparison:
51 |
52 | `system.time(get_swissvotes(to_date="1983-12-04"))`
53 |
54 | user system elapsed
55 |
56 | 2.492 0.160 47.024
57 |
58 | *comparison with swissdd version 1.0.0*
59 |
60 | user system elapsed
61 |
62 | 3.120 0.276 64.693
63 |
--------------------------------------------------------------------------------
/R/zzz.R:
--------------------------------------------------------------------------------
1 | # package startup-message (data source displayed)
2 |
3 | #' Title
4 | #'
5 | #' @param lib
6 | #' @param pkg
7 | #' @importFrom utils packageVersion
8 | #'
9 | #' @examples
10 |
11 | .onAttach <- function(lib, pkg)
12 | {
13 | packageStartupMessage('************************************************************')
14 | packageStartupMessage(paste('* swissdd',utils::packageVersion("swissdd"),' *'))
15 | packageStartupMessage('* developed by politan.ch *')
16 | packageStartupMessage('* *')
17 | packageStartupMessage('* Data sources: *')
18 | packageStartupMessage('* Federal Statistical Office *')
19 | packageStartupMessage('* https://www.bfs.admin.ch/ *')
20 | packageStartupMessage('* *')
21 | packageStartupMessage('* Swissvotes *')
22 | packageStartupMessage('* https://swissvotes.ch/ *')
23 | packageStartupMessage('* *')
24 | packageStartupMessage('************************************************************')
25 | }
26 |
27 | # suppress notes
28 |
29 | utils::globalVariables(c("id", "resultat","res","geoid",
30 | "kantId",
31 | "canton_id","canton_name",
32 | "district_id","district_name",
33 | "mun_id","mun_name",
34 | "langKey",
35 | "yes",
36 | "anr",
37 | "name",
38 | # "kantonname",
39 | "results2",
40 | "geoLevelnummer",
41 | "geoLevelname",
42 | "ktdata_zh",
43 | "jaStimmenInProzent",
44 | "cor","cov","correlation",
45 | "text",
46 | "measure", "vogeId", "geometry",
47 | "bezkId", "stimmbeteiligungInProzent",
48 | "text",#,"ktid"
49 | "packageVersion"
50 | ))
51 |
52 |
53 |
54 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | [](https://www.gnu.org/licenses/gpl-2.0.en.html)
2 | [](http://cran.rstudio.com/web/packages/swissdd/index.html)
3 | [](https://github.com/politanch/swissdd/actions?workflow=R-CMD-check)
4 |
5 | # swissdd
6 |
7 | ## the swiss direct democracy R package
8 | Site built with pkgdown {{#pkgdown}}{{version}}{{/pkgdown}}.
9 |
9 | 
10 |
11 |
12 | ### Installation
13 | Swissdd can be installed from github (on going updates) `devtools::install_github("politanch/swissdd")`.
14 |
15 |
16 | `swissdd` builds upon real time data service for federal and cantonal votes provided by the __Federal Statistical Office__ via [opendata.swiss](https://opendata.swiss/de/). It brings the results of popular votes, aggregated at the geographical level of choice, straight into R. Available levels are
17 |
18 | * national
19 | * cantons
20 | * districts
21 | * municipalities
22 |
23 | The package wraps the real time data on vote Sundays. As soon as the ballots close (from 12:00 on), the datastream is continuosly updated, until the data for all municipalities is complete and the final results are available. Additionally, it allows to access the archive and to retrieve the *harmonized* results of national votes since 1981. Thanks to a major contribution of [David Zumbach](https://github.com/zumbov2) the latest version contains new functions to retrieve geodata of administrative boundaries and plot vote results maps.
24 |
25 | It also allows to retrieve data from the [swissvotes-database](https://swissvotes.ch/page/home), the most comprehensive database on swiss popular votes.
26 |
27 | The documentation is available here: https://politanch.github.io/swissdd/
28 |
29 | The webservice of the FSO is documented on opendata.swiss (language settings can be found at the bottom of the page):
30 |
31 | https://opendata.swiss/de/dataset/echtzeitdaten-am-abstimmungstag-zu-eidgenoessischen-abstimmungsvorlagen
32 |
33 | https://opendata.swiss/de/dataset/echtzeitdaten-am-abstimmungstag-zu-kantonalen-abstimmungsvorlagen
34 |
35 | ## More data on Swiss politics
36 | - [DigDemLab](https://digdemlab.io/)
37 | - [swissparl](https://github.com/zumbov2/swissparl)
38 | - [swissvotes](https://swissvotes.ch/)
39 |
--------------------------------------------------------------------------------
/.github/workflows/pkgdown.yaml:
--------------------------------------------------------------------------------
1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
3 | on:
4 | push:
5 | branches: [main, master]
6 | pull_request:
7 | branches: [main, master]
8 | release:
9 | types: [published]
10 | workflow_dispatch:
11 |
12 | name: pkgdown
13 |
14 | jobs:
15 | pkgdown:
16 | runs-on: ubuntu-latest
17 | # Only restrict concurrency for non-PR jobs
18 | concurrency:
19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
20 | env:
21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
22 | permissions:
23 | contents: write
24 | steps:
25 | - uses: actions/checkout@v4
26 |
27 | - uses: r-lib/actions/setup-pandoc@v2
28 |
29 | - uses: r-lib/actions/setup-r@v2
30 | with:
31 | use-public-rspm: true
32 |
33 | - uses: r-lib/actions/setup-r-dependencies@v2
34 | with:
35 | extra-packages: any::pkgdown, local::.
36 | needs: website
37 |
38 | - uses: r-lib/actions/setup-pandoc@v1
39 |
40 | - name: Query dependencies
41 | run: |
42 | install.packages('remotes')
43 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
44 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
45 | shell: Rscript {0}
46 |
47 | - name: Cache R packages
48 | uses: actions/cache@v2
49 | with:
50 | path: ${{ env.R_LIBS_USER }}
51 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
52 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
53 |
54 | - name: Install dependencies
55 | run: |
56 | remotes::install_deps(dependencies = TRUE)
57 | install.packages(c("RSwissMaps","viridis"), type = "binary")
58 | remotes::install_github("politanch/swissdd")
59 | shell: Rscript {0}
60 |
61 |
62 | - name: Install package
63 | run: R CMD INSTALL .
64 |
65 | - name: Build site
66 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
67 | shell: Rscript {0}
68 |
69 | - name: Deploy to GitHub pages 🚀
70 | if: github.event_name != 'pull_request'
71 | uses: JamesIves/github-pages-deploy-action@v4.5.0
72 | with:
73 | clean: false
74 | branch: gh-pages
75 | folder: docs
76 |
--------------------------------------------------------------------------------
/R/get_poll.R:
--------------------------------------------------------------------------------
1 | #' Download poll data collected after a national vote by gfs.bern and the political science departements of the universities of Berne, Zurich, and Geneva.
2 | #'
3 | #' \code{get_poll} downloads exit poll data Please cite data.
4 | #'
5 | #' get_poll - retrieve poll data on votes. The unit of analysis are individuals.
6 | #'
7 | #' @param bfsnr number of identification of the vote, by default = NULL. Polls available after September 2020 (from voteid 6360 onwards). Bfsnr corresponds to anr in swissvotes data and has to be four digits (available through get_swissvotes).
8 | #' @param codebook by default = FALSE. If TRUE navigates your browser to the codebook if available.
9 | #' @importFrom RCurl getBinaryURL
10 | #' @export
11 | #'
12 | #' @return a tibble containing the results
13 | #'
14 | #' @examples
15 | #' results <- get_poll(bfsnr=6360, codebook=FALSE)
16 |
17 | get_poll <- function(bfsnr = NULL, codebook = F) {
18 |
19 | if(is.null(bfsnr)) stop("Identifier number of vote (voteid) has to be specified. See for the variable `anr` obtained through swissdd::get_swissvotes ")
20 | if(class(bfsnr)=="numeric"){
21 | if(nchar(bfsnr)<4) stop("vote identifier has to have four digits, for example 6360")
22 | if(bfsnr<6360) stop("Polls are available from November 2020 onwards. Hence, bfsnr cannot be smaller than 6360.")
23 | }
24 |
25 | #create download url
26 | if(nchar(bfsnr/10)==3) voteid <- paste0((bfsnr/10),".00")
27 | if(nchar(bfsnr/10)==5) voteid <- paste0((bfsnr/10),"0")
28 | download_url <- paste0("https://swissvotes.ch/vote/", voteid, "/nachbefragung.csv")
29 |
30 | safe_csv <-purrr::possibly(utils::read.csv, otherwise=tibble())
31 |
32 | #download data
33 |
34 | exitpoll <- try(utils::read.csv(
35 | file=download_url,
36 | sep=",",
37 | header=T,
38 | fileEncoding="latin1",
39 | stringsAsFactors = F
40 | ))
41 |
42 | if(class(exitpoll)=="try-error"){
43 | stop("Data is not (yet) available on swissvotes.\nFollow @swissvotes on Twitter for update information.")
44 | }else{
45 | message("Data is downloaded from swissvotes.")
46 | }
47 |
48 |
49 |
50 |
51 | if (codebook) {
52 | codebook_url <- z <- vector("list", 2)
53 | codebook_url[[1]] <- paste0("https://swissvotes.ch/vote/", voteid, "/nachbefragung-codebuch-de.xlsx")
54 | codebook_url[[2]] <- paste0("https://swissvotes.ch/vote/", voteid, "/nachbefragung-codebuch-de.pdf")
55 |
56 | #test which version is available (xlsx or pdf)
57 | for(i in 1:2){
58 | try(z[[i]] <- RCurl::getBinaryURL(codebook_url[[i]], failonerror = TRUE))
59 | }
60 |
61 | pdf_or_xlsx <- which(!is.null(z))
62 | utils::browseURL(codebook_url[[pdf_or_xlsx]])
63 | }
64 |
65 |
66 | return(exitpoll)
67 |
68 | }
69 |
70 |
--------------------------------------------------------------------------------
/vignettes/plot_correlations.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Find and plot correlated vote results"
3 | output: rmarkdown::html_vignette
4 | ---
5 |
6 | ```{r, include = FALSE}
7 | knitr::opts_chunk$set(
8 | collapse = TRUE,
9 | comment = "#>"
10 | )
11 | ```
12 |
13 | ```{r setup, include=FALSE}
14 | knitr::opts_chunk$set(echo = TRUE)
15 | ```
16 |
17 |
18 | ### What other votes correlate with the 2014 vote on immigration (mei)?
19 |
20 | For the sake of illustration we are interested in the result of the 2014 vote on immigration for Swiss municipalities. The initiative was voted upon on 9th of February 2014. There are different ways to find this exact vote. One of them is using the information in the title. An other solution would be to look up the `id` provided by the FSO.
21 |
22 | `unique(federalvotes$name[grep("Massen", federalvotes$name)])`
23 |
24 | First, we invoke the necessary packages and use the function `get_nationalvotes` to access the data. We further specify the unit of analysis as well as the range.
25 |
26 |
27 | ```{r echo=TRUE, warning=FALSE, message=FALSE}
28 | # installation from CRAN (stable)
29 | # install.packages("swissdd")
30 | # install.packages("dplyr")
31 |
32 | # installation from github (ongoing updates)
33 | # devtools::install_github("politanch/swissdd")
34 |
35 | library(swissdd)
36 | library(dplyr)
37 | library(ggplot2)
38 | library(tidyr)
39 |
40 | #get results of all votes between 2010-2019
41 | federalvotes <- get_nationalvotes(geolevel = "municipality",
42 | from_date = "2010-03-07",
43 | to_date = "2020-09-27")
44 |
45 | #get correlations for votes on municipal level with mei
46 | simvotes <- similar_votes(federalvotes, id=5800, from=.4, to=.6)
47 | simvotes
48 |
49 | #extract names of correlated votes
50 | ballotnames <- federalvotes %>%
51 | dplyr::select(name, id, mun_id)%>%
52 | filter(id%in%c(5800, simvotes[2,1]))%>%
53 | distinct(name)
54 |
55 |
56 | #get correlations for votes on municipal level with mei
57 | simvotes <- similar_votes(federalvotes, id=6310, from=.3, to=1)
58 | simvotes
59 |
60 | #extract names of correlated votes
61 | ballotnames <- federalvotes %>%
62 | dplyr::select(name, id, mun_id)%>%
63 | filter(id%in%c(6310, simvotes[1,1]))%>%
64 | distinct(name)
65 |
66 | #subset for correlated votes
67 | corrvotes <- federalvotes %>%
68 | filter(id%in%c(6310, simvotes[1,1]))%>%
69 | dplyr::select(id, jaStimmenInProzent, mun_id)%>%
70 | mutate(id=as.character(id))
71 |
72 | #plot
73 | corrvotes%>%
74 | pivot_wider(names_from="id", values_from="jaStimmenInProzent")%>%
75 | ggplot(aes(y=`6310`, x=`5800`))+
76 | geom_point(alpha=.2)+
77 | scale_y_continuous(limits=c(0,100))+
78 | scale_x_continuous(limits=c(0,100))+
79 | geom_abline(intercept = 0, slope=1, size=.1)+
80 | geom_smooth(method="lm", size=.3, color="orange")+
81 | labs(y="BGI, Yes Shares", x="MEI, Yes Shares", caption="politan.ch")+
82 | theme_bw()
83 |
84 | ```
85 |
--------------------------------------------------------------------------------
/vignettes/use_SwissvotesDB.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Retrieve Swissvotes-Data"
3 | output: rmarkdown::html_vignette
4 | ---
5 |
6 | ```{r, include = FALSE}
7 | knitr::opts_chunk$set(
8 | collapse = TRUE,
9 | comment = "#>"
10 | )
11 | ```
12 |
13 | ### How to Use Swissvotes Data
14 |
15 | First, you have to make sure that your machine is connected to the internet.
16 |
17 | ```{r echo=TRUE, warning=FALSE, message=FALSE}
18 | # installation from CRAN (stable)
19 | # install.packages("swissdd")
20 | # install.packages("dplyr")
21 |
22 | # installation from github (ongoing updates)
23 | # devtools::install_github("politanch/swissdd")
24 |
25 | Sys.setlocale('LC_ALL','C')
26 |
27 | library(swissdd)
28 | library(dplyr)
29 |
30 | ```
31 |
32 |
33 | By default, function extracts only the database provided by [Swissvotes](https://swissvotes.ch){target="_blank"}. However, you can specify that you want the codebook as well (or just the codebook for that matter). Additionally, there is a specification to save the citation. If you work with data from Swissvotes, we recommend to save the citation.
34 |
35 | If you don't specify anything the function will be executed with the following specifications.
36 |
37 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=FALSE}
38 | #default
39 | swissvotesDB <- get_swissvotes(DB=T, savecitation=F, codebook=F)
40 | ```
41 |
42 | ```{r echo=FALSE, warning=FALSE, message=FALSE}
43 | #default
44 | swissvotesDB <- get_swissvotes()
45 | ```
46 |
47 | If you use the parameter `codebook=T` the function will download the data and direct your browser automatically to the codebook. If you're only interested in the codebook (you accessed the data already, for example), set the parameter `DB` to `FALSE`.
48 |
49 | Since we loaded the data already, there is no need to download it again.
50 |
51 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=FALSE}
52 |
53 | get_swissvotes(DB=F, codebook=T)
54 |
55 | ```
56 |
57 | For illustration, we are interested in the upcoming vote on affordable housing (date of vote 9th of February, 2020). The variable `titel_kurz_d` or `titel_kurz_f` contains the title of a vote (shorter version than the official title `titel_off_d` or `titel_off_f`). Please note that the letter `d` indicates the German title, while the letter `f` gives you the French title. Since we don't know too much about the initiative we can read about it as well. First, we find the position in the data and then use the hyperlink provided to read about it.
58 |
59 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
60 |
61 | #get position in dataset
62 | pos_ah <- grep("bezahlbare Wohnungen", swissvotesDB$titel_kurz_d)
63 |
64 | #extract url that directs you to more information about the vote
65 | mei_url <- swissvotesDB$anneepolitique[pos_ah]
66 |
67 | #mei_url
68 | #"https://anneepolitique.swiss/prozesse/56996-volksinitiative-mehr-bezahlbare-wohnungen"
69 | ```
70 |
71 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=FALSE}
72 | #access url
73 | browseURL(mei_url)
74 | ```
75 |
76 |
77 |
78 |
79 |
80 |
--------------------------------------------------------------------------------
/index.md:
--------------------------------------------------------------------------------
1 | # swissdd
2 |
3 | [](https://cran.r-project.org/package=swissdd)
4 | [](https://www.gnu.org/licenses/gpl-2.0.en.html)
5 | [](http://cran.rstudio.com/web/packages/swissdd/index.html)
6 |
7 | ## the swiss direct democracy R package
8 |
`, then ``, etc.) that has more than one element. Defaults to 1 (for ``).
76 | getTopLevel: function($scope) {
77 | for (var i = 1; i <= 6; i++) {
78 | var $headings = this.findOrFilter($scope, 'h' + i);
79 | if ($headings.length > 1) {
80 | return i;
81 | }
82 | }
83 |
84 | return 1;
85 | },
86 |
87 | // returns the elements for the top level, and the next below it
88 | getHeadings: function($scope, topLevel) {
89 | var topSelector = 'h' + topLevel;
90 |
91 | var secondaryLevel = topLevel + 1;
92 | var secondarySelector = 'h' + secondaryLevel;
93 |
94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector);
95 | },
96 |
97 | getNavLevel: function(el) {
98 | return parseInt(el.tagName.charAt(1), 10);
99 | },
100 |
101 | populateNav: function($topContext, topLevel, $headings) {
102 | var $context = $topContext;
103 | var $prevNav;
104 |
105 | var helpers = this;
106 | $headings.each(function(i, el) {
107 | var $newNav = helpers.generateNavItem(el);
108 | var navLevel = helpers.getNavLevel(el);
109 |
110 | // determine the proper $context
111 | if (navLevel === topLevel) {
112 | // use top level
113 | $context = $topContext;
114 | } else if ($prevNav && $context === $topContext) {
115 | // create a new level of the tree and switch to it
116 | $context = helpers.createChildNavList($prevNav);
117 | } // else use the current $context
118 |
119 | $context.append($newNav);
120 |
121 | $prevNav = $newNav;
122 | });
123 | },
124 |
125 | parseOps: function(arg) {
126 | var opts;
127 | if (arg.jquery) {
128 | opts = {
129 | $nav: arg
130 | };
131 | } else {
132 | opts = arg;
133 | }
134 | opts.$scope = opts.$scope || $(document.body);
135 | return opts;
136 | }
137 | },
138 |
139 | // accepts a jQuery object, or an options object
140 | init: function(opts) {
141 | opts = this.helpers.parseOps(opts);
142 |
143 | // ensure that the data attribute is in place for styling
144 | opts.$nav.attr('data-toggle', 'toc');
145 |
146 | var $topContext = this.helpers.createChildNavList(opts.$nav);
147 | var topLevel = this.helpers.getTopLevel(opts.$scope);
148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel);
149 | this.helpers.populateNav($topContext, topLevel, $headings);
150 | }
151 | };
152 |
153 | $(function() {
154 | $('nav[data-toggle="toc"]').each(function(i, el) {
155 | var $nav = $(el);
156 | Toc.init($nav);
157 | });
158 | });
159 | })();
160 |
--------------------------------------------------------------------------------
/R/plot_nationalvotes.R:
--------------------------------------------------------------------------------
1 | #' Plot National Votes
2 | #'
3 | #' \code{plot_nationalvotes} plots the results of national votes in a choropleth map using ggplot2.
4 | #'
5 | #' @param votedate date of the ballot. Default: most recent ballot available.
6 | #' @param vote_id id of the vote. Default: first id mentioned in the data set.
7 | #' @param geolevel geographical level. Options: "canton", "district", "municipality" or "zh_counting_districts".
8 | #' @param measure measure to color the administrative units. Options: "result" for the yes vote share or "turnout"
9 | #' for the voter turnout of a given vote.
10 | #' @param standardize if \code{TRUE}, the scale of the measure ranges from 0 to 100 percent. Recommended for comparisons
11 | #' between votes.
12 | #' @param lakes if \code{TRUE}, the largest Swiss lakes are shown in color on the map.
13 | #' @param language defines the language. Options: "DE" for German, "FR" for French, "IT" for Italian or "RM" for Romansh.
14 | #' @param theme defines basic appearance of the map. Five options are available: "srf" for a theme inspired by the
15 | #' plots of Swiss Radio and Television, and "A" to "E" for the viridis color scales magma, inferno, plasma, viridis and cividis.
16 | #'
17 | #' @return a ggplot object
18 | #'
19 | #' @importFrom lubridate ymd
20 | #' @importFrom dplyr left_join rename bind_rows
21 | #' @importFrom tibble tibble
22 | #'
23 | #' @examples
24 | #'
25 | #' # Plot the most recent national vote
26 | #' \donttest{
27 | #' plot_nationalvotes()
28 | #' # Plot a specific national vote at cantonal level
29 | #' plot_nationalvotes(
30 | #' votedate = "2014-02-09",
31 | #' vote_id = 5800,
32 | #' geolevel = "canton"
33 | #' )
34 | #' }
35 | #' @export
36 | plot_nationalvotes <- function(votedate = NULL, vote_id = NULL, geolevel = "municipality", measure = "result",
37 | standardize = T, lakes = T, language = "DE", theme = "srf") {
38 |
39 | # Check inputs
40 | check_geolevel(geolevel, available_geolevels = c("canton", "district", "municipality", "zh_counting_districts"))
41 | check_measure(measure, available_measures = c("result", "turnout"))
42 | check_language(language, available_languages = c("DE", "FR", "IT", "RM"))
43 | check_theme(theme, available_themes = c("srf", "A", "B", "C", "D", "E"))
44 |
45 | # API calls
46 | call_res_base <- call_api_base()
47 | call_res_geodata <- call_api_geodata()
48 | available_dates <- available_votedates(geolevel = "national", call_res_base)
49 |
50 | # check status of api calls /available votedates and fail gracefully in case of errors
51 | if(httr::http_error(call_res_base)==FALSE &
52 | httr::http_error(call_res_geodata)==FALSE&
53 | is.null(available_dates)==FALSE& length(available_dates)>0) {
54 |
55 | # Handle votedate
56 | if (!is.null(votedate)) votedate <- lubridate::ymd(votedate)
57 | if (is.null(votedate)) votedate <- max(available_dates)
58 | check_votedate(votedate, available_dates)
59 |
60 | # Fetch vote data
61 | vote_data <- get_nationalvotes(geolevel = geolevel, votedates = votedate, language = language)
62 |
63 | # Subset vote data
64 | if (is.null(vote_id)) vote_id <- unique(vote_data[["id"]])[1]
65 | vote_data <- vote_data[vote_data[["id"]] == vote_id,]
66 | if (nrow(vote_data) == 0) stop ("No data found for the specified 'vote_id'")
67 | # warning if no results are available yet for the chosen vote id
68 | if (all(is.na(vote_data$jaStimmenInProzent))==TRUE) message("No results available yet for the specified 'vote_id'")
69 |
70 | #fetch geodata for the requested geolevel
71 | geodata <- get_geodata(geolevel = geolevel, call_res = call_res_geodata)
72 |
73 | # stop here and return an invisible null if geodata cannot be fetched
74 | if(is.null(geodata)) {return(invisible(NULL))}
75 |
76 | # Join geo with vote data
77 | if (geolevel == "municipality") {
78 |
79 | pd <- dplyr::left_join(
80 | geodata ,
81 | vote_data,
82 | by = "mun_id"
83 | )
84 |
85 | }
86 | if (geolevel == "district") {
87 |
88 | pd <- dplyr::left_join(
89 | geodata ,
90 | vote_data,
91 | by = "district_id"
92 | )
93 |
94 | }
95 | if (geolevel == "canton") {
96 |
97 | pd <- dplyr::left_join(
98 | geodata ,
99 | vote_data,
100 | by = "canton_id"
101 | )
102 |
103 | }
104 | if (geolevel == "zh_counting_districts") {
105 |
106 | pd <- dplyr::left_join(
107 | geodata ,
108 | vote_data,
109 | by = "mun_id"
110 | )
111 |
112 | }
113 |
114 | # Measure
115 | if (measure == "result") {
116 |
117 | pd <- pd %>% dplyr::rename(measure = jaStimmenInProzent)
118 | legend_title <- "jaStimmenInProzent"
119 |
120 | }
121 | if (measure == "turnout") {
122 |
123 | pd <- pd %>% dplyr::rename(measure = stimmbeteiligungInProzent)
124 | legend_title <- "stimmbeteiligungInProzent"
125 |
126 | }
127 |
128 | # Pseudo-standardization
129 | if (standardize) {
130 |
131 | pd2 <- tibble::tibble(
132 | id = vote_id,
133 | measure = c(0, 100)
134 | )
135 |
136 | pd <- pd %>% dplyr::bind_rows(pd2)
137 |
138 | }
139 |
140 | # Lakes
141 | lakes_data <- NULL
142 | if (lakes) lakes_data <- get_geodata(geolevel = "lakes", call_res = call_res_geodata)
143 | if (geolevel == "zh_counting_districts") lakes_data <- NULL
144 |
145 | # Base plot
146 | plot_map_national(pd, lakes = lakes_data, legend_title = legend_title, language = language, theme = theme)
147 | } else {
148 | message(paste("Data :",httr::http_status(call_res_base),
149 | "Geodata :",httr::http_status(call_res_geodata),
150 | "Votedates status:", !is.null(available_dates)
151 | ))
152 | }
153 |
154 | }
155 |
156 |
157 |
--------------------------------------------------------------------------------
/R/get_geodata.R:
--------------------------------------------------------------------------------
1 | #' Get Swiss Geodata
2 | #'
3 | #' \code{get_geodata} retrieves the latest geodata provided by the Federal Statistical Office in connection with federal votes.
4 | #'
5 | #' @param geolevel geographical level. Options: "national", "canton", "district", "municipality", "zh_counting_districts" or "lakes".
6 | #' @param latest if \code{TRUE}, the latest data is retrieved. If \code{FALSE}, geo data from the beginning of the year is retrieved.
7 | #' The API does not support finer distinctions. For more detailed information on the exact status of the data, please use
8 | #' \code{verbode = TRUE}.
9 | #' @param verbose if \code{TRUE}, the date from which the data originates is displayed.
10 | #' @param call_res result of a previous call to the geodata API. Optional argument.
11 | #'
12 | #' @return a simple feature collection of the desired spatial units with corresponding IDs.
13 | #'
14 | #' @importFrom httr content
15 | #' @importFrom sf st_read st_layers
16 | #' @importFrom dplyr rename mutate select
17 | #' @importFrom stringr str_detect
18 | #'
19 | #' @examples
20 | #'
21 | #' # Get latest geodata at municipal level
22 | #' get_geodata()
23 | #'
24 | #' # Get latest geodata at cantonal level
25 | #' get_geodata(geolevel = "canton")
26 | #'
27 | #' @export
28 | get_geodata <- function(geolevel = "municipality", latest = T, verbose = F, call_res) {
29 |
30 | # Check input
31 | check_geolevel(geolevel, available_geolevels = c("national", "canton", "district", "municipality", "zh_counting_districts", "lakes"))
32 |
33 | # Call geodata api
34 | if (missing(call_res)) call_res <- call_api_geodata()
35 |
36 | # Check if there is an error
37 | if (httr::http_error(call_res)){
38 |
39 | message("The API does not respond properly. Do you have an internet connection and an open proxy?")
40 |
41 | return(invisible(NULL))
42 |
43 | }
44 |
45 |
46 | # check_api_call_geo(call_res)
47 |
48 | # FIX in order that function fails gracefully
49 |
50 | # if(!is.null(call_res)){
51 |
52 | cnt <- httr::content(call_res)
53 | # } # Check
54 |
55 | resources <- get_vote_urls(geolevel = geolevel, call_res = call_res)
56 |
57 | # Get info and check whether resource metadata can be parsed properly
58 | if (latest & is.null(resources$download_url)==FALSE) {
59 |
60 |
61 | #### Fix retrieval of latest - via latest publication date
62 |
63 | max_issued_date <- max(as.Date(resources$pub_date))
64 |
65 | # Get URL
66 | urls <- get_vote_urls(geolevel = "national", call_res = call_res)
67 |
68 | # urls$download_url
69 |
70 | # test: broken link
71 | # gdUrl <- "https://www.bfs.admin.ch/bfsstatic/dam/assets/1812413211/master"
72 |
73 | gdUrl <- urls[urls[["pub_date"]] == max_issued_date,][["download_url"]]
74 |
75 | gdInfoLatest <- which(urls[["pub_date"]] == max_issued_date)
76 |
77 | gdInfo <- cnt[["result"]][["resources"]][[gdInfoLatest]][["title"]]
78 |
79 | # get layer names - if they are available
80 | gdLayers <- suppressWarnings(tryCatch(sf::st_layers(gdUrl)[1][["name"]],
81 | error = function(e) {gdLayers <- NULL}))
82 |
83 | # interrupt function (without error) if internet resource is unavailable
84 | if(is.null(gdLayers )){ return(invisible(NULL))}
85 |
86 |
87 | } else {
88 |
89 | if(is.null(resources$download_url)==TRUE & latest) message("Resource metadata cannot be parsed properly. Selection of the latest resource by order instead of latest date.")
90 |
91 | gdInfo <- cnt[["result"]][["resources"]][[1]][["title"]]
92 | gdUrl <- cnt[["result"]][["resources"]][[1]][["download_url"]]
93 | gdLayers <- sf::st_layers(gdUrl)[1][["name"]]
94 |
95 | }
96 |
97 | if (verbose) cat(paste0(gdInfo[!gdInfo == ""], collapse = "\n"), "\n\n")
98 |
99 | # Load geodata and join votes
100 | if (geolevel == "municipality") {
101 |
102 | # Load
103 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "voge_")], quiet = T)
104 |
105 | # Mutate if variable vogenr exists
106 | if ("vogeId" %in% names(gd)) {
107 |
108 | gd <- gd %>%
109 | dplyr::mutate(id = vogeId) %>%
110 | dplyr::select(-vogeId)
111 |
112 | }
113 |
114 | # Adjust variable mun_id
115 | gd <- gd %>%
116 | dplyr::rename(mun_id = id) %>%
117 | dplyr::mutate(mun_id = as.character(mun_id)) %>%
118 | dplyr::select(mun_id, geometry)
119 |
120 | }
121 | if (geolevel == "district") {
122 |
123 | # Load
124 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "bezk_")], quiet = T)
125 |
126 | # Mutate if variable vogenr exists
127 | if ("bezkId" %in% names(gd)) {
128 |
129 | gd <- gd %>%
130 | dplyr::mutate(id = bezkId) %>%
131 | dplyr::select(-bezkId)
132 |
133 | }
134 |
135 | # Adjust variable district_id
136 | gd <- gd %>%
137 | dplyr::rename(district_id = id) %>%
138 | dplyr::mutate(district_id = as.character(district_id)) %>%
139 | dplyr::select(district_id, geometry)
140 |
141 | }
142 | if (geolevel == "canton") {
143 |
144 | # Load
145 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "kant_")], quiet = T) %>%
146 | dplyr::rename(canton_id = kantId) %>%
147 | # dplyr::rename(canton_name = name) %>%
148 | dplyr::mutate(canton_id = as.character(canton_id)) %>%
149 | dplyr::select(canton_id, geometry)
150 |
151 | }
152 | if (geolevel == "zh_counting_districts") {
153 |
154 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "zaelhkreise_")], quiet = T) %>%
155 | dplyr::rename(mun_id = id) %>%
156 | # dplyr::rename(mun_name = name) %>%
157 | dplyr::mutate(mun_id = as.character(mun_id)) %>%
158 | dplyr::select(mun_id, geometry)
159 |
160 | }
161 | if (geolevel == "lakes") {
162 |
163 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "seen_")], quiet = T) %>%
164 | dplyr::select(id, geometry)
165 |
166 | }
167 | if (geolevel == "national") {
168 |
169 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "suis_")], quiet = T) %>%
170 | dplyr::select(id, geometry)
171 |
172 | }
173 |
174 | # Return
175 | return(gd)
176 |
177 | }
178 |
179 |
--------------------------------------------------------------------------------
/R/canton_json_to_dfr.R:
--------------------------------------------------------------------------------
1 | #' Transform a opendata.swiss cantonal results json into a tibble
2 | #'
3 | #' \code{canton_json_to_dfr} tranforms a single results json for a selected cantonal votedate into a tibble.
4 | #'
5 | #' @param votedate date of the ballot. Default: most recent ballot available.
6 | #' @param geolevel geographical level for which the results should be loaded. Options: "canton", "district" or "municipality".
7 | #' @param dataurl list of datasets / metadata for the given dataset and its resources OR url of the dcat dataset on opendata.swiss
8 | #' @param index selection by index of the resource (last published = 1).
9 | #' @param call_res result of a previous call to the base API. Optional argument.
10 | #'
11 | #' @importFrom httr add_headers GET http_error content
12 | #' @importFrom jsonlite fromJSON
13 | #' @importFrom tibble tibble
14 | #' @importFrom purrr map
15 | #' @importFrom dplyr "%>%" filter bind_rows rename left_join
16 | #' @importFrom tidyr unnest unpack
17 | #' @importFrom lubridate ymd
18 | #'
19 | #' @return a tibble containing the results
20 | #'
21 | #' @export
22 | #'
23 | #' @examples
24 | #'
25 | #' # Get and transform the json for the most recent vote
26 | #' results <- canton_json_to_dfr()
27 | #'
28 | #' # Get and transform the json for a single votedate at counting district level
29 | #' canton_json_to_dfr(votedate = "2020-02-09", geolevel = "zh_counting_districts")
30 | #'
31 | canton_json_to_dfr <- function(votedate = NULL, geolevel = "municipality", dataurl = NULL, index = NULL, call_res) {
32 |
33 | # Check inputs
34 | check_geolevel(geolevel, available_geolevels = c("canton", "district", "municipality", "zh_counting_districts"))
35 |
36 | # Get urls
37 | if (is.null(dataurl)) {
38 |
39 | # Call API if required
40 | if (missing(call_res)) call_res <- call_api_base(geolevel = "canton")
41 |
42 | # Handle votedate
43 | available_dates <- available_votedates(geolevel = "canton", call_res)
44 |
45 | # Fail gracefully if available votedates cannot be retrieved
46 | if(length(available_dates)<1){
47 |
48 | message("Available Votedates cannot be parsed. There might be a technical issue with the opendata.swiss API.")
49 |
50 | return(invisible(NULL))
51 |
52 | }
53 | #
54 |
55 | if (is.null(votedate)) votedate <- max(available_dates)
56 | votedate <- lubridate::ymd(votedate)
57 | check_votedate(votedate, available_dates)
58 |
59 | # Get URL
60 | urls <- get_vote_urls(geolevel = "canton", call_res = call_res)
61 | dataurl <- urls[urls[["date"]] == votedate,][["download_url"]]
62 |
63 | }
64 |
65 | # Index
66 | if (!is.null(index)) dataurl <- dataurl[index]
67 | if (length(dataurl) > 1) stop("This is not a vectorised function. Only one URL can be queried at a time.")
68 |
69 | # Fetch, check and extract vote data
70 | res <- httr::GET(dataurl, httr::add_headers(`User-Agent` = "Mozilla/5.0"))
71 | res_data <- check_api_call(res)
72 | # res_data <- suppressWarnings(jsonlite::fromJSON(httr::content(res, as = "text", encoding = "UTF-8")))
73 |
74 | if(!is.null(res_data)){
75 |
76 | # Simplification
77 | data_cantons <- res_data[["kantone"]]
78 |
79 | # Geolevel specific extraction
80 | if (geolevel == "canton") {
81 |
82 | ktdata2 <- tibble::tibble(
83 | canton_name = data_cantons[["geoLevelname"]],
84 | id = purrr::map(data_cantons[["vorlagen"]], 1),
85 | resultat = purrr::map(data_cantons[["vorlagen"]], "resultat")
86 | ) %>%
87 | tidyr::unnest(c(id, resultat))
88 |
89 | }
90 | if (!(geolevel == "canton")) {
91 |
92 | # Switch
93 | switch(
94 | geolevel,
95 | municipality = {geoindex <- "gemeinden"},
96 | zh_counting_districts = {geoindex <- "gemeinden"},
97 | district = {geoindex <- "bezirke"}
98 | )
99 |
100 | ## tibble with data
101 | ktdata <- tibble::tibble(
102 | id = purrr::map(data_cantons[["vorlagen"]], 1),
103 | canton_name = data_cantons[["geoLevelname"]],
104 | res = purrr::map(data_cantons[["vorlagen"]], geoindex)
105 | ) %>%
106 | tidyr::unnest(c(id, res)) %>%
107 | tidyr::unnest(res) %>%
108 | tidyr::unpack(resultat)
109 |
110 | # Zaehlkreisdaten einlesen (nur falls vorhanden)
111 | if (geolevel == "zh_counting_districts" & is.list(data_cantons$vorlagen[[1]]$zaehlkreise)) {
112 |
113 | zaehlkreise <- tibble::tibble(
114 | id = purrr::map(data_cantons[["vorlagen"]], 1),
115 | canton_name = data_cantons[["geoLevelname"]],
116 | res = purrr::map(data_cantons[["vorlagen"]], "zaehlkreise")
117 | ) %>%
118 | tidyr::unnest(c(id, res)) %>%
119 | tidyr::unnest(res) %>%
120 | tidyr::unpack(resultat)
121 |
122 | }
123 |
124 | }
125 | if (geolevel == "district") ktdata2 <- ktdata %>% dplyr::rename(district_id = geoLevelnummer, district_name = geoLevelname)
126 | if (geolevel %in% c("municipality","zh_counting_districts")) ktdata2 <- ktdata %>% dplyr::rename(mun_id = geoLevelnummer, mun_name = geoLevelname)
127 | if (geolevel == "zh_counting_districts" & is.list(data_cantons$vorlagen[[1]]$zaehlkreise)) {
128 |
129 | # remove winterthur and zurich as single municipalities
130 | ktdata2 <- ktdata2 %>%
131 | dplyr::filter(!mun_id %in% c(261,230)) %>%
132 | dplyr::bind_rows(zaehlkreise %>% dplyr::rename(mun_id = geoLevelnummer, mun_name = geoLevelname))
133 |
134 | }
135 |
136 | # vote names in all languages
137 | canton_vote_names <- tibble::tibble(
138 | id = purrr::map(data_cantons[["vorlagen"]], 1),
139 | yes = purrr::map(c(1:length(data_cantons[["vorlagen"]])), ~data_cantons[["vorlagen"]][[.x]]$vorlagenTitel)
140 | ) %>%
141 | # unnest lists with ids and the vote-names
142 | tidyr::unnest(c(id, yes)) %>%
143 | # unnest list with language versions
144 | tidyr::unnest(yes) %>%
145 | #spread to wide to join descriptions to data
146 | tidyr::spread(langKey, text)
147 |
148 | # join vote names to result
149 | ktdata3 <- ktdata2 %>% dplyr::left_join(canton_vote_names, by = "id")
150 |
151 | # Add votedate
152 | if (is.null(votedate)) {
153 |
154 | urls <- get_vote_urls(geolevel = "canton", call_res = call_res)
155 | votedate <- urls[urls[["download_url"]] == dataurl,][["date"]]
156 |
157 | }
158 | ktdata3$votedate <- lubridate::ymd(votedate)
159 |
160 | # Return
161 | return(ktdata3)
162 |
163 | }
164 | }
--------------------------------------------------------------------------------
/docs/articles/test.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 | test • swissdd
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
20 |
21 |
22 |
23 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
101 |
102 |
103 |
104 | library(swissdd)
105 | #> **************************************************************
106 | #> * swissdd 1.0.1 *
107 | #> * provided by politan.ch *
108 | #> * *
109 | #> * *
110 | #> * Data source: Federal Statistical Office *
111 | #> * https://www.bfs.admin.ch/ *
112 | #> * *
113 | #> **************************************************************
114 |
115 |
116 |
118 |
119 |
120 |
121 |
122 |
123 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
--------------------------------------------------------------------------------
/R/swiss_json_to_dfr.R:
--------------------------------------------------------------------------------
1 | #' Transform an opendata.swiss national results json into a tibble
2 | #'
3 | #' \code{swiss_json_to_dfr} transforms the json containing the results of a selected federal votedate into a tibble.
4 | #'
5 | #' @param votedate date of the ballot. Default: most recent ballot available. To select multiple ballots use the 'get_swissvotes'-function. Format = YYYYMMDD
6 | #' @param geolevel geographical level for which the results should be loaded. Options: "national", "canton", "district" or "municipality".
7 | #' @param dataurl url of the dataset on opendata.swiss
8 | #' @param index selection by index of the resource (last published = 1).
9 | #' @param language defines the language of the vote title. Options: "DE" for German, "FR" for French, "IT" for Italian or "RM" for Romansh.
10 | #' @param call_res result of a previous call to the base API. Optional argument.
11 | #'
12 | #' @importFrom httr add_headers GET http_error content
13 | #' @importFrom jsonlite fromJSON
14 | #' @importFrom tibble tibble
15 | #' @importFrom purrr map_chr map
16 | #' @importFrom dplyr "%>%" bind_cols rename filter bind_rows case_when
17 | #' @importFrom tidyr unnest unpack
18 | #' @importFrom lubridate ymd
19 | #'
20 | #' @return a tibble containing the results
21 | #'
22 | #' @export
23 | #'
24 | #' @examples
25 | #'
26 | #' # Transform the json of the most recent vote
27 | #' results <- swiss_json_to_dfr()
28 | #'
29 | #' # Transform the json of a selected votedate
30 | #' swiss_json_to_dfr(votedate = "2019-02-10")
31 | #'
32 | swiss_json_to_dfr <- function(votedate = NULL, geolevel = "municipality", dataurl = NULL, index = NULL, language = "DE", call_res) {
33 |
34 | # Check inputs
35 | check_geolevel(geolevel, available_geolevels = c("national", "canton", "district", "municipality", "zh_counting_districts"))
36 | check_language(language, available_languages = c("DE", "FR", "IT", "RM"))
37 |
38 | # Get URL if required
39 | if (is.null(dataurl)) {
40 |
41 | # Call API if required
42 | if (missing(call_res)) call_res <- call_api_base(geolevel = "national")
43 |
44 | # Handle votedate
45 | available_dates <- available_votedates(geolevel = "national", call_res)
46 | if (is.null(votedate)) votedate <- max(available_dates)
47 | votedate <- lubridate::ymd(votedate)
48 | check_votedate(votedate, available_dates)
49 |
50 | # Fail gracefully when available votedates cannot be parsed.
51 | if(length(available_dates)<1){
52 |
53 | message("Available Votedates cannot be parsed. There might be a technical issue with the opendata.swiss API.")
54 |
55 | return(invisible(NULL))
56 |
57 | }
58 |
59 | # Get URL
60 | urls <- get_vote_urls(geolevel = "national", call_res = call_res)
61 | dataurl <- urls[urls[["date"]] == votedate,][["download_url"]]
62 |
63 | }
64 |
65 | # Index
66 | if (!is.null(index)) dataurl <- dataurl[index]
67 | if (length(dataurl) > 1) stop("This is not a vectorised function. Only one URL can be queried at a time.")
68 |
69 | # Fetch, check and extract vote data
70 | res <- httr::GET(dataurl, httr::add_headers(`User-Agent` = "Mozilla/5.0"))
71 | res_data <- check_api_call(res)
72 | # res_data <- suppressWarnings(jsonlite::fromJSON(httr::content(res, as = "text", encoding = "UTF-8")))
73 |
74 | if(!is.null(res_data)){
75 |
76 | # Simplify data
77 | data_national <- res_data[["schweiz"]][["vorlagen"]]
78 | data_cantons <- res_data[["schweiz"]][["vorlagen"]][["kantone"]]
79 |
80 | # Language index
81 | lang_ind <- dplyr::case_when(
82 | language == "DE" ~ 1,
83 | language == "FR" ~ 2,
84 | language == "IT" ~ 3,
85 | language == "RM" ~ 4
86 | )
87 |
88 | # Geolevel specific extraction
89 | if (geolevel == "national") {
90 |
91 | findata <- tibble::tibble(
92 | id = data_national[["vorlagenId"]],
93 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind))
94 | ) %>%
95 | dplyr::bind_cols(data_national[["resultat"]])
96 |
97 | }
98 | if (geolevel == "canton") {
99 |
100 | findata <- tibble::tibble(
101 | canton_id = purrr::map(data_cantons, 1),
102 | canton_name = purrr::map(data_cantons, 2),
103 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
104 | id = data_national[["vorlagenId"]],
105 | res = purrr::map(data_cantons, 3)
106 | ) %>%
107 | tidyr::unnest(c(canton_id, canton_name, res))
108 |
109 | }
110 | if (geolevel == "district") {
111 |
112 | findata <- tibble::tibble(
113 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
114 | id = data_national[["vorlagenId"]],
115 | canton_id = purrr::map(data_cantons, 1),
116 | canton_name = purrr::map(data_cantons, 2),
117 | res = purrr::map(res_data[["schweiz"]][["vorlagen"]][["kantone"]], "bezirke")
118 | ) %>%
119 | tidyr::unnest(c(res, canton_id, canton_name)) %>%
120 | tidyr::unnest(res) %>%
121 | dplyr::rename(
122 | district_id = geoLevelnummer,
123 | district_name = geoLevelname
124 | ) %>%
125 | tidyr::unpack(resultat)
126 |
127 | }
128 | if (geolevel == "zh_counting_districts" & is.list(data_cantons[[1]]$zaehlkreise)) {
129 |
130 | zaehlkreise <- tibble::tibble(
131 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
132 | id = data_national[["vorlagenId"]],
133 | canton_id = "1",
134 | canton_name = data_cantons[[1]][["geoLevelname"]][[1]],
135 | res = purrr::map(data_cantons, "zaehlkreise")
136 | ) %>%
137 | tidyr::unnest(res) %>%
138 | tidyr::unnest(res) %>%
139 | tidyr::unpack(resultat) %>%
140 | dplyr::rename(
141 | mun_id = geoLevelnummer,
142 | mun_name = geoLevelname
143 | )
144 |
145 | }
146 | if (geolevel %in% c("municipality", "zh_counting_districts")){
147 |
148 | findata <- tibble::tibble(
149 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
150 | id = data_national[["vorlagenId"]],
151 | canton_id = purrr::map(data_cantons, 1),
152 | canton_name = purrr::map(data_cantons, 2),
153 | res = purrr::map(res_data[["schweiz"]][["vorlagen"]][["kantone"]], "gemeinden")
154 | ) %>%
155 | tidyr::unnest(c(res, canton_id, canton_name)) %>%
156 | tidyr::unnest(res) %>%
157 | tidyr::unpack(resultat) %>%
158 | dplyr::rename(
159 | mun_id = geoLevelnummer,
160 | mun_name = geoLevelname
161 | )
162 |
163 | # Add results for counting districts
164 | if(geolevel == "zh_counting_districts" & is.list(data_cantons[[1]]$zaehlkreise)){
165 |
166 | findata <- findata %>%
167 | dplyr::filter(!mun_id %in% c(261, 230)) %>%
168 | dplyr::bind_rows(zaehlkreise)
169 |
170 | }
171 |
172 |
173 | }
174 |
175 | # Add votedate
176 | if (is.null(votedate)) {
177 |
178 | urls <- get_vote_urls(geolevel = "national", call_res = call_res)
179 | votedate <- urls[urls[["download_url"]] == dataurl,][["date"]]
180 |
181 | }
182 | findata$votedate <- lubridate::ymd(votedate)
183 |
184 | # Return
185 | return(findata)
186 |
187 | }
188 |
189 | }
--------------------------------------------------------------------------------
/vignettes/predict_voteshare.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Predict vote shares"
3 | output: rmarkdown::html_vignette
4 | ---
5 |
6 | ```{r, include = FALSE}
7 | knitr::opts_chunk$set(
8 | collapse = TRUE,
9 | comment = "#>"
10 | )
11 | ```
12 |
13 | ## How to get Swissvotes Data
14 |
15 | First, you have to make sure that your machine is connected to the internet. The function `get_swissvotes` fetches all data stored within the swissvotes database. Swissvotes offers one of the most comprehensive data platforms in relation to Swiss referendums and initiatives.
16 |
17 | 
18 |
19 | # Predict vote outcomes with {width=120px} Data
20 |
21 | This blogpost shows how to perform a simple prediction of vote outcomes based on Swissvotes data in just a few steps.
22 |
23 | ## 1. Retrieve and prepare the data
24 |
25 | First, you have to make sure that your machine is connected to the internet. The function `get_swissvotes` fetches all data stored within the swissvotes database. Swissvotes offers one of the most comprehensive data platforms in relation to Swiss referendums and initiatives.
26 |
27 | ```{r echo=TRUE, warning=FALSE, message=FALSE}
28 |
29 | # installation from CRAN (stable)
30 | # install.packages("swissdd")
31 | # install.packages("dplyr")
32 |
33 | # installation from github (ongoing updates)
34 | # devtools::install_github("politanch/swissdd")
35 |
36 | library(swissdd)
37 | library(dplyr)
38 | library(ggplot2)
39 | ```
40 |
41 |
42 | By default, the function simply extracts the database provided by [Swissvotes](https://swissvotes.ch){target="_blank"}. However, you can specify that you want the codebook as well (or just the codebook for that matter). Additionally, there is a specification to save the citation. If you work with data from Swissvotes, please cite the data accordingly.
43 |
44 | We first extract the data and the select the variables we need to make predictions. For some reason we may believe that the National Council represents the people. Therefore, we hope to see a pattern between the final votes in the National Council and the actual yes shares on a voting day.
45 |
46 | We download and prettify the data. After that we calculate the share of yes votes in the National Council and create a scatterplot to inspect if our intuition about the relationship can be seen in the data.
47 |
48 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
49 |
50 | #extract data from database
51 | swissvotesdata <- get_swissvotes(DB=T, savecitation=F, codebook=F) %>%
52 | #select variables we need
53 | dplyr::select(anr, volkja.proz, nrja, nrnein) %>%
54 | #make numeric and rename variables
55 | mutate(nrja = as.numeric(nrja),
56 | nrnein = as.numeric(nrnein),
57 | volkja.proz= volkja.proz/100)%>%
58 | rename(bfsnr=anr,
59 | yesshare = volkja.proz)
60 |
61 | #clean data
62 | swissvotesdata[swissvotesdata=="."] <- NA
63 |
64 | #calculate share of yes votes in national council
65 | swissvotesdata <- swissvotesdata %>%
66 | mutate(nr_yesshare = nrja / (nrja+nrnein))
67 |
68 | ```
69 |
70 |
71 | By default, function extracts only the database provided by [Swissvotes](https://swissvotes.ch){target="_blank"}. However, you can specify that you want the codebook as well (or just the codebook for that matter). Additionally, there is a specification to save the citation. If you work with data from Swissvotes, please cite the data accordingly.
72 |
73 | First, we extract data from the database and select the variables we need to create our prediction. For some reason we might assume that the National Council represents the people. It this is the case, it should be reflected in a similar pattern in yes shares in the National Council and later on in the actual yes share of a popular vote.
74 |
75 | ## 2. Exploratory Analysis : is our assumption accurate?
76 |
77 | After downloading and preparing the data, we calculate the share of yes votes in the National Council and create a scatterplot to inspect if our intuition about the relationship can be seen in the data.
78 |
79 | ```{r echo=TRUE, warning=FALSE, message=FALSE}
80 |
81 | plot1 <- ggplot(data=swissvotesdata, aes(x=nr_yesshare, y= yesshare))+
82 | geom_hline(yintercept=.5, linetype="dashed", color="grey70")+
83 | geom_point()+
84 | geom_abline(intercept = 0, slope=1, size=.1)+
85 | scale_y_continuous(limits=c(0,1), labels=scales::percent)+
86 | scale_x_continuous(limits=c(0,1), labels=scales::percent)+
87 | geom_smooth(method="lm", se=T, size=.5, color="#FF6B00")+
88 | labs(y="Actual Outcome of Vote", x="Yes Share in National Council", caption="politan.ch")+
89 | theme_bw()
90 |
91 | plot1
92 | ```
93 |
94 | There seems to be a positive correlation (what a surprise!)... In a next step, we estimate a very basic model and then predict the vote shares for the two national votes on February 9th, 2020. In order to do so, we split the data into a training set and a prediction set.
95 |
96 | There seems to be a positive correlation (what a surprise!)...
97 |
98 | ## 3. Predict the results of the upcoming votes
99 |
100 | In the last step we estimate a very basic model and then predict the vote shares for the two national votes on February 9th, 2020. In order to do so, we split the data into a training set and a prediction set.
101 |
102 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
103 | #split data
104 | estimation_data <- swissvotesdata[!swissvotesdata$bfsnr%in%c(6290, 6300),]
105 | prediction_data <- swissvotesdata[swissvotesdata$bfsnr%in%c(6290, 6300),]
106 |
107 | #estimate a model
108 | fit_m1 <- lm(yesshare ~ nr_yesshare, data=estimation_data)
109 |
110 | #predict
111 | prediction <- predict(fit_m1, newdata = prediction_data, interval="predict") %>% as.data.frame
112 | prediction$bfsnr <- c(6290, 6300)
113 | ```
114 |
115 | We can now plot the predictions for the two ballots. Note, it is crucial to correctly report uncertainty, hence, we have to include the prediction interval as well.
116 |
117 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
118 |
119 | ggplot(prediction, aes(x=as.factor(bfsnr), y=fit, ymin=lwr, ymax=upr))+
120 | geom_pointrange(aes(color="#FF6B00"))+
121 | geom_text(aes(label=round(fit*100, 1)), nudge_x = 0.05)+
122 | scale_y_continuous(limits=c(0,1), labels=scales::percent)+
123 | scale_x_discrete(labels=c("Housing\nInitiative", "Law against\ndiscrimination"))+
124 | geom_hline(yintercept=.5, linetype="dashed", color="grey70")+
125 | labs(title="Simple Prediction of Vote-Shares", subtitle="February 9th, 2020", y="Predicted Yes-Share", x="", caption="politan.ch")+
126 | theme_bw()+
127 | theme(legend.position="none",
128 | axis.ticks.x = element_blank(),
129 | panel.grid.major.x = element_blank())
130 |
131 | #add the points to the previous plot
132 | prediction_data$yesshare[prediction_data$bfsnr==6290] <- prediction$fit[1]
133 | prediction_data$yesshare[prediction_data$bfsnr==6300] <- prediction$fit[2]
134 |
135 | prediction_data$lwr[prediction_data$bfsnr==6290] <- prediction$lwr[1]
136 | prediction_data$lwr[prediction_data$bfsnr==6300] <- prediction$lwr[2]
137 |
138 | prediction_data$upr[prediction_data$bfsnr==6290] <- prediction$upr[1]
139 | prediction_data$upr[prediction_data$bfsnr==6300] <- prediction$upr[2]
140 |
141 | plot1 + geom_point(data=prediction_data, aes(y=yesshare, x=nr_yesshare), color="#FF6B00", size=3)+
142 | geom_linerange(data=prediction_data,aes(ymin=lwr, ymax=upr), color="#FF6B00")
143 |
144 | ```
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
--------------------------------------------------------------------------------
/docs/authors.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Authors • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
60 |
61 |
62 |
63 |
64 |
70 |
71 |
72 |
73 |
74 |
180 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
--------------------------------------------------------------------------------
/docs/404.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Page not found (404) • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
60 |
61 |
62 |
63 |
64 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 | Page not found (404)
148 |
149 |
150 | Content not found. Please use links in the navbar.
151 |
152 |
153 |
154 |
159 |
160 |
161 |
162 |
163 |
164 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 |
185 |
--------------------------------------------------------------------------------
/docs/articles/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Articles • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
60 |
61 |
62 |
63 |
64 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 | Articles
148 |
149 |
150 |
151 | All vignettes
152 |
153 |
154 |
155 | - Find and plot correlated vote results
156 | -
157 |
- Plot vote shares
158 | -
159 |
- Predict vote shares
160 | -
161 |
- Retrieve Swissvotes-Data
162 | -
163 |
164 |
165 |
166 |
167 |
168 |
169 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
189 |
190 |
--------------------------------------------------------------------------------
/docs/pkgdown.css:
--------------------------------------------------------------------------------
1 | /* Sticky footer */
2 |
3 | /**
4 | * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/
5 | * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css
6 | *
7 | * .Site -> body > .container
8 | * .Site-content -> body > .container .row
9 | * .footer -> footer
10 | *
11 | * Key idea seems to be to ensure that .container and __all its parents__
12 | * have height set to 100%
13 | *
14 | */
15 |
16 | html, body {
17 | height: 100%;
18 | }
19 |
20 | body {
21 | position: relative;
22 | }
23 |
24 | body > .container {
25 | display: flex;
26 | height: 100%;
27 | flex-direction: column;
28 | }
29 |
30 | body > .container .row {
31 | flex: 1 0 auto;
32 | }
33 |
34 | footer {
35 | margin-top: 45px;
36 | padding: 35px 0 36px;
37 | border-top: 1px solid #e5e5e5;
38 | color: #666;
39 | display: flex;
40 | flex-shrink: 0;
41 | }
42 | footer p {
43 | margin-bottom: 0;
44 | }
45 | footer div {
46 | flex: 1;
47 | }
48 | footer .pkgdown {
49 | text-align: right;
50 | }
51 | footer p {
52 | margin-bottom: 0;
53 | }
54 |
55 | img.icon {
56 | float: right;
57 | }
58 |
59 | img {
60 | max-width: 100%;
61 | }
62 |
63 | /* Fix bug in bootstrap (only seen in firefox) */
64 | summary {
65 | display: list-item;
66 | }
67 |
68 | /* Typographic tweaking ---------------------------------*/
69 |
70 | .contents .page-header {
71 | margin-top: calc(-60px + 1em);
72 | }
73 |
74 | dd {
75 | margin-left: 3em;
76 | }
77 |
78 | /* Section anchors ---------------------------------*/
79 |
80 | a.anchor {
81 | margin-left: -30px;
82 | display:inline-block;
83 | width: 30px;
84 | height: 30px;
85 | visibility: hidden;
86 |
87 | background-image: url(./link.svg);
88 | background-repeat: no-repeat;
89 | background-size: 20px 20px;
90 | background-position: center center;
91 | }
92 |
93 | .hasAnchor:hover a.anchor {
94 | visibility: visible;
95 | }
96 |
97 | @media (max-width: 767px) {
98 | .hasAnchor:hover a.anchor {
99 | visibility: hidden;
100 | }
101 | }
102 |
103 |
104 | /* Fixes for fixed navbar --------------------------*/
105 |
106 | .contents h1, .contents h2, .contents h3, .contents h4 {
107 | padding-top: 60px;
108 | margin-top: -40px;
109 | }
110 |
111 | /* Navbar submenu --------------------------*/
112 |
113 | .dropdown-submenu {
114 | position: relative;
115 | }
116 |
117 | .dropdown-submenu>.dropdown-menu {
118 | top: 0;
119 | left: 100%;
120 | margin-top: -6px;
121 | margin-left: -1px;
122 | border-radius: 0 6px 6px 6px;
123 | }
124 |
125 | .dropdown-submenu:hover>.dropdown-menu {
126 | display: block;
127 | }
128 |
129 | .dropdown-submenu>a:after {
130 | display: block;
131 | content: " ";
132 | float: right;
133 | width: 0;
134 | height: 0;
135 | border-color: transparent;
136 | border-style: solid;
137 | border-width: 5px 0 5px 5px;
138 | border-left-color: #cccccc;
139 | margin-top: 5px;
140 | margin-right: -10px;
141 | }
142 |
143 | .dropdown-submenu:hover>a:after {
144 | border-left-color: #ffffff;
145 | }
146 |
147 | .dropdown-submenu.pull-left {
148 | float: none;
149 | }
150 |
151 | .dropdown-submenu.pull-left>.dropdown-menu {
152 | left: -100%;
153 | margin-left: 10px;
154 | border-radius: 6px 0 6px 6px;
155 | }
156 |
157 | /* Sidebar --------------------------*/
158 |
159 | #pkgdown-sidebar {
160 | margin-top: 30px;
161 | position: -webkit-sticky;
162 | position: sticky;
163 | top: 70px;
164 | }
165 |
166 | #pkgdown-sidebar h2 {
167 | font-size: 1.5em;
168 | margin-top: 1em;
169 | }
170 |
171 | #pkgdown-sidebar h2:first-child {
172 | margin-top: 0;
173 | }
174 |
175 | #pkgdown-sidebar .list-unstyled li {
176 | margin-bottom: 0.5em;
177 | }
178 |
179 | /* bootstrap-toc tweaks ------------------------------------------------------*/
180 |
181 | /* All levels of nav */
182 |
183 | nav[data-toggle='toc'] .nav > li > a {
184 | padding: 4px 20px 4px 6px;
185 | font-size: 1.5rem;
186 | font-weight: 400;
187 | color: inherit;
188 | }
189 |
190 | nav[data-toggle='toc'] .nav > li > a:hover,
191 | nav[data-toggle='toc'] .nav > li > a:focus {
192 | padding-left: 5px;
193 | color: inherit;
194 | border-left: 1px solid #878787;
195 | }
196 |
197 | nav[data-toggle='toc'] .nav > .active > a,
198 | nav[data-toggle='toc'] .nav > .active:hover > a,
199 | nav[data-toggle='toc'] .nav > .active:focus > a {
200 | padding-left: 5px;
201 | font-size: 1.5rem;
202 | font-weight: 400;
203 | color: inherit;
204 | border-left: 2px solid #878787;
205 | }
206 |
207 | /* Nav: second level (shown on .active) */
208 |
209 | nav[data-toggle='toc'] .nav .nav {
210 | display: none; /* Hide by default, but at >768px, show it */
211 | padding-bottom: 10px;
212 | }
213 |
214 | nav[data-toggle='toc'] .nav .nav > li > a {
215 | padding-left: 16px;
216 | font-size: 1.35rem;
217 | }
218 |
219 | nav[data-toggle='toc'] .nav .nav > li > a:hover,
220 | nav[data-toggle='toc'] .nav .nav > li > a:focus {
221 | padding-left: 15px;
222 | }
223 |
224 | nav[data-toggle='toc'] .nav .nav > .active > a,
225 | nav[data-toggle='toc'] .nav .nav > .active:hover > a,
226 | nav[data-toggle='toc'] .nav .nav > .active:focus > a {
227 | padding-left: 15px;
228 | font-weight: 500;
229 | font-size: 1.35rem;
230 | }
231 |
232 | /* orcid ------------------------------------------------------------------- */
233 |
234 | .orcid {
235 | font-size: 16px;
236 | color: #A6CE39;
237 | /* margins are required by official ORCID trademark and display guidelines */
238 | margin-left:4px;
239 | margin-right:4px;
240 | vertical-align: middle;
241 | }
242 |
243 | /* Reference index & topics ----------------------------------------------- */
244 |
245 | .ref-index th {font-weight: normal;}
246 |
247 | .ref-index td {vertical-align: top; min-width: 100px}
248 | .ref-index .icon {width: 40px;}
249 | .ref-index .alias {width: 40%;}
250 | .ref-index-icons .alias {width: calc(40% - 40px);}
251 | .ref-index .title {width: 60%;}
252 |
253 | .ref-arguments th {text-align: right; padding-right: 10px;}
254 | .ref-arguments th, .ref-arguments td {vertical-align: top; min-width: 100px}
255 | .ref-arguments .name {width: 20%;}
256 | .ref-arguments .desc {width: 80%;}
257 |
258 | /* Nice scrolling for wide elements --------------------------------------- */
259 |
260 | table {
261 | display: block;
262 | overflow: auto;
263 | }
264 |
265 | /* Syntax highlighting ---------------------------------------------------- */
266 |
267 | pre {
268 | word-wrap: normal;
269 | word-break: normal;
270 | border: 1px solid #eee;
271 | }
272 |
273 | pre, code {
274 | background-color: #f8f8f8;
275 | color: #333;
276 | }
277 |
278 | pre code {
279 | overflow: auto;
280 | word-wrap: normal;
281 | white-space: pre;
282 | }
283 |
284 | pre .img {
285 | margin: 5px 0;
286 | }
287 |
288 | pre .img img {
289 | background-color: #fff;
290 | display: block;
291 | height: auto;
292 | }
293 |
294 | code a, pre a {
295 | color: #375f84;
296 | }
297 |
298 | a.sourceLine:hover {
299 | text-decoration: none;
300 | }
301 |
302 | .fl {color: #1514b5;}
303 | .fu {color: #000000;} /* function */
304 | .ch,.st {color: #036a07;} /* string */
305 | .kw {color: #264D66;} /* keyword */
306 | .co {color: #888888;} /* comment */
307 |
308 | .message { color: black; font-weight: bolder;}
309 | .error { color: orange; font-weight: bolder;}
310 | .warning { color: #6A0366; font-weight: bolder;}
311 |
312 | /* Clipboard --------------------------*/
313 |
314 | .hasCopyButton {
315 | position: relative;
316 | }
317 |
318 | .btn-copy-ex {
319 | position: absolute;
320 | right: 0;
321 | top: 0;
322 | visibility: hidden;
323 | }
324 |
325 | .hasCopyButton:hover button.btn-copy-ex {
326 | visibility: visible;
327 | }
328 |
329 | /* headroom.js ------------------------ */
330 |
331 | .headroom {
332 | will-change: transform;
333 | transition: transform 200ms linear;
334 | }
335 | .headroom--pinned {
336 | transform: translateY(0%);
337 | }
338 | .headroom--unpinned {
339 | transform: translateY(-100%);
340 | }
341 |
342 | /* mark.js ----------------------------*/
343 |
344 | mark {
345 | background-color: rgba(255, 255, 51, 0.5);
346 | border-bottom: 2px solid rgba(255, 153, 51, 0.3);
347 | padding: 1px;
348 | }
349 |
350 | /* vertical spacing after htmlwidgets */
351 | .html-widget {
352 | margin-bottom: 10px;
353 | }
354 |
355 | /* fontawesome ------------------------ */
356 |
357 | .fab {
358 | font-family: "Font Awesome 5 Brands" !important;
359 | }
360 |
361 | /* don't display links in code chunks when printing */
362 | /* source: https://stackoverflow.com/a/10781533 */
363 | @media print {
364 | code a:link:after, code a:visited:after {
365 | content: "";
366 | }
367 | }
368 |
--------------------------------------------------------------------------------
/docs/reference/keys.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Merge data — keys • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
63 |
64 |
65 |
66 |
67 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
154 |
155 |
156 | Merge keys that allow to easily combine aggregate data from
157 | swissvotes with post-ballot surveys (VOX).
158 |
159 |
160 | data(keys)
161 |
162 |
163 | Format
164 |
165 | An object of class data.frame with 297 rows and 3 columns.
166 | Source
167 |
168 | Walder, Maxime ([Twitter](https://twitter.com/WalderMaxime))
169 |
170 | Examples
171 |
175 |
176 |
181 |
182 |
183 |
184 |
196 |
197 |
198 |
199 |
200 |
201 |
202 |
203 |
204 |
205 |
--------------------------------------------------------------------------------
`).
76 | getTopLevel: function($scope) {
77 | for (var i = 1; i <= 6; i++) {
78 | var $headings = this.findOrFilter($scope, 'h' + i);
79 | if ($headings.length > 1) {
80 | return i;
81 | }
82 | }
83 |
84 | return 1;
85 | },
86 |
87 | // returns the elements for the top level, and the next below it
88 | getHeadings: function($scope, topLevel) {
89 | var topSelector = 'h' + topLevel;
90 |
91 | var secondaryLevel = topLevel + 1;
92 | var secondarySelector = 'h' + secondaryLevel;
93 |
94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector);
95 | },
96 |
97 | getNavLevel: function(el) {
98 | return parseInt(el.tagName.charAt(1), 10);
99 | },
100 |
101 | populateNav: function($topContext, topLevel, $headings) {
102 | var $context = $topContext;
103 | var $prevNav;
104 |
105 | var helpers = this;
106 | $headings.each(function(i, el) {
107 | var $newNav = helpers.generateNavItem(el);
108 | var navLevel = helpers.getNavLevel(el);
109 |
110 | // determine the proper $context
111 | if (navLevel === topLevel) {
112 | // use top level
113 | $context = $topContext;
114 | } else if ($prevNav && $context === $topContext) {
115 | // create a new level of the tree and switch to it
116 | $context = helpers.createChildNavList($prevNav);
117 | } // else use the current $context
118 |
119 | $context.append($newNav);
120 |
121 | $prevNav = $newNav;
122 | });
123 | },
124 |
125 | parseOps: function(arg) {
126 | var opts;
127 | if (arg.jquery) {
128 | opts = {
129 | $nav: arg
130 | };
131 | } else {
132 | opts = arg;
133 | }
134 | opts.$scope = opts.$scope || $(document.body);
135 | return opts;
136 | }
137 | },
138 |
139 | // accepts a jQuery object, or an options object
140 | init: function(opts) {
141 | opts = this.helpers.parseOps(opts);
142 |
143 | // ensure that the data attribute is in place for styling
144 | opts.$nav.attr('data-toggle', 'toc');
145 |
146 | var $topContext = this.helpers.createChildNavList(opts.$nav);
147 | var topLevel = this.helpers.getTopLevel(opts.$scope);
148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel);
149 | this.helpers.populateNav($topContext, topLevel, $headings);
150 | }
151 | };
152 |
153 | $(function() {
154 | $('nav[data-toggle="toc"]').each(function(i, el) {
155 | var $nav = $(el);
156 | Toc.init($nav);
157 | });
158 | });
159 | })();
160 |
--------------------------------------------------------------------------------
/R/plot_nationalvotes.R:
--------------------------------------------------------------------------------
1 | #' Plot National Votes
2 | #'
3 | #' \code{plot_nationalvotes} plots the results of national votes in a choropleth map using ggplot2.
4 | #'
5 | #' @param votedate date of the ballot. Default: most recent ballot available.
6 | #' @param vote_id id of the vote. Default: first id mentioned in the data set.
7 | #' @param geolevel geographical level. Options: "canton", "district", "municipality" or "zh_counting_districts".
8 | #' @param measure measure to color the administrative units. Options: "result" for the yes vote share or "turnout"
9 | #' for the voter turnout of a given vote.
10 | #' @param standardize if \code{TRUE}, the scale of the measure ranges from 0 to 100 percent. Recommended for comparisons
11 | #' between votes.
12 | #' @param lakes if \code{TRUE}, the largest Swiss lakes are shown in color on the map.
13 | #' @param language defines the language. Options: "DE" for German, "FR" for French, "IT" for Italian or "RM" for Romansh.
14 | #' @param theme defines basic appearance of the map. Five options are available: "srf" for a theme inspired by the
15 | #' plots of Swiss Radio and Television, and "A" to "E" for the viridis color scales magma, inferno, plasma, viridis and cividis.
16 | #'
17 | #' @return a ggplot object
18 | #'
19 | #' @importFrom lubridate ymd
20 | #' @importFrom dplyr left_join rename bind_rows
21 | #' @importFrom tibble tibble
22 | #'
23 | #' @examples
24 | #'
25 | #' # Plot the most recent national vote
26 | #' \donttest{
27 | #' plot_nationalvotes()
28 | #' # Plot a specific national vote at cantonal level
29 | #' plot_nationalvotes(
30 | #' votedate = "2014-02-09",
31 | #' vote_id = 5800,
32 | #' geolevel = "canton"
33 | #' )
34 | #' }
35 | #' @export
36 | plot_nationalvotes <- function(votedate = NULL, vote_id = NULL, geolevel = "municipality", measure = "result",
37 | standardize = T, lakes = T, language = "DE", theme = "srf") {
38 |
39 | # Check inputs
40 | check_geolevel(geolevel, available_geolevels = c("canton", "district", "municipality", "zh_counting_districts"))
41 | check_measure(measure, available_measures = c("result", "turnout"))
42 | check_language(language, available_languages = c("DE", "FR", "IT", "RM"))
43 | check_theme(theme, available_themes = c("srf", "A", "B", "C", "D", "E"))
44 |
45 | # API calls
46 | call_res_base <- call_api_base()
47 | call_res_geodata <- call_api_geodata()
48 | available_dates <- available_votedates(geolevel = "national", call_res_base)
49 |
50 | # check status of api calls /available votedates and fail gracefully in case of errors
51 | if(httr::http_error(call_res_base)==FALSE &
52 | httr::http_error(call_res_geodata)==FALSE&
53 | is.null(available_dates)==FALSE& length(available_dates)>0) {
54 |
55 | # Handle votedate
56 | if (!is.null(votedate)) votedate <- lubridate::ymd(votedate)
57 | if (is.null(votedate)) votedate <- max(available_dates)
58 | check_votedate(votedate, available_dates)
59 |
60 | # Fetch vote data
61 | vote_data <- get_nationalvotes(geolevel = geolevel, votedates = votedate, language = language)
62 |
63 | # Subset vote data
64 | if (is.null(vote_id)) vote_id <- unique(vote_data[["id"]])[1]
65 | vote_data <- vote_data[vote_data[["id"]] == vote_id,]
66 | if (nrow(vote_data) == 0) stop ("No data found for the specified 'vote_id'")
67 | # warning if no results are available yet for the chosen vote id
68 | if (all(is.na(vote_data$jaStimmenInProzent))==TRUE) message("No results available yet for the specified 'vote_id'")
69 |
70 | #fetch geodata for the requested geolevel
71 | geodata <- get_geodata(geolevel = geolevel, call_res = call_res_geodata)
72 |
73 | # stop here and return an invisible null if geodata cannot be fetched
74 | if(is.null(geodata)) {return(invisible(NULL))}
75 |
76 | # Join geo with vote data
77 | if (geolevel == "municipality") {
78 |
79 | pd <- dplyr::left_join(
80 | geodata ,
81 | vote_data,
82 | by = "mun_id"
83 | )
84 |
85 | }
86 | if (geolevel == "district") {
87 |
88 | pd <- dplyr::left_join(
89 | geodata ,
90 | vote_data,
91 | by = "district_id"
92 | )
93 |
94 | }
95 | if (geolevel == "canton") {
96 |
97 | pd <- dplyr::left_join(
98 | geodata ,
99 | vote_data,
100 | by = "canton_id"
101 | )
102 |
103 | }
104 | if (geolevel == "zh_counting_districts") {
105 |
106 | pd <- dplyr::left_join(
107 | geodata ,
108 | vote_data,
109 | by = "mun_id"
110 | )
111 |
112 | }
113 |
114 | # Measure
115 | if (measure == "result") {
116 |
117 | pd <- pd %>% dplyr::rename(measure = jaStimmenInProzent)
118 | legend_title <- "jaStimmenInProzent"
119 |
120 | }
121 | if (measure == "turnout") {
122 |
123 | pd <- pd %>% dplyr::rename(measure = stimmbeteiligungInProzent)
124 | legend_title <- "stimmbeteiligungInProzent"
125 |
126 | }
127 |
128 | # Pseudo-standardization
129 | if (standardize) {
130 |
131 | pd2 <- tibble::tibble(
132 | id = vote_id,
133 | measure = c(0, 100)
134 | )
135 |
136 | pd <- pd %>% dplyr::bind_rows(pd2)
137 |
138 | }
139 |
140 | # Lakes
141 | lakes_data <- NULL
142 | if (lakes) lakes_data <- get_geodata(geolevel = "lakes", call_res = call_res_geodata)
143 | if (geolevel == "zh_counting_districts") lakes_data <- NULL
144 |
145 | # Base plot
146 | plot_map_national(pd, lakes = lakes_data, legend_title = legend_title, language = language, theme = theme)
147 | } else {
148 | message(paste("Data :",httr::http_status(call_res_base),
149 | "Geodata :",httr::http_status(call_res_geodata),
150 | "Votedates status:", !is.null(available_dates)
151 | ))
152 | }
153 |
154 | }
155 |
156 |
157 |
--------------------------------------------------------------------------------
/R/get_geodata.R:
--------------------------------------------------------------------------------
1 | #' Get Swiss Geodata
2 | #'
3 | #' \code{get_geodata} retrieves the latest geodata provided by the Federal Statistical Office in connection with federal votes.
4 | #'
5 | #' @param geolevel geographical level. Options: "national", "canton", "district", "municipality", "zh_counting_districts" or "lakes".
6 | #' @param latest if \code{TRUE}, the latest data is retrieved. If \code{FALSE}, geo data from the beginning of the year is retrieved.
7 | #' The API does not support finer distinctions. For more detailed information on the exact status of the data, please use
8 | #' \code{verbode = TRUE}.
9 | #' @param verbose if \code{TRUE}, the date from which the data originates is displayed.
10 | #' @param call_res result of a previous call to the geodata API. Optional argument.
11 | #'
12 | #' @return a simple feature collection of the desired spatial units with corresponding IDs.
13 | #'
14 | #' @importFrom httr content
15 | #' @importFrom sf st_read st_layers
16 | #' @importFrom dplyr rename mutate select
17 | #' @importFrom stringr str_detect
18 | #'
19 | #' @examples
20 | #'
21 | #' # Get latest geodata at municipal level
22 | #' get_geodata()
23 | #'
24 | #' # Get latest geodata at cantonal level
25 | #' get_geodata(geolevel = "canton")
26 | #'
27 | #' @export
28 | get_geodata <- function(geolevel = "municipality", latest = T, verbose = F, call_res) {
29 |
30 | # Check input
31 | check_geolevel(geolevel, available_geolevels = c("national", "canton", "district", "municipality", "zh_counting_districts", "lakes"))
32 |
33 | # Call geodata api
34 | if (missing(call_res)) call_res <- call_api_geodata()
35 |
36 | # Check if there is an error
37 | if (httr::http_error(call_res)){
38 |
39 | message("The API does not respond properly. Do you have an internet connection and an open proxy?")
40 |
41 | return(invisible(NULL))
42 |
43 | }
44 |
45 |
46 | # check_api_call_geo(call_res)
47 |
48 | # FIX in order that function fails gracefully
49 |
50 | # if(!is.null(call_res)){
51 |
52 | cnt <- httr::content(call_res)
53 | # } # Check
54 |
55 | resources <- get_vote_urls(geolevel = geolevel, call_res = call_res)
56 |
57 | # Get info and check whether resource metadata can be parsed properly
58 | if (latest & is.null(resources$download_url)==FALSE) {
59 |
60 |
61 | #### Fix retrieval of latest - via latest publication date
62 |
63 | max_issued_date <- max(as.Date(resources$pub_date))
64 |
65 | # Get URL
66 | urls <- get_vote_urls(geolevel = "national", call_res = call_res)
67 |
68 | # urls$download_url
69 |
70 | # test: broken link
71 | # gdUrl <- "https://www.bfs.admin.ch/bfsstatic/dam/assets/1812413211/master"
72 |
73 | gdUrl <- urls[urls[["pub_date"]] == max_issued_date,][["download_url"]]
74 |
75 | gdInfoLatest <- which(urls[["pub_date"]] == max_issued_date)
76 |
77 | gdInfo <- cnt[["result"]][["resources"]][[gdInfoLatest]][["title"]]
78 |
79 | # get layer names - if they are available
80 | gdLayers <- suppressWarnings(tryCatch(sf::st_layers(gdUrl)[1][["name"]],
81 | error = function(e) {gdLayers <- NULL}))
82 |
83 | # interrupt function (without error) if internet resource is unavailable
84 | if(is.null(gdLayers )){ return(invisible(NULL))}
85 |
86 |
87 | } else {
88 |
89 | if(is.null(resources$download_url)==TRUE & latest) message("Resource metadata cannot be parsed properly. Selection of the latest resource by order instead of latest date.")
90 |
91 | gdInfo <- cnt[["result"]][["resources"]][[1]][["title"]]
92 | gdUrl <- cnt[["result"]][["resources"]][[1]][["download_url"]]
93 | gdLayers <- sf::st_layers(gdUrl)[1][["name"]]
94 |
95 | }
96 |
97 | if (verbose) cat(paste0(gdInfo[!gdInfo == ""], collapse = "\n"), "\n\n")
98 |
99 | # Load geodata and join votes
100 | if (geolevel == "municipality") {
101 |
102 | # Load
103 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "voge_")], quiet = T)
104 |
105 | # Mutate if variable vogenr exists
106 | if ("vogeId" %in% names(gd)) {
107 |
108 | gd <- gd %>%
109 | dplyr::mutate(id = vogeId) %>%
110 | dplyr::select(-vogeId)
111 |
112 | }
113 |
114 | # Adjust variable mun_id
115 | gd <- gd %>%
116 | dplyr::rename(mun_id = id) %>%
117 | dplyr::mutate(mun_id = as.character(mun_id)) %>%
118 | dplyr::select(mun_id, geometry)
119 |
120 | }
121 | if (geolevel == "district") {
122 |
123 | # Load
124 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "bezk_")], quiet = T)
125 |
126 | # Mutate if variable vogenr exists
127 | if ("bezkId" %in% names(gd)) {
128 |
129 | gd <- gd %>%
130 | dplyr::mutate(id = bezkId) %>%
131 | dplyr::select(-bezkId)
132 |
133 | }
134 |
135 | # Adjust variable district_id
136 | gd <- gd %>%
137 | dplyr::rename(district_id = id) %>%
138 | dplyr::mutate(district_id = as.character(district_id)) %>%
139 | dplyr::select(district_id, geometry)
140 |
141 | }
142 | if (geolevel == "canton") {
143 |
144 | # Load
145 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "kant_")], quiet = T) %>%
146 | dplyr::rename(canton_id = kantId) %>%
147 | # dplyr::rename(canton_name = name) %>%
148 | dplyr::mutate(canton_id = as.character(canton_id)) %>%
149 | dplyr::select(canton_id, geometry)
150 |
151 | }
152 | if (geolevel == "zh_counting_districts") {
153 |
154 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "zaelhkreise_")], quiet = T) %>%
155 | dplyr::rename(mun_id = id) %>%
156 | # dplyr::rename(mun_name = name) %>%
157 | dplyr::mutate(mun_id = as.character(mun_id)) %>%
158 | dplyr::select(mun_id, geometry)
159 |
160 | }
161 | if (geolevel == "lakes") {
162 |
163 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "seen_")], quiet = T) %>%
164 | dplyr::select(id, geometry)
165 |
166 | }
167 | if (geolevel == "national") {
168 |
169 | gd <- sf::st_read(gdUrl, layer = gdLayers[stringr::str_detect(gdLayers, "suis_")], quiet = T) %>%
170 | dplyr::select(id, geometry)
171 |
172 | }
173 |
174 | # Return
175 | return(gd)
176 |
177 | }
178 |
179 |
--------------------------------------------------------------------------------
/R/canton_json_to_dfr.R:
--------------------------------------------------------------------------------
1 | #' Transform a opendata.swiss cantonal results json into a tibble
2 | #'
3 | #' \code{canton_json_to_dfr} tranforms a single results json for a selected cantonal votedate into a tibble.
4 | #'
5 | #' @param votedate date of the ballot. Default: most recent ballot available.
6 | #' @param geolevel geographical level for which the results should be loaded. Options: "canton", "district" or "municipality".
7 | #' @param dataurl list of datasets / metadata for the given dataset and its resources OR url of the dcat dataset on opendata.swiss
8 | #' @param index selection by index of the resource (last published = 1).
9 | #' @param call_res result of a previous call to the base API. Optional argument.
10 | #'
11 | #' @importFrom httr add_headers GET http_error content
12 | #' @importFrom jsonlite fromJSON
13 | #' @importFrom tibble tibble
14 | #' @importFrom purrr map
15 | #' @importFrom dplyr "%>%" filter bind_rows rename left_join
16 | #' @importFrom tidyr unnest unpack
17 | #' @importFrom lubridate ymd
18 | #'
19 | #' @return a tibble containing the results
20 | #'
21 | #' @export
22 | #'
23 | #' @examples
24 | #'
25 | #' # Get and transform the json for the most recent vote
26 | #' results <- canton_json_to_dfr()
27 | #'
28 | #' # Get and transform the json for a single votedate at counting district level
29 | #' canton_json_to_dfr(votedate = "2020-02-09", geolevel = "zh_counting_districts")
30 | #'
31 | canton_json_to_dfr <- function(votedate = NULL, geolevel = "municipality", dataurl = NULL, index = NULL, call_res) {
32 |
33 | # Check inputs
34 | check_geolevel(geolevel, available_geolevels = c("canton", "district", "municipality", "zh_counting_districts"))
35 |
36 | # Get urls
37 | if (is.null(dataurl)) {
38 |
39 | # Call API if required
40 | if (missing(call_res)) call_res <- call_api_base(geolevel = "canton")
41 |
42 | # Handle votedate
43 | available_dates <- available_votedates(geolevel = "canton", call_res)
44 |
45 | # Fail gracefully if available votedates cannot be retrieved
46 | if(length(available_dates)<1){
47 |
48 | message("Available Votedates cannot be parsed. There might be a technical issue with the opendata.swiss API.")
49 |
50 | return(invisible(NULL))
51 |
52 | }
53 | #
54 |
55 | if (is.null(votedate)) votedate <- max(available_dates)
56 | votedate <- lubridate::ymd(votedate)
57 | check_votedate(votedate, available_dates)
58 |
59 | # Get URL
60 | urls <- get_vote_urls(geolevel = "canton", call_res = call_res)
61 | dataurl <- urls[urls[["date"]] == votedate,][["download_url"]]
62 |
63 | }
64 |
65 | # Index
66 | if (!is.null(index)) dataurl <- dataurl[index]
67 | if (length(dataurl) > 1) stop("This is not a vectorised function. Only one URL can be queried at a time.")
68 |
69 | # Fetch, check and extract vote data
70 | res <- httr::GET(dataurl, httr::add_headers(`User-Agent` = "Mozilla/5.0"))
71 | res_data <- check_api_call(res)
72 | # res_data <- suppressWarnings(jsonlite::fromJSON(httr::content(res, as = "text", encoding = "UTF-8")))
73 |
74 | if(!is.null(res_data)){
75 |
76 | # Simplification
77 | data_cantons <- res_data[["kantone"]]
78 |
79 | # Geolevel specific extraction
80 | if (geolevel == "canton") {
81 |
82 | ktdata2 <- tibble::tibble(
83 | canton_name = data_cantons[["geoLevelname"]],
84 | id = purrr::map(data_cantons[["vorlagen"]], 1),
85 | resultat = purrr::map(data_cantons[["vorlagen"]], "resultat")
86 | ) %>%
87 | tidyr::unnest(c(id, resultat))
88 |
89 | }
90 | if (!(geolevel == "canton")) {
91 |
92 | # Switch
93 | switch(
94 | geolevel,
95 | municipality = {geoindex <- "gemeinden"},
96 | zh_counting_districts = {geoindex <- "gemeinden"},
97 | district = {geoindex <- "bezirke"}
98 | )
99 |
100 | ## tibble with data
101 | ktdata <- tibble::tibble(
102 | id = purrr::map(data_cantons[["vorlagen"]], 1),
103 | canton_name = data_cantons[["geoLevelname"]],
104 | res = purrr::map(data_cantons[["vorlagen"]], geoindex)
105 | ) %>%
106 | tidyr::unnest(c(id, res)) %>%
107 | tidyr::unnest(res) %>%
108 | tidyr::unpack(resultat)
109 |
110 | # Zaehlkreisdaten einlesen (nur falls vorhanden)
111 | if (geolevel == "zh_counting_districts" & is.list(data_cantons$vorlagen[[1]]$zaehlkreise)) {
112 |
113 | zaehlkreise <- tibble::tibble(
114 | id = purrr::map(data_cantons[["vorlagen"]], 1),
115 | canton_name = data_cantons[["geoLevelname"]],
116 | res = purrr::map(data_cantons[["vorlagen"]], "zaehlkreise")
117 | ) %>%
118 | tidyr::unnest(c(id, res)) %>%
119 | tidyr::unnest(res) %>%
120 | tidyr::unpack(resultat)
121 |
122 | }
123 |
124 | }
125 | if (geolevel == "district") ktdata2 <- ktdata %>% dplyr::rename(district_id = geoLevelnummer, district_name = geoLevelname)
126 | if (geolevel %in% c("municipality","zh_counting_districts")) ktdata2 <- ktdata %>% dplyr::rename(mun_id = geoLevelnummer, mun_name = geoLevelname)
127 | if (geolevel == "zh_counting_districts" & is.list(data_cantons$vorlagen[[1]]$zaehlkreise)) {
128 |
129 | # remove winterthur and zurich as single municipalities
130 | ktdata2 <- ktdata2 %>%
131 | dplyr::filter(!mun_id %in% c(261,230)) %>%
132 | dplyr::bind_rows(zaehlkreise %>% dplyr::rename(mun_id = geoLevelnummer, mun_name = geoLevelname))
133 |
134 | }
135 |
136 | # vote names in all languages
137 | canton_vote_names <- tibble::tibble(
138 | id = purrr::map(data_cantons[["vorlagen"]], 1),
139 | yes = purrr::map(c(1:length(data_cantons[["vorlagen"]])), ~data_cantons[["vorlagen"]][[.x]]$vorlagenTitel)
140 | ) %>%
141 | # unnest lists with ids and the vote-names
142 | tidyr::unnest(c(id, yes)) %>%
143 | # unnest list with language versions
144 | tidyr::unnest(yes) %>%
145 | #spread to wide to join descriptions to data
146 | tidyr::spread(langKey, text)
147 |
148 | # join vote names to result
149 | ktdata3 <- ktdata2 %>% dplyr::left_join(canton_vote_names, by = "id")
150 |
151 | # Add votedate
152 | if (is.null(votedate)) {
153 |
154 | urls <- get_vote_urls(geolevel = "canton", call_res = call_res)
155 | votedate <- urls[urls[["download_url"]] == dataurl,][["date"]]
156 |
157 | }
158 | ktdata3$votedate <- lubridate::ymd(votedate)
159 |
160 | # Return
161 | return(ktdata3)
162 |
163 | }
164 | }
--------------------------------------------------------------------------------
/docs/articles/test.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 | test • swissdd
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
20 |
21 |
22 |
23 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
101 |
102 |
103 |
104 | library(swissdd)
105 | #> **************************************************************
106 | #> * swissdd 1.0.1 *
107 | #> * provided by politan.ch *
108 | #> * *
109 | #> * *
110 | #> * Data source: Federal Statistical Office *
111 | #> * https://www.bfs.admin.ch/ *
112 | #> * *
113 | #> **************************************************************
114 |
115 |
116 |
118 |
119 |
120 |
121 |
122 |
123 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
--------------------------------------------------------------------------------
/R/swiss_json_to_dfr.R:
--------------------------------------------------------------------------------
1 | #' Transform an opendata.swiss national results json into a tibble
2 | #'
3 | #' \code{swiss_json_to_dfr} transforms the json containing the results of a selected federal votedate into a tibble.
4 | #'
5 | #' @param votedate date of the ballot. Default: most recent ballot available. To select multiple ballots use the 'get_swissvotes'-function. Format = YYYYMMDD
6 | #' @param geolevel geographical level for which the results should be loaded. Options: "national", "canton", "district" or "municipality".
7 | #' @param dataurl url of the dataset on opendata.swiss
8 | #' @param index selection by index of the resource (last published = 1).
9 | #' @param language defines the language of the vote title. Options: "DE" for German, "FR" for French, "IT" for Italian or "RM" for Romansh.
10 | #' @param call_res result of a previous call to the base API. Optional argument.
11 | #'
12 | #' @importFrom httr add_headers GET http_error content
13 | #' @importFrom jsonlite fromJSON
14 | #' @importFrom tibble tibble
15 | #' @importFrom purrr map_chr map
16 | #' @importFrom dplyr "%>%" bind_cols rename filter bind_rows case_when
17 | #' @importFrom tidyr unnest unpack
18 | #' @importFrom lubridate ymd
19 | #'
20 | #' @return a tibble containing the results
21 | #'
22 | #' @export
23 | #'
24 | #' @examples
25 | #'
26 | #' # Transform the json of the most recent vote
27 | #' results <- swiss_json_to_dfr()
28 | #'
29 | #' # Transform the json of a selected votedate
30 | #' swiss_json_to_dfr(votedate = "2019-02-10")
31 | #'
32 | swiss_json_to_dfr <- function(votedate = NULL, geolevel = "municipality", dataurl = NULL, index = NULL, language = "DE", call_res) {
33 |
34 | # Check inputs
35 | check_geolevel(geolevel, available_geolevels = c("national", "canton", "district", "municipality", "zh_counting_districts"))
36 | check_language(language, available_languages = c("DE", "FR", "IT", "RM"))
37 |
38 | # Get URL if required
39 | if (is.null(dataurl)) {
40 |
41 | # Call API if required
42 | if (missing(call_res)) call_res <- call_api_base(geolevel = "national")
43 |
44 | # Handle votedate
45 | available_dates <- available_votedates(geolevel = "national", call_res)
46 | if (is.null(votedate)) votedate <- max(available_dates)
47 | votedate <- lubridate::ymd(votedate)
48 | check_votedate(votedate, available_dates)
49 |
50 | # Fail gracefully when available votedates cannot be parsed.
51 | if(length(available_dates)<1){
52 |
53 | message("Available Votedates cannot be parsed. There might be a technical issue with the opendata.swiss API.")
54 |
55 | return(invisible(NULL))
56 |
57 | }
58 |
59 | # Get URL
60 | urls <- get_vote_urls(geolevel = "national", call_res = call_res)
61 | dataurl <- urls[urls[["date"]] == votedate,][["download_url"]]
62 |
63 | }
64 |
65 | # Index
66 | if (!is.null(index)) dataurl <- dataurl[index]
67 | if (length(dataurl) > 1) stop("This is not a vectorised function. Only one URL can be queried at a time.")
68 |
69 | # Fetch, check and extract vote data
70 | res <- httr::GET(dataurl, httr::add_headers(`User-Agent` = "Mozilla/5.0"))
71 | res_data <- check_api_call(res)
72 | # res_data <- suppressWarnings(jsonlite::fromJSON(httr::content(res, as = "text", encoding = "UTF-8")))
73 |
74 | if(!is.null(res_data)){
75 |
76 | # Simplify data
77 | data_national <- res_data[["schweiz"]][["vorlagen"]]
78 | data_cantons <- res_data[["schweiz"]][["vorlagen"]][["kantone"]]
79 |
80 | # Language index
81 | lang_ind <- dplyr::case_when(
82 | language == "DE" ~ 1,
83 | language == "FR" ~ 2,
84 | language == "IT" ~ 3,
85 | language == "RM" ~ 4
86 | )
87 |
88 | # Geolevel specific extraction
89 | if (geolevel == "national") {
90 |
91 | findata <- tibble::tibble(
92 | id = data_national[["vorlagenId"]],
93 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind))
94 | ) %>%
95 | dplyr::bind_cols(data_national[["resultat"]])
96 |
97 | }
98 | if (geolevel == "canton") {
99 |
100 | findata <- tibble::tibble(
101 | canton_id = purrr::map(data_cantons, 1),
102 | canton_name = purrr::map(data_cantons, 2),
103 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
104 | id = data_national[["vorlagenId"]],
105 | res = purrr::map(data_cantons, 3)
106 | ) %>%
107 | tidyr::unnest(c(canton_id, canton_name, res))
108 |
109 | }
110 | if (geolevel == "district") {
111 |
112 | findata <- tibble::tibble(
113 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
114 | id = data_national[["vorlagenId"]],
115 | canton_id = purrr::map(data_cantons, 1),
116 | canton_name = purrr::map(data_cantons, 2),
117 | res = purrr::map(res_data[["schweiz"]][["vorlagen"]][["kantone"]], "bezirke")
118 | ) %>%
119 | tidyr::unnest(c(res, canton_id, canton_name)) %>%
120 | tidyr::unnest(res) %>%
121 | dplyr::rename(
122 | district_id = geoLevelnummer,
123 | district_name = geoLevelname
124 | ) %>%
125 | tidyr::unpack(resultat)
126 |
127 | }
128 | if (geolevel == "zh_counting_districts" & is.list(data_cantons[[1]]$zaehlkreise)) {
129 |
130 | zaehlkreise <- tibble::tibble(
131 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
132 | id = data_national[["vorlagenId"]],
133 | canton_id = "1",
134 | canton_name = data_cantons[[1]][["geoLevelname"]][[1]],
135 | res = purrr::map(data_cantons, "zaehlkreise")
136 | ) %>%
137 | tidyr::unnest(res) %>%
138 | tidyr::unnest(res) %>%
139 | tidyr::unpack(resultat) %>%
140 | dplyr::rename(
141 | mun_id = geoLevelnummer,
142 | mun_name = geoLevelname
143 | )
144 |
145 | }
146 | if (geolevel %in% c("municipality", "zh_counting_districts")){
147 |
148 | findata <- tibble::tibble(
149 | name = purrr::map_chr(data_national[["vorlagenTitel"]], c(2, lang_ind)),
150 | id = data_national[["vorlagenId"]],
151 | canton_id = purrr::map(data_cantons, 1),
152 | canton_name = purrr::map(data_cantons, 2),
153 | res = purrr::map(res_data[["schweiz"]][["vorlagen"]][["kantone"]], "gemeinden")
154 | ) %>%
155 | tidyr::unnest(c(res, canton_id, canton_name)) %>%
156 | tidyr::unnest(res) %>%
157 | tidyr::unpack(resultat) %>%
158 | dplyr::rename(
159 | mun_id = geoLevelnummer,
160 | mun_name = geoLevelname
161 | )
162 |
163 | # Add results for counting districts
164 | if(geolevel == "zh_counting_districts" & is.list(data_cantons[[1]]$zaehlkreise)){
165 |
166 | findata <- findata %>%
167 | dplyr::filter(!mun_id %in% c(261, 230)) %>%
168 | dplyr::bind_rows(zaehlkreise)
169 |
170 | }
171 |
172 |
173 | }
174 |
175 | # Add votedate
176 | if (is.null(votedate)) {
177 |
178 | urls <- get_vote_urls(geolevel = "national", call_res = call_res)
179 | votedate <- urls[urls[["download_url"]] == dataurl,][["date"]]
180 |
181 | }
182 | findata$votedate <- lubridate::ymd(votedate)
183 |
184 | # Return
185 | return(findata)
186 |
187 | }
188 |
189 | }
--------------------------------------------------------------------------------
/vignettes/predict_voteshare.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "Predict vote shares"
3 | output: rmarkdown::html_vignette
4 | ---
5 |
6 | ```{r, include = FALSE}
7 | knitr::opts_chunk$set(
8 | collapse = TRUE,
9 | comment = "#>"
10 | )
11 | ```
12 |
13 | ## How to get Swissvotes Data
14 |
15 | First, you have to make sure that your machine is connected to the internet. The function `get_swissvotes` fetches all data stored within the swissvotes database. Swissvotes offers one of the most comprehensive data platforms in relation to Swiss referendums and initiatives.
16 |
17 | 
18 |
19 | # Predict vote outcomes with {width=120px} Data
20 |
21 | This blogpost shows how to perform a simple prediction of vote outcomes based on Swissvotes data in just a few steps.
22 |
23 | ## 1. Retrieve and prepare the data
24 |
25 | First, you have to make sure that your machine is connected to the internet. The function `get_swissvotes` fetches all data stored within the swissvotes database. Swissvotes offers one of the most comprehensive data platforms in relation to Swiss referendums and initiatives.
26 |
27 | ```{r echo=TRUE, warning=FALSE, message=FALSE}
28 |
29 | # installation from CRAN (stable)
30 | # install.packages("swissdd")
31 | # install.packages("dplyr")
32 |
33 | # installation from github (ongoing updates)
34 | # devtools::install_github("politanch/swissdd")
35 |
36 | library(swissdd)
37 | library(dplyr)
38 | library(ggplot2)
39 | ```
40 |
41 |
42 | By default, the function simply extracts the database provided by [Swissvotes](https://swissvotes.ch){target="_blank"}. However, you can specify that you want the codebook as well (or just the codebook for that matter). Additionally, there is a specification to save the citation. If you work with data from Swissvotes, please cite the data accordingly.
43 |
44 | We first extract the data and the select the variables we need to make predictions. For some reason we may believe that the National Council represents the people. Therefore, we hope to see a pattern between the final votes in the National Council and the actual yes shares on a voting day.
45 |
46 | We download and prettify the data. After that we calculate the share of yes votes in the National Council and create a scatterplot to inspect if our intuition about the relationship can be seen in the data.
47 |
48 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
49 |
50 | #extract data from database
51 | swissvotesdata <- get_swissvotes(DB=T, savecitation=F, codebook=F) %>%
52 | #select variables we need
53 | dplyr::select(anr, volkja.proz, nrja, nrnein) %>%
54 | #make numeric and rename variables
55 | mutate(nrja = as.numeric(nrja),
56 | nrnein = as.numeric(nrnein),
57 | volkja.proz= volkja.proz/100)%>%
58 | rename(bfsnr=anr,
59 | yesshare = volkja.proz)
60 |
61 | #clean data
62 | swissvotesdata[swissvotesdata=="."] <- NA
63 |
64 | #calculate share of yes votes in national council
65 | swissvotesdata <- swissvotesdata %>%
66 | mutate(nr_yesshare = nrja / (nrja+nrnein))
67 |
68 | ```
69 |
70 |
71 | By default, function extracts only the database provided by [Swissvotes](https://swissvotes.ch){target="_blank"}. However, you can specify that you want the codebook as well (or just the codebook for that matter). Additionally, there is a specification to save the citation. If you work with data from Swissvotes, please cite the data accordingly.
72 |
73 | First, we extract data from the database and select the variables we need to create our prediction. For some reason we might assume that the National Council represents the people. It this is the case, it should be reflected in a similar pattern in yes shares in the National Council and later on in the actual yes share of a popular vote.
74 |
75 | ## 2. Exploratory Analysis : is our assumption accurate?
76 |
77 | After downloading and preparing the data, we calculate the share of yes votes in the National Council and create a scatterplot to inspect if our intuition about the relationship can be seen in the data.
78 |
79 | ```{r echo=TRUE, warning=FALSE, message=FALSE}
80 |
81 | plot1 <- ggplot(data=swissvotesdata, aes(x=nr_yesshare, y= yesshare))+
82 | geom_hline(yintercept=.5, linetype="dashed", color="grey70")+
83 | geom_point()+
84 | geom_abline(intercept = 0, slope=1, size=.1)+
85 | scale_y_continuous(limits=c(0,1), labels=scales::percent)+
86 | scale_x_continuous(limits=c(0,1), labels=scales::percent)+
87 | geom_smooth(method="lm", se=T, size=.5, color="#FF6B00")+
88 | labs(y="Actual Outcome of Vote", x="Yes Share in National Council", caption="politan.ch")+
89 | theme_bw()
90 |
91 | plot1
92 | ```
93 |
94 | There seems to be a positive correlation (what a surprise!)... In a next step, we estimate a very basic model and then predict the vote shares for the two national votes on February 9th, 2020. In order to do so, we split the data into a training set and a prediction set.
95 |
96 | There seems to be a positive correlation (what a surprise!)...
97 |
98 | ## 3. Predict the results of the upcoming votes
99 |
100 | In the last step we estimate a very basic model and then predict the vote shares for the two national votes on February 9th, 2020. In order to do so, we split the data into a training set and a prediction set.
101 |
102 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
103 | #split data
104 | estimation_data <- swissvotesdata[!swissvotesdata$bfsnr%in%c(6290, 6300),]
105 | prediction_data <- swissvotesdata[swissvotesdata$bfsnr%in%c(6290, 6300),]
106 |
107 | #estimate a model
108 | fit_m1 <- lm(yesshare ~ nr_yesshare, data=estimation_data)
109 |
110 | #predict
111 | prediction <- predict(fit_m1, newdata = prediction_data, interval="predict") %>% as.data.frame
112 | prediction$bfsnr <- c(6290, 6300)
113 | ```
114 |
115 | We can now plot the predictions for the two ballots. Note, it is crucial to correctly report uncertainty, hence, we have to include the prediction interval as well.
116 |
117 | ```{r echo=TRUE, warning=FALSE, message=FALSE, eval=TRUE}
118 |
119 | ggplot(prediction, aes(x=as.factor(bfsnr), y=fit, ymin=lwr, ymax=upr))+
120 | geom_pointrange(aes(color="#FF6B00"))+
121 | geom_text(aes(label=round(fit*100, 1)), nudge_x = 0.05)+
122 | scale_y_continuous(limits=c(0,1), labels=scales::percent)+
123 | scale_x_discrete(labels=c("Housing\nInitiative", "Law against\ndiscrimination"))+
124 | geom_hline(yintercept=.5, linetype="dashed", color="grey70")+
125 | labs(title="Simple Prediction of Vote-Shares", subtitle="February 9th, 2020", y="Predicted Yes-Share", x="", caption="politan.ch")+
126 | theme_bw()+
127 | theme(legend.position="none",
128 | axis.ticks.x = element_blank(),
129 | panel.grid.major.x = element_blank())
130 |
131 | #add the points to the previous plot
132 | prediction_data$yesshare[prediction_data$bfsnr==6290] <- prediction$fit[1]
133 | prediction_data$yesshare[prediction_data$bfsnr==6300] <- prediction$fit[2]
134 |
135 | prediction_data$lwr[prediction_data$bfsnr==6290] <- prediction$lwr[1]
136 | prediction_data$lwr[prediction_data$bfsnr==6300] <- prediction$lwr[2]
137 |
138 | prediction_data$upr[prediction_data$bfsnr==6290] <- prediction$upr[1]
139 | prediction_data$upr[prediction_data$bfsnr==6300] <- prediction$upr[2]
140 |
141 | plot1 + geom_point(data=prediction_data, aes(y=yesshare, x=nr_yesshare), color="#FF6B00", size=3)+
142 | geom_linerange(data=prediction_data,aes(ymin=lwr, ymax=upr), color="#FF6B00")
143 |
144 | ```
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
--------------------------------------------------------------------------------
/docs/authors.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Authors • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
60 |
61 |
62 |
63 |
64 |
70 |
71 |
72 |
73 |
74 |
180 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
--------------------------------------------------------------------------------
/docs/404.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Page not found (404) • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
60 |
61 |
62 |
63 |
64 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 | Page not found (404)
148 |
149 |
150 | Content not found. Please use links in the navbar.
151 |
152 |
153 |
154 |
159 |
160 |
161 |
162 |
163 |
164 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 |
185 |
--------------------------------------------------------------------------------
/docs/articles/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Articles • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
60 |
61 |
62 |
63 |
64 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 | Articles
148 |
149 |
150 |
151 | All vignettes
152 |
153 |
154 |
155 | - Find and plot correlated vote results
156 | -
157 |
- Plot vote shares
158 | -
159 |
- Predict vote shares
160 | -
161 |
- Retrieve Swissvotes-Data
162 | -
163 |
164 |
165 |
166 |
167 |
168 |
169 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
189 |
190 |
--------------------------------------------------------------------------------
/docs/pkgdown.css:
--------------------------------------------------------------------------------
1 | /* Sticky footer */
2 |
3 | /**
4 | * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/
5 | * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css
6 | *
7 | * .Site -> body > .container
8 | * .Site-content -> body > .container .row
9 | * .footer -> footer
10 | *
11 | * Key idea seems to be to ensure that .container and __all its parents__
12 | * have height set to 100%
13 | *
14 | */
15 |
16 | html, body {
17 | height: 100%;
18 | }
19 |
20 | body {
21 | position: relative;
22 | }
23 |
24 | body > .container {
25 | display: flex;
26 | height: 100%;
27 | flex-direction: column;
28 | }
29 |
30 | body > .container .row {
31 | flex: 1 0 auto;
32 | }
33 |
34 | footer {
35 | margin-top: 45px;
36 | padding: 35px 0 36px;
37 | border-top: 1px solid #e5e5e5;
38 | color: #666;
39 | display: flex;
40 | flex-shrink: 0;
41 | }
42 | footer p {
43 | margin-bottom: 0;
44 | }
45 | footer div {
46 | flex: 1;
47 | }
48 | footer .pkgdown {
49 | text-align: right;
50 | }
51 | footer p {
52 | margin-bottom: 0;
53 | }
54 |
55 | img.icon {
56 | float: right;
57 | }
58 |
59 | img {
60 | max-width: 100%;
61 | }
62 |
63 | /* Fix bug in bootstrap (only seen in firefox) */
64 | summary {
65 | display: list-item;
66 | }
67 |
68 | /* Typographic tweaking ---------------------------------*/
69 |
70 | .contents .page-header {
71 | margin-top: calc(-60px + 1em);
72 | }
73 |
74 | dd {
75 | margin-left: 3em;
76 | }
77 |
78 | /* Section anchors ---------------------------------*/
79 |
80 | a.anchor {
81 | margin-left: -30px;
82 | display:inline-block;
83 | width: 30px;
84 | height: 30px;
85 | visibility: hidden;
86 |
87 | background-image: url(./link.svg);
88 | background-repeat: no-repeat;
89 | background-size: 20px 20px;
90 | background-position: center center;
91 | }
92 |
93 | .hasAnchor:hover a.anchor {
94 | visibility: visible;
95 | }
96 |
97 | @media (max-width: 767px) {
98 | .hasAnchor:hover a.anchor {
99 | visibility: hidden;
100 | }
101 | }
102 |
103 |
104 | /* Fixes for fixed navbar --------------------------*/
105 |
106 | .contents h1, .contents h2, .contents h3, .contents h4 {
107 | padding-top: 60px;
108 | margin-top: -40px;
109 | }
110 |
111 | /* Navbar submenu --------------------------*/
112 |
113 | .dropdown-submenu {
114 | position: relative;
115 | }
116 |
117 | .dropdown-submenu>.dropdown-menu {
118 | top: 0;
119 | left: 100%;
120 | margin-top: -6px;
121 | margin-left: -1px;
122 | border-radius: 0 6px 6px 6px;
123 | }
124 |
125 | .dropdown-submenu:hover>.dropdown-menu {
126 | display: block;
127 | }
128 |
129 | .dropdown-submenu>a:after {
130 | display: block;
131 | content: " ";
132 | float: right;
133 | width: 0;
134 | height: 0;
135 | border-color: transparent;
136 | border-style: solid;
137 | border-width: 5px 0 5px 5px;
138 | border-left-color: #cccccc;
139 | margin-top: 5px;
140 | margin-right: -10px;
141 | }
142 |
143 | .dropdown-submenu:hover>a:after {
144 | border-left-color: #ffffff;
145 | }
146 |
147 | .dropdown-submenu.pull-left {
148 | float: none;
149 | }
150 |
151 | .dropdown-submenu.pull-left>.dropdown-menu {
152 | left: -100%;
153 | margin-left: 10px;
154 | border-radius: 6px 0 6px 6px;
155 | }
156 |
157 | /* Sidebar --------------------------*/
158 |
159 | #pkgdown-sidebar {
160 | margin-top: 30px;
161 | position: -webkit-sticky;
162 | position: sticky;
163 | top: 70px;
164 | }
165 |
166 | #pkgdown-sidebar h2 {
167 | font-size: 1.5em;
168 | margin-top: 1em;
169 | }
170 |
171 | #pkgdown-sidebar h2:first-child {
172 | margin-top: 0;
173 | }
174 |
175 | #pkgdown-sidebar .list-unstyled li {
176 | margin-bottom: 0.5em;
177 | }
178 |
179 | /* bootstrap-toc tweaks ------------------------------------------------------*/
180 |
181 | /* All levels of nav */
182 |
183 | nav[data-toggle='toc'] .nav > li > a {
184 | padding: 4px 20px 4px 6px;
185 | font-size: 1.5rem;
186 | font-weight: 400;
187 | color: inherit;
188 | }
189 |
190 | nav[data-toggle='toc'] .nav > li > a:hover,
191 | nav[data-toggle='toc'] .nav > li > a:focus {
192 | padding-left: 5px;
193 | color: inherit;
194 | border-left: 1px solid #878787;
195 | }
196 |
197 | nav[data-toggle='toc'] .nav > .active > a,
198 | nav[data-toggle='toc'] .nav > .active:hover > a,
199 | nav[data-toggle='toc'] .nav > .active:focus > a {
200 | padding-left: 5px;
201 | font-size: 1.5rem;
202 | font-weight: 400;
203 | color: inherit;
204 | border-left: 2px solid #878787;
205 | }
206 |
207 | /* Nav: second level (shown on .active) */
208 |
209 | nav[data-toggle='toc'] .nav .nav {
210 | display: none; /* Hide by default, but at >768px, show it */
211 | padding-bottom: 10px;
212 | }
213 |
214 | nav[data-toggle='toc'] .nav .nav > li > a {
215 | padding-left: 16px;
216 | font-size: 1.35rem;
217 | }
218 |
219 | nav[data-toggle='toc'] .nav .nav > li > a:hover,
220 | nav[data-toggle='toc'] .nav .nav > li > a:focus {
221 | padding-left: 15px;
222 | }
223 |
224 | nav[data-toggle='toc'] .nav .nav > .active > a,
225 | nav[data-toggle='toc'] .nav .nav > .active:hover > a,
226 | nav[data-toggle='toc'] .nav .nav > .active:focus > a {
227 | padding-left: 15px;
228 | font-weight: 500;
229 | font-size: 1.35rem;
230 | }
231 |
232 | /* orcid ------------------------------------------------------------------- */
233 |
234 | .orcid {
235 | font-size: 16px;
236 | color: #A6CE39;
237 | /* margins are required by official ORCID trademark and display guidelines */
238 | margin-left:4px;
239 | margin-right:4px;
240 | vertical-align: middle;
241 | }
242 |
243 | /* Reference index & topics ----------------------------------------------- */
244 |
245 | .ref-index th {font-weight: normal;}
246 |
247 | .ref-index td {vertical-align: top; min-width: 100px}
248 | .ref-index .icon {width: 40px;}
249 | .ref-index .alias {width: 40%;}
250 | .ref-index-icons .alias {width: calc(40% - 40px);}
251 | .ref-index .title {width: 60%;}
252 |
253 | .ref-arguments th {text-align: right; padding-right: 10px;}
254 | .ref-arguments th, .ref-arguments td {vertical-align: top; min-width: 100px}
255 | .ref-arguments .name {width: 20%;}
256 | .ref-arguments .desc {width: 80%;}
257 |
258 | /* Nice scrolling for wide elements --------------------------------------- */
259 |
260 | table {
261 | display: block;
262 | overflow: auto;
263 | }
264 |
265 | /* Syntax highlighting ---------------------------------------------------- */
266 |
267 | pre {
268 | word-wrap: normal;
269 | word-break: normal;
270 | border: 1px solid #eee;
271 | }
272 |
273 | pre, code {
274 | background-color: #f8f8f8;
275 | color: #333;
276 | }
277 |
278 | pre code {
279 | overflow: auto;
280 | word-wrap: normal;
281 | white-space: pre;
282 | }
283 |
284 | pre .img {
285 | margin: 5px 0;
286 | }
287 |
288 | pre .img img {
289 | background-color: #fff;
290 | display: block;
291 | height: auto;
292 | }
293 |
294 | code a, pre a {
295 | color: #375f84;
296 | }
297 |
298 | a.sourceLine:hover {
299 | text-decoration: none;
300 | }
301 |
302 | .fl {color: #1514b5;}
303 | .fu {color: #000000;} /* function */
304 | .ch,.st {color: #036a07;} /* string */
305 | .kw {color: #264D66;} /* keyword */
306 | .co {color: #888888;} /* comment */
307 |
308 | .message { color: black; font-weight: bolder;}
309 | .error { color: orange; font-weight: bolder;}
310 | .warning { color: #6A0366; font-weight: bolder;}
311 |
312 | /* Clipboard --------------------------*/
313 |
314 | .hasCopyButton {
315 | position: relative;
316 | }
317 |
318 | .btn-copy-ex {
319 | position: absolute;
320 | right: 0;
321 | top: 0;
322 | visibility: hidden;
323 | }
324 |
325 | .hasCopyButton:hover button.btn-copy-ex {
326 | visibility: visible;
327 | }
328 |
329 | /* headroom.js ------------------------ */
330 |
331 | .headroom {
332 | will-change: transform;
333 | transition: transform 200ms linear;
334 | }
335 | .headroom--pinned {
336 | transform: translateY(0%);
337 | }
338 | .headroom--unpinned {
339 | transform: translateY(-100%);
340 | }
341 |
342 | /* mark.js ----------------------------*/
343 |
344 | mark {
345 | background-color: rgba(255, 255, 51, 0.5);
346 | border-bottom: 2px solid rgba(255, 153, 51, 0.3);
347 | padding: 1px;
348 | }
349 |
350 | /* vertical spacing after htmlwidgets */
351 | .html-widget {
352 | margin-bottom: 10px;
353 | }
354 |
355 | /* fontawesome ------------------------ */
356 |
357 | .fab {
358 | font-family: "Font Awesome 5 Brands" !important;
359 | }
360 |
361 | /* don't display links in code chunks when printing */
362 | /* source: https://stackoverflow.com/a/10781533 */
363 | @media print {
364 | code a:link:after, code a:visited:after {
365 | content: "";
366 | }
367 | }
368 |
--------------------------------------------------------------------------------
/docs/reference/keys.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Merge data — keys • swissdd
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
63 |
64 |
65 |
66 |
67 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
154 |
155 |
156 | Merge keys that allow to easily combine aggregate data from
157 | swissvotes with post-ballot surveys (VOX).
158 |
159 |
160 | data(keys)
161 |
162 |
163 | Format
164 |
165 | An object of class data.frame with 297 rows and 3 columns.
166 | Source
167 |
168 | Walder, Maxime ([Twitter](https://twitter.com/WalderMaxime))
169 |
170 | Examples
171 |
175 |
176 |
181 |
182 |
183 |
184 |
196 |
197 |
198 |
199 |
200 |
201 |
202 |
203 |
204 |
205 |
--------------------------------------------------------------------------------
92 |
120 |
121 |
122 |
123 |
132 |
93 |
101 |
102 |
103 |
104 |
114 |
115 |
116 |
118 |
119 | library(swissdd)
105 | #> **************************************************************
106 | #> * swissdd 1.0.1 *
107 | #> * provided by politan.ch *
108 | #> * *
109 | #> * *
110 | #> * Data source: Federal Statistical Office *
111 | #> * https://www.bfs.admin.ch/ *
112 | #> * *
113 | #> **************************************************************
145 |
161 |
162 |
163 |
164 |
176 |
146 |
153 |
154 |
159 |
160 |
147 |
149 |
150 | Content not found. Please use links in the navbar.
151 |
152 | Page not found (404)
148 |
145 |
167 |
168 |
169 |
181 |
146 |
166 |
147 |
149 |
150 | Articles
148 |
151 |
165 | All vignettes
152 | 153 | 154 |-
155 |
- Find and plot correlated vote results 156 |
- 157 |
- Plot vote shares 158 |
- 159 |
- Predict vote shares 160 |
- 161 |
- Retrieve Swissvotes-Data 162 |
- 163 |
148 |
182 |
183 |
184 |
196 |
149 |
154 |
155 |
176 |
181 |
156 |
159 |
160 | Merge keys that allow to easily combine aggregate data from 157 | swissvotes with post-ballot surveys (VOX).
158 |data(keys)161 | 162 | 163 |
Format
164 | 165 |An object of class data.frame with 297 rows and 3 columns.
Source
167 | 168 |Walder, Maxime ([Twitter](https://twitter.com/WalderMaxime))
169 | 170 |Examples
171 |175 |