git

.gitignore

-# History files
+.Rproj.user
 .Rhistory
-.Rapp.history
-
-# Session Data files
 .RData
-.RDataTmp
-
-# User-specific files
 .Ruserdata
-
-# Example code in package build process
-*-Ex.R
-
-# Output files from R CMD build
-/*.tar.gz
-
-# Output files from R CMD check
-/*.Rcheck/
-
-# RStudio files
-.Rproj.user/
-
-# produced vignettes
-vignettes/*.html
-vignettes/*.pdf
-
-# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
-.httr-oauth
-
-# knitr and R markdown default cache directories
-*_cache/
-/cache/
-
-# Temporary files created by R markdown
-*.utf8.md
-*.knit.md
-
-# R Environment Variables
-.Renviron
-
-# pkgdown site
-docs/
-
-# translation temp files
-po/*~
-
-# RStudio Connect folder
-rsconnect/
+.DS_Store
+.gitignore
+algorithmwatch
+obwahl.log
+obwahl_success.log
+projektplanung.md
+projekt
+kandidaten
+livedaten
\ No newline at end of file

Musterdateien/Wahlvorschlaege_Landtagswahl_2023.csv

+1;CDU;Christlich Demokratische Union Deutschlands
+2;GRÜNE;BÜNDNIS 90/DIE GRÜNEN
+3;SPD;Sozialdemokratische Partei Deutschlands
+4;AfD;Alternative für Deutschland
+5;FDP;Freie Demokratische Partei
+6;DIE LINKE;DIE LINKE
+7;FREIE WÄHLER;FREIE WÄHLER
+8;Tierschutzpartei;PARTEI MENSCH UMWELT TIERSCHUTZ
+9;Die PARTEI;Partei für Arbeit, Rechtsstaat, Tierschutz, Elitenförderung und basisdemokratische Initiative
+10;PIRATEN;Piratenpartei Deutschland
+11;ÖDP;Ökologisch-Demokratische Partei
+12;Verjüngungsforschung;Partei für schulmedizinische Verjüngungsforschung
+13;V-Partei³;V-Partei³ - Partei für Veränderung, Vegetarier und Veganer
+14;PdH;Partei der Humanisten
+15;ABG;Aktion Bürger für Gerechtigkeit
+16;APPD;Anarchistische Pogo-Partei Deutschlands
+17;dieBasis;Basisdemokratische Partei Deutschland
+18;DKP;Deutsche Kommunistische Partei
+19;DIE NEUE MITTE;DIE NEUE MITTE
+20;Volt;Volt Deutschland
+21;KLIMALISTE WÄHLERL.;Wählerliste Klimaliste Hessen
+22;Bündnis C;Bündnis C - Christen für Deutschland
+23;WDMR;Bürgerliste Weiterdenken
+24;BUNDESPA. KLIMALISTE;Klimaliste Deutschland
+25;MERA25;MERA25
+26;NEV;Nichtparteigebundene Einwohnervertreter
+27;PP;Praktiker Partei
+28;SGV;SGV - Solidarität, Gerechtigkeit, Veränderung
+29;Solibew;Solidaritätsbewegung

R/aktualisiere_grafiken.R

+#' aktualisiere_grafiken.R
+#' 
+#' Enthält die Funktionen: 
+#' 
+
+
+#--- Grafikfunktionen ----
+generiere_auszählungsbalken <- function(anz = gezaehlt,max_s = stimmbezirke_n,ts = ts) {
+  fortschritt <- floor(anz/max_s*100)
+  annotate_str <- paste0("Ausgezählt sind ",
+                         # Container Fake-Balken
+                         "<span style='height:24px;display: flex;justify-content: space-around;align-items: flex-end; width: 100%;'>",
+                         # Vordere Pufferzelle 70px
+                         "<span style='width:70px; text-align:center;'>",
+                         anz,
+                         "</span>",
+                         # dunkelblauer Balken
+                         "<span style='width:",
+                         fortschritt,
+                         "%; background:#002747; height:16px;'></span>",
+                         # grauer Balken
+                         "<span style='width:",
+                         100-fortschritt,
+                         "%; background:#CCC; height:16px;'></span>",
+                         # Hintere Pufferzelle 5px
+                         "<span style='width:5px;'></span>",
+                         # Ende Fake-Balken
+                         "</span>",
+                         "<br>",
+                         " von ",max_s,
+                         " Stimmbezirken - ",
+                         "<strong>Stand: ",
+                         format.Date(ts, "%d.%m.%y, %H:%M Uhr"),
+                         "</strong>"
+  )
+  
+}
+
+#---- Daten-Kopierfunktionen ----
+
+# Kopiere Livedaten-Ordner in das Google Bucket
+aktualisiere_bucket_alle <- function() {
+  if (SERVER) {
+    n <- now()
+    system('gsutil -m -h "Cache-Control:no-cache, max_age=0" cp livedaten/* gs://d.data.gcp.cloud.hr.de/livedaten/')
+    copy_time <- now()-n
+    return(copy_time)
+  } else return(NA)
+}
+
+# Kopiere nur die Direktkandidaten der Kreise
+aktualisiere_bucket_kreise_direkt <- function() {
+  if (SERVER) {
+    n <- now()
+    system('gsutil -m -h "Cache-Control:no-cache, max_age=0" cp livedaten/wk*_direkt.* gs://d.data.gcp.cloud.hr.de/livedaten/')
+    copy_time <- now()-n
+    return(copy_time)
+  } else return(NA)
+}
+
+
+#---- Metadaten-Anpassungsfunktionen ----
+
+#' metadaten_balken
+#' 
+#' Kopiert die Metadaten-Anpassungen aus der Parteien-Tabelle in die Balkengrafik, 
+#' vor allem die Farben. 
+#' 
+
+
+#---- Grafiken einrichten ----
+
+kreise_direkt_saeulen <- function() {
+  for (wahlkreis in 1:55) {
+    wk_str <- formatC(wahlkreis, width = 3,format="fg", flag="0")
+    # Hole eine Grafik
+    fname <- datawrapper_ids_df %>% filter(id == wk_str) %>% 
+      pull(fname) %>% first()
+    dw_id <- datawrapper_ids_df %>% filter(id == wk_str) %>% 
+      pull(dw_id) %>% first()
+    
+    kand_df <- direktkandidaten_df %>% filter(wk == wahlkreis)
+    farbliste <- setNames(as.list(kand_df$farbwert), 
+                          kand_df$name)
+    meta <- dw_retrieve_chart_metadata(dw_id)
+    viz <- meta$content$metadata$visualize
+    # Balkengrafik
+    viz$`custom-colors` <- farbliste
+    viz$`x-grid-format` <- "0.0%"
+    viz$`custom-range`[[1]] <- "0"
+    viz$`custom-range`[[2]] <- "50"
+    
+    # Visual-Metadaten hochladen
+    dw_edit_chart(dw_id,visualize = viz)
+    #
+    title <- paste0("Wahlkreis ",wahlkreis," - ",
+                    kand_df %>% pull(wk_name) %>% first,
+                    ": Stimmen fürs Direktmandat")
+    kand_str <- paste0(kand_df %>% tail(nrow(.)-5) %>% 
+                         mutate(n = paste0(name,": 0,0%")) %>% pull(n),
+                            collapse = ", ")
+    # Metadaten anlegen
+    forced_meta <- list()
+    forced_meta[["title"]] <- title
+    forced_meta[["describe"]][["intro"]] <- "Bisher gezählte Stimmanteile für das Direktmandat im Wahlkreis; fünf erste Kandidierende von der Liste"
+    forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+    forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+    forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+    forced_meta[["annotate"]][["notes"]] <- paste0(ifelse(nchar(kand_str) > 0,
+                                                   "Sonstige: ",
+                                                   ""),
+                                                   kand_str,"<br><br>",
+    # hier später der Auszählungsbalken                                              
+      "Auszählung beginnt am 8.10.2023, 18 Uhr")
+    # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+    # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+    # (obwohl die eine ganz normale Liste ist)
+    forced_meta_json <- toJSON(forced_meta,force=T)
+    write(forced_meta_json,
+          paste0("livedaten/",fname,".json"))
+    
+    # CSV anlegen
+    # Im Prinzip: Eine leere Kandidatenliste für den Wahlkreis
+    kand_list_df <- kand_df %>%
+      mutate(prozent = 0.0) %>% 
+      select(name,prozent) %>% 
+      head(5)
+    write_csv(kand_list_df,paste0("livedaten/",
+                                  fname,
+                                  ".csv"))
+    
+  }
+  
+}
+  
+  
+ 
+# Landesstimmen-Grafiken
+# Haben 3 Spalten (Partei, Veränderung, prozentplusminus)
+
+# Lies s
+source_meta <- dw_retrieve_chart_metadata("p6i6a")
+
+viz[["columns"]][["stimmen"]][["customColorBarBackground"]]
+
+
+#
+
+#' copy_visuals 
+#' 
+#' @description 
+#' Kopiert die visual-Metadaten von einer Vorlage-Grafik auf alle anderen in der Liste.
+#' Sichert die überschriebenen Visuals in einer Liste - und gibt die zurück.
+copy_visuals <- function(dw_source,dw_id_v) {
+  # Vorbild-Grafik auslesen
+  source_meta <- dw_retrieve_chart_metadata(dw_source)
+  meta_backup <- list()
+  # visualize-Zweig extrahieren
+  vis <- source_meta$content$metadata$visualize
+  for (id in dw_id_v) {
+    old_metadata <- dw_retrieve_chart_metadata(id) 
+    # Neuen Listeneintrag mit den visualize-Metadaten unter der id generieren
+    meta_backup[[id]] <- old_metadata$content$metadata$visualize
+    # Metadaten überschreiben
+    dw_edit_chart(id, visualize = vis)
+  }
+  return(meta_backup)
+}
+
+#' copy_fix_data 
+#' 
+#' @description 
+#' Kopiert die data-Metadaten von einer Vorlage-Grafik auf alle anderen in der Liste.
+#' Die sind vor allem für die Benennung und Verrechnung der Achsen nötig - aber haben
+#' sich als problematisch herausgestellt, wenn man sie setzt. 
+#' 
+#' Überschriebene Data-Einstellungen werden in einer Liste/als JSON gesichert. 
+#' 
+#' Holt sich die Dateinamen für die externen Quellen und überschreibt die Einstellungen
+#' so, dass das externe CSV / Metadaten-JSON gezogen wird. 
+fix_data <- function(dw_id_v) {
+  for (did in dw_id_v) {
+    old_metadata <- dw_retrieve_chart_metadata(did) 
+    # Neuen Listeneintrag mit den visualize-Metadaten unter der id generieren
+    dat <- old_metadata$content$metadata$data
+    # fname aus Tabelle holen
+    fname <- datawrapper_ids_df %>% filter(dw_id == did) %>% pull(fname)
+    # Metadaten überschreiben
+    # Livedaten, URL in den Data-Zweig kopieren
+    dat[["upload-method"]]= "external-data"
+    dat[["external-data"]] = paste0("https://d.data.gcp.cloud.hr.de/livedaten/",
+                                    fname,
+                                    ".csv")
+    dat[["external-metadata"]] = paste0("https://d.data.gcp.cloud.hr.de/livedaten/",
+                                              fname,
+                                              ".json")
+    dat[["use-datawrapper-cdn"]] = FALSE
+    # 
+    dw_edit_chart(did, data = dat)
+    dw_publish_chart(did)
+  }
+  return(TRUE)
+}
+
+
+
+write_meta_json <- function(fname,title,intro,notes) {
+  # Metadaten anlegen
+  forced_meta <- list()
+  forced_meta[["title"]] <- new_dw$content$title
+  forced_meta[["describe"]][["intro"]] <- new_dw$content$metadata$describe$intro
+  forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+  forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+  forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  forced_meta[["annotate"]][["notes"]] <- "Auszählung beginnt am 8.10.2023, 18 Uhr"
+  # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+  # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+  # (obwohl die eine ganz normale Liste ist)
+  forced_meta_json <- toJSON(forced_meta,force=T)
+  write(forced_meta_json,
+        paste0("livedaten/",fname,".json"))
+}
+
+write_data_csv <- function(fname,data)
+#---- Hauptfunktionen ----
+
+
+#' aktualisiere_kreise_direkt
+#' 
+#' Erwartet ein langes Dataframe mit den Ergebnissen nach Partei
+#' und kopiert 
+aktualisiere_kreise_direkt <- function(live_long_df, wk_v = c(1:55)) {
+  # Gehe durch die Wahlkreis-IDs und suche die passenden Wahlkreisdaten
+  for (i in wk_v) {
+    wahlkreis_df <- live_long_df %>% filter()
+  }
+}
+
+aktualisiere_kreise_landesstimmen <- function(live_df) {
+  
+}
+
+aktualisiere_gemeinden_direkt <- function(live_df) {
+  
+}
+
+aktualisiere_gemeinden_landesstimmen <- function(live_df) {
+  
+}
+
+aktualisiere_staedte_landesstimmen {
+  
+}
+
+aktualisiere_hessen_landesstimmen {
+  
+}
+
+
+
+
+
+
+
+
+

R/dw_write_chart_metadata.R

+# Aus dem DatawRappr-Paket abgeschriebene, modifizierte Funktion,
+# die einen kompletten Metadatensatz hochlädt. 
+
+dw_check_chart_id <- function(chart_id) {
+  
+  if (class(chart_id) == "dw_chart") {
+    chart_id <- chart_id[["id"]]
+  } else if (class(chart_id) == "character") {
+    if (!grepl("[a-zA-Z0-9_]{5}", chart_id)) {
+      stop("Entered chart_id is not valid!", call. = FALSE)
+    }
+  }
+  return(chart_id)
+}
+
+.DatawRappr_ua <- httr::user_agent(
+  sprintf(
+    "DatawRappr package v%s: (<%s>)",
+    utils::packageVersion("DatawRappr"),
+    utils::packageDescription("DatawRappr")$URL
+  )
+) -> .DATAWRAPPR_UA
+
+dw_call_api <- function(..., return_raw_response=F, enforce_json_response=T) {
+  r <- httr::RETRY(...)
+  
+  httr::handle_reset("https://api.datawrapper.de/")
+  
+  if (!(httr::status_code(r) %in% c(200, 201, 202, 204))) {
+    stop(paste0("There has been an error in an API call. Statuscode of the response: ", httr::status_code(r)), immediate. = TRUE)
+  }
+  
+  if (return_raw_response) {
+    return (r)
+  }
+  
+  if (!enforce_json_response) {
+    return (httr::content(r))
+  }
+  
+  parsed <- dw_handle_errors(r)
+  
+  return(parsed)
+}
+
+
+
+  
+  
+  # work in additional arguments, if specified
+  if (length(data) > 0) {
+    if (!is.list(call_body$metadata$data)) {
+      call_body$metadata$data <- list()
+    }
+    call_body$metadata$data <- utils::modifyList(call_body$metadata$data, data)
+  }
+  
+  if (length(visualize) > 0) {
+    if (!is.list(call_body$metadata$visualize)) {
+      call_body$metadata$visualize <- list()
+    }
+    
+    call_body$metadata$visualize <- utils::modifyList(call_body$metadata$visualize, visualize)
+  }
+  
+  if (length(describe) > 0) {
+    if (!is.list(call_body$metadata$describe)) {
+      call_body$metadata$describe <- list()
+    }
+    
+    call_body$metadata$describe <- utils::modifyList(call_body$metadata$describe, describe)
+  }
+  
+  if (length(publish) > 0) {
+    if (!is.list(call_body$metadata$publish)) {
+      call_body$metadata$publish <- list()
+    }
+    
+    call_body$metadata$publish <- utils::modifyList(call_body$metadata$publish, publish)
+  }
+  
+  if (length(axes) > 0) {
+    if (!is.list(call_body$metadata$axes)) {
+      call_body$metadata$axes <- list()
+    }
+    call_body$metadata$axes <- utils::modifyList(call_body$metadata$axes, axes)
+  }
+  
+  additional_arguments <- list(...)
+  
+  if (length(additional_arguments) > 0) {
+    call_body <- append(call_body, additional_arguments)
+  }
+
+
+
+dw_write_chart_metadata <- function(chart_id, api_key = "environment", meta = list(), ...) {
+  
+  if (api_key == "environment") {
+    api_key <- dw_get_api_key()
+  }
+  
+  chart_id <- dw_check_chart_id(chart_id)
+  # Check metadata!
+  # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  # 
+  # Right now, it just expects to find a dw_chart object: 
+  # a list of 
+  try(if (chart_id != meta[["id"]]) stop("ID != ID"))
+  # create empty body for API-call with dw_chart object
+  call_body <- list(metadata = list())
+  call_body$title <- meta$content$title
+  call_body$type <- meta$content$type
+  call_body$folderId <- meta$content$folderId
+  call_body$intro <- meta$content$intro
+  call_body$metadata$annotate <- meta$content$metadata$annotate
+  call_body$metadata$describe$byline <- meta$content$metadata$describe$byline
+  
+  
+  
+  
+  call_body$metadata <- meta$content$metadata
+  
+  # change only specified parts of existing data
+
+  # send call to API
+  # upload modified data
+  # solution for API v1:
+  # url_upload <- paste0("https://api.datawrapper.de/charts/", chart_id)
+  #
+  # r <- dw_call_api("PUT", url_upload, httr::add_headers(Authorization = paste("Bearer", api_key, sep = " ")),
+  #                       body = call_body, encode = "json", .DATAWRAPPR_UA)
+  
+  url_upload <- paste0("https://api.datawrapper.de/v3/charts/", chart_id)
+  parsed <- dw_call_api("PATCH", url_upload, httr::add_headers(Authorization = paste("Bearer", api_key, sep = " ")),
+                        body = call_body, encode = "json", .DATAWRAPPR_UA)
+  
+  chart_id_response <- parsed["id"][[1]] #for v3: parsed["id"][[1]], for v1: parsed[["data"]][[1]][["id"]]
+  
+  try(if (chart_id != chart_id_response) stop(paste0("The chart_ids between call (",  chart_id ,") and response (",  chart_id_response ,") do not match. Try again and check API.")))
+  
+  if (chart_id == chart_id_response) {
+    
+    message(paste0("Chart ", chart_id_response, " succesfully updated.", "\n"))
+    
+  } else {
+    stop(paste0("There has been an error in the upload process."), immediate. = TRUE)
+  }
+  
+  httr::handle_reset(url_upload)
+  
+}

R/generiere-dummy-url.R

+# generiere-dummy-url.R
+
+# legt für die TS eine Tabelle mit den URLs der Ergebnisartikel an
+
+
+library(stringr)
+library(dplyr)
+library(tidyr)
+library(openxlsx)
+
+# Aktuelles Verzeichnis als workdir
+setwd(this.path::this.dir())
+# Aus dem R-Verzeichnis eine Ebene rauf
+setwd("..")
+
+sophora_str <- "https://www.hessenschau.de/politik/landtagswahl/ergebnisse/"
+gemeinden_df <- read.xlsx("./gemeinden-kreise.xlsx",sheet="Gemeinden") %>%
+  filter(Gesamtbevölkerung > 0) %>% 
+  select(AGS,hr_name) %>% 
+  mutate(hr_url = paste0(sophora_str,"ltwhe23-kommune-g06",AGS,"-ergebnis-100.html"))
+
+write.xlsx(gemeinden_df,"./info/hessenschau_gemeinden_autotext_url.xlsx")
+
+wahlkreise_df <- read.xlsx("./index/wahlkreise_alle.xlsx") %>% 
+  select(wk, wk_name) %>% 
+  arrange(wk) %>% 
+  mutate(hr_url = paste0(sophora_str,"ltwhe23-wahlkreis-wk",
+                         formatC(wk, width = 3,format="fg", flag="0"),
+                         "-ergebnis-100.html"))
+
+write.xlsx(wahlkreise_df,"./info/hessenschau_wahlkreise_autotext_url.xlsx")
+

R/generiere_dw.R

+# generiere_dw.R
+#
+# Legt alle Datawrapper-Karten an und speichert die JSON-Files mit den 
+# Metadaten für die Live-Aktualisierung. 
+
+# Namen der Grafiken: 
+# - g06xxxxxx_direkt (Gemeinde, alle Wahlkreisstimmen)
+# - g06xxxxxx_land (Gemeinde, alle Landesstimmen)
+# - wk0xx_direkt (Wahlkreis, alle Wahlkreisstimmen)
+# - wk0xx_land (Wahlkreis, alle Landesstimmen)
+
+library(pacman)
+p_load(dplyr)
+p_load(stringr)
+p_load(openxlsx)
+p_load(jsonlite)
+p_load(lubridate)
+p_load(readr)
+
+rm(list=ls())
+
+# Aktuelles Verzeichnis als workdir
+setwd(this.path::this.dir())
+# Aus dem R-Verzeichnis eine Ebene rauf
+setwd("..")
+
+# Globale Parameter
+ltw_folder_id = "144571" # Datawrapper-Ordner wahlen/ltwhe23
+hsde_theme = "hessischer-rundfunk"
+bucket_url = "https://d.data.gcp.cloud.hr.de/ltwhe23/"
+
+
+require(DatawRappr)
+
+
+#### Hilfsfunktionen zum Umgang mit den Kandidaten- und Listendaten
+listen_df <- read.xlsx("index/listen.xlsx") 
+
+direktkandidaten_df <- read.xlsx("index/kandidaten_alle.xlsx") %>% 
+  filter(!is.na(wk)) %>% 
+  rename(partei = Partei) %>% 
+  left_join(listen_df %>% rename(p_id = id),by="partei") %>% 
+  arrange(wk,p_id)
+
+gemeinden_df <- read.xlsx("index/gemeinden_alle.xlsx") %>% 
+  mutate(AGS = as.character(AGS)) %>% 
+  filter(bevoelkerung > 0)
+
+wahlkreisnamen_v <- gemeinden_df %>% select (wk,wk_name) %>% 
+  distinct(wk, wk_name) %>% pull(wk_name)
+
+ks_ags <- gemeinden_df %>% filter(Gebietstyp == "KS") %>% 
+  # Offenbach rausnehmen und wie Gemeinde behandeln
+  filter(!str_detect(name,"Offenbach")) %>% 
+  pull (AGS) %>% unique()
+
+
+
+#' dw_direkt_anlegen
+#' 
+#' @description Legt eine Säulengrafik der Direktstimmen für eine Gemeinde 
+#' oder einen Wahlkreis in Datawrapper an, richtet die Farben und Namen ein, 
+#' biegt die Verweise auf CSV- und JSON- Dateien im Google Bucket um (Live-Daten
+#' und Live-Metadaten), und legt diese Daten im livedaten-Ordner an.
+#' Zieht sich den Namen der Gemeinde aus der Tabelle gemeinden_df 
+#'
+#' @param id String mit der ID der Gemeinde oder des Wahlkreises
+#' @param type description
+#' 
+#' @returns Datawrapper-ID der angelegten Karte
+#' 
+#' 
+dw_direkt_anlegen <- function(id="001") {
+  # Einzelfunktionen: Lege Wahlkreis, Stadt oder Gemeinde an
+  # Gemeinde und Stadt unterscheiden sich nur durch den Titel
+  w_direkt <- function(id) {
+    id_i <- as.numeric(id)
+    id <- formatC(id_i, width = 3,format="fg", flag="0")
+    # id bereinigen
+    title <- paste0("Wahlkreis ",id_i," - ",
+                    wahlkreisnamen_v[id_i],
+                    ": Stimmen fürs Direktmandat")
+    intro <- "Die nach Auszählung führenden fünf Direktkandidaten, Prozentanteile"
+    # Wahlkreiskarte: Säulengrafik der ersten fünf
+    #
+    # Datawrapper gibt ein Objekt dw_chart zurück - eigentlich eine Liste, 
+    # die die ganzen Metadaten-Elemente in einer JSON-artigen Struktur enthält.
+    # In Python wär's ein Dictionary of dictionaries. 
+    new_dw <- dw_create_chart(title = title, 
+                                type="column-chart",
+                                folderId = ltw_folder_id,
+                                theme = hsde_theme) 
+    
+    
+    # Namen in die ANmerkung - erst mal
+    new_dw$content$metadata$annotate$notes <- paste0("wk",id,"_direkt")
+    
+    return(new_dw)
+  }
+  # Wie gesagt: Gemeinde und Stadt nur unterschiedlich im Titel, 
+  # deshalb den Wrapper 
+  gs_direkt <- function(title) {
+    # Der gemeinsame Teil von Gemeinden udn Städten
+    intro <- "Ausgezählte Stimmen für die Direktkandidaten, in der Reihenfolge vom Wahlzettel"
+    new_dw <- dw_create_chart(title = title, 
+                              type="tables",
+                              folderId = ltw_folder_id,
+                              theme = hsde_theme)
+    # Namen in die ANmerkungen - erst mal
+    new_dw$content$metadata$annotate$notes <- paste0("g06",id,"_direkt")
+    # Jetzt die Schlüssel verändern, die verändert werden sollen: 
+    return(new_dw)
+  }
+  g_direkt <- function(id) {
+    name <- gemeinden_df %>% filter(id == AGS) %>% 
+      pull(name) %>% first()
+    title <-paste0(name,": Stimmen fürs Direktmandat")
+    return(gs_direkt(title))
+  }
+  s_direkt <- function(id) {
+    name <- gemeinden_df %>% filter(id == AGS) %>% 
+      pull(name) %>% first()
+    title <- paste0("Kreisfreie Stadt ",name,
+                    ": Stimmen fürs Direktmandat")
+    return(gs_direkt(title))
+  }
+  
+  # Let's get the party started!
+  id_i <- as.integer(id)
+  if (id_i > 0 & id_i < 56) {
+    # Wahlkreis?
+    new_dw <- w_direkt(id)
+  } else {
+    # G oder S? 
+    if (id %in% ks_ags) {
+      new_dw <- s_direkt(id)
+    } else {
+      # Gemeinde - checken, ob bekannt, sonst stop
+      if (!id %in% gemeinden_df$AGS) stop("Unbekannte ID ",id)
+      new_dw <- g_direkt(id)
+    }
+  }
+
+  # EIn paar allgemeine Dinge einrichten - mit der noch leeren Grafik
+  # ... und unter Publish verstecken sich die Publikations-Optionen
+  #
+  # Alle Daten, Datenauswahl-, Farb- und Benennungs-Metadaten 
+  # werden gesondert angepasst. (Das muss ja ggf. auch live gehen!)
+  publish <- list()
+  publish$blocks$enabled <- TRUE
+  publish$blocks$embed <- TRUE
+  publish$blocks[["blocks"]][["get-the-data"]] <- TRUE
+  describe <- list()
+  describe[["source-name"]] <- "Hessisches Statistisches Landesamt"
+  describe[["source-url"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  describe[["byline"]] <- "Jan Eggers/Sandra Kiefer, hr" 
+  dw_edit_chart(chart_id = new_dw$id,
+                annotate = "Auszählung beginnt am 8.10.2023 um 18 Uhr",
+#                describe = describe,
+                byline = "Jan Eggers/Sandra Kiefer, hr",
+                publish = publish
+                )
+  # Kleine Fiesheit: einige der Metadaten-Keys, z.B. annotate$notes, 
+  # weichen jetzt in der Grafik von den zurückgegebenen ab. Stört aber nicht
+  # weiter, weil sie ohnehin überschrieben werden. 
+  return(new_dw)
+}
+  
+#--- Funktion Landesstimmen (alles: Tabellen) ----  
+dw_landesstimmen_anlegen <- function(id="001") {
+  # Einzelfunktionen: Lege Wahlkreis, Stadt oder Gemeinde an
+  # Gemeinde und Stadt unterscheiden sich nur durch den Titel
+  w_landesstimmen <- function(id) {
+    id_i <- as.numeric(id)
+    id <- formatC(id_i, width = 3,format="fg", flag="0")
+    # id bereinigen
+    title <- paste0("Wahlkreis ",id_i," - ",
+                    wahlkreisnamen_v[id_i],
+                    ": Landesstimmen")
+    intro <- "Alle Stimmen für die Parteien im neuen Landtag, in der Reihenfolge vom Stimmzettel"
+    new_dw <- dw_create_chart(title = title, 
+                              type="tables",
+                              folderId = ltw_folder_id,
+                              theme = hsde_theme) 
+    
+    
+    # Namen in die ANmerkung - erst mal
+    new_dw$content$metadata$annotate$notes <- paste0("wk",id,"_landesstimmen")
+    new_dw$content$metadata$describe$intro <- intro
+    
+    return(new_dw)
+  }
+  # Wie gesagt: Gemeinde und Stadt nur unterschiedlich im Titel, 
+  # deshalb den Wrapper 
+  gs_landesstimmen <- function(title) {
+    # Der gemeinsame Teil von Gemeinden udn Städten
+    new_dw <- dw_create_chart(title = title, 
+                              type="tables",
+                              folderId = ltw_folder_id,
+                              theme = hsde_theme)
+    new_dw$content$metadata$annotate$notes <- paste0("g06",id,"_landesstimmen")
+   return(new_dw)
+  }
+  g_landesstimmen <- function(id) {
+    name <- gemeinden_df %>% filter(id == AGS) %>% 
+      pull(name) %>% first()
+    title <-paste0(name,": Landesstimmen")
+    new_dw <- gs_landesstimmen(title)
+    # Jetzt die Schlüssel verändern, die verändert werden sollen:
+    new_dw$content$metadata$describe$intro <- paste0(
+      "Stimmen für die Parteien im neuen Landtag, ",
+      "in der Reihenfolge vom Wahlzettel"
+    )
+
+    return(new_dw)
+  }
+  s_landesstimmen <- function(id) {
+    name <- gemeinden_df %>% filter(id == AGS) %>% 
+      pull(name) %>% first()
+    title <- paste0("Kreisfreie Stadt ",name,
+                    ": Landesstimmen für die Parteien")
+    new_dw <- gs_landesstimmen(title)
+    wahlkreise_stadt_v <- gemeinden_df %>% filter(id == AGS) %>% 
+      arrange(wk) %>% pull(wk) %>% unique()
+    new_dw$content$metadata$describe$intro <- paste0("Stimmen für die Parteien ",
+                    "im neuen Landtag; alle Wahlkreise (",
+                    paste(wahlkreise_stadt_v[1:length(wahlkreise_stadt_v)-1]),
+                    last(wahlkreise_stadt_v),") zusammen")
+    return(new_dw)
+  }
+  
+  # Let's get the party started!
+  id_i <- as.integer(id)
+  if (id_i > 0 & id_i < 56) {
+    # Wahlkreis?
+    new_dw <- w_landesstimmen(id)
+  } else {
+    # G oder S? 
+    if (id %in% ks_ags) {
+      new_dw <- s_landesstimmen(id)
+      
+    } else {
+      # Gemeinde - checken, ob bekannt, sonst stop
+      if (!id %in% gemeinden_df$AGS) stop("Unbekannte ID ",id)
+      new_dw <- g_landesstimmen(id)
+    }
+  }
+  
+  # EIn paar allgemeine Dinge einrichten - mit der noch leeren Grafik
+  # ... und unter Publish verstecken sich die Publikations-Optionen
+  #
+  # Alle Daten, Datenauswahl-, Farb- und Benennungs-Metadaten 
+  # werden gesondert angepasst. (Das muss ja ggf. auch live gehen!)
+  publish <- list()
+  publish$blocks$enabled <- TRUE
+  publish$blocks$embed <- TRUE
+  publish$blocks[["blocks"]][["get-the-data"]] <- TRUE
+  describe <- list()
+  describe[["source-name"]] <- "Hessisches Statistisches Landesamt"
+  describe[["source-url"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  describe[["byline"]] <- "Jan Eggers/Sandra Kiefer, hr" 
+
+  
+  dw_edit_chart(chart_id = new_dw$id,
+                annotate = "Auszählung beginnt am 8.10.2023 um 18 Uhr",
+                describe = describe,
+                byline = "Jan Eggers/Sandra Kiefer, hr",
+                publish = publish
+  )
+  # Kleine Fiesheit: einige der Metadaten-Keys, z.B. annotate$notes, 
+  # weichen jetzt in der Grafik von den zurückgegebenen ab. Stört aber nicht
+  # weiter, weil sie ohnehin überschrieben werden. 
+  return(new_dw)
+}
+
+
+
+#### MAIN ####
+
+# Livedaten-Verzeichnis anlegen bzw. leeren
+if (dir.exists("./livedaten")) {
+  # alles löschen
+  livedaten_files <- list.files("./livedaten/", full.names=TRUE) 
+  for (f in livedaten_files) {
+    # Grausam, I know. 
+    file.remove(f)
+  }
+} else {
+  dir.create("./livedaten")
+}
+
+# Jetzt erst mal die Direktkandidaten-Säulen für die Wahlkreise
+dw_df <- tibble()
+for (wahlkreis in 1:55) {
+  wk_str <- formatC(wahlkreis, width = 3,format="fg", flag="0")
+  # Hole eine Grafik
+  new_dw <- dw_direkt_anlegen(wk_str)
+  fname <- new_dw$content$metadata$annotate$notes
+  dw_id <- new_dw$id
+  dw_df <- rbind(dw_df, tibble(id = wk_str,
+                               typ = "w",
+                               dw_id = dw_id,
+                               fname = fname))
+  # Metadaten anlegen
+  forced_meta <- list()
+  forced_meta[["title"]] <- new_dw$content$title
+  forced_meta[["describe"]][["intro"]] <- new_dw$content$metadata$describe$intro
+  forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+  forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+  forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  forced_meta[["annotate"]][["notes"]] <- "Auszählung beginnt am 8.10.2023, 18 Uhr"
+  # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+  # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+  # (obwohl die eine ganz normale Liste ist)
+  forced_meta_json <- toJSON(forced_meta,force=T)
+  write(forced_meta_json,
+        paste0("livedaten/",fname,".json"))
+  
+  # CSV anlegen
+  # Im Prinzip: Eine leere Kandidatenliste für den Wahlkreis
+  kand_list_df <- direktkandidaten_df %>% 
+    filter(wk == wahlkreis) %>%
+    mutate(prozent = 0.01) %>% 
+    mutate(name = paste0(Nachname," (",partei,")")) %>% 
+    select(name,prozent) %>% 
+    head(5)
+  write_csv(kand_list_df,paste0("livedaten/",
+                                fname,
+                                ".csv"))
+}
+
+# Liste mit den Datawrapper-IDs als XLSX exportieren
+write.xlsx(dw_df,"datawrapper_ids.xlsx",overwrite = T)
+
+#--- Die Direkt-Tabellen für die Gemeinden ----
+g_v <- gemeinden_df %>% 
+  # Die Gutsbezirke rausnehmen
+  filter(bevoelkerung>0) %>% 
+  filter(!AGS %in% ks_ags) %>% 
+  pull(AGS) %>% 
+  unique()
+
+for (g in g_v) {
+    new_dw <- dw_direkt_anlegen(g)
+    fname <- new_dw$content$metadata$annotate$notes
+    dw_id <- new_dw$id
+    dw_df <- rbind(dw_df, tibble(id = g,
+                                 typ = "g",
+                                 dw_id = dw_id,
+                                 fname = fname))
+    
+  # Noch ein wenig Metadaten-Zauber: Farbwerte der Parteien übergeben
+  
+  # Metadaten anlegen
+  forced_meta <- list()
+  forced_meta[["title"]] <- new_dw$content$title
+  forced_meta[["describe"]][["intro"]] <- new_dw$content$metadata$describe$intro
+  forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+  forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+  forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  forced_meta[["annotate"]][["notes"]] <- "Auszählung beginnt am 8.10.2023, 18 Uhr"
+  # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+  # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+  # (obwohl die eine ganz normale Liste ist)
+  forced_meta_json <- toJSON(forced_meta,force=T)
+  write(forced_meta_json,
+        paste0("livedaten/",fname,".json"))
+  
+  wahlkreis <- gemeinden_df %>% filter(AGS==g) %>% pull(wk) %>% first()
+  # CSV anlegen
+  # Im Prinzip: Eine leere Kandidatenliste für den Wahlkreis
+  kand_list_df <- direktkandidaten_df %>% 
+    filter(wk == wahlkreis) %>%
+    mutate(stimmen = 0.01, prozent = "0,0% (+0)") %>% 
+    mutate(name = paste0(Nachname," (",partei,")")) %>% 
+    select(name,partei,stimmen,prozent) 
+  write_csv(kand_list_df,paste0("livedaten/",
+                                fname,
+                                ".csv"))
+}
+
+# Liste mit den Datawrapper-IDs als XLSX exportieren
+write.xlsx(dw_df,"datawrapper_ids.xlsx",overwrite = T)
+
+#--- Landesstimmen: alle Wahlkreise, alle Gemeinden, alle Städte ----
+part_list_df <- listen_df %>% 
+  select(partei) %>% 
+  mutate(stimmen = 0.01, prozent = "0,0% (+0)")
+
+for (wahlkreis in 1:55) {
+  wk_str <- formatC(wahlkreis, width = 3,format="fg", flag="0")
+  # Hole eine Grafik
+  new_dw <- dw_landesstimmen_anlegen(wk_str)
+  fname <- new_dw$content$metadata$annotate$notes
+  dw_id <- new_dw$id
+  dw_df <- rbind(dw_df, tibble(id = wk_str,
+                               typ = "w",
+                               dw_id = dw_id,
+                               fname = fname))
+  # Metadaten anlegen
+  forced_meta <- list()
+  forced_meta[["title"]] <- new_dw$content$title
+  forced_meta[["describe"]][["intro"]] <- new_dw$content$metadata$describe$intro
+  forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+  forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+  forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  forced_meta[["annotate"]][["notes"]] <- "Auszählung beginnt am 8.10.2023, 18 Uhr"
+  # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+  # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+  # (obwohl die eine ganz normale Liste ist)
+  forced_meta_json <- toJSON(forced_meta,force=T)
+  write(forced_meta_json,
+        paste0("livedaten/",fname,".json"))
+  
+  # CSV anlegen
+  # Im Prinzip: Eine leere Parteienliste für den Wahlkreis
+  write_csv(part_list_df %>% mutate(wk = wahlkreis),paste0("livedaten/",
+                                fname,
+                                ".csv"))
+}
+
+# Liste mit den Datawrapper-IDs als XLSX exportieren
+write.xlsx(dw_df,"datawrapper_ids.xlsx",overwrite = T)
+
+
+for (g in g_v) {
+  new_dw <- dw_landesstimmen_anlegen(g)
+  fname <- new_dw$content$metadata$annotate$notes
+  dw_id <- new_dw$id
+  dw_df <- rbind(dw_df, tibble(id = g,
+                               typ = "g",
+                               dw_id = dw_id,
+                               fname = fname))
+  
+  # Noch ein wenig Metadaten-Zauber: Farbwerte der Parteien übergeben
+  
+  # Metadaten anlegen
+  forced_meta <- list()
+  forced_meta[["title"]] <- new_dw$content$title
+  forced_meta[["describe"]][["intro"]] <- new_dw$content$metadata$describe$intro
+  forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+  forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+  forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  forced_meta[["annotate"]][["notes"]] <- "Auszählung beginnt am 8.10.2023, 18 Uhr"
+  # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+  # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+  # (obwohl die eine ganz normale Liste ist)
+  forced_meta_json <- toJSON(forced_meta,force=T)
+  write(forced_meta_json,
+        paste0("livedaten/",fname,".json"))
+  
+  wahlkreis <- gemeinden_df %>% filter(AGS==g) %>% pull(wk) %>% first()
+  # CSV anlegen
+  
+  write_csv(part_list_df %>% mutate(wk = wahlkreis),paste0("livedaten/",
+                                fname,
+                                ".csv"))
+}
+
+# Liste mit den Datawrapper-IDs als XLSX exportieren
+write.xlsx(dw_df,"datawrapper_ids.xlsx",overwrite = T)
+
+# Stadt
+for (s in ks_ags) {
+  new_dw <- dw_landesstimmen_anlegen(s)
+  fname <- new_dw$content$metadata$annotate$notes
+  dw_id <- new_dw$id
+  dw_df <- rbind(dw_df, tibble(id = s,
+                               typ = "s",
+                               dw_id = dw_id,
+                               fname = fname))
+  
+  # Noch ein wenig Metadaten-Zauber: Farbwerte der Parteien übergeben
+  
+  # Metadaten anlegen
+  forced_meta <- list()
+  forced_meta[["title"]] <- new_dw$content$title
+  forced_meta[["describe"]][["intro"]] <- new_dw$content$metadata$describe$intro
+  forced_meta[["describe"]][["byline"]] <- "Jan Eggers/Sandra Kiefer"
+  forced_meta[["describe"]][["source-url"]] <- "Hessisches Statistisches Landesamt"
+  forced_meta[["describe"]][["source-name"]] <- "https://wahlen.hessen.de/landtagswahlen"
+  forced_meta[["annotate"]][["notes"]] <- "Auszählung beginnt am 8.10.2023, 18 Uhr"
+  # Liste in JSON - der force-Parameter ist nötig, weil R sonst darauf
+  # beharrt, dass es mit der S3-Klasse dw_chart nichts anfangen kann
+  # (obwohl die eine ganz normale Liste ist)
+  forced_meta_json <- toJSON(forced_meta,force=T)
+  write(forced_meta_json,
+        paste0("livedaten/",fname,".json"))
+  
+   
+  write_csv(part_list_df,paste0("livedaten/",
+                                                           fname,
+                                                           ".csv"))
+}
+
+
+# Liste mit den Datawrapper-IDs als XLSX exportieren
+write.xlsx(dw_df,"datawrapper_ids.xlsx",overwrite = T)
+
+# Last but not least: Ganz Hessen
+# new_dw <- dw_create_chart(title = "Landesstimmen: Hessen gesamt", 
+#                           type="tables",
+#                           folderId = ltw_folder_id,
+#                           theme = hsde_theme)
+
+# Alle Livedaten kopieren
+n <- now()
+system('gsutil -m -h "Cache-Control:no-cache, max_age=0" cp livedaten/* gs://d.data.gcp.cloud.hr.de/livedaten/')
+copy_time <- now()-n
+cat("Operation took ",copy_time)
+
+
+#### Grafiken scharf schalten ####
+# Ultrastumpfer und nicht sehr R-mäßiger Loop - aber die DW-Grafiken sind ohnehin langsam
+#
+for (i in 1:nrow(dw_df)) {
+  new_id <- dw_df$dw_id[i]
+  fname <- dw_df$fname[i]
+    
+  meta_data <- list()
+  meta_data[["upload-method"]]= "external-data"
+  meta_data[["external-data"]] = paste0("https://d.data.gcp.cloud.hr.de/livedaten/",
+                                        fname,
+                                        ".csv")
+  meta_data[["external-metadata"]] = paste0("https://d.data.gcp.cloud.hr.de/livedaten/",
+                                            fname,
+                                            ".json")
+  meta_data[["use-datawrapper-cdn"]] = FALSE
+  dw_edit_chart(new_id,data = meta_data)
+  dw_publish_chart(new_id)
+}
+
+#### Parteifarben in die Tabellen setzen ####
+# Au
+
+einrichten_tabellengrafik <- function(dw_ids_v) {
+  # Parteifarben an die Tabelle so übergeben, dass die Balkengrafik-Spalte
+  # über die Spalte "partei" in der Farbe gesteuert werden kann. 
+  # Geht davon aus, dass der Vektor Datawrapper-IDs für Tabellen enthält 
+  
+  # Liste mit Namen und Farben erzeugen
+  # Jedem Attribut der Liste (Parteiname) wird ein Farbwert als Attribut zugewiesen
+  farbliste <- setNames(as.list(listen_df$farbwert), 
+           listen_df$partei)
+  
+  for (id in dw_ids_v) {
+    meta <- dw_retrieve_chart_metadata(id)
+    viz <- meta$content$metadata$visualize
+    # Balkengrafik
+    viz$columns$stimmen$ShowAsBar = TRUE
+    # Balkenfarbe nach anderer Spalte
+    viz$columns$stimmen$customBarColor = TRUE
+    viz$columns$stimmen$customBarColorBy = "partei"
+    viz$columns$stimmen$customColorBarBackground <- farbliste
+    # Spalte "partei" ausblenden
+    viz$columns$partei$showOnDesktop = FALSE
+    viz$columns$partei$showOnMobile = FALSE
+    # Format der Stimmen-Spalte
+    viz$columns$stimmen$format = '0'
+    viz$columns$stimmen$barRangeMin ='0'
+    ####
+    # Den Schlüssel an der Maximal-Prozentzahl aller Tabellen orientieren später
+    viz$columns$stimmen$barRangeMin = '10'
+    
+    # Textgröße anpassen
+    viz$header$style$fontSize = 0.9
+    viz$columns$stimmen$style$fontSize = 0.9
+    viz$columns$name$style$fontSize = 0.9
+    viz$columns$prozent$style$fontSize = 0.9
+    
+    
+    # Spalten umbenennen
+    # ...das scheint zu crashen. 
+    # 
+    # mydata <- meta$content$metadata$data
+    # mydata$changes$`0`$value = "Kandidat/in"
+    # mydata$changes$`0`$previous = "name"
+    # mydata$changes$`0`$row = "0"
+    # mydata$changes$`1`$value = "Partei"
+    # mydata$changes$`1`$previous = "partei"
+    # mydata$changes$`1`$row = "1"
+    # mydata$changes$`2`$value = "Stimmen"
+    # mydata$changes$`2`$previous = "stimmen"
+    # mydata$changes$`2`$row = "2"
+    # mydata$changes$`3`$value = "+/-"
+    # mydata$changes$`3`$previous = "prozent"
+    # mydata$changes$`3`$row = "3"
+    # 
+    
+    
+    # Schriftgrößen anpassen
+    
+    
+    dw_edit_chart(id,visualize = viz,
+                  data =  mydata)
+  }
+} 
+
+
+
+#### TEST ####
+t <- dw_retrieve_chart_metadata("8Eviv")
+# tt <- read_file("livedaten/Untitled.md") %>% str_extract_all(.,"(?<=s id\\: ).....")
+# ALle angelegten Tabellen wieder löschen
+if (FALSE) {
+  dw_df <- read.xlsx("livedaten/datawrapper_ids.xlsx")
+  for (dw in dw_df$dw_id) {
+    try(dw_delete_chart(dw))
+  }
+  
+}
+
+t3 <- dw_retrieve_chart_metadata("i084q")
+
+dw_source <- "ODjTJ"
+t4 <- dw_retrieve_chart_metadata(src)
+desc2 <- t4$content$metadata$describe

R/gsutil-speedtest.R

+# gsutil-speedtest
+
+library(readr)
+library(dplyr)
+library(tidyr)
+library(lubridate)
+
+
+# 
+# leer_df <- tibble(n=c(1,2,3),val=c("a","b","c"))
+# 
+if (!dir.exists("test")) dir.create("test")
+# for (i in 1:1000) {
+#   write_csv(leer_df,paste0("sttmp/test",
+#                            formatC(i, width = 3,format="fg", flag="0"),
+#                            ".csv"))
+# }
+
+n <- now()
+system('gsutil -m -h "Cache-Control:no-cache, max_age=0" cp test/* gs://d.data.gcp.cloud.hr.de/test/')
+copy_time <- now()-n
+n <- now()
+cat("Operation took ",copy_time)
+#file.remove("sttmp/*.*")
+
+# Erstes Experiment: 1000 Files mit ca. 20k --> 20s (mit -m)
+# Löschen der 1000 Files vom Bucket: 7,5s
+
+
+

R/lies_aktuellen_stand.R

+# lies_aktuellen_stand.R
+#
+# Enthält die Funktion zum Lesen der aktuellen Daten. 
+
+#---- Hilfsfunktionen ----
+
+hole_daten <- function(stand_url,a_directory = "daten") {
+  #' Schreibt das Dataframe mit den zuletzt geholten Stimmbezirks-Daten
+  #' als Sicherungskopie in das angegebene Verzeichnis
+  #' 
+  if (!dir.exists(a_directory)) {
+    dir.create(a_directory)
+  }
+  
+  fname = paste0(a_directory,"/",
+                 str_replace_all(now(),"\\:","") %>% str_sub(1,15),
+                 ".csv")
+  # Bei Internet-Adresse: Daten aus dem Netz in den lokalen Ordner kopieren
+  if (str_detect(stand_url,"^http")) {
+    check = tryCatch(
+      { 
+        # Einmal Daten einlesen
+        utils::download.file(stand_url,fname)
+      },
+      warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Daten von ",stand_url," kopieren"))},
+      error = function(e) {teams_warning(e,title=paste0(wahl_name,": Kann Daten nicht von ",stand_url,
+                                                        " kopieren nach ",fname))}
+    )  
+  }
+  # Jetzt vom lokalen Laufwerk einlesen
+  check = tryCatch(
+    {
+      tmp_df <-read_delim(fname, 
+                           delim = ";", escape_double = FALSE, 
+                           locale = locale(date_names = "de", 
+                                           decimal_mark = ",", 
+                                           grouping_mark = "."), 
+                           trim_ws = TRUE, 
+                           skip =1)
+    },
+    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))}
+  )
+  return(tmp_df)
+}
+
+hole_letztes_df <- function(a_directory = "daten") {
+  #' 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())
+  # Die zuletzt geschriebene Datei finden und einlesen
+  neuester_file <- list.files(a_directory, full.names=TRUE) %>% 
+    file.info() %>% 
+    # Legt eine Spalte namens path an
+    tibble::rownames_to_column(var = "path") %>% 
+    arrange(desc(ctime)) %>% 
+    head(1) %>% 
+    # Pfad wieder rausziehen
+    pull(path)
+  if (length(neuester_file)==0) {
+    # Falls keine Daten archiviert, gibt leeres df zurück
+    return(tibble())
+  } else {
+    return(hole_daten(neuester_file))
+  }
+}
+
+#--- 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() + hours(1)
+    } 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")
+    }
+  } else { # lokale Datei
+    t = file.info(my_url)$ctime %>%  as_datetime
+    print(t)
+  }
+  return(t)
+}
+
+
+#---- Lese-Funktionen ----
+
+# Das hier ist die Haupt-Lese-Funktion - ein Wrapper für hole_daten
+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(
+    { 
+      stand_df <- hole_daten(stimmbezirke_url)
+    },
+    warning = function(w) {teams_warning(w,title="OB-Wahl: Datenakquise")},
+    error = function(e) {teams_warning(e,title="OB-Wahl: Datenakquise")})
+  return(stand_df)
+}
+
+#' hole_kreise_direkt()
+#' 
+#' Funktion formatiert den Kreis-Direktwahlergebnis-Teil in eine lange Tabelle um,
+#' ergänzt sie um Vergleichswerte von 2018, und gibt die Tabelle zurück. 
+hole_kreise_direkt <- function(live_df) {
+  # Vorbereitung: Bruda, mach Tabelle lang!
+  
+  #Liste mit den Kreisnamen
+  live_kreise_direkt_long_df <- live_df %>% 
+    filter(Gebietstyp == "WK") %>% 
+    select(wk = 1,
+           wk_name = 2, 
+           wahlberechtigt = 6,
+           waehler = 10,
+           wahlbeteiligung = 12,
+           gueltig = 15,
+           ungueltig = 14,
+           ungueltig_prozent = 17, 
+           all_of(spaltenindex_direkt_df$idx)
+    ) %>% 
+    mutate(wk = as.integer(str_sub(wk,1,3))) %>% 
+    pivot_longer(cols = 9:33,names_to="partei",values_to ="stimmen")   %>% 
+    mutate(partei = str_replace(partei," Wahlkreisstimmen",""))%>% 
+    # Ergänze die (Nach-)Namen der Direktkandidaten
+    left_join(kandidaten_alle_df %>% select (wk,partei=Partei,Nachname,name),
+               by=c("wk","partei"))  %>% 
+    # Parteien ausfiltern
+    filter(!is.na(name)) %>% 
+    # Ergänze 2018er Ergebnisse aus der "Frankentabelle" (Kombination direkte und umgerechnete WK)
+    
+    left_join(frankentable_direkt_lang_df,by=c("wk","partei")) %>% 
+    mutate(differenz = prozent - prozent_2018)
+  return(live_kreise_direkt_long_df)
+  # Filtere Kreise
+}

R/lies_konfiguration.R

+#' lies_konfiguration.R
+#' 
+#' Konfigurationsdatei lesen, Indexdateien lesen, zusätzliche Indizes erzeugen
+#' 
+
+# (das später durch ein schnelleres .rda ersetzen)
+# 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; für "ltwhe23" leer lassen 
+# - stimmbezirke_url - URL auf Ergebnisdaten
+# - kandidaten_fname - Dateiname der Kandidierenden-Liste (s.u.)
+
+# - parteien_fname - Index aller kandidierenden Parteien mit Langnamen und Farbwert
+
+# - datawrapper_fname - Dateiname für die Datawrapper-Verweis-Datei
+
+#' 
+
+
+# Falls der Parameter wahl_name noch nicht definiert ist, 
+# setze ihn erst mal auf das derzeitige Verzeichnis. 
+if (exists("wahl_name")) {
+  index_pfad = paste0("index/",wahl_name,"/")
+  if (!dir.exists(index_pfad)) {
+    index_pfad <- "index/"
+  }
+} else {
+  index_pfad <- "index/"
+}
+
+if (!exists("TEST")) TEST <- FALSE
+# Lies die Indexdatei aus dem Verzeichnis wahl_name. 
+# Falls keines angegeben: aus dem aktuellen Verzeichnis
+if (TEST) {
+  config_df <- read.xlsx(paste0(index_pfad,"config_test.xlsx"))
+} else {
+  config_df <- read.xlsx(paste0(index_pfad,"config.xlsx"))
+}
+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(index_pfad = index_pfad, fname) {
+  fname = paste0(index_pfad, 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.
+    # Schau in die erste Zeile und zähle Kommas vs. Semikolons
+    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 Trenn-Semikolon, 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
+                       )))
+    }
+    
+  }
+}
+
+#### Indexdaten holen ####
+# alle _df Variablen aus der hinterlegten Datei lesen
+
+vars_df <- config_df %>% filter(str_detect(name,"\\_df$"))
+for (i in 1:nrow(vars_df)) {
+  assign(vars_df$name[i],lies_daten(index_pfad,vars_df$value[i]))
+} 
+
+# Läufst du auf dem Server?
+SERVER <- dir.exists("/home/jan_eggers_hr_de") 
+
+#### Ergebnisse 2018 vorbereiten ####
+
+# Vektor mit allen WK, die sich verändert haben: 
+wk_veraendert_v <- c(wk_vergroesserungen_df %>%  pull(wk),
+                     wk_verkleinerungen_df %>% pull(wk)) %>% 
+  unique()
+
+
+# Den simplen Teil zuerst: die "Frankentables" laden
+#
+# (Das sind die Kreis-Ergebnisse umgerechnet auf die neuen WK-Zuschnitte)
+# Zusätzliche Variable veraendert gibt an, ob WK-Zuschnitt sich verändert hat
+
+frankentable_direkt_df <- read.xlsx("ergebnisse2018/frankentabelle_direkt_2018.xlsx",
+                                    sep.names = "_",
+                                    check.names =T) %>% 
+  mutate(veraendert = (wk %in% wk_veraendert_v))
+
+# read.xlsx weigert sich, Leerzeichen in Variablennamen zu lesen. Deshalb der Unterstrich
+# und hier die Umwandlung
+colnames(frankentable_direkt_df) <- colnames(frankentable_direkt_df) %>% str_replace("_"," ")
+
+frankentable_landesstimmen_df <- read.xlsx("ergebnisse2018/frankentabelle_landesstimmen_2018.xlsx",
+                                           sep.names = "_",
+                                           check.names =T) %>% 
+  mutate(veraendert = (wk %in% wk_veraendert_v))
+
+colnames(frankentable_landesstimmen_df) <- colnames(frankentable_landesstimmen_df) %>% 
+  str_replace("_"," ")
+
+# "Frankentabelle" (umgerechnete 2018er Ergebnisse, ergänzt) als Langformat.
+frankentable_direkt_lang_df <- frankentable_direkt_df %>% 
+  pivot_longer(cols=9:21,
+               names_to="partei",
+               values_to="stimmen_2018") %>% 
+  select(wk,wahlberechtigte_2018 = wahlberechtigte,
+         waehler_2018 = waehler,
+         gueltig_2018 = gueltig,
+         ungueltig_2018 = ungueltig,
+         veraendert,
+         partei,
+         stimmen_2018) %>% 
+  mutate(prozent_2018 = stimmen_2018 / gueltig_2018 * 100)
+
+frankentable_landesstimmen_lang_df <- frankentable_landesstimmen_df %>% 
+  pivot_longer(cols=9:21,
+               names_to="partei",
+               values_to="stimmen_2018") %>% 
+  select(wk,wahlberechtigte_2018 = wahlberechtigte,
+         waehler_2018 = waehler,
+         gueltig_2018 = gueltig,
+         ungueltig_2018 = ungueltig,
+         veraendert,
+         partei,
+         stimmen_2018) %>% 
+  mutate(prozent_2018 = stimmen_2018 / gueltig_2018 * 100)
+
+
+# Gemeinde-Ergebnisse laden
+e2018_df <- read_delim("ergebnisse2018/wahlergebnisse2.csv", 
+                       delim = ";", escape_double = FALSE, 
+                       locale = locale(date_names = "de", 
+                                       decimal_mark = ",", 
+                                       grouping_mark = ".", 
+                                       encoding = "WINDOWS-1252"), 
+                       trim_ws = TRUE, skip = 1) %>% 
+  # Zeilen 1-2 enthalten Grütze, Zeile 3 enthält ganz Hessen
+  filter(row_number()>2)
+
+
+
+### Spalten 14-32: Wahlkreisstimmen
+direkt_2018_df <- e2018_df %>%  
+  select(wk = 2,
+         wk_name = 4, 
+         AGS = 3,
+         wahlberechtigt = 9,
+         waehler = 10,
+         wahlbeteiligung = 11,
+         gueltig = 13,
+         ungueltig = 12,
+         ungueltig_prozent = 8, 
+         14:32
+  ) %>% 
+  mutate(across(4:ncol(.), ~ as.numeric(.))) %>% 
+  mutate(wahlbeteiligung = waehler / wahlberechtigt * 100,
+         ungueltig_prozent = gueltig / waehler * 100) %>%
+  # Sonderbedingung: Ganz Hessen = "Wahlkreis 0"
+  mutate(wk = if_else(is.na(wk),0,wk))
+
+# Jetzt die Namen umfrickeln
+colnames(direkt_2018_df) <- colnames(direkt_2018_df) %>% 
+  str_replace("\\.\\.\\.[0-9]+$","")
+
+# Gemeinden und Städte (hier: noch nicht getrennt)
+gemeinden_direkt_2018_df <- direkt_2018_df %>% 
+  filter(!is.na(AGS)) %>%
+  # Stimmbezirks-Zeilen ausfiltern; die machen wir diesmal nicht
+  filter(AGS < 1000000) %>% 
+  mutate(AGS = as.character(AGS)) %>% 
+  select(-wk_name) %>% 
+  # vernünftige Gemeindenamen und Wahlkreisnamen reinjoinen
+  left_join(gemeinden_alle_df %>% select(AGS,name,wk_name), by="AGS") %>% 
+  relocate(AGS,name,wk_name) %>% 
+  # Mehrfach-Einträge für Städte rauswerfen
+  distinct(AGS,name,.keep_all=TRUE)
+  
+  
+### Spalten 35-57: Landesstimmen
+  landesstimmen_2018_df <- e2018_df %>%  
+  select(wk = 2,
+         wk_name = 4,
+         AGS = 3, 
+         wahlberechtigt = 9,
+         waehler = 10,
+         wahlbeteiligung = 11,
+         gueltig = 34,
+         ungueltig = 33,
+         ungueltig_prozent = 8, 
+         35:57
+  ) %>% 
+  mutate(across(4:ncol(.), ~ as.numeric(.))) %>% 
+  mutate(wahlbeteiligung = waehler / wahlberechtigt * 100,
+         ungueltig_prozent = gueltig / waehler * 100) %>%
+  # Sonderbedingung: Ganz Hessen = "Wahlkreis 0"
+  mutate(wk = if_else(is.na(wk),0,wk))
+
+# Jetzt die Namen umfrickeln
+colnames(landesstimmen_2018_df) <- colnames(landesstimmen_2018_df) %>% 
+  str_replace("\\.\\.\\.[0-9]+$","")
+
+# Gemeinden und Städte (hier: noch nicht getrennt)
+gemeinden_landesstimmen_2018_df <- landesstimmen_2018_df %>% 
+  filter(!is.na(AGS)) %>%
+  # Stimmbezirks-Zeilen ausfiltern; die machen wir diesmal nicht
+  filter(AGS < 1000000) %>% 
+  mutate(AGS = as.character(AGS)) %>% 
+  select(-wk_name) %>% 
+  # vernünftige Gemeindenamen und Wahlkreisnamen reinjoinen
+  left_join(gemeinden_alle_df %>% select(AGS,name,wk_name), by="AGS") %>% 
+  relocate(AGS,name,wk_name) %>% 
+  # Mehrfach-Einträge für Städte rauswerfen
+  distinct(AGS,name,.keep_all=TRUE)
+
+# Ganz Hessen? Ganz Hessen!
+hessen_landesstimmen_lang_df <- landesstimmen_2018_df %>% 
+  filter(wk == 0 & is.na(AGS)) %>% 
+  select(-AGS) %>% 
+  pivot_longer(cols = 9:31,
+               names_to = "partei",
+               values_to = "stimmen") %>% 
+  mutate(prozent = stimmen / gueltig * 100)
+
+
+# Direktkandidaten
+
+direktkandidaten_df <- kandidaten_alle_df %>% 
+  filter(!is.na(wk)) %>% 
+  rename(partei = Partei) %>% 
+  left_join(parteien_idx_df %>% rename(p_id = id),by="partei") %>% 
+  arrange(wk,p_id) %>% 
+  mutate(name = paste0(Nachname," (",partei,")")) %>% 
+  select(wk,wk_name = wkn,
+         name,farbwert,Titel,Nachname, Vorname, 
+         Geburtsjahr, Geburtsort, Beruf,
+         Listenplatz, Check_id)
+
+         
\ No newline at end of file

R/main.R

+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)
+p_load(utils)
+p_load(jsonlite)
+
+rm(list=ls())
+
+# Aktuelles Verzeichnis als workdir
+setwd(this.path::this.dir())
+# Aus dem R-Verzeichnis eine Ebene rauf
+setwd("..")
+
+# Lies Kommandozeilen-Parameter: 
+# (Erweiterte Funktion aus dem R.utils-Paket)
+TEST = TRUE
+DO_PREPARE_MAPS = FALSE
+# Kommandozeilen-Argumente
+args = R.utils::commandArgs(asValues = TRUE)
+if (length(args)!=0) { 
+  if (any(c("h","help","HELP") %in% names(args))) {
+    cat("Parameter: \n",
+        "--TEST schaltet Testbetrieb ein\n",
+        "--DO_PREPARE_MAPS schaltet Generierung der Switcher ein\n",
+        "wahl_name=<name> holt Index-Dateien aus dem Verzeichnis ./index/<name>\n\n")
+  }
+  TEST <- "TEST" %in% names(args)
+  DO_PREPARE_MAPS <- "DO_PREPARE_MAPS" %in% names(args)
+  if ("wahl_name" %in% names(args)) {
+    wahl_name <- args[["wahl_name"]]
+    if (!dir.exists(paste0("index/",wahl_name))) stop("Kein Index-Verzeichnis für ",wahl_name)
+  }
+} 
+
+
+
+# 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, die Index-Daten und die Vergleichsdaten
+source("R/lies_konfiguration.R")
+
+# Funktionen einbinden
+# Das könnte man auch alles hier in diese Datei schreiben, aber ist es übersichtlicher
+
+source("R/lies_aktuellen_stand.R")
+
+#---- MAIN ----
+# Vorbereitung
+gezaehlt <- 0 # Ausgezählte Stimmbezirke
+ts <- as_datetime(startdatum) # ts, Zeitstempel, der letzten gelesenen Daten
+
+# Anzahl Stimmbezirke: einmal aus der Hessen-Zeile filtern 
+alte_daten <- hole_daten(stimmbezirke_url) # Leere Stimmbezirke
+stimmbezirke_n <- alte_daten %>% filter(Gebietstyp == "LD") %>% select(all_of(stimmbezirke_i)) %>% pull()
+
+# Grafiken einrichten: Farbwerte und Switcher für die Karten
+# Richtet auch die globale Variable switcher ein, deshalb brauchen wir sie
+
+
+if (DO_PREPARE_MAPS) {
+  
+  # Säulengrafiken-Farben anpassen, individuelle CSV
+  kreise_direkt_saeulen()
+  if (SERVER) {
+    n <- now()
+    system('gsutil -m -h "Cache-Control:no-cache, max_age=0" cp livedaten/* gs://d.data.gcp.cloud.hr.de/livedaten/')
+    copy_time <- now()-n
+    cat("Operation took ",copy_time)
+  } else { teams_warning("Lokaler Zyklus, keine Daten auf Google Bucket kopiert")}
+  # Alle Grafiken auf CSV-und JSON-URL umbiegen
+  fix_data(datawrapper_ids_df %>%  pull(dw_id))
+} 
+
+# 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
+    live_df <- hole_daten(stimmbezirke_url)
+    #
+    live_hessen_direkt_df <- hole_kreise_direkt(live_df)
+    aktualisiere_kreise_landesstimmen()
+    cat("Grafik Land aktualisiert\n")
+    #
+    aktualisiere_kreise_direkt(live_df)
+    aktualisiere_kreise_landesstimmen(live_df)
+    aktualisiere_gemeinden_direkt(live_df)
+    aktualisiere_gemeinden_landesstimmen(live_df)
+    aktualisiere_staedte_landesstimmen(live_df)
+    #
+    cat("Aktualisierte Daten kopiert in",aktualisiere_bucket(),"\n")
+    #
+    neu_gezaehlt <- live_df %>% filter(Gebietstyp == "LD") %>% select(all_of(stimmbezirke_i)) %>% pull()
+    # Nachricht neu gezählte Stimmbezirke
+    gezaehlt <- neu_gezaehlt
+  } else {
+    # Logfile erneuern und 30 Sekunden schlafen
+    system("touch obwahl.log")
+    if (TEST) cat("Warte...\n")
+    Sys.sleep(30)
+  }
+}
+# Titel der Grafik "top" umswitchen
+# dw_edit_chart(top_id,title="Ergebnis: Wahlsieger")
+# dw_publish_chart(top_id)
+
+# Logging beenden
+if (!TEST) {
+  cat("OK: FERTIG - alle Stimmbezirke ausgezählt: ",as.character(ts),"\n")
+  sink()
+  sink(type="message")
+  file.rename("obwahl.log","obwahl_success.log")
+}
+teams_meldung(wahl_name," erfolgreich abgeschlossen.")
+
+
+# EOF
\ No newline at end of file

R/messaging.R

+library(readr)
+library(lubridate)
+library(tidyr)
+library(stringr)
+library(dplyr)
+library(teamr)
+
+#' messaging.R
+#' 
+#' Kommunikation mit Teams
+#' 
+#' 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? 
+if (Sys.getenv("WEBHOOK_OBWAHL") == "") {
+  t_txt <- read_file("~/key/webhook_obwahl.key")
+  Sys.setenv(WEBHOOK_REFERENDUM = t_txt)
+}
+
+teams_meldung <- function(...,title="OB-Wahl-Update") {
+  cc <- teamr::connector_card$new(hookurl = t_txt)
+  if (TEST) {title <- paste0("TEST: ",title) }
+  cc$title(paste0(title," - ",lubridate::with_tz(lubridate::now(),
+                                                 "Europe/Berlin")))
+  alert_str <- paste0(...)
+  cc$text(alert_str)
+  cc$print()
+  cc$send()
+} 
+
+teams_error <- function(...) {
+  alert_str <- paste0(...)
+  teams_meldung("***FEHLER: ",...)
+  stop(alert_str)
+} 
+
+teams_warning <- function(...) {
+  alert_str <- paste0(...)
+  teams_meldung("***WARNUNG: ",...)
+  warning(alert_str)
+} 
+

R/vorbereitung_wahlkreisdaten.R

+library(tidyverse)
+library(pacman)
+library(readr)
+p_load(openxlsx)
+
+rm(list=ls())
+
+# Aktuelles Verzeichnis als workdir
+setwd(this.path::this.dir())
+# Aus dem R-Verzeichnis eine Ebene rauf
+setwd("..")
+
+#' vorbereitung_wahlkreisdaten.R
+#' 
+#' Erstellung der Index-Dateien durch FIltern und Joinen der Ausgangsdaten
+#' In der Regel jeden Abschnitt für sich ausführen; voriges Environment ggf. der
+#' Übersichtlichkeit halber löschen
+
+
+#### Wahlkreis-s anlegen ####
+
+# Erledigt. Besser mit den aufgearbeiteten Daten arbeiten. 
+if (FALSE)
+{
+  wahlkreise_df <- read.xlsx("index/hsl-wahlkreise-2023.xlsx") %>% 
+  select(wk = LWK, wk_name = LWK_NAME)
+
+  gemeinden_df <- read.xlsx("index/gemeinden-kreise.xlsx",sheet=1) %>% 
+    select(AGS,name=kommune_name,flaeche=`Fläche_km2`,
+           bevoelkerung=Gesamtbevölkerung) %>% 
+    mutate(AGS = as.integer(AGS)) 
+  
+  kreise_df <- read.xlsx("index/gemeinden-kreise.xlsx", sheet =2) %>% 
+    select(k_ags = AGS,kreis_name=hr_name)
+  
+  tabelle_df <- read.xlsx("index/gemeinden_wahlkreise_lang.xlsx") %>% 
+    rename(wk = Wahlkreis) %>% 
+    left_join(wahlkreise_df,by="wk") %>% 
+    mutate(k_ags = (AGS %/% 1000) * 1000) %>% 
+    left_join(kreise_df,by="k_ags") %>% 
+    left_join(gemeinden_df, by="AGS")
+  
+  unused_df <- read.xlsx("index/gemeinden_wahlkreise_lang.xlsx") %>%
+    anti_join(gemeinden_df,by="AGS")
+  
+  #write.xlsx(tabelle_df,"../index/wahlgemeinden_alle.xlsx", overwrite = T)
+  # Zuordnung Stadtteile -> Wahlkreis?
+}
+
+#### Parteien mit Wahllisten
+if (FALSE) {
+  parteien_v <- read.xlsx("index/kandidaten_alle.xlsx") %>% 
+    filter(!is.na(Listenplatz)) %>% 
+    pull(Partei) %>% unique()
+  
+  write.xlsx(read.xlsx("index/parteien_idx.xlsx") %>% 
+               filter(partei %in% parteien_v),
+             "index/parteien_listen.xlsx")
+}
+
+#### Gemeinden zu Sophora-Geotag-IDs
+
+if (FALSE) {
+  sophora_df <- read.xlsx("index/sophora-export-1.xlsx") %>% 
+    bind_rows(read.xlsx("index/sophora-export-2.xlsx")) %>% 
+    bind_rows(read.xlsx("index/sophora-export-3.xlsx")) %>% 
+    bind_rows(read.xlsx("index/sophora-export-4.xlsx")) %>% 
+    bind_rows(read.xlsx("index/sophora-export-5.xlsx")) %>% 
+    select(AGS = 3, hr_name = 1, sophora_id = 4, uuid = 5, import_id = 6) %>% 
+    arrange(AGS)
+  
+  sophora_tests_df <- sophora_df %>% left_join(tabelle_df %>% 
+                                                 filter(Gebietstyp != "ST") %>% 
+                                                 select(AGS,wk,wk_name,kreis_name) %>% 
+                                                 mutate(AGS=paste0("06",AGS)),
+                                               by="AGS")
+  
+  
+  write.xlsx(sophora_tests_df,"index/ags_sophora_id.xlsx", overwrite = T)  
+}
+
+#### Indexdatei Spalten zu Ergebnissen ####
+
+if (FALSE) {
+  direktkandidaten_df <- read.xlsx("index/kandidaten_alle.xlsx") %>% 
+    filter(!is.na(wk)) %>% 
+    arrange(wk,Partei)
+  
+  listenkandidaten_df <- read.xlsx("index/kandidaten_alle.xlsx") %>% 
+    filter(!is.na(Listenplatz)) %>% 
+    arrange(wk,Partei)
+  
+  
+  listen_df <- read_delim("Musterdateien/Wahlvorschlaege_Landtagswahl_2023.csv", 
+                          delim = ";", escape_double = FALSE, col_names = FALSE, 
+                          col_types = cols(X1 = col_integer()), 
+                          trim_ws = TRUE) %>% 
+    select(id=1,partei=2,parteiname=3)
+  
+  wahldaten_df <- read_delim("Musterdateien/Muster_Downloaddatei_Wahlergebnisse_Landtagswahl_2023.csv", 
+                             delim = ";", escape_double = FALSE, 
+                             locale = locale(date_names = "de", 
+                                             decimal_mark = ",", 
+                                             grouping_mark = "."), 
+                             trim_ws = TRUE, skip = 1)
+  
+  
+  spalten_df <- tibble(spalte = colnames(wahldaten_df)) %>%  mutate(idx = seq_along(spalte)) 
+  
+  # Parteien zu Spalten
+  
+  # Kandidaten zu Spalten:
+  # Spalten 18-46
+  spaltenindex_direkt_df <- spalten_df %>%  filter(idx %in% 18:46) %>% 
+    mutate(partei = stringr::str_replace(spalte," Wahlkreisstimmen","")) %>% 
+    select(-spalte) %>% 
+    # Parteien, die nicht zur Direktwahl antreten: 
+    # - ÖDP
+    # - Verjüngungsforschung
+    # - DIE NEUE MITTE
+    # - BUNDESPARTEI KLIMALISTE
+    mutate(OK = (partei %in% unique(direktkandidaten_df$Partei))) %>% 
+    filter(OK) %>% select(-OK) 
+  
+  
+  write.xlsx(spaltenindex_direkt_df,"index/spaltenindex_direkt.xlsx",overwrite = T)
+
+  # Wahllisten zu Spalten: 
+  # Spalten 80-108
+  
+  spaltenindex_landesstimmen_df <- spalten_df %>%  filter(idx %in% 80:108) %>% 
+    mutate(partei = stringr::str_replace(spalte," Landesstimmen","")) %>% 
+    select(-spalte) %>% 
+    # Parteien, die nicht zur Listenwahl antreten: 
+    # - Klimaliste Wählerliste (sondern: Bundesliste)
+    # - Bündnis C
+    # - WDMR
+    # - MERA25
+    # - NEV
+    # - PP
+    # - SGV
+    # - Solibew
+    mutate(OK = (partei %in% unique(listenkandidaten_df$Partei))) %>% 
+    filter(OK) %>% select(-OK) 
+  
+  write.xlsx(spaltenindex_landesstimmen_df,"index/spaltenindex_landesstimmen.xlsx")
+    
+}
+
+
+#--- Wahlkreis-Ergebnisse 2018 umgerechnet, Index 2018 ----
+
+
+gemeinden_df <- read.xlsx("index/gemeinden_alle.xlsx")
+dw_id <- read.xlsx("index/datawrapper_ids.xlsx")
+dw_id_direkt_kreise <- dw_id %>% filter(typ=="w") %>% filter(str_detect(fname,"direkt$"))
+dw_id_direkt_gemeinden <- dw_id %>% filter(typ=="g") %>% filter(str_detect(fname,"direkt$"))
+dw_id_landesstimmen_gemeinden <- dw_id %>% filter(typ %in% c("g","s")) %>% filter(str_detect(fname,"landesstimmen$"))
+dw_id_landesstimmen_kreise <- dw_id %>% filter(typ =="w") %>% filter(str_detect(fname,"landesstimmen$"))
+
+
+gemeinden_id_df <- gemeinden_df %>% filter(Gebietstyp %in% c("VF","KS")) %>% 
+  select(AGS,name,wk,wk_name,kreis_name,flaeche,bevoelkerung,) %>% 
+  filter(bevoelkerung > 0) %>% 
+  mutate(AGS = as.character(AGS)) %>% 
+  mutate(bev_dichte = bevoelkerung / flaeche) %>% 
+  mutate(dichte_quintil = ntile(bev_dichte,5)) %>% 
+  left_join(dw_id_direkt_gemeinden %>% select(AGS=id,direkt_id=dw_id),by="AGS") %>% 
+  left_join(dw_id_landesstimmen_gemeinden %>%  select(AGS=id,landesstimmen_id=dw_id),by="AGS")
+
+write.xlsx(gemeinden_id_df,"info/gemeinden_idx.xlsx")
+
+kreise_id_df <- gemeinden_df %>% filter(Gebietstyp %in% c("VF", "KS")) %>% 
+  select(AGS,name,wk,wk_name,kreis_name,flaeche,bevoelkerung,) %>% 
+  group_by(wk) %>% 
+  summarize(wk_name = first(wk_name),
+            kreise = paste(unique(kreis_name),collapse= " "), 
+            gemeinden = n(),
+            bevoelkerung = sum(bevoelkerung), 
+            flaeche = sum(flaeche),
+            ) %>% 
+  mutate(wk = formatC(wk,width = 3,format="fg", flag="0")) %>% 
+  mutate(bev_dichte = bevoelkerung / flaeche) %>% 
+  mutate(dichte_quintil = ntile(bev_dichte,5)) %>% 
+  left_join(dw_id_direkt_kreise %>% select(wk=id,direkt_id=dw_id),by="wk") %>% 
+  left_join(dw_id_landesstimmen_kreise %>%  select(wk=id,landesstimmen_id=dw_id),by="wk")
+
+write.xlsx(kreise_id_df,"info/kreise_idx.xlsx")
+
+#### Direktwahl-Sieger 2018 ####
+
+direkt2018_df <- read.xlsx("ergebnisse2018/vergleichsdaten_hs_umgerechnet_2018.xlsx",
+                           sheet = 4,
+                           startRow = 4,
+                           colNames = FALSE) %>% 
+  select(wk = 1,
+         wk_name = 2,
+         full_name = 3,
+         partei = 4, 
+         stimmen = 5,
+         prozent = 6, 
+         vorsprung = 7) %>% 
+  mutate(gueltig = stimmen/prozent*100,
+         zweiter_stimmen = stimmen - vorsprung) %>% 
+  mutate(zweiter_prozent = zweiter_stimmen/gueltig * 100) %>% 
+  mutate(Nachname = str_replace(full_name,"Dr\\. ","" )) %>% 
+  mutate(Nachname = str_extract(Nachname,"[A-Za-zäöüßÄÖÜ\\-]+")) %>% 
+  filter(!is.na(wk))
+
+write.xlsx(direkt2018_df,"ergebnisse2018/direktwahl2018.xlsx")
+
+direkt2018_n_df <- read.xlsx("ergebnisse2018/vergleichsdaten_hs_umgerechnet_2018.xlsx",
+                           sheet = 4,
+                           startRow = 4,
+                           colNames = FALSE) %>% 
+  select(wk = 1,
+         wk_name = 2,
+         full_name = 3,
+         partei = 4, 
+         stimmen = 5,
+         prozent = 6, 
+         vorsprung = 7) %>% 
+  mutate(gueltig = stimmen/prozent*100,
+         zweiter_stimmen = stimmen - vorsprung) %>%
+  # Nachrücker und Ausgeschiedene markieren
+  mutate(nachrücker = is.na(wk)) %>% 
+  mutate(ausgeschieden = lead(nachrücker)) %>% 
+  # Löcher stopfen
+  mutate_all(~if_else(is.na(.x), lag(.x), .x)) %>% 
+  mutate(gueltig = stimmen/prozent*100,
+         zweiter_stimmen = stimmen - vorsprung) %>% 
+  mutate(zweiter_prozent = zweiter_stimmen/gueltig * 100) %>% 
+  mutate(Nachname = str_replace(full_name,"Nachrücker\\: ","")) %>% 
+  mutate(Nachname = str_replace(Nachname,"Nachrückerin\\: ","")) %>%
+  mutate(Vorname = str_extract(full_name,"(Dr\\. )|(Prof\\. )")) %>% 
+  mutate(Vorname = paste0(ifelse(is.na(Vorname),"",Vorname),str_split_i(full_name,"\\, ",2))) %>% 
+  # Delorzify
+  mutate(Nachname = str_replace(Nachname,"Prof\\. ","" )) %>% 
+  # Doktoren raus
+  mutate(Nachname = str_replace(Nachname,"Dr\\. ","" )) %>% 
+  mutate(Nachname = str_extract(Nachname,"[A-Za-zäöüßÄÖÜ\\-]+")) %>% 
+  # Kreisnamen enthalten irritierende Leerzeichen- 
+  # deshalb nochmal korrekte Kreisnamen reinholen
+  left_join(read.xlsx("index/wahlkreise_alle.xlsx") %>% 
+              select(wk,wkn = wk_name),by="wk" ) %>% 
+  mutate(wk_name = wkn) %>% 
+  select (-wkn)
+
+write.xlsx(direkt2018_n_df,"ergebnisse2018/direktwahl2018_nachrücker.xlsx")
+
+#--- Ergebnisse 2018 Landesstimmen nach Wahlkreis umgerechnet ----
+
+k2018_umgerechnet_df <- read.xlsx("ergebnisse2018/vergleichsdaten_hs_umgerechnet_2018.xlsx",
+                                                  sheet = 6,
+                                                  startRow = 5,
+                                                  colNames = FALSE) %>% 
+  select(wk = 1, 
+         wk_name = 2,
+         wahl = 3,
+         wahlberechtigte = 4,
+         waehler = 5,
+         wahlbeteiligung = 6,
+         ungueltig = 7,
+         ungueltig_prozent = 8,
+         gueltig = 9,
+         CDU = 10,
+         GRÜNE = 12,
+         SPD = 14,
+         AfD = 16,
+         FDP = 18,
+         `DIE LINKE` = 20,
+         `FREIE WÄHLER` = 22,
+         Tierschutzpartei = 24,
+         `Die PARTEI` = 26,
+         PIRATEN = 28,
+         ÖDP = 30,
+         NPD = 32,
+         Sonstige = 34
+         ) %>% 
+  # Wahlkreis-Zelle aus der Zwischenzeile darunter ausfüllen
+  fill(wk,wk_name) %>% 
+  # Zwischenzeilen ausfiltern
+  filter(!is.na(wahl)) %>% 
+  # Sonderbedingugn für ganz Hessen
+  mutate(wk = ifelse(is.na(wk),0,wk))
+
+
+k2018_umgerechnet_landesstimmen_df <- k2018_umgerechnet_df %>% 
+  filter(wahl == "L  18 L") %>% 
+  select(-wahl) %>% 
+  # Die Frankfurt-Punkte durch NA ersetzen
+  mutate(across(everything(), ~  ifelse(str_detect(., "\\•"), NA, .)))
+
+k2018_umgerechnet_direkt_df <- k2018_umgerechnet_df %>% 
+  filter(wahl == "L  18 W") %>% 
+  select(-wahl) %>% 
+  # Die Frankfurt-Punkte durch NA ersetzen
+  mutate(across(everything(), ~  ifelse(str_detect(., "\\•"), NA, .)))
+
+write.xlsx(k2018_umgerechnet_landesstimmen_df,"ergebnisse2018/kreis_landesstimmen_um_2018.xlsx")
+write.xlsx(k2018_umgerechnet_direkt_df,"ergebnisse2018/kreis_direkt_um_2018.xlsx")
+
+#--- 2018er Ergebnisse nicht umgerechnet ----
+
+
+kreise2018_df <- read_csv2("ergebnisse2018/wahlergebnisse2.csv", 
+                                    locale = locale(date_names = "de",
+                                                    decimal_mark = ",", 
+                                                    grouping_mark = ".", 
+                                                    encoding = "ISO-8859-1"), 
+                                    skip = 1) %>% 
+  filter(is.na(GKZ) & Wahlkreis %in% 1:55) %>% 
+  mutate(across(6:55, ~ as.numeric(.)))
+
+#temp
+spalten_direkt_2018_df <- read_csv2("ergebnisse2018/wahlergebnisse2.csv", 
+                            locale = locale(date_names = "de",
+                                            decimal_mark = ",", 
+                                            grouping_mark = ".", 
+                                            encoding = "ISO-8859-1")) %>% 
+  rename(x =1) %>% 
+  filter(str_detect(x,"^Lfd")) %>% 
+  select(14:32) %>% 
+  pivot_longer(everything(),names_to = "idx", values_to = "partei") %>% 
+  mutate(idx = as.integer(str_extract(idx,"[0-9]+")))
+
+spalten_landesstimmen_2018_df <- read_csv2("ergebnisse2018/wahlergebnisse2.csv", 
+                                    locale = locale(date_names = "de",
+                                                    decimal_mark = ",", 
+                                                    grouping_mark = ".", 
+                                                    encoding = "ISO-8859-1")) %>% 
+  rename(x =1) %>% 
+  filter(str_detect(x,"^Lfd")) %>% 
+  select(35:57) %>% 
+  pivot_longer(everything(),names_to = "idx", values_to = "partei") %>% 
+  mutate(idx = as.integer(str_extract(idx,"[0-9]+")))
+
+
+kreise_direkt_2018_df <- kreise2018_df %>% 
+  select(wk = 2, 
+         wk_name = 4,
+         wahlberechtigte = 9,
+         waehler = 10,
+         wahlbeteiligung = 6,
+         ungueltig = 12,
+         ungueltig_prozent = 8,
+         gueltig = 13,
+         14:32) %>% 
+  mutate(wahlbeteiligung = waehler / wahlberechtigte * 100,
+         ungueltig_prozent = ungueltig / waehler * 100)
+
+# Spaltennamen begradigen
+colnames(kreise_direkt_2018_df) <- c(colnames(kreise_direkt_2018_df)[1:8],
+                                     spalten_direkt_2018_df %>% pull(partei))
+
+write.xlsx(kreise_direkt_2018_df,"ergebnisse2018/kreise_direkt_2018.xlsx")
+
+# "Frankentabelle" aus den umgerechneten Wahlkreis-Werten plus der 2018er-Ergebnisse
+# für die nicht umzurechnenden Wahlkreise Frankfurt I und III.
+
+frankentabelle_direkt_df <- k2018_umgerechnet_direkt_df %>% 
+  filter(!(wk %in% c(34,36))) %>%
+  mutate(across(3:21, ~as.numeric(ifelse(.=="x",NA,.)))) %>% 
+  bind_rows(kreise_direkt_2018_df %>% 
+              mutate (Sonstige = `DIE VIOLETTEN` +
+                        LKR + 
+                        `MENSCHLICHE WELT` +
+                        `V-Partei3` +
+                        APPD +
+                        DiB +
+                        NEV +
+                        `ÖkoLinX Hessen`) %>% 
+              select(-`DIE VIOLETTEN`,
+                     -LKR,
+                     -`MENSCHLICHE WELT`,
+                     -`V-Partei3`,
+                     -APPD,
+                     -DiB,
+                     -NEV,
+                     -`ÖkoLinX Hessen`) %>% 
+              filter(wk %in% c(34,36))
+            )
+
+write.xlsx(frankentabelle_kreise_df,"ergebnisse2018/frankentabelle_direkt_2018.xlsx")
+
+# Landesstimmen direkt 
+kreise_landesstimmen_2018_df <- kreise2018_df %>% 
+  select(wk = 2, 
+         wk_name = 4,
+         wahlberechtigte = 9,
+         waehler = 8,
+         wahlbeteiligung = 6,
+         ungueltig = 33,
+         ungueltig_prozent = 7,
+         gueltig = 34,
+         35:57) %>% 
+  mutate(waehler = ungueltig + gueltig) %>% 
+  mutate(wahlbeteiligung = waehler / wahlberechtigte * 100,
+         ungueltig_prozent = ungueltig / waehler * 100) 
+  
+
+# Spaltennamen begradigen
+colnames(kreise_landesstimmen_2018_df) <- c(colnames(kreise_landesstimmen_2018_df)[1:8],
+                                     spalten_landesstimmen_2018_df %>% pull(partei))
+
+write.xlsx(kreise_landesstimmen_2018_df,"ergebnisse2018/kreise_landesstimmen_2018.xlsx")
+
+
+frankentabelle_landesstimmen_df <- k2018_umgerechnet_landesstimmen_df %>% 
+  filter(!(wk %in% c(34,36))) %>%
+  mutate(across(3:21, ~as.numeric(ifelse(.=="x",NA,.)))) %>% 
+  bind_rows(kreise_landesstimmen_2018_df %>% 
+              mutate(across(3:31, ~ as.numeric(.))) %>% 
+              mutate (Sonstige = `Graue Panther`+
+                        BüSo +
+                        `AD-Demokraten` +
+                        `Bündnis C` +
+                        BGE +
+                        `DIE VIOLETTEN` + 
+                        LKR +
+                        `MENSCHLICHE WELT` + 
+                        `Die Humanisten` +
+                        Gesundheitsforschung +
+                        `V-Partei3`) %>% 
+              select(-`Graue Panther`,
+                     -BüSo,
+                     -`AD-Demokraten`,
+                     -`Bündnis C`,
+                     -BGE,
+                     -`DIE VIOLETTEN`,
+                     -LKR,
+                     -`MENSCHLICHE WELT`,
+                     -`V-Partei3`,
+                     -`Die Humanisten`,
+                     -Gesundheitsforschung) %>% 
+              filter(wk %in% c(34,36))
+  )
+
+write.xlsx(frankentabelle_landesstimmen_df,"ergebnisse2018/frankentabelle_landesstimmen_2018.xlsx")
+
+#---- Für Sandra die tabelle der Kandidat:innen nach Kreis - und die Kreise mit Änderungen ----
+
+wk_vergroesserungen_df <- read.xlsx("index/gemeinden_alle.xlsx") %>% 
+  filter(!is.na(Wahlkreis2018)) %>% 
+  mutate(neu_dazu = ifelse(is.na(name),Stadtteilname,name)) %>% 
+  select(wk,wk_name,neu_dazu)
+
+wk_verkleinerungen_df <- read.xlsx("index/gemeinden_alle.xlsx") %>%
+  filter(!is.na(Wahlkreis2018)) %>% 
+  mutate(abgegeben = ifelse(is.na(name),Stadtteilname,name)) %>% 
+  select(-wk) %>% 
+  select(wk = Wahlkreis2018,abgegeben) %>% 
+  left_join(read.xlsx("index/wahlkreise_alle.xlsx"),by="wk") %>% 
+  select(wk,wk_name,abgegeben) %>% 
+  arrange(wk)
+
+write.xlsx(wk_vergroesserungen_df,"index/wk_vergroesserungen.xlsx")
+write.xlsx(wk_verkleinerungen_df,"index/wk_verkleinerungen.xlsx")
+
+wk_direkt_2018_df <- read.xlsx("index/kandidaten_alle.xlsx") %>%
+  filter(!is.na(wk)) %>% 
+  mutate(link_kandidatencheck = ifelse(is.na(Check_id),NA,
+                                       paste0("https://www.hessenschau.de/politik/landtagswahl/kandidatencheck/candidate/",Check_id))) %>% 
+  mutate(vorname = paste0(ifelse(is.na(Titel),"",paste0(Titel," ")),Vorname)) %>% 
+  select(wk, wk_name = wkn, partei = Partei,
+         nachname = Nachname, vorname, beruf = Beruf, geboren = Geburtsjahr, 
+         geburtsort = Geburtsort,
+         link_kandidatencheck) %>% 
+  left_join(read.xlsx("index/parteien_idx.xlsx"), by="partei") %>% 
+  arrange(wk,id) %>%
+  select(-id,-farbwert) %>% 
+  left_join(read.xlsx("ergebnisse2018/direktwahl2018_nachrücker.xlsx") %>% 
+              filter(!nachrücker) %>% 
+              select(wk, 
+                     sieger2018_vorname= Vorname,
+                     sieger2018_nachname = Nachname, 
+                     sieger2018_partei = partei,
+                     sieger2018_prozent = prozent,
+                     sieger_vorsprung = vorsprung), 
+            by="wk") %>% 
+  left_join(read.xlsx("ergebnisse2018/direktwahl2018_nachrücker.xlsx") %>% 
+              filter(nachrücker) %>% 
+              select(wk,
+                     nachrücker_vorname = Vorname,
+                     nachrücker_nachname = Nachname),
+            by="wk")
+
+write.xlsx(wk_direkt_2018_df,"info/kandidaten_kreis.xlsx")
+  
\ No newline at end of file

README.md

+# sophoRa  
+Ein R-Package für das Erstellen und Bearbeiten von Sophora-Elementen und 
+Artikeln.  
+
+## Funktionsweise
+Sophora-Artikel und Elemente werden als XML-Dokumente gespeichert und an eine
+Import-API geschickt, die diese Dokumente dann in die Sophora-Datenbank einträgt.  
+Dabei gibt es zwei Schnittstellen, sogenannte Importer.  
+`dev` (die Entwicklungsumgebung und default-Einstellung in den Funktionen von 
+`sophoRa`) und `prod` (die Produktionsumgebung).  
+Hinter den Kulissen arbeitet in `sophoRa` das R-Package [xml2](https://xml2.r-lib.org/).  
+Dabei wird ein XML-Dokument mit einem [`external_pointer`](https://cran.r-project.org/web/packages/future/vignettes/future-4-non-exportable-objects.html) genutzt. Das führt dazu, dass alle Änderungen an einem eingelesenen Dokument in
+diesem `external_pointer` durchschlagen, auch wenn sie in einer Kopie des 
+eingelesenen Dokuments geschehen, da diese Kopie ebenfalls auf den `external_pointer` 
+verweist.    
+
+Ein Sophora-Artikel besteht aus verschiedenen Absätzen (childNodes), die 
+entweder selbst den Inhalt besitzen (Überschriften und Absätze) oder Referenzen
+auf Sophora-Objekte haben (Bilder, Drittplattform-Elemente wie Datawrapper oder 
+das Datenjournalismus-Element).  
+Die Referenzen werden immer über deren Sophora-Id (external_id) erkannt und
+eingebunden.  
+
+### Erstellen von Sophora-Objekten  
+Sophora-Objekte wie Bilder, Datawrapper-Elemente, Datenjournalismus-Elemente usw.
+werden mit den `create_...()` Funktionen erstellt.  
+Jedes Element wird dabei mit seiner eindeutigen `external_id` in die 
+`prod-Tabelle` in der Bigquery-Datenbank geschrieben.  
+
+#### Schreiben eines Sophora-XML
+Mit der Funktion `write_sophora_xml()` kann ein XML-Dokument in eine lokale 
+Datei geschrieben werden.  
+
+#### Publizieren eines Sophora-XML  
+Mit der Funktion `publish_to_sophora()` wird ein XML-Dokument zum Importer von
+Sophora geschickt und damit in der Entwicklungs- oder Produktionsumgebung 
+veröffentlicht.  
+Jedes importierte Objekt hat dabei einen Publikationsstatus:  
+* preview - Vorschau des Artikels  
+* setOffline - Offline nehmen des Artikels  
+* publish - Veröffentlichen des Artikels    
+
+Der Publikationsstatus wird über die Funktion `set_published_state()` gesetzt.  
+__ACHTUNG:__  
+Jedes Dokument in Sophora besitzt eine eindeutige ID, die Sophora-ID oder 
+`external_id`. Werden zwei unterschiedliche Dokumente mit demselben Artikelstamm
+(idstem) veröffentlicht, wird die Zahl am Ende der Url um 2 hochgezählt, d.h. 
+die Url lautet dann nicht mehr "idstem~100.html" sondern "idstem~102.html" usw.  
+
+## Erstellen eines neuen Sophora-Artikels  
+Ein neuer leerer Sophora-Artikel wird mit der Funktion `create_article()` 
+erstellt.  
+Damit wird ein leeres Template als XML-Dokuemnt `doc` geladen, dessen Metadaten
+noch mit folgenden Funktionen gefüllt werden können:  
+```
+  # Setzt den Titel und die Seo-Url  
+  doc <- set_headline(doc, headline)
+  
+  # Setzt die diversen Titel-Angaben in den Metadaten des Artikels  
+  doc <- set_meta_headline(doc, headline)
+
+  # Setzt den Text des Teasers und den Text auf Drittplattformen  
+  doc <- set_teaser_text(doc, text)
+  
+  # Setzt die Dachzeile eines Artikels und dem zugehörigen Teaser  
+  doc <- set_topline(doc, topline)
+  
+``` 
+Weitere Meta-Angaben wie bspw. "placemark" oder "leadText" können mit der 
+Funktion `set_meta_headline()` gesetzt werden:  
+```
+doc <- set_article_metafield(doc, "swr:placemark", "Baden-Baden")
+```
+
+## Bearbeiten eines Sophora-Artikels  
+Um ein vorhandenen Artikel zu bearbeiten ist es notwendig seine Struktur zu 
+kennen, da über die Position im XML-Baum die Elemente erkannt bzw. platziert 
+werden. Hier wird bspw. der Artikel "test.xml" eingelesen und die 
+Artikel-Struktur angezeigt:  
+```
+library(sophoRa)
+doc <- xml2::read_xml("test.xml")
+show_article_structure(doc)
+```
+![Artikel-Struktur](vignettes/img/show_article_structure.png)
+
+### Url des Artikels ändern  
+Die Url eines Artikels ist im XML als `idstem` hinterlegt. Mit der Funktion 
+`set_idstem()` kann sie geschrieben und verändert werden. Besitzen zwei 
+Dokumente denselben `idstem` wird die Url hochgezählt (siehe oben unter 
+Publizieren).  
+
+### Bearbeitungsdatum ändern  
+Mit `set_editing_date()` wird das Bearbeitungsdatum des XML-Dokuments auf die 
+aktuelle Systemzeit gesetzt.  
+Dieser Zeitstempel wird auch als "Stand" im Sophora-Frontend ausgespielt.  
+
+### Titel (Headline)  
+Mit `set_headline()` wird der Titel und die Seo-Url festgelegt.
+
+### Füge neue Elemente ein  
+Mit den `add_...()` Funktionen werden die verschiedenen Elemente in den XML-Baum
+eines Sophora-Artikels als "childNode" eingefügt.  
+Standardmäßig werden diese Elemente immer am Ende eingefügt. Mit dem Argmuent 
+`pos` kann eine spezifische Position (Absatz) im XML-Baum angegeben werden.  
+So wird bspw. ein neuer Absatz an die dritte Stelle des XML-Baums eingefügt.
+```
+library(sophoRa)
+doc <- xml2::read_xml("test.xml")
+show_article_structure(doc)
+text <- "Ich bin der Text eines neuen Absatzes mit viel Inhalt."
+add_paragraph(doc, text, pos = 3)
+```
+
+### Lösche Elemente  
+Um ein Absatz-Element (Bild, Datawrapper, Überschrift, Textabsatz etc.) aus 
+einem Artikel zu entfernen wird die Funktion `remove_element_in_tree()` benutzt.  
+Hier muss ebenfalls die Position des zu löschenden Elements als Parameter 
+gesetzt werden.  
+Hier wird bspw. das Element im zweiten Absatz aus dem Artikel entfernt.  
+```
+library(sophoRa)
+doc <- xml2::read_xml("test.xml")
+show_article_structure(doc)
+remove_element_in_tree(doc, pos = 2)
+```
+
+### Elemente aktualisieren oder austauschen  
+Um Elemente in Sophora-Objekten auszutauschen werden die `update_...()` 
+Funktionen genutzt.  
+Sie aktualisieren entweder direkt Sophora-Objekte (Drittplattform-Objekte, 
+Bilder etc.) oder tauschen den Inhalt eines Absatzes aus (Überschriften, 
+Textabsätze).  
+Eine Überschrift im zweiten Absatz ändern:  
+```
+doc <- xml2::read_xml("test.xml")
+show_article_structure(doc)
+update_heading(doc, text = "TEST TEST TEST", level = 4, pos = 2)
+
+```
+Das bestehende Bild unter der Sophora-Id (external_id) `energy-plot-from-nuclear-source` 
+wird durch das lokale `new_image.jpg` ausgetauscht:  
+```
+update_image_element("new_image.jpg",
+                     external_id = "energy-plot-from-nuclear-source",
+                     structurenode = "/swraktuell",
+                     alt_text = "Anteil der Atomenergie an der Gesamtstromerzeugung am 20.11.2022")
+```
+
+
+## Referenzen  
+Offizielle Importer Anleitung  
+https://subshell.com/docs/4/importer/importxml/importer216.html  
+Sophora Glossar von SWR Online  
+https://swrlearnit-suedwestrundfunk.msappproxy.net/ilias.php?baseClass=ilGlossaryPresentationGUI&ref_id=217
+