Skip to content
Snippets Groups Projects
Commit 9fa45f85 authored by untergeekDE's avatar untergeekDE
Browse files

V1.0 - getestet für Kassel

parent a8de679b
No related branches found
No related tags found
No related merge requests found
Showing
with 1304 additions and 495 deletions
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
# Session Data files # Session Data files
.RData .RData
.DS_Store
# User-specific files # User-specific files
.Ruserdata .Ruserdata
...@@ -37,3 +38,13 @@ vignettes/*.pdf ...@@ -37,3 +38,13 @@ vignettes/*.pdf
# R Environment Variables # R Environment Variables
.Renviron .Renviron
# This file
.gitignore
# Test and sample data
/testdaten/
/vorlagen/
/daten/
/png/
/R/Vorbereitung/
This diff is collapsed.
#' generiere_testdaten.R
#'
#' Macht aus den Templates für Ortsteil- und Wahllokal-Ergebnisse
#' jeweils eine Serie von fiktiven Livedaten, um das Befüllen der
#' Grafiken testen zu können.
#'
require(tidyr)
require(dplyr)
require(readr)
# Alles weg, was noch im Speicher rumliegt
rm(list=ls())
source("R/lies_aktuellen_stand.R")
#---- Funktion zum Testdaten-Löschen ----
lösche_testdaten <- function(){
q <- tolower(readline(prompt = "Testdaten löschen - sicher? "))
if (!(q %in% c("j","y","ja"))) { return() }
# Datenarchiv weg
if (file.exists("daten/fom_df.rds")){
file.remove("daten/fom_df.rds")
}
# Testdaten
testdaten_files <- list.files("testdaten", full.names=TRUE)
for (f in testdaten_files) {
# Grausam, I know.
if (str_detect(f,"ortsteile[0-9]+\\.csv") |
str_detect(f,"wahllokale[0-9]+\\.csv")) {
file.remove(f)
}
}
}
# Vorlagen laden
vorlage_wahllokale_df <- read_delim("testdaten/Open-Data-06412000-Buergerentscheid-zur-Abwahl-des-Oberbuergermeisters-der-Stadt-Frankfurt-am-Main_-Herrn-Peter-Feldmann-Stimmbezirk.csv",
delim = ";", escape_double = FALSE,
locale = locale(date_names = "de",
decimal_mark = ",",
grouping_mark = "."),
trim_ws = TRUE)
wahllokale_max <- sum(vorlage_wahllokale_df$`max-schnellmeldungen`)
# Konstanten für die Simulation - werden jeweils um bis zu +/-25% variiert
c_wahlberechtigt = 510000 / wahllokale_max # Gleich große Wahlbezirke
c_wahlbeteiligung = 0.3 # Wahlbeteiligung um 30%, wird im Lauf der "Wahl" erhöht (kleinere WL sind schneller ausgezählt)
c_wahlschein = 0.25 # 25% Briefwähler
c_nv = 0.05 # 0,5% wählen "spontan" und sind nicht verzeichnet (nv) im Wählerverzeichnis
c_ungültig = 0.01 # 1% Ungültige
c_nein = 0.15 # unter den gültigen: 85% Ja-Stimmen (Varianz also von ca 81-89%)
variiere <- function(x = 1) {
# Variiert den übergebenen Wert zufällig um -25% bis +25%:
# Zufallswerte zwischen 0,75 und 1,25 erstellen und multiplizieren
#
# Die Length-Funktion ist wichtig - sonst erstellt runif() nur einen
# Zufallswert, mit dem alle Werte von x multipliziert werden.
return(floor(x * (runif(length(x),0.75,1.25))))
}
i = 1
# Schleife für die Wahllokale: Solange noch nicht alle "ausgezählt" sind...
while(sum(vorlage_wahllokale_df$`anz-schnellmeldungen`) < wahllokale_max) {
# ...splitte das df in die gemeldeten (meldungen_anz == 1) und nicht gemeldeten Zeilen
tmp_gemeldet_df <- vorlage_wahllokale_df %>% filter(`anz-schnellmeldungen` == 1)
# Die Variable rand wird als Anteil von 20 Meldungen an debn noch offenen Wahllokale berechnet
rand <- 20 / (nrow(vorlage_wahllokale_df) - nrow(tmp_gemeldet_df))
tmp_sample_df <- vorlage_wahllokale_df %>%
filter(`anz-schnellmeldungen` == 0) %>%
# Bei den noch nicht ausgefüllten "Meldungen" mit einer Wahrscheinlichkeit
# von rand in die Gruppe sortieren, die neu "gemeldet" wird
mutate(sample = (runif(nrow(.)) < rand))
tmp_offen_df <- tmp_sample_df %>%
filter(sample == 0) %>%
# sample-Variable wieder raus
select(-sample)
tmp_neu_df <- tmp_sample_df %>%
filter(sample == 1) %>%
select(-sample) %>%
# Alle als gemeldet markieren
mutate(`anz-schnellmeldungen` = 1) %>%
# Und jetzt der Reihe nach (weil die Werte z.T. aufeinander aufbauen)
# Wahlberechtigte
mutate(A = floor(c_wahlberechtigt * runif(nrow(.),0.75,1.25))) %>%
# Wahlschein
mutate(A2 = floor(A * c_wahlschein * runif(nrow(.),0.75,1.25))) %>%
# Nicht verzeichnet
mutate(A3 = floor(A * c_nv * runif(nrow(.),0.75,1.25))) %>%
# Regulär Wahlberechtigte (ohne Wahlschein oder nv)
mutate(A1 = A - A2 - A3) %>%
# Abgegebene Stimmen
mutate(B = floor(A * c_wahlbeteiligung * runif(nrow(.),0.75,1.25))) %>%
# davon mit Wahlschein
mutate(B1 = floor(B * c_wahlschein * runif(nrow(.),0.75,1.25))) %>%
# davon ungültig
mutate(C = floor(B * c_ungültig * runif(nrow(.),0.75,1.25))) %>%
# gültig
mutate(D = B - C) %>%
# davon ja
mutate(D2 = floor(D * c_nein *runif(nrow(.),0.75,1.25))) %>%
mutate(D1 = D - D2)
# Kurze Statusmeldung
cat("Neu gemeldet:",nrow(tmp_neu_df),"noch offen:",nrow(tmp_offen_df))
# Phew. Aktualisierte Testdatei zusammenführen und anlegen.
vorlage_wahllokale_df <- tmp_gemeldet_df %>%
bind_rows(tmp_neu_df) %>%
bind_rows(tmp_offen_df) %>%
# wieder in die Reihenfolge nach Wahllokal-Nummer
arrange(`gebiet-nr`)
write_csv2(vorlage_wahllokale_df,
paste0("testdaten/wahllokale",
sprintf("%02i",i),
".csv"),
escape = "backslash")
# Generiere die passende Ortsteil-Meldung
# Geht aus irgeneindem Grund nicht, aber wir brauchens ja auch nicht.
# ortsteile_df <- zuordnung_wahllokale_df %>%
# select(`gebiet-name` = name,ortsteilnr) %>%
# left_join(vorlage_wahllokale_df,by="gebiet-name") %>%
# # Zuordnung der Wahllokale
# group_by(ortsteilnr) %>%
# # Das crasht - WTF???
# summarize(across(7:18, ~ sum(.,na.rm = T))) %>%
# left_join(stadtteile_df %>% select(ortsteilnr = nr,name),by="ortsteilnr") %>%
# rename(`gebiet-nr` = ortsteilnr) %>%
# mutate(`gebiet-name` = name) %>%
# select(-ortsteilnr)
i <- i+1
# Wahlbeteiligung schrittweise ein wenig anheben - um zu simulieren,
# dass "kleinere" Wahllokale zuerst ausgezählt werden
c_wahlbeteiligung <- c_wahlbeteiligung + 0.002
}
# its_alive.R - Watchdog-Skript für update_all.R
#
# Wird per CRON-Job aufgerufen: Wenn das letzte Update der Log-Datei "wahl.log"
# länger als x Minuten zurückliegt, löst das Skript einen Alarm über Teams aus.
# Mehr als die Datumsfunktionen brauchen wir nicht
library(lubridate)
library(this.path)
# Das Projektverzeichnis "obwahl" als Arbeitsverzeichnis wählen
# Aktuelles Verzeichnis als workdir
setwd(this.path::this.dir())
# Aus dem R-Verzeichnis eine Ebene rauf
setwd("..")
# Teams-Funktionen einbinden
source("R/messaging.R")
# Maximales Alter in Sekunden?
max_alter = 120
# Startzeit festhalten
ts = now()
# Gibt es überhaupt eine Logdatei?
if (file.exists("obwahl.log")) {
metadaten <- file.info("obwahl.log")
# Berechne Alter der Logdatei in Sekunden
alter = as.integer(difftime(ts,metadaten$mtime,units="secs"))
if (alter > max_alter)
{
cat("WATCHDOG its_alive.R: obwahl.log seit ",alter," Sekunden unverändert")
cat("Benenne obwahl.log um in obwahl_crash.log")
file.rename("obwahl.log","obwahl_crash.log")
teams_error("PROGRAMM STEHEN GEBLIEBEN? obwahl.log ist seit ",alter," Sekunden unverändert")
}
} else {
# Tue nichts.
cat("its_alive.R: obwahl.log im Arbeitsverzeichnis",getwd(),"nicht gefunden")
}
# Library-Aufrufe kann man sich eigentlich sparen, aber...
library(readr) library(readr)
library(lubridate) library(lubridate)
library(tidyr) library(tidyr)
library(stringr) library(stringr)
library(dplyr) library(dplyr)
library(openxlsx)
library(curl)
# lies_aktuellen_stand.R # lies_aktuellen_stand.R
# #
# Enthält die Funktion zum Lesen der aktuellen Daten. # Enthält die Funktion zum Lesen der aktuellen Daten.
#---- Vorbereitung ---- #---- Hilfsfunktionen ----
# Statische Daten einlesen
# (das später durch ein schnelleres .rda ersetzen)
# Enthält drei Datensätze:
# - opendata_wahllokale_df mit der Liste aller Stimmwahlbezirke nach Wahllokal
# - statteile_df: Stadtteil mit Namen und laufender Nummer, Geokoordinaten, Ergebnissen 2018
# - zuordnung_stimmbezirke: Stimmbezirk-Nummer (als int und String) -> Stadtteilnr.
load ("index/index.rda")
# Konfiguration auslesen und in Variablen schreiben
config_df <- read_csv("index/config.csv")
for (i in c(1:nrow(config_df))) {
# Erzeuge neue Variablen mit den Namen und Werten aus der CSV
assign(config_df$name[i],
# Kann man den Wert auch als Zahl lesen?
# Fieses Regex sucht nach reiner Zahl oder Kommawerten.
# Keine Exponentialschreibweise!
ifelse(grepl("^[0-9]*\\.*[0-9]+$",config_df$value[i]),
# Ist eine Zahl - wandle um
as.numeric(config_df$value[i]),
# Keine Zahl - behalte den String
config_df$value[i]))
}
#---- Daten ins Archiv schreiben oder daraus lesen
archiviere <- function(df,a_directory = "daten/stimmbezirke") { archiviere <- function(df,a_directory = "daten/stimmbezirke") {
#' Schreibt das Dataframe mit den zuletzt geholten Stimmbezirks-Daten
#' als Sicherungskopie in das angegebene Verzeichnis
#'
if (!dir.exists(a_directory)) { if (!dir.exists(a_directory)) {
dir.create(a_directory) dir.create(a_directory)
} }
write_csv(df, fname = paste0(a_directory,"/",
paste0(a_directory,"/",
# Zeitstempel isolieren und alle Doppelpunkte # Zeitstempel isolieren und alle Doppelpunkte
# durch Bindestriche ersetzen # durch Bindestriche ersetzen
str_replace_all(df %>% pull(zeitstempel) %>% last(), str_replace_all(df %>% pull(zeitstempel) %>% last(),
"\\:","_"), "\\:","_"),
".csv")) ".csv")
write_csv(df,fname)
cat(as.character(now())," - Daten archiviert als ",paste0(a_directory,fname))
} }
hole_letztes_df <- function(a_directory = "daten/stimmbezirke") { hole_letztes_df <- function(a_directory = "daten/stimmbezirke") {
#' Schaut im angegebenen Verzeichnis nach der zuletzt angelegten Datei
#' und holt die Daten zurück in ein df
if (!dir.exists(a_directory)) return(tibble()) if (!dir.exists(a_directory)) return(tibble())
# Die zuletzt geschriebene Datei finden und einlesen
neuester_file <- list.files(a_directory, full.names=TRUE) %>% neuester_file <- list.files(a_directory, full.names=TRUE) %>%
file.info() %>% file.info() %>%
# Legt eine Spalte namens path an # Legt eine Spalte namens path an
...@@ -67,11 +51,56 @@ hole_letztes_df <- function(a_directory = "daten/stimmbezirke") { ...@@ -67,11 +51,56 @@ hole_letztes_df <- function(a_directory = "daten/stimmbezirke") {
} }
} }
# Sind die beiden df abgesehen vom Zeitstempel identisch?
# Funktion vergleicht die numerischen Werte - Spalte für Spalte.
vergleiche_stand <- function(alt_df, neu_df) {
#' Spaltenweiser Vergleich: Haben die Daten sich verändert?
#' (Anders gefragt: ist die Summe aller numerischen Spalten gleich?)
#' Wurde für die Feldmann-Wahl benötigt; bei OB-Wahlen eigentlich überflüssig
neu_sum_df <- alt_df %>% summarize_if(is.numeric,sum,na.rm=T)
alt_sum_df <- neu_df %>% summarize_if(is.numeric,sum,na.rm=T)
# Unterschiedliche Spaltenzahlen? Dann können sie keine von Finns Männern sein.
if (length(neu_sum_df) != length(alt_sum_df)) return(FALSE)
# Differenzen? Dann können sie keine von Finns Männern sein.
return(sum(abs(neu_sum_df - alt_sum_df))==0)
}
#--- CURL-Polling (experimentell!)
#
# Gibt das Änderungsdatum der Daten-Datei auf dem Wahlamtsserver zurück -
# wenn es sich verändert hat, ist das das Signal, neue Daten zu holen.
check_for_timestamp <- function(my_url) {
# Erst checken: Wirklich eine Internet-Verbindung?
# Sonst behandle als lokale Datei.
if(str_detect(my_url,"^http")) {
tmp <- curlGetHeaders(my_url, redirect = T, verify = F)
# Redirect
# if (stringr::str_detect(tmp[1]," 404")) {
# Library(curl)
h <- new_handle()
# Das funktioniert, holt aber alle Daten -> hohe Last
t <- curl_fetch_memory(my_url,handle=h)$modified %>%
as_datetime()
# } else {
# t <- tmp[stringr::str_detect(tmp,"last-modified")] %>%
# stringr::str_replace("last-modified: ","") %>%
# parse_date_time("%a, %d %m %Y %H:%M:%S",tz = "CET") + hours(1)
# }
} else { # lokale Datei
t = file.info(my_url)$mtime %>% as_datetime
}
return(t)
}
#---- Lese-Funktionen ---- #---- Lese-Funktionen ----
lies_gebiet <- function(stand_url = stimmbezirke_url) {
ts <- now() # Das hier ist die Haupt-Lese-Funktion
# Versuch Daten zu lesen - und gib ggf. Warnung oder Fehler zurück lies_stimmbezirke <- function(stand_url = stimmbezirke_url) {
#' Versuche, Daten vom Wahlamtsserver zu lesen - und gib ggf. Warnung oder Fehler zurück
#' Schreibt eine Meldung ins Logfile - zugleich ein Lesezeichen
cat(as.character(now())," - Neue Daten lesen\n") # Touch logfile
check = tryCatch( check = tryCatch(
{ stand_df <- read_delim(stand_url, { stand_df <- read_delim(stand_url,
delim = ";", escape_double = FALSE, delim = ";", escape_double = FALSE,
...@@ -81,6 +110,9 @@ lies_gebiet <- function(stand_url = stimmbezirke_url) { ...@@ -81,6 +110,9 @@ lies_gebiet <- function(stand_url = stimmbezirke_url) {
trim_ws = TRUE) %>% trim_ws = TRUE) %>%
# Spalten umbenennen, Zeitstempel-Spalte einfügen # Spalten umbenennen, Zeitstempel-Spalte einfügen
mutate(zeitstempel=ts) %>% mutate(zeitstempel=ts) %>%
# Sonderregel: wir haben einen Zeitstempel, die "datum"-Spalte macht
# Probleme, weil: starts_with("D").
select(-datum) %>%
select(zeitstempel, select(zeitstempel,
nr = `gebiet-nr`, nr = `gebiet-nr`,
name = `gebiet-name`, name = `gebiet-name`,
...@@ -96,57 +128,243 @@ lies_gebiet <- function(stand_url = stimmbezirke_url) { ...@@ -96,57 +128,243 @@ lies_gebiet <- function(stand_url = stimmbezirke_url) {
stimmen_wahlschein = B1, stimmen_wahlschein = B1,
ungueltig = C, ungueltig = C,
gueltig = D, gueltig = D,
ja = D1, # neu: alle Zeilen mit Stimmen (D1..Dn)
nein = D2) starts_with("D"))
}, },
warning = function(w) {teams_warning(w,title="Feldmann: Datenakquise")}, warning = function(w) {teams_warning(w,title="OB-Wahl: Datenakquise")},
error = function(e) {teams_warning(e,title="Feldmann: Datenakquise")}) error = function(e) {teams_warning(e,title="OB-Wahl: Datenakquise")})
# Spalten umbenennen,
return(stand_df) return(stand_df)
} }
aggregiere_stadtteildaten <- function(stimmbezirksdaten_df = stimmbezirksdaten_df) {
# Sind die beiden df abgesehen vom Zeitstempel identisch?
# Funktion vergleicht die numerischen Werte - Spalte für Spalte.
vergleiche_stand <- function(alt_df, neu_df) {
neu_sum_df <- alt_df %>% summarize_if(is.numeric,sum,na.rm=T)
alt_sum_df <- neu_df %>% summarize_if(is.numeric,sum,na.rm=T)
# Unterschiedliche Spaltenzahlen? Dann können sie keine von Finns Männern sein.
if (length(neu_sum_df) != length(alt_sum_df)) return(FALSE)
# Differenzen? Dann können sie keine von Finns Männern sein.
return(sum(abs(neu_sum_df - alt_sum_df))==0)
}
#' Liest Stimmbezirke, gibt nach Ortsteil aggregierte Daten zurück #' Liest Stimmbezirke, gibt nach Ortsteil aggregierte Daten zurück
#' (hier: kein Sicherheitscheck) #' (hier: kein Sicherheitscheck)
aggregiere_stadtteile <- function(stimmbezirke_df) { stadtteildaten_df <- stimmbezirksdaten_df %>%
ortsteile_df <- stimmbezirke_df %>% left_join(stimmbezirke_df %>% select(nr,ortsteilnr,stadtteil),
left_join(zuordnung_stimmbezirke_df,by=c("nr","name")) %>% by="nr") %>%
group_by(ortsteilnr) %>% group_by(ortsteilnr) %>%
# Fasse alle Spalten von meldungen_anz bis Ende der Tabelle zusammen -
# mit der sum()-Funktion (NA wird wie null behandelt)
summarize(zeitstempel = last(zeitstempel), summarize(zeitstempel = last(zeitstempel),
across(meldungen_anz:nein, ~ sum(.,na.rm = T))) %>% nr = first(ortsteilnr),
rename(nr = ortsteilnr) %>% meldungen_anz = sum(meldungen_anz,na.rm =T),
# Stadtteilnamen, 2018er Ergebnisse, Geokoordinaten dazuholen meldungen_max = sum(meldungen_max,na.rm = T),
wahlberechtigt = sum(wahlberechtigt, na.rm = T),
waehler_regulaer = sum(waehler_regulaer, na.rm = T),
waehler_wahlschein = sum(waehler_wahlschein, na.rm = T),
waehler_nv = sum(waehler_nv, na.rm = T),
stimmen = sum(stimmen, na.rm = T),
stimmen_wahlschein = sum(stimmen_wahlschein, na.rm = T),
ungueltig = sum(ungueltig, na.rm = T),
gueltig = sum(gueltig, na.rm = T),
across(starts_with("D"), ~ sum(.,na.rm = T))) %>%
mutate(across(where(is.numeric), ~ifelse(is.na(.), 0, .))) %>%
# Stadtteilnamen, Geokoordinaten dazuholen
left_join(stadtteile_df, by="nr") %>% left_join(stadtteile_df, by="nr") %>%
# Nach Ortsteil sortieren
arrange(nr) %>%
# Wichtige Daten für bessere Lesbarkeit nach vorn # Wichtige Daten für bessere Lesbarkeit nach vorn
relocate(zeitstempel,nr,name,lon,lat) relocate(zeitstempel,nr,name,lon,lat)
# Sicherheitscheck: Warnen, wenn nicht alle Ortsteile zugeordnet # Sicherheitscheck: Warnen, wenn nicht alle Ortsteile zugeordnet
if (nrow(ortsteile_df) != nrow(stadtteile_df)) teams_warnung("Nicht alle Ortsteile zugeordnet") if (nrow(stadtteildaten_df) != nrow(stadtteile_df)) teams_warnung("Nicht alle Stadtteile zugeordnet")
if (nrow(zuordnung_stimmbezirke_df) != length(unique(stimmbezirke_df$nr))) teams_warnung("Nicht alle Stimmbezirke zugeordnet") if (nrow(stimmbezirke_df) != length(unique(stimmbezirke_df$nr))) teams_warnung("Nicht alle Stimmbezirke zugeordnet")
return(ortsteile_df) cat("Stadtteildaten aggregiert.\n")
return(stadtteildaten_df)
}
#---- Die Tabellen für die DW-Grafiken ergänzen ----
berechne_ergänzt <- function(stadtteildaten_df = stadtteildaten_df, top = top) {
#' Ergänze die jeweils fünf führenden Kandidaten, ihre Prozentanteile ihre
#' Stimmen und ihre Farbwerte. Und benenne die D1...Dn-Spalten nach
#' Kandidat/in/Partei in der Form "Müller (ABC)" - gleichzeitig der Index für DW
#'
#' Gibt eine megalange Tabelle für Datawrapper zurück.
# Zuerst ein temporäres Langformat, bei dem jede/d Kand in jedem Stadtteil eine Zeile
# hat. Das brauchen wir 2x, um es wieder zusammenführen zu können.
tmp_long_df <- stadtteildaten_df %>%
pivot_longer(cols = starts_with("D"), names_to = "kand_nr", values_to = "kand_stimmen") %>%
mutate(kand_nr = as.integer(str_extract(kand_nr,"[0-9]+"))) %>%
# Ortsteil- bzw. Stimmbezirks-Gruppen, um dort nach Stimmen zu sortieren
group_by(nr,name) %>%
arrange(desc(kand_stimmen)) %>%
mutate(Platz = row_number()) %>%
left_join(kandidaten_df %>% select(kand_nr = Nummer,
kand_name = Name,
kand_partei = Parteikürzel,
farbe= Farbwert), by="kand_nr") %>%
mutate(kand = paste0(kand_name," (",kand_partei,")")) %>%
mutate(prozent = if_else(gueltig != 0,kand_stimmen / gueltig * 100, 0))
ergänzt_df <- tmp_long_df %>%
# Ist noch nach Stadtteil (name, nr) sortiert
arrange(kand_nr) %>%
# Alles weg, was verhindert, was individuell auf den Kand ist - außer
# kand und Prozentwert
select(-kand_stimmen, -kand_nr, -Platz, -kand_name, -kand_partei, -farbe) %>%
# Kandidatennamen in die Spalten zurückverteilen
pivot_wider(names_from = kand, values_from = prozent) %>%
ungroup() %>%
# und die zweite Hälfte dazu:
left_join(
tst <- tmp_long_df %>%
# Brauchen nur die Kand-Ergebnisse - und den (Stadtteil-)name
select(name, Platz, kand=kand_name,prozent,farbe) %>%
# Nur die ersten (top) Plätze
filter(Platz <= (top)) %>%
#The Big Pivot: Breite die ersten (top) aus.
pivot_wider(names_from = Platz,
values_from = c(kand,prozent,farbe),
names_glue = "{.value}{Platz}") %>%
ungroup() %>%
select(-nr),
by="name") %>%
# Sonderregelung: Wenn keine Stimmen, weise kand1-(top) NA zu (wg. Stadtteilen ohne Daten)
mutate(across(starts_with("kand"), ~ if_else(meldungen_anz > 0, .,""))) %>%
mutate(across(starts_with("farbe"), ~ if_else(meldungen_anz > 0, .,"#aaaaaa")))
cat("Ergänzte Stadtteildaten berechnet.\n")
return(ergänzt_df)
}
berechne_kand_tabelle <- function(stimmbezirksdaten_df = stimmbezirksdaten_df) {
# Nimmt die Stadtteildaten - oder auch die Wahllokale - und berechne daraus die
# Nummer, Kandidat(in) in der Form "Müller (XYZ)", Parteikürzel, Stimmen, Prozent
kand_tabelle_df <- stimmbezirksdaten_df %>%
summarize(gueltig = sum(gueltig, na.rm = T),
across(starts_with("D"), ~ sum(.,na.rm=TRUE))) %>%
pivot_longer(cols=starts_with("D"),names_to = "nr", values_to = "Stimmen") %>%
# Namen in Nr. umwandeln
mutate(Nummer = as.integer(str_extract(nr,"[0-9]+"))) %>%
left_join(kandidaten_df %>% select(Nummer, Name, Parteikürzel, Farbwert),
by="Nummer") %>%
mutate(name = paste0(Name," (",Parteikürzel,")")) %>%
mutate(Prozent = Stimmen / gueltig * 100) %>%
select(Nummer, `Kandidat/in` = name, Parteikürzel, Stimmen, Prozent)
cat("Gesamttabelle alle Kandidaten berechnet.\n")
return(kand_tabelle_df)
} }
lies_stadtteil_direkt <- function(stand_url = ortsteile_url) { berechne_hochburgen <- function(stadtteildaten_df = stadtteildaten_df) {
neu_df <- lies_gebiet(stand_url) %>% # Tabelle mit den drei stärksten und drei schwächsten Stadtteilen
# nr bei Ortsteil-Daten leer/ignorieren # im Vergleich zu GESAMT
select(!nr) %>% hochburgen_df <- stadtteildaten_df %>%
# Stadtteilnr., Geodaten und Feldmann-2018-Daten reinholen: select(name,gueltig,D1:ncol(.)) %>%
left_join(stadtteile_df, by=c("name")) %>% # Eine Zeile für Frankfurt dazu
mutate(trend = (meldungen_anz < meldungen_max), bind_rows(stadtteildaten_df %>%
quorum_erreicht = (ja >= (wahlberechtigt * 0.3))) select(name,gueltig,D1:ncol(.)) %>%
return(neu_df) summarize(gueltig = sum(gueltig, na.rm = T),
across(starts_with("D"), ~ sum(.,na.rm=TRUE))) %>%
mutate(name = "GESAMT")) %>%
# Ins Langformat umformen, Nummer ist die Kandidatennummer
pivot_longer(cols=starts_with("D"),names_to = "Nummer", values_to = "Stimmen") %>%
mutate(Prozent = if_else(Stimmen == 0,0,Stimmen / gueltig * 100)) %>%
# D1... in Integer umwandeln
mutate(Nummer = as.numeric(str_extract(Nummer,"[0-9]+"))) %>%
mutate(ist_gesamt = (name == "GESAMT")) %>%
# Wichtig: "Currently, group_by() internally orders in ascending order."
group_by(Nummer,ist_gesamt) %>%
arrange(desc(Prozent)) %>%
mutate(Platz = row_number()) %>%
filter(Platz <= 3 | Platz > (nrow(stadtteile_df) - 3)) %>%
mutate(Platz = if_else(ist_gesamt, as.integer(0),row_number())) %>%
ungroup(ist_gesamt) %>%
arrange(Platz) %>%
# Namen dazuholen
left_join(kandidaten_df %>% select (Nummer, Vorname, Name, Parteikürzel),
by = "Nummer") %>%
mutate(`Kandidat/in` = if_else(ist_gesamt,
paste0(Vorname," ",Name," (",Parteikürzel,")"),
"")) %>%
# sortieren
mutate(sort = 7* Nummer + Platz) %>%
ungroup() %>%
arrange(sort) %>%
select(Nummer, `Kandidat/in`, Stadtteil = name, Prozent)
cat("Hochburgen nach Kandidaten berechnet.\n")
return(hochburgen_df)
}
#---- Haupt-Funktion ----
#
#
hole_wahldaten <- function() {
# Hole und archiviere die Stimmbezirks-Daten;
# erzeuge ein df mit den Stimmen nach Stadtteil.
stimmbezirksdaten_df <<- lies_stimmbezirke(stimmbezirke_url)
gezaehlt <<- stimmbezirksdaten_df %>% pull(meldungen_anz) %>% sum(.)
archiviere(stimmbezirksdaten_df,paste0("daten/",wahl_name,"/"))
kand_tabelle_df <<- berechne_kand_tabelle(stimmbezirksdaten_df)
stadtteildaten_df <<- aggregiere_stadtteildaten(stimmbezirksdaten_df)
ergänzt_df <<- berechne_ergänzt(stadtteildaten_df,top)
hochburgen_df <<- berechne_hochburgen(stadtteildaten_df)
# Neue Daten: Die Stimmdaten-zeilen, die ausgezählt sind.
neue_daten <<- stimmbezirksdaten_df %>%
# Filtere auf alle gezählten Stimmbezirke
filter(meldungen_anz == 1) %>%
# Ziehe die ab, die schon in den alten Daten gezählt waren
anti_join(alte_daten %>%
filter(meldungen_anz == 1) %>%
select(name),
by="name")
alte_daten <<- stimmbezirksdaten_df
# Aktualisiere die Karten (bzw. warne, wenn keine neuen da.)
if (nrow(neue_daten)==0) {
# teams_warning("Neue Stimmbezirk-Daten, aber keine neuen Ortsdaten?",title=wahl_name)
cat("Frischer Zeitstempel, aber keine neu ausgezählten Stimmbezirke")
} }
check = tryCatch(
{ # Die Ergebnistabellen mit allen Stimmen/Top-Kandidaten und Ergebnistabelle.
aktualisiere_top(kand_tabelle_df,top)
aktualisiere_tabelle_alle(kand_tabelle_df)
},
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Grafiken A"))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": Grafiken A"))}
)
ergebnistabelle_df <<- aktualisiere_ergebnistabelle(stadtteildaten_df)
# Jetzt erst mal die Teams-Meldung absetzen.
meldung_s <- paste0(nrow(neue_daten),
" Stimmbezirke neu ausgezählt ",
"(insgesamt ",gezaehlt,
" von ",stimmbezirke_n,")<br>",
"<br><strong>DERZEITIGER STAND: GANZE STADT</strong><br>",
# Oberste Zeile der Ergebnistabelle ausgeben
ergebnistabelle_df %>% head(1) %>% pull(Wahlbeteiligung),
"<br>",
ergebnistabelle_df %>% head(1) %>% pull(Ergebnis))
# Neue Stadtteile? Dann
neue_stadtteile <- stadtteildaten_df %>%
# Ausgezählte Stadtteile ausfiltern
filter(meldungen_anz == meldungen_max) %>%
# ...und schauen, ob da ein neuer dabei ist
inner_join(neue_daten %>%
# Neu gezählte Stimmbezirks-Meldung um Stadtteile ergänzen
left_join(stimmbezirke_df, by="nr") %>%
select(name = stadtteil) %>% unique(),
by="name")
#
if(nrow(neue_stadtteile)>0) {
for (s in neue_stadtteile %>% pull(nr)) {
# Isoliere den Stadtteil, dessen Nummer wir gerade anschauen
stadtteil <- stadtteildaten_df %>% filter(nr == s)
meldung_s <- paste0(meldung_s,
"<br><br><strong>Ausgezählter Stadtteil: ",
stadtteil$name,
"</strong><br>",
ergebnistabelle_df %>% filter(nr == s) %>% pull(Wahlbeteiligung),
"<br>",
ergebnistabelle_df %>% filter(nr == s) %>% pull(Ergebnis))
}
# Stadtteil neu ausgezählt?
}
meldung_s <- paste0(meldung_s,"<br><br>",
generiere_socialmedia())
teams_meldung(meldung_s,title=wahl_name)
check = tryCatch(
{
aktualisiere_karten(ergänzt_df)
aktualisiere_hochburgen(hochburgen_df)
},
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Grafiken B"))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": Grafiken B"))}
)
}
\ No newline at end of file
#---- Vorbereitung ----
# Statische Daten einlesen
# (das später durch ein schnelleres .rda ersetzen)
# Enthält drei Datensätze:
# - opendata_wahllokale_df mit der Liste aller Stimmwahlbezirke nach Wahllokal
# - statteile_df: Stadtteil mit Namen und laufender Nummer, Geokoordinaten, Ergebnissen 2018
# - zuordnung_stimmbezirke: Stimmbezirk-Nummer (als int und String) -> Stadtteilnr.
# load ("index/index.rda")
# Konfiguration auslesen und in Variablen schreiben
#
# Generiert für jede Zeile die genannte Variable mit dem Wert value
#
# Derzeit erwartet das Programm:
# - wahl_name - Name der Wahl ("obwahl_ffm", "obwahl_kassel_stichwahl" etc.)
# - stimmbezirke_url - URL auf Ergebnisdaten
# - kandidaten_fname - Dateiname der Kandidierenden-Liste (s.u.)
# - datawrapper_fname - Dateiname für die Datawrapper-Verweis-Datei
# - stadtteile_fname
# - zuordnung_fname
# - startdatum - wann beginne ich zu arbeiten?
# - wahlberechtigt - Zahl der Wahlberechtigen (kommt Sonntag)
# - briefwahl - Zahl der Briefwahlstimmen (kommt Sonntag)
if (TEST) {
config_df <- read_csv("index/config_test.csv")
} else {
config_df <- read_csv("index/config.csv")
}
for (i in c(1:nrow(config_df))) {
# Erzeuge neue Variablen mit den Namen und Werten aus der CSV
assign(config_df$name[i],
# Kann man den Wert auch als Zahl lesen?
# Fieses Regex sucht nach reiner Zahl oder Kommawerten.
# Keine Exponentialschreibweise!
ifelse(grepl("^[0-9]*\\.*[0-9]+$",config_df$value[i]),
# Ist eine Zahl - wandle um
as.numeric(config_df$value[i]),
# Keine Zahl - behalte den String
config_df$value[i]))
}
lies_daten <- function(fname) {
if (toupper(str_extract(fname,"(?<=\\.)[A-zA-Z]+$")) %in% c("XLS","XLSX")) {
# Ist offensichtlich eine Excel-Datei. Lies das erste Sheet.
return(read.xlsx(fname))
} else {
# Geh von einer CSV-Datei aus.
first_line <- readLines(fname, n = 1)
commas <- str_split(first_line, ",") %>% unlist() %>% length()
semicolons <- str_split(first_line, ";") %>% unlist() %>% length()
if (commas > semicolons) {
return(read_csv(fname))
} else {
# Glaube an das Gute im Menschen: Erwarte UTF-8 und deutsche Kommasetzung.
return(read_csv2(fname,
locale = locale(
date_names = "de",
date_format = "%Y-%m-%d",
time_format = "%H:%M:%S",
decimal_mark = ",",
grouping_mark = ".",
encoding = "UTF-8",
asciify = FALSE
)))
}
}
}
# Stadtteilname und -nr; Geokoordinaten. Später: Ergebnisse
# der 2021er Kommunalwahl
stadtteile_df <- lies_daten(paste0("index/",wahl_name,"/",stadtteile_fname))
# Zuordnung Stimmbezirk (Wahllokale und Briefwahl-Bezirke) -> Stadtteil
stimmbezirke_df <- lies_daten(paste0("index/",wahl_name,"/",zuordnung_fname)) %>%
# Nummer-Spalten in numerische INdizes umwandeln
mutate(ortsteilnr = as.integer(ortsteilnr)) %>%
mutate(nr = as.integer(nr)) %>%
left_join(stadtteile_df %>% select(nr=1,stadtteil=2), by=c("ortsteilnr"="nr"))
# Kandidat:innen-Index
kandidaten_df <- lies_daten(paste0("index/",wahl_name,"/",kandidaten_fname))
# Läufst du auf dem Server?
SERVER <- dir.exists("/home/jan_eggers_hr_de")
R/main.R 0 → 100644
library(pacman)
# Laden und ggf. installieren
p_load(this.path)
p_load(readr)
p_load(lubridate)
p_load(tidyr)
p_load(stringr)
p_load(dplyr)
p_load(DatawRappr)
p_load(curl)
p_load(magick)
p_load(openxlsx)
p_load(R.utils)
rm(list=ls())
TEST = TRUE
DO_PREPARE_MAPS = TRUE
# Aktuelles Verzeichnis als workdir
setwd(this.path::this.dir())
# Aus dem R-Verzeichnis eine Ebene rauf
setwd("..")
# Logfile anlegen, wenn kein Test
if (!TEST) {
logfile = file("obwahl.log")
sink(logfile, append=T)
sink(logfile, append=T, type="message")
}
# Messaging-Funktionen einbinden
source("R/messaging.R")
# Hole die Konfiguration und die Index-Daten
check = tryCatch(
{
source("R/lies_konfiguration.R")
},
warning = function(w) {teams_warning(w,title="OBWAHL: Warnung beim Lesen der Konfigurationsdatei")},
error = function(e) {teams_error(e,title="OBWAHL: Konfigurationsdatei nicht gelesen!")})
# Funktionen einbinden
# Das könnte man auch alles hier in diese Datei schreiben, aber ist es übersichtlicher.
source("R/lies_aktuellen_stand.R")
source("R/aktualisiere_karten.R")
#---- MAIN ----
# Vorbereitung
gezaehlt <- 0 # Ausgezählte Stimmbezirke
ts <- as_datetime(startdatum) # ts, Zeitstempel, der letzten gelesenen Daten
stimmbezirke_n <- nrow(stimmbezirke_df) # Anzahl aller Stimmbezirke bei der Wahl
alte_daten <- lies_stimmbezirke(stimmbezirke_url) # Leere Stimmbezirke
# Grafiken einrichten: Farbwerte und Switcher für die Karten
# Richtet auch die globale Variable switcher ein, deshalb brauchen wir sie
if (DO_PREPARE_MAPS) {
check = tryCatch(
vorbereitung_alle_karten(),
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Vorbereitung"))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": Vorbereitung"))}
)
} else {
# Alle Datawrapper-IDs in einen Vektor extrahieren
id_df <- config_df %>%
filter(str_detect(name,"_kand[0-9]+")) %>%
mutate(Nummer = as.integer(str_extract(name,"[0-9]+"))) %>%
select(Nummer,dw_id = value)#
# Mach aus der Switcher-Tabelle eine globale Variable
# Nur die Globale switcher_df definieren (mit den IDs der DW-Karten zum Kandidaten/Farbwert)
switcher_df <- kandidaten_df %>%
select(Nummer, Vorname, Name, Parteikürzel, Farbwert) %>%
left_join(id_df, by="Nummer")
}
# Schleife.
# Arbeitet so lange, bis alle Wahlbezirke ausgezählt sind.
# Als erstes immer einmal durchlaufen lassen.
while (gezaehlt < stimmbezirke_n) {
check = tryCatch(
{ # Zeitstempel der Daten holen
ts_daten <- check_for_timestamp(stimmbezirke_url)
},
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": CURL-Polling"))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": CURL-Polling"))}
)
# Neuere Daten?
if (ts_daten > ts) {
ts <- ts_daten
hole_wahldaten()
} else {
# Logfile erneuern und 15 Sekunden schlafen
system("touch obwahl.log")
if (TEST) cat("Warte...\n")
Sys.sleep(15)
}
}
# Titel der Grafik "top" umswitchen
dw_edit_chart(top_id,title="Ergebnis: Wahlsieger")
dw_publish_chart(top_id)
# Logging beenden
if (!TEST) {
sink()
sink(type="message")
file.rename("obwahl.log","obwahl_success.log")
}
teams_meldung(wahl_name," erfolgreich abgeschlossen.")
# EOF
\ No newline at end of file
library(pacman)
# Laden und ggf. installieren
p_load(this.path)
p_load(readr)
p_load(lubridate)
p_load(tidyr)
p_load(stringr)
p_load(dplyr)
p_load(DatawRappr)
p_load(curl)
p_load(magick)
p_load(openxlsx)
rm(list=ls())
TEST = TRUE
DO_PREPARE_MAPS = FALSE
# Aktuelles Verzeichnis als workdir
setwd(this.path::this.dir())
# Aus dem R-Verzeichnis eine Ebene rauf
setwd("..")
# Logfile anlegen, wenn kein Test
# if (!TEST) {
# logfile = file("obwahl.log")
# sink(logfile, append=T)
# sink(logfile, append=T, type="message")
#
# }
# Messaging-Funktionen einbinden
source("R/messaging.R")
# Hole die Konfiguration und die Index-Daten
check = tryCatch(
{
source("R/lies_konfiguration.R")
},
warning = function(w) {teams_warning(w,title="OBWAHL: Warnung beim Lesen der Konfigurationsdatei")},
error = function(e) {teams_error(e,title="OBWAHL: Konfigurationsdatei nicht gelesen!")})
# Funktionen einbinden
# Das könnte man auch alles hier in diese Datei schreiben, aber ist es übersichtlicher.
source("R/lies_aktuellen_stand.R")
source("R/aktualisiere_karten.R")
#---- MAIN ----
# Vorbereitung
gezaehlt <- 0 # Ausgezählte Stimmbezirke
ts <- as_datetime(startdatum) # ts, Zeitstempel, der letzten gelesenen Daten
stimmbezirke_n <- nrow(stimmbezirke_df) # Anzahl aller Stimmbezirke bei der Wahl
alte_daten <- lies_stimmbezirke(stimmbezirke_url) # Leere Stimmbezirke
# Grafiken einrichten: Farbwerte und Switcher für die Karten
# Richtet auch die globale Variable switcher ein, deshalb brauchen wir sie
if (DO_PREPARE_MAPS) {
check = tryCatch(
vorbereitung_alle_karten(),
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Vorbereitung"))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": Vorbereitung"))}
)
} else {
# Alle Datawrapper-IDs in einen Vektor extrahieren
id_df <- config_df %>%
filter(str_detect(name,"_kand[0-9]+")) %>%
mutate(Nummer = as.integer(str_extract(name,"[0-9]+"))) %>%
select(Nummer,dw_id = value)#
# Mach aus der Switcher-Tabelle eine globale Variable
# Nur die Globale switcher_df definieren (mit den IDs der DW-Karten zum Kandidaten/Farbwert)
switcher_df <- kandidaten_df %>%
select(Nummer, Vorname, Name, Parteikürzel, Farbwert) %>%
left_join(id_df, by="Nummer")
}
# One-shot.
check = tryCatch(
{ # Zeitstempel der Daten holen
ts_daten <- check_for_timestamp(stimmbezirke_url)
},
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": CURL-Polling"))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": CURL-Polling"))}
)
# Zeitstempel aktualisieren, Datenverarbeitung anstoßen
ts <- ts_daten
# Hole die neuen Daten
hole_wahldaten()
# EOF
\ No newline at end of file
...@@ -9,15 +9,18 @@ library(teamr) ...@@ -9,15 +9,18 @@ library(teamr)
#' #'
#' Kommunikation mit Teams #' Kommunikation mit Teams
#' #'
#' Webhook wird als URL im Environment gespeichert. Wenn nicht dort, dann #' Webhook wird als URL im Environment gespeichert. Wenn nicht dort, dann Datei im Nutzerverzeichnis ~/key/ einlesen.
#' MSG-Funktion schreibt alles in die Logdatei und auf den Bildschirm. (Vgl. Corona.)
# Webhook schon im Environment? # Webhook schon im Environment?
if (Sys.getenv("WEBHOOK_REFERENDUM") == "") { if (Sys.getenv("WEBHOOK_OBWAHL") == "") {
t_txt <- read_file("../key/webhook_referendum.key") t_txt <- read_file("~/key/webhook_obwahl.key")
Sys.setenv(WEBHOOK_REFERENDUM = t_txt) Sys.setenv(WEBHOOK_REFERENDUM = t_txt)
} }
teams_meldung <- function(...,title="Feldmann-Update") { teams_meldung <- function(...,title="OB-Wahl-Update") {
cc <- teamr::connector_card$new(hookurl = t_txt) cc <- teamr::connector_card$new(hookurl = t_txt)
cc$title(paste0(title," - ",lubridate::with_tz(lubridate::now(), cc$title(paste0(title," - ",lubridate::with_tz(lubridate::now(),
"Europe/Berlin"))) "Europe/Berlin")))
...@@ -29,13 +32,13 @@ teams_meldung <- function(...,title="Feldmann-Update") { ...@@ -29,13 +32,13 @@ teams_meldung <- function(...,title="Feldmann-Update") {
teams_error <- function(...) { teams_error <- function(...) {
alert_str <- paste0(...) alert_str <- paste0(...)
teams_meldung(title="Feldmann: FEHLER: ", ...) teams_meldung(title="OB-Wahl: FEHLER: ", ...)
stop(alert_str) stop(alert_str)
} }
teams_warning <- function(...) { teams_warning <- function(...) {
alert_str <- paste0(...) alert_str <- paste0(...)
teams_meldung("Feldmann: WARNUNG: ",...) teams_meldung("OB-Wahl: WARNUNG: ",...)
warning(alert_str) warning(alert_str)
} }
library(pacman)
# Laden und ggf. installieren
p_load(this.path)
p_load(readr)
p_load(lubridate)
p_load(tidyr)
p_load(stringr)
p_load(dplyr)
p_load(DatawRappr)
rm(list=ls())
# Aktuelles Verzeichnis als workdir
setwd(this.path::this.dir())
# Aus dem R-Verzeichnis eine Ebene rauf
setwd("..")
source("R/messaging.R")
source("R/lies_aktuellen_stand.R")
source("R/aktualisiere_karten.R")
source("R/generiere_balken.R")
#----aktualisiere_fom() ----
# fom ist das "Feldmann-o-meter", die zentrale Grafik mit dem Stand der Auszählung.
aktualisiere_fom <- function(wl_url = stimmbezirke_url) {
# Einlesen: Feldmann-o-meter-Daten so far.
# Wenn die Daten noch nicht existieren, generiere ein leeres df.
if(file.exists("daten/fom_df.rds")) {
fom_df <- readRDS("daten/fom_df.rds")
} else {
# Leeres df mit einer Zeile
fom_df <- tibble(zeitstempel = as_datetime(startdatum),
meldungen_anz = 0,
meldungen_max = 575,
# Ergebniszellen
wahlberechtigt = 0,
# Mehr zum Wahlschein hier: https://www.bundeswahlleiter.de/service/glossar/w/wahlscheinvermerk.html
waehler_regulaer = 0,
waehler_wahlschein = 0,
waehler_nv = 0,
stimmen = 0,
stimmen_wahlschein = 0,
ungueltig = 0,
gueltig = 0,
ja = 0,
nein = 0)
# SAVE kann man sich schenken; df ist schneller neu erzeugt
# save(feldmann_df,"daten/feldmann_df.rda")
}
# Daten zur Sicherheit sortieren, dann die letzte Zeile rausziehen
letzte_fom_df <- fom_df %>%
arrange(zeitstempel) %>%
tail(1)
# Neue Daten holen (mit Fehlerbehandlung)
stimmbezirke_df <- lies_gebiet(wl_url)
neue_fom_df <- stimmbezirke_df %>%
# Namen raus
select(-name,-nr) %>%
# Daten aufsummieren
summarize(zeitstempel = last(zeitstempel),
across(2:ncol(.), ~ sum(.,na.rm=T)))
# Alte und neue Daten identisch? Dann brich ab.
if (vergleiche_stand(letzte_fom_df,neue_fom_df)) {
return(FALSE)
} else {
# Archiviere die Rohdaten
archiviere(stimmbezirke_df,"daten/stimmbezirke/")
# Ergänze das fom_df um die neuen Daten und sichere es
fom_df <- fom_df %>% bind_rows(neue_fom_df)
saveRDS(fom_df,"daten/fom_df.rds")
# Bilde das Dataframe
# Sende die Daten an Datawrapper und aktualisiere
fom_dw_df <- fom_df %>%
mutate(ausgezählt = meldungen_anz / meldungen_max *100) %>%
mutate(prozent30 = NA) %>%
mutate(quorum = ja / wahlberechtigt * 100) %>%
select(ausgezählt, wahlberechtigt, ungueltig, ja, nein, quorum, prozent30) %>%
# Noch den Endpunkt der 30-Prozent-Linie
bind_rows(tibble(ausgezählt = 100, prozent30 = ffm_waehler * 0.3))
dw_data_to_chart(fom_dw_df,fom_id)
# Parameter setzen
alles_ausgezählt <- (neue_fom_df$meldungen_max == neue_fom_df$meldungen_anz)
if (neue_fom_df$meldungen_anz == 0) {
quorum = 0
feldmann_str <- "Es liegen noch keine Auszählungsdaten des Bürgerentscheids vor."
} else {
quorum <- (neue_fom_df$ja / neue_fom_df$wahlberechtigt * 100)
if (quorum >= 30) {
if (alles_ausgezählt ) {
feldmann_str <- "Peter Feldmann ist als OB abgewählt."
} else {
feldmann_str <- "Nach dem derzeitigen Auszählungsstand wäre Peter Feldmann als OB abgewählt."
}
} else {
if (alles_ausgezählt ) {
feldmann_str <- "Peter Feldmann bleibt OB von Frankfurt."
} else {
feldmann_str <- "Nach dem derzeitigen Auszählungsstand bliebe Peter Feldmann OB von Frankfurt."
}
}
}
# Breite des Balkens: Wenn das Quorum erreicht ist, hat er die volle Breite,
# wenn nicht, einen Anteil von 30%, um die Entfernung von der Markierung zu zeigen
# Jetzt die Beschreibungstexte mit den Fake-Balkengrafiken generieren
beschreibung_str <- paste0(
"Die Abwahl ist beschlossen, wenn mindestens 30 Prozent aller Wahlberechtigten mit &quot;Ja&quot; stimmen.<br/><br>",
"<b style='font-weight:700;font-size:120%;'>",
# Erste dynamisch angepasste Textstelle: Bleibt Feldmann?
feldmann_str,
"</b><br/><br>",
generiere_balken(wb = neue_fom_df$wahlberechtigt,
ja = neue_fom_df$ja,
nein = neue_fom_df$nein,
auszählung_beendet = alles_ausgezählt))
annotate_str <- generiere_auszählungsbalken(
ausgezählt = floor(neue_fom_df$wahlberechtigt / ffm_waehler * 100),
anz = neue_fom_df$meldungen_anz,
max = neue_fom_df$meldungen_max,
ts = neue_fom_df$zeitstempel)
briefwahl_anz <- stimmbezirke_df %>% filter(str_detect(nr,"^9")) %>%
pull(meldungen_anz) %>% sum()
briefwahl_max <- stimmbezirke_df %>% filter(str_detect(nr,"^9")) %>%
nrow()
annotate_str <- paste0("<strong>Derzeit sind ",
briefwahl_anz,
" von ",
briefwahl_max,
" Briefwahl-Stimmbezirken ausgezählt.</strong><br/><br/>",
annotate_str)
dw_edit_chart(fom_id,intro = beschreibung_str,annotate = annotate_str)
dw_publish_chart(fom_id)
return(TRUE)
}
}
#---- MAIN ----
# Ruft aktualisiere_fom() auf
# (die dann wieder aktualisiere_karten() aufruft)
check = tryCatch(
{
neue_daten <- aktualisiere_fom(stimmbezirke_url)
},
warning = function(w) {teams_warning(w,title="Feldmann: fom")},
error = function(e) {teams_warning(e,title="Feldmann: fom")})
# Neue Daten? Dann aktualisiere die Karten
if (neue_daten) {
check = tryCatch(
{
neue_daten <- aktualisiere_karten(stimmbezirke_url)
},
warning = function(w) {teams_warning(w,title="Feldmann: Karten")},
error = function(e) {teams_warning(e,title="Feldmann: Karten")})
if (neue_daten) {
# Alles OK, letzte Daten nochmal holen und ausgeben
fom_df <- readRDS("daten/fom_df.rds") %>%
arrange(zeitstempel) %>%
tail(1)
if(fom_df$meldungen_anz > 0) {
stimmbezirke_df <- lies_gebiet(stimmbezirke_url)
briefwahl_anz <- stimmbezirke_df %>% filter(str_detect(nr,"^9")) %>%
pull(meldungen_anz) %>% sum()
briefwahl_max <- stimmbezirke_df %>% filter(str_detect(nr,"^9")) %>%
nrow()
fom_update_str <- paste0(
"<strong>Update OK</strong><br/><br/>",
fom_df$meldungen_anz,
" von ",
fom_df$meldungen_max," Stimmbezirke ausgezählt.<br> ",
"Derzeit sind ",
briefwahl_anz,
" von ",
briefwahl_max,
" Briefwahl-Stimmbezirken ausgezählt.<br/>",
"<ul><li><strong>Quorum zur Abwahl ist derzeit",
ifelse(fom_df$ja / fom_df$wahlberechtigt < 0.3, " nicht ", " "),
"erreicht</strong></li>",
"<li><strong>Anteil der Ja-Stimmen an den Wahlberechtigten: ",
format(fom_df$ja / fom_df$wahlberechtigt * 100,decimal.mark=",",big.mark=".",nsmall=1, digits=3),"%",
"</li><li>Ja-Stimmen: ",
format(fom_df$ja,decimal.mark=",",big.mark="."),
"</li><li>Nein-Stimmen: ",
format(fom_df$nein,decimal.mark=",",big.mark="."),
"</li><li>Verhältnis Ja:Nein: ",
format(fom_df$ja / (fom_df$ja + fom_df$nein) * 100,decimal.mark=",",big.mark=".",nsmall=1, digits=3),"% : ",
format(fom_df$nein / (fom_df$ja + fom_df$nein) *100,decimal.mark=",",big.mark=".",nsmall=1, digits=3),"%</li></ul>"
)
teams_meldung(fom_update_str,title="Feldmann-Referendum")
}
} else {
teams_warning("Neue Stimmbezirk-Daten, aber keine neuen Ortsdaten?")
}
}
# Auch hier TRUE zurückbekommen;; alles OK?
\ No newline at end of file
# obwahlen PRE # obwahlen PRE
**DIES IST IM AUGENBLICK NUR EINE NOCH NICHT ANGEPASSTE KOPIE DES REFERENDUMS-CODES** - bitte nicht nutzen und wundern! Anpassung spätestens zur [1. Runde der OB-Wahl in Frankfurt am 5. März 2023](https://frankfurt.de/aktuelle-meldung/meldungen/direktwahl-oberbuergermeisterin-oberbuergermeister-frankfurt/).
R-Code, um den Auszählungsstand hessischer Bürgermeisterwahlen in Echtzeit abzurufen und mit Datawrapper darzustellen R-Code, um den Auszählungsstand hessischer Bürgermeisterwahlen in Echtzeit abzurufen und mit Datawrapper darzustellen
## Ordnerstruktur ## Ordnerstruktur
- **R** enthält den Code - **R** enthält den Code
- **index** enthält Index-, Konfigurations-, und Template-Dateien - **index** enthält die Konfigurationsdatei index.csv und Unterordner mit den Indexdateien: Kandidaten, Stadtteile, Stimmbezirke, Datawrapper-Zuordnungen.
- **daten** wird vom Code beschrieben und enthält den aktuellen Datenstand. - **daten** wird vom Code beschrieben und enthält den aktuellen Datenstand.
## Daten aufarbeiten ## Daten aufarbeiten
### Ziele ### Ziele
Folgende Grafiken wären denkbar: Grafiken:
* Balkengrafik Ergebnis nach derzeitigem Auszählungsstand mit "Fortschrittsbalken" * Säulengrafik erste fünf; Ergebnis nach derzeitigem Auszählungsstand mit "Fortschrittsbalken"
* Choropleth Stadtteil-Sieger
* Balkengrafik alle
* Choropleth Stadtteil-Sieger (mit Switcher alle, die gewonnen haben)
* Choropleth Ergebnis nach Kandidat * Choropleth Ergebnis nach Kandidat
* Choropleth Wahlbeteiligung * Tabelle nach Kandidaten (3 beste, 3 schlechteste Stadtteile)
* Choropleth Briefwahl
* Tabelle nach Stadtteil * Tabelle nach Stadtteil
* Tabelle nach Kandidaten (Erste drei? fünf?)
### Konfiguration ### Konfiguration
...@@ -41,15 +39,20 @@ Aggregation auf Stadtebene ...@@ -41,15 +39,20 @@ Aggregation auf Stadtebene
- Fortschrittsbalken ausgezählte Stimmen (mit akt. Briefwahlstimmendaten) - Fortschrittsbalken ausgezählte Stimmen (mit akt. Briefwahlstimmendaten)
## Struktur des Codes ## Struktur des Codes: Was tut was?
(siehe ["Sitemap"](./sitemap.md) für den Code)
# TODO
### Hauptroutinen
- **update_all.R** ist das Skript für den CRON-Job. Es pollt nach Daten, ruft die Abruf-, Aggregations- und Auswertungsfunktionen auf und gibt Meldungen aus. - Upload aufs Repository
- **lies_aktuellen_stand.R** enthält Funktionen, die die Daten lesen, aggregieren und archivieren
- **aktualisiere_karten.R** enthält die Funktionen zur Datenausgabe
- **messaging.R** enthält Funktionen, die Teams-Updates und -Fehlermeldungen generieren
### Hilfsfunktionen ## NTH
- **generiere_testdaten.R** ist ein Skript, das zufällige, aber plausible CSV-Daten auf Stimmbezirks-Ebene zum Testen generiert - Umschalten Top5-Titel Ergebnis
- Zusatzfeature: Briefwahlprognostik - wieviele Stimmen fehlen vermutlich noch?
- Shapefiles KS, DA verbessern
- Datensparsamere Alternativ-CURL-Poll-Datei (zB mit dem Gesamtergebnis)
- Mehr Licht in den Choropleth-Karten farbabhängig
1. Shapefile in QGIS importieren
2. GEOJSON im richtigen Koordinatensystem erstellen
Dazu Rechtsklick auf den Layer; Koordinatensystem WGS84, exportieren
3. Stadtteile generieren
Menü "Vektor", "Geometrieverarbeitungswerkzeuge", "Auflösen" - und dann in der Dialogbox auswählen "Felder auflösen [optional]", und dann die Attribute hinzufügen, nach denen zusammengeführt werden soll.
In KS beispielsweise gab es die
- Rechtsklick auf den Layer; Exportieren als GEOJSON - nicht vergessen, das Bezugssystem auf WGS84 umzustellen!
- Rechtsklick auf den Layer; Export als XLSX - ggf. Geo-Attribute abschalten
4. Mittelpunkte der Stadtteile
Menü "Vektor", "Geometrie-Werkzeuge", "Zentroide"
Dann noch Geokoordinaten der Zentroidpunkte: Rechte Seite die Toolbox, dort "Vektortabelle" aufklappen, "X/Y-Felder zu Attributen hinzufügen"
- Rechtsklick auf den neu erzeugten Layer, exportieren als XLSX bzw CSV
5. CSV-/XLSX-Dateien putzen
- Brauchen eine Stadtteil-Datei mit nr,name,lon,lat (erzeugt aus den Zentroiden)
- Brauchen einen Wahlbezirks-Zuordnung
name,value,comment name,value,comment
stimmbezirke_url,https://votemanager-ffm.ekom21cdn.de/2022-11-06/06412000/praesentation/Open-Data-06412000-Buergerentscheid-zur-Abwahl-des-Oberbuergermeisters-der-Stadt-Frankfurt-am-Main_-Herrn-Peter-Feldmann-Stimmbezirk.csv?ts=1667662273015,URL Daten-CSV Stimmbezirke wahl_name,obwahl_ks_2023,Welche Wahl?
ffm_waehler,508182,Wahlamt stimmbezirke_url,https://votemanager-ks.ekom21cdn.de/2023-03-12/06611000/daten/opendata/Open-Data-06611000-Direktwahl-zur-Oberbuergermeisterin-zum-Oberbuergermeister-Wahlbezirk.csv?ts=1678486050153,URL Daten-CSV Stimmbezirke
fom_id,bIm87,Datawrapper-ID Feldmann-o-meter wahlberechtigt,147463,Anzahl Wahlberechtigte lt. Wahlamt (kommt Sonntag)
choropleth_id,UwKOO,Datawrapper-ID Stadtteile Choropleth-Karte briefwahl,39092,Anzahl Briefwahlstimmen lt. Wahlamt (kommt Sonntag)
symbol_id,RWqrf,Datawrapper-ID Stadtteile Symbole (absolute Stimmen) top,6,Anzahl der Top-Kandidaten in den Darstellungen
tabelle_id,hLqMi,Datawrapper-ID Tabelle Stadtteile kandidaten_fname,kandidaten.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
startdatum,2022-11-06 18:00:00 CET,Beginn der Auszählung zuordnung_fname,wahlbezirke.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
stadtteile_fname,stadtteile.csv,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
startdatum,2023-03-12 16:00:00,Beginn der Auszählung
top_id,Ts1oS,
karte_sieger_id,O9wPT,
karte_kand1_id,hM9SE,Schöller
karte_kand2_id,07CR4,Carqueville
karte_kand3_id,whgzp,Kühne-Hörmann
karte_kand4_id,5CpYu,Bock
karte_kand5_id,pc6vH,Käufler
karte_kand6_id,sEJhl,Geselle
tabelle_alle_id,EQ4dd,
hochburgen_id,GMTSJ,
tabelle_stadtteile_id,q7yjs,
social1_id,Ts1oS,5 stärkste
social2_id,S9BbQ,Alle Stimmen angepasst
name,value,comment
wahl_name,obwahl_ks_2023,Welche Wahl?
stimmbezirke_url,https://www.eggers-elektronik.de/files/test.csv,URL Daten-CSV Stimmbezirke
wahlberechtigt,147463,Anzahl Wahlberechtigte lt. Wahlamt (kommt Sonntag)
briefwahl,39092,Anzahl Briefwahlstimmen lt. Wahlamt (kommt Sonntag)
kandidaten_fname,kandidaten.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
zuordnung_fname,wahlbezirke.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
stadtteile_fname,ks-stadtteile.csv,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
startdatum,2023-01-01 18:00:00 CET,Beginn der Auszählung
top,6,
top_id,028Fp,
karte_sieger_id,7gscI,
karte_kand1_id,hM9SE,Schöller
karte_kand2_id,07CR4,Carqueville
karte_kand3_id,whgzp,Kühne-Hörmann
karte_kand4_id,5CpYu,Bock
karte_kand5_id,pc6vH,Käufler
karte_kand6_id,sEJhl,Geselle
tabelle_alle_id,PLwHI,
hochburgen_id,Im2PX,
tabelle_stadtteile_id,BM8kD,
social1_id,028Fp,5 stärkste
social2_id,S9BbQ,Alle Stimmen angepasst
name,value,comment
wahl_name,obwahl_ffm_2023,Welche Wahl?
stimmbezirke_url,https://votemanager-ffm.ekom21cdn.de/2023-03-05/06412000/daten/opendata/Open-Data-06412000-OB-Wahl-Wahlbezirk.csv?ts=1677904123448,URL Daten-CSV Stimmbezirke
wahlberechtigt,508182,Anzahl Wahlberechtigte lt. Wahlamt (kommt Sonntag)
briefwahl,250000,Anzahl Briefwahlstimmen lt. Wahlamt (kommt Sonntag)
kandidaten_fname,kandidaten.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
datawrapper_fname,datawrapper.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
zuordnung_fname,zuordnung_wahllokale.csv,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
stadtteile_fname,stadtteile.csv,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
startdatum,2023-03-05 16:00:00,Beginn der Auszählung
top5_id,2DYBQ,
karte_sieger_id,ANKmx,
karte_kand1_id,RcvQp,Rottmann (Grüne)
karte_kand2_id,jrm2v,Becker (CDU)
karte_kand3_id,bKR8r,Josef (SPD)
karte_kand4_id,etN3J,Mehler-Würzbach (Linke)
karte_kand5_id,3mydT,Pürsün (FDP)
karte_kand6_id,K3aCw,Lobenstein (AfD)
karte_kand7_id,vtG4Y,Pfeiffer (BFF)
karte_kand8_id,tRHeI,Tanczos (PARTEI)
karte_kand9_id,v4Y5m,Schwichtenberg (Gartenpartei)
karte_kand10_id,g3iBN,Wirth (unabh.)
karte_kand11_id,4LxcN,Camara (FPF)
karte_kand12_id,RZDF7,Pauli (unabh.)
karte_kand13_id,F86gf,Junghans (unabh.)
karte_kand14_id,bLPXL,Xu (unabh.)
karte_kand15_id,Ktufa,Wolff (unabh.)
karte_kand16_id,MO41j,Akhtar (Todenhöfer)
karte_kand17_id,ccrfL,Großenbach (Basis)
karte_kand18_id,q2S6m,Pawelski (unabh.)
karte_kand19_id,697CL,Schulte (unabh.)
karte_kand20_id,3lMmu,Eulig (unabh.)
tabelle_alle_id,7kRPR,
hochburgen_id,oB3KH,
tabelle_stadtteile_id,LiXnz,
social1_id,2DYBQ,5 stärkste
social2_id,S9BbQ,Alle Stimmen angepasst
name,value,comment
wahl_name,obwahl_ffm_2023,Welche Wahl?
stimmbezirke_url,testdaten/dummy.csv,URL Daten-CSV Stimmbezirke
wahlberechtigt,508182,Anzahl Wahlberechtigte lt. Wahlamt (kommt Sonntag)
briefwahl,250000,Anzahl Briefwahlstimmen lt. Wahlamt (kommt Sonntag)
kandidaten_fname,kandidaten.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
datawrapper_fname,datawrapper.xlsx,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
zuordnung_fname,zuordnung_wahllokale.csv,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
stadtteile_fname,stadtteile.csv,"XLSX oder CSV, wird im Ordner <wahl_name> erwartet"
startdatum,2023-01-01 18:00:00 CET,Beginn der Auszählung
top5_id,028Fp,
karte_sieger_id,7gscI,
karte_kand1_id,hM9SE,Rottmann (Grüne)
karte_kand2_id,hM9SE,Becker (CDU)
karte_kand3_id,07CR4,Josef (SPD)
karte_kand4_id,07CR4,Mehler-Würzbach (Linke)
karte_kand5_id,07CR4,Pürsün (FDP)
karte_kand6_id,07CR4,Lobenstein (AfD)
karte_kand7_id,07CR4,Pfeiffer (BFF)
karte_kand8_id,07CR4,Tanczos (PARTEI)
karte_kand9_id,07CR4,Schwichtenberg (Gartenpartei)
karte_kand10_id,07CR4,Wirth (unabh.)
karte_kand11_id,07CR4,Camara (FPF)
karte_kand12_id,07CR4,Pauli (unabh.)
karte_kand13_id,07CR4,Junghans (unabh.)
karte_kand14_id,07CR4,Xu (unabh.)
karte_kand15_id,07CR4,Wolff (unabh.)
karte_kand16_id,07CR4,Akhtar (Todenhöfer)
karte_kand17_id,07CR4,Großenbach (Basis)
karte_kand18_id,07CR4,Pawelski (unabh.)
karte_kand19_id,07CR4,Schulte (unabh.)
karte_kand20_id,07CR4,Eulig (unabh.)
tabelle_alle_id,PLwHI,
hochburgen_id,Im2PX,
tabelle_stadtteile_id,BM8kD,
social1_id,028Fp,5 stärkste
social2_id,S9BbQ,Alle Stimmen angepasst
File added
nr,name,lon,lat
1,Altstadt,8.682385346400634,50.11059669873516
2,Innenstadt,8.682664888207869,50.113790989177375
4,Westend-Süd,8.6594393465439925,50.11682467903111
5,Westend-Nord,8.666488952498467,50.128769620533795
6,Nordend-West,8.684596043386934,50.13022858244322
7,Nordend-Ost,8.69761974358955,50.127318654892264
8,Ostend,8.719218276147204,50.11554639352114
9,Bornheim,8.712407551447747,50.13090801018288
10,Gutleut- und Bahnhofsviertel,8.652137942960298,50.099479845695974
11,Gallus,8.636377745265355,50.10300477630784
12,Bockenheim,8.632922516089874,50.12128753657858
13,Sachsenhausen-Nord,8.684579993638577,50.10051804775371
14,Sachsenhausen-Süd und Flughafen,8.629663957345496,50.0607635296547
16,Oberrad,8.727138168461476,50.09922899999497
17,Niederrad,8.636199605275262,50.081631798202295
18,Schwanheim,8.572652070944704,50.081760019105545
19,Griesheim,8.600109548586545,50.09781734654457
20,Rödelheim,8.603076601631098,50.127692431637506
21,Hausen,8.626134516198546,50.13524298077671
22,Praunheim,8.61444644716483,50.14547905112678
24,Heddernheim,8.64020132453368,50.158128239125205
25,Niederursel,8.616911198776547,50.16683966510584
26,Ginnheim,8.648134546192246,50.14388748058928
27,Dornbusch,8.670541998003081,50.14434313041997
28,Eschersheim,8.659950213724542,50.16002839395001
29,Eckenheim,8.683795236784233,50.148564823086005
30,Preungesheim,8.697198159142667,50.15544843144313
31,Bonames,8.665887880254154,50.18258113675648
32,Berkersheim,8.702941786636124,50.17015956481773
33,Riederwald,8.73274589886058,50.12667040584185
34,Seckbach,8.726644066440096,50.147246840458955
35,Fechenheim,8.762275115113775,50.12551773891441
36,Höchst,8.539657322936813,50.098523172532
37,Nied,8.57676379509509,50.103479453362766
38,Sindlingen,8.51273746688725,50.07800492013246
39,Zeilsheim,8.495768400332896,50.097784690964886
40,Unterliederbach,8.525490184772172,50.10992510336304
41,Sossenheim,8.574019745075416,50.12010605434964
42,Nieder-Erlenbach,8.709219115856458,50.20871646737095
43,Kalbach-Riedberg,8.639008245521376,50.1846309062546
44,Harheim,8.689844680792895,50.18583895746724
45,Nieder-Eschbach,8.668094243977997,50.20106152063871
46,Bergen-Enkheim,8.766772308170399,50.15913246211432
47,Frankfurter Berg,8.673427563622,50.169778678198924
File added
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment