Skip to content
Snippets Groups Projects
Commit 0e313906 authored by Jan Eggers's avatar Jan Eggers
Browse files

Complete training data

parent d2718678
No related branches found
No related tags found
No related merge requests found
......@@ -75,6 +75,41 @@ kreise_2018_df <- e2018_df %>%
ungueltige_l_2018 = 33,
gueltige_l_2018 = 34) %>%
mutate(across(everything(), ~ as.integer(.)))
gemeinden_2018_df <- e2018_df %>%
filter(nchar(GKZ) == 6) %>%
select(ags = GKZ,
wahlberechtigte2018 = 9,
waehler2018 = 10,
wahlschein2018 = 11,
ungueltige2018 = 12,
gueltige2018 = 13,
ungueltige_l_2018 = 33,
gueltige_l_2018 = 34) %>%
mutate(across(everything(), ~ as.integer(.)))
g_direkt_lang_2018_df <- e2018_df %>% filter(nchar(GKZ) == 6) %>%
select(ags = GKZ,
14:32) %>%
pivot_longer(cols = 2:19, names_to = "partei", values_to ="stimmen_2018") %>%
mutate(partei = str_replace(partei,"\\.\\.\\..+","")) %>%
mutate(stimmen_2018 = as.integer(stimmen_2018))
g_landesstimmen_lang_2018_df <- e2018_df %>% filter(nchar(GKZ) == 6) %>%
select(ags = GKZ,
35:57) %>%
pivot_longer(cols = 2:24, names_to = "partei", values_to ="stimmen_2018") %>%
mutate(partei = str_replace(partei,"\\.\\.\\..+","")) %>%
mutate(stimmen_2018 = as.integer(stimmen_2018))
parteien_v <- function(ags) {
# Schaut, welcher Wahlkreis (bzw. welche Wahlkreise)
# zu dieser AGS gehören und liefert dann die Gemeinden
wk_v <- gemeinden_alle_df %>% filter(AGS %in% ags) %>% pull(wk)
partei_v <- direktkandidaten_df %>% filter(wk %in% wk_v) %>% pull(partei) %>% unique()
}
i = 0
# Schleife für die Kreis-Tests: Solange "ausgezählt" sind...
while(hessen_df %>%
......@@ -135,7 +170,64 @@ while(hessen_df %>%
for (ii in c(6:137,143)) {
hessen_df[[ii]] <- sum(kreise_df[[ii]])
}
muster_df <- hessen_df %>% bind_rows(kreise_df)
gemeinden_df <- vorlage_df %>% filter(Gebietstyp %in% c("VF","KS")) %>%
mutate(ags = as.integer(str_sub(Gebietsschlüssel,4,9))) %>%
# Wahllokale ausgezählt - Zufall, aber immer ein Fünftel mehr
mutate(`Anzahl Wahlbezirke ausgezählt` = floor(`Anzahl Wahlbezirke` * factor)) %>%
left_join(gemeinden_2018_df,by = "ags") %>%
mutate(Wahlberechtigte = wahlberechtigte2018,
`Wählerinnen und Wähler`= floor(waehler2018 * factor),
`Wählerinnen und Wähler mit Wahlschein` = floor(wahlschein2018 * factor),
# Wahlbeteiligung später
`ungültige Wahlkreisstimmen` = floor(ungueltige2018 * factor),
#gültig später
) %>%
mutate(Wahlbeteiligung = `Wählerinnen und Wähler` / Wahlberechtigte *100,
`gültige Wahlkreisstimmen` = `Wählerinnen und Wähler` - `ungültige Wahlkreisstimmen`) %>%
mutate(`ungültige Landesstimmen` = floor(ungueltige_l_2018 * factor)) %>%
mutate(`gültige Landesstimmen` = `Wählerinnen und Wähler` - `ungültige Landesstimmen`) %>%
# Parteien ins Langformat bringen
pivot_longer(cols = 18:46,names_to ="partei", values_to = "stimmen") %>%
# Kandidaten für die bekannten Gemeinden
# nicht filtern, sonst hat man später zu wenige Spalten
# rowwise() %>%
# mutate(pv = list(parteien_v(ags))) %>%
# ungroup() %>%
# mutate(partei = str_replace(partei," Wahlkreisstimmen","")) %>%
# mutate(p_exists = (partei %in% pv[[1]])) %>%
# filter(p_exists) %>%
# select(-p_exists,-pv) %>%
# Reale Ergebnisse 2018 nach Direktmandat/Partei
left_join(g_direkt_lang_2018_df %>%
select(ags,partei,stimmen_2018), by=c("ags","partei")) %>%
# Errechne Zufallsanteil
mutate(stimmen = floor(stimmen_2018 * factor)) %>%
select(-stimmen_2018) %>%
# Zurück ins Querformat, Zusatzspalten weg
pivot_wider(names_from = partei, values_from = stimmen) %>%
# Zurücksortieren
select(1:17,
# jettz die neu erzeugten Stimmen
128:156,
# normal weiter
18:119) %>%
# Landesstimmen
mutate(ags = as.integer(str_sub(Gebietsschlüssel,4,9))) %>%
pivot_longer(cols = 80:108,names_to ="partei", values_to = "stimmen") %>%
# Reale Ergebnisse 2018 nach Direktmandat/Partei
left_join(g_landesstimmen_lang_2018_df %>%
select(ags,partei,stimmen_2018), by=c("ags","partei")) %>%
# Errechne Zufallsanteil
mutate(stimmen = floor(stimmen_2018 * factor)) %>%
select(-stimmen_2018,ags) %>%
# Zurück ins Querformat, Zusatzspalten weg
pivot_wider(names_from = partei, values_from = stimmen) %>%
# Zurücksortieren
select(1:79,
121:149,
80:119)
# Alles zusammenbinden, schreiben
muster_df <- hessen_df %>% bind_rows(kreise_df) %>% bind_rows(gemeinden_df)
write_csv2(muster_df,"testdaten/kreise_tmp.csv")
datumsstring = paste0("Musterdatei;JanEggers;Stand: ",format(now(),format="%d.%m.%Y %H:%M:%S"))
tmp <- c(datumsstring,read_lines("testdaten/kreise_tmp.csv"))
......
......@@ -422,6 +422,17 @@ copy_visuals <- function(dw_source,dw_id_v) {
return(meta_backup)
}
copy_column_names <- function(source_id,dw_id_v) {
meta <- dw_retrieve_chart_metadata(source_id)
dat_changes <- meta$content$metadata$data$changes
for (id in dw_id_v) {
meta <- dw_retrieve_chart_metadata(id)
dat <- meta$content$metadtata$data
dat$changes <- dat_changes
dw_edit_chart(id, data = dat)
}
}
#' fix_data
#'
#' @description
......@@ -475,11 +486,23 @@ fix_hide_wk <- function(id_v) {
for (id in id_v) {
meta <- dw_retrieve_chart_metadata(id)
dat <- meta$content$metadata$data
data$`column-format`$wk$ignore <- TRUE
dat$`column-format`$wk$type <- 'auto'
dat$`column-format`$wk$`number-append` <- ''
dat$`column-format`$wk$`number-format` <- 'auto'
dat$`column-format`$wk$`number-divisor` <- 0
dat$`column-format`$wk$`number-prepend` <- ''
dat$`column-format`$wk$ignore <- TRUE
dw_edit_chart(chart_id = id, data = dat)
}
}
republish <- function(id_v){
for (id in id_v) {
dw_publish_chart(chart_id = id)
}
}
write_meta_json <- function(fname,title,intro,notes) {
# Metadaten anlegen
forced_meta <- list()
......@@ -518,6 +541,9 @@ aktualisiere_kreise_direkt <- function(live_kreise_direkt_lang_df, wk_v = c(1:55
# Spalte 142 und 143
stimmbezirke <- wahlkreis_df %>% pull(stimmbezirke) %>% first()
gezaehlt <- wahlkreis_df %>% pull(gezaehlt) %>% first()
waehler <- wahlkreis_df %>% pull(waehler) %>% first()
wahlberechtigt <- wahlkreis_df %>% pull(wahlberechtigt) %>% first()
ungueltig <- wahlkreis_df %>% pull(ungueltig) %>% first()
wk <- i
wk_name <- wahlkreis_df %>% pull(wk_name) %>% first()
fname <- datawrapper_ids_df %>%
......@@ -534,6 +560,15 @@ aktualisiere_kreise_direkt <- function(live_kreise_direkt_lang_df, wk_v = c(1:55
fname,
".csv"))
# Metadaten einrichten:
wahlbeteiligung_str <- paste0(
"Wahlbeteiligung: ",
formatC(waehler / wahlberechtigt * 100,format="f",
decimal.mark=",", digits = 1, big.mark="."),
" %, ungültige Stimmen ",
format(ungueltig / waehler * 100, format="f",
decimal.mark=",", digits = 1, big.mark="."),
" %<br><br>"
)
kand_str <- paste0(kand_df %>% tail(nrow(.)-5) %>%
mutate(n = paste0(name,": 0,0%")) %>% pull(n),
collapse = ", ")
......@@ -541,8 +576,10 @@ aktualisiere_kreise_direkt <- function(live_kreise_direkt_lang_df, wk_v = c(1:55
" - ",wk_name,
": Stimmen fürs Direktmandat",
ifelse(gezaehlt == stimmbezirke,""," - TREND"))
intro <- paste0("Erststimmen",
" für die Wahl des Direktkandidaten des Wahlkreises ")
intro <- paste0(ifelse(gezaehlt == stimmbezirke,
wahlbeteiligung_str,
""),
"Erststimmen für die Wahl des Direktkandidaten im Wahlkreis")
notes <- notes_text_auszaehlung(gezaehlt,
stimmbezirke,
ts,
......@@ -589,6 +626,9 @@ aktualisiere_kreise_landesstimmen <- function(live_kreise_landesstimmen_lang_df)
# Spalte 142 und 143
stimmbezirke <- kreis_df %>% pull(stimmbezirke) %>% first()
gezaehlt <- kreis_df %>% pull(gezaehlt) %>% first()
waehler <- kreis_df %>% pull(waehler) %>% first()
wahlberechtigt <- kreis_df %>% pull(wahlberechtigt) %>% first()
ungueltig <- kreis_df %>% pull(ungueltig) %>% first()
# Dran denken: Bei Städten ist es mehr als einer,
wk <- w
wk_name <- kreis_df %>% pull(wk_name) %>% unique()
......@@ -598,7 +638,7 @@ aktualisiere_kreise_landesstimmen <- function(live_kreise_landesstimmen_lang_df)
filter(as.integer(id) == w) %>%
pull(fname) %>%
# direkt ist der erste der beiden möglichen Werte
first()
last()
liste_df <- kreis_df %>%
mutate(prozent = paste0(formatC(prozent,digits=1,format="f",
big.mark = ".",decimal.mark = ","),
......@@ -610,6 +650,15 @@ aktualisiere_kreise_landesstimmen <- function(live_kreise_landesstimmen_lang_df)
write_csv(liste_df,paste0("livedaten/",
fname,
".csv"))
wahlbeteiligung_str <- paste0(
"Wahlbeteiligung: ",
formatC(waehler / wahlberechtigt * 100,format="f",
decimal.mark=",", digits = 1, big.mark="."),
" %, ungültige Stimmen ",
format(ungueltig / waehler * 100, format="f",
decimal.mark=",", digits = 1, big.mark="."),
" %<br><br>"
)
# Metadaten einrichten:
title <- paste0("Wahlkreis ",wk,
" - ",wk_name,
......
......@@ -4,17 +4,21 @@
#---- Hilfsfunktionen ----
hole_daten <- function(stand_url,a_directory = "daten") {
hole_daten <- function(stand_url,a_directory = "daten", copy=TRUE) {
#' Schreibt das Dataframe mit den zuletzt geholten Stimmbezirks-Daten
#' als Sicherungskopie in das angegebene Verzeichnis
#'
if (!dir.exists(a_directory)) {
dir.create(a_directory)
}
if (copy) {
fname = paste0(a_directory,"/",
str_replace_all(now(),"\\:","") %>% str_sub(1,15),
".csv")
} else {
fname = "livedaten/tmp.csv"
if (file.exists(fname)) { file.remove(fname)}
}
# Bei Internet-Adresse: Daten aus dem Netz in den lokalen Ordner kopieren
if (str_detect(stand_url,"^http")) {
check = tryCatch(
......@@ -43,6 +47,7 @@ hole_daten <- function(stand_url,a_directory = "daten") {
warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Datenakquise - Warnung beim Einlesen von ",fname))},
error = function(e) {teams_warning(e,title=paste0(wahl_name,": Datenakquise - Fehler beim Einlesen von ",fname))}
)
if (file.exists("livedaten/tmp.csv")) { file.remove("livedaten/tmp.csv")}
return(tmp_df)
}
......
......@@ -164,7 +164,8 @@ e2018_df <- read_delim("ergebnisse2018/wahlergebnisse2.csv",
# Zeilen 1-2 enthalten Grütze, Zeile 3 enthält ganz Hessen
filter(row_number()>2)
# Spalte 28 und 57 enthalten die V-Partei3
colnames(e2018_df) <- str_replace(colnames(e2018_df),"V-Partei3","V-Partei³")
### Spalten 14-32: Wahlkreisstimmen
direkt_2018_df <- e2018_df %>%
......@@ -181,7 +182,7 @@ direkt_2018_df <- e2018_df %>%
) %>%
mutate(across(4:ncol(.), ~ as.numeric(.))) %>%
mutate(wahlbeteiligung = waehler / wahlberechtigt * 100,
ungueltig_prozent = gueltig / waehler * 100) %>%
ungueltig_prozent = 100 - (gueltig / waehler * 100)) %>%
# Sonderbedingung: Ganz Hessen = "Wahlkreis 0"
mutate(wk = if_else(is.na(wk),0,wk))
......
......@@ -81,8 +81,9 @@ check = tryCatch(
gezaehlt <- 0 # Ausgezählte Stimmbezirke
ts <- as_datetime(startdatum) # ts, Zeitstempel, der letzten gelesenen Daten
# Anzahl Stimmbezirke bestimmen
# Anzahl Stimmbezirke: einmal aus der Hessen-Zeile filtern
alte_daten <- hole_daten(stimmbezirke_url) # Leere Stimmbezirke
alte_daten <- hole_daten(stimmbezirke_url, copy = FALSE) # Leere Stimmbezirke
stimmbezirke_n <- alte_daten %>% filter(Gebietstyp == "LD") %>% select(all_of(stimmbezirke_i)) %>% pull()
# Grafiken einrichten: Farbwerte und Switcher für die Karten
......@@ -144,9 +145,9 @@ while (gezaehlt < stimmbezirke_n) {
# # aktualisiere_staedte_landesstimmen(live_df) Schon mit drin
# cat("Grafiken Gemeinde Landesstimmen CSV/JSON aktualisiert\n")
# #
cat("Aktualisierte Daten kopiert in",aktualisiere_bucket(),"\n")
cat("Aktualisierte Daten kopiert in",aktualisiere_bucket_alle(),"\n")
#
neu_gezaehlt <- live_df %>% filter(Gebietstyp == "LD") %>% select(all_of(stimmbezirke_i)) %>% pull()
neu_gezaehlt <- live_df %>% filter(Gebietstyp == "LD") %>% select(all_of(gezaehlt_i)) %>% pull()
# Nachricht neu gezählte Stimmbezirke
teams_meldung("Gezählte Stimmbezirke: ",neu_gezaehlt," (neu: ",neu_gezaehlt-gezaehlt,")")
gezaehlt <- neu_gezaehlt
......
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
Source diff could not be displayed: it is too large. Options to address this: view the blob.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment