Bundestagswahl 2021 Wahlkreise: Ergebnisse und Strukturdaten

app.R

library(shiny)
library(tidyverse)

if(!require(plotly)){
    install.packages("plotly")
}
if(!require(viridis)){
    install.packages("viridis")
}

df <- read_csv("data/processed_data.csv", 
               col_types = cols(
                `Wahlkreis-Name` = col_character(),
                UMAP1 = col_double(),
                UMAP2 = col_double(),
                variable = col_character(),
                value = col_character()
              )) %>% 
    drop_na()
df_land <- df %>% 
    filter(variable == "Land")
df <- df %>% 
    filter(variable != "Land") %>% 
    mutate(value = as.numeric(value))

print(head(df))
print(head(df_land))

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Bundestagswahl 2021"),
    h4("Wahlergebnisse und Strukturdaten"),
    p("Daten via", a("www.bundeswahlleiter.de", href = "https://www.bundeswahlleiter.de")),
    p("App und Visualisierung von ",
      a("Kevin Leiss", href = "https://twitter.com/kl_print")),
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            p("Diese App erlaubt eine interaktive Erkundung der Wahlergebnisse (Zweitstimme) je Wahlkreis und zugehörige Strukturdaten."),
            p("Alle Plots sind interaktiv erkundbar. Beispielsweise lassen sich einzelne Bundesländer im unteren Plot durch Klicken ein- und ausschalten."),
            p("Die hier ausgewählten Variablen werden in den Grafiken auf der rechten Seite berücksichtigt."),
            p("Nutzt das Feld unten, um Parteien, oder Strukturdaten auszuwählen. Es ist möglich mehrere Variablen gleichzeitig auszuwählen und zu visualisieren.
              Einfach mit der Maus in den Textkasten klicken und Variablen durch Klick auswählen oder per Texteingabe suchen und mit Enter bestätigen."),
            selectInput("select_features",
                        label = "Variablen",
                        choices = sort(unique(df$variable)),
                        selected = c("SPD",
                                     "CxU",
                                     "GRÜNE",
                                     "FDP"),
                        multiple = TRUE), 
            sliderInput('umap_pointsize', 
                        label = 'Punktgröße',
                        min = .1, max = 2, value = 1),
            br(),
            h4("Bundesland je Wahlkreis"),
            plotlyOutput("bundesland_umap", 
                        height = "500px"),
            width = 5 
        ),

        # Show a plot of the generated distribution
        mainPanel(
           tabsetPanel(
               tabPanel(
                   title = "Visualisierung",
                   br(),
                   p(
                     strong('Farbskala: '),
                     "Alle gezeigten Werte sind zwischen 0 und 1 skaliert.
                     Dies soll für eine bessere Vergleichbarkeit sorgen.
                     Um die tatsächlichen Werte zu sehen, einfach die Maus über die Punkte halten.
                     Als Tooltip erscheint der Name des Wahlkreises und die jeweiligen Rohdaten."
                   ),
                   plotlyOutput("feature_umap",
                                height = "900px"),
                   br(),
                   br()
                ),
               tabPanel(
                   title = "Methodik",
                   br(),
                   p("Der in dieser App verwendete Scatterplot stellt ein sogenanntes",
                     a("UMAP Embedding", href = "https://github.com/lmcinnes/umap"), 
                     " dar.",
                     "Hierbei handelt es sich um eine nicht-lineare Projektion eines
                     hochdimensionalen Datensets auf wenige Dimensionen.
                     Ähnlich wie eine 2D Karte eine Projektion der 3D Erde darstellt.
                     Wie auch bei einer Karte kommt es zu verzerrungen und Abweichungen von
                     der Realität. Da wir Menschen aber nicht in der Lage sind
                     mehr als drei Dimensionen zu erfassen, sind Techniken wie UMAP
                     ein tolles Tool um einen Überblick über ein hochdimensionales Datenset
                     zu erhalten."),
                   br(),
                   p("Um die UMAP zu trainieren nutzte ich die offiziellen Wahlergebnisse
                     je Wahlkreis einer jeden Partei in Prozent (CDU und CSU sind als CxU zusammengefasst).
                     Somit ist deren aussehen einzig von den jeweiligen Wahlergebnissen abhängig.")
               )
                   
              ),
            width = 7
        ) 
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    output$bundesland_umap <- renderPlotly({
        ggplotly(
            df_land %>% 
                ggplot(aes(x = UMAP1,
                           y = UMAP2,
                           color = value,
                           text = paste0(`Wahlkreis-Name`, 
                                         " (",
                                         value,
                                         ")"))) + 
                geom_point(size = .75) +
                labs(
                    color = 'Bundesland'
                ),
            tooltip = "text"
        )
    })
    
    output$feature_umap <- renderPlotly({
        
        color_by <- input$select_features
        
        theme_set(theme_classic())
        tmp <- df %>% 
            filter(variable %in% color_by) %>% 
            group_by(variable) %>% 
            mutate(scaled_value = value - min(value, na.rm = TRUE)) %>% 
            mutate(scaled_value = scaled_value / max(scaled_value, na.rm=TRUE))
        
        plt <- tmp %>% 
            mutate(value = round(value, 2)) %>% 
            ggplot(aes(x = UMAP1,
                       y = UMAP2,
                       text = paste0(`Wahlkreis-Name`, ": ", value),
                       color = scaled_value)) +
            geom_point(size = input$umap_pointsize) +
            scale_color_gradientn(colors = viridis::viridis(100)) +
            facet_wrap(vars(variable), 
                       ncol = 2) +
            theme(legend.position = 'none')
        
        ggplotly(plt, tooltip = 'text')
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

preprocessing.R

library(tidyverse)
library(matrixStats)
library(plotly)

kerg <- read_csv2('https://www.bundeswahlleiter.de/bundestagswahlen/2021/ergebnisse/opendata/csv/kerg2.csv',
                  skip = 9) %>% 
  dplyr::rename(
    'Wahlkreis-Nr.' = Gebietsnummer,
    'Wahlkreis-Name' = Gebietsname
  ) %>% 
  mutate(`Wahlkreis-Nr.` = as.numeric(`Wahlkreis-Nr.`))

struk <- read_csv2('https://www.bundeswahlleiter.de/dam/jcr/b1d3fc4f-17eb-455f-a01c-a0bf32135c5d/btw21_strukturdaten.csv',
                comment = '#', skip = 8)


## Strukturdaten


## Wahlergebnisse

wahlkreis_ergebnisse <- kerg %>% 
  filter(Gebietsart == "Wahlkreis") %>% 
  filter(Gruppenart == "Partei") %>% 
  filter(Stimme == 2) %>% 
  mutate(Gruppenname = case_when(
    Gruppenname %in% c("CDU", "CSU") ~ "CxU",
    TRUE ~ Gruppenname
  )) %>% 
  group_by(Gruppenname, `Wahlkreis-Name`) %>% 
  summarise(Prozent = sum(Prozent)) %>% 
  select(`Wahlkreis-Name`, Gruppenname, Prozent) %>% 
  spread(Gruppenname, Prozent, fill = 0)

m_we <- wahlkreis_ergebnisse %>% 
  as.data.frame() %>% 
  column_to_rownames("Wahlkreis-Name") %>% 
  as.matrix()

m_we <- m_we[,colVars(m_we) > 0]

um <- uwot::umap(m_we, 
                 n_neighbors = 15, 
                 min_dist = .15,
                 metric = "cosine")

wahlkreis_ergebnisse$UMAP1 <- um[,1]
wahlkreis_ergebnisse$UMAP2 <- um[,2]

all_dat <- wahlkreis_ergebnisse %>% 
  left_join(struk) %>% 
  select( -`Fußnoten` ) %>% 
  gather('variable', 'value', 2:99, -c(UMAP1, UMAP2))

write_csv(all_dat, "data/processed_data.csv")