Stand

R/aktualisiere_grafiken.R

@@ -36,6 +36,17 @@ generiere_auszählungsbalken <- function(anz = gezaehlt,max_s = stimmbezirke_n,t
   
 }
 
+notes_text_auszaehlung <- function(anz = gezaehlt,max_s = stimmbezirke_n,ts = ts,...) {
+  sd <- as_datetime(startdatum)
+  if (ts >= sd) {
+    return(paste0(...,generiere_auszählungsbalken(anz,max_s,ts)))
+  } else {
+    return(paste0(...,
+                  "Auszählung beginnt am ",
+                  format(sd,"%A, %d. %B %Y, %H:%M Uhr")))
+  }
+}
+
 #---- Daten-Kopierfunktionen ----
 
 # Kopiere Livedaten-Ordner in das Google Bucket
@@ -132,16 +143,93 @@ kreise_direkt_saeulen <- function() {
   }
   
 }
+
   
-  
- 
-# Landesstimmen-Grafiken
-# Haben 3 Spalten (Partei, Veränderung, prozentplusminus)
+#' gemeinde_direkt_tabelle()
+#' 
+#' Passt die Metadaten der Landesstimmen-Grafiken an:
+#' - Farbtabelle für Barcharts in das Vorbild laden
+#' - Vorbild-Visualize-Metadaten klonen
+#' - Data-Daten klonen 
+#' - Daten überschreiben
+#' - Livedaten generieren
+#' Die haben 3 Spalten (Partei, Veränderung, prozentplusminus)
+gemeinde_direkt_tabelle <- function() {
+  # Vorbild-Metadaten laden
+  source_meta <- dw_retrieve_chart_metadata(dw_template4)
+  viz <- source_meta$content$metadata$visualize
+  # Farbliste mit allen Partei-IDs - ruhig die lange
+  farbliste <- setNames(as.list(partei_idx_df$farbwert), 
+                        parteien_idx_df$name)
+  viz[["columns"]][["stimmen"]][["customColorBarBackground"]] <- farbliste
+  viz[["columns"]][["stimmen"]][["customBarColorBy"]] <- "partei"
+  gemeinden_v <- gemeinden_alle_df %>% 
+    filter(!(AGS %in% staedte_v)) %>% 
+             pull(AGS)
+  for (g in gemeinden_v) {
+    # Hole den "letzten" (also den zweiten) Eintrag zu dieser AGS
+    fname <- datawrapper_ids_df %>% filter(id == g) %>% 
+      pull(fname) %>% last()
+    dw_id <- datawrapper_ids_df %>% filter(id == g) %>% 
+      pull(dw_id) %>% last()
+    gemeinde_name <- gemeinden_alle_df %>% filter(AGS == g) %>% pull(name)
+    wk <- gemeinden_alle_df %>% filter(AGS == g) %>% pull(wk)
+    wk_name <- gemeinden_alle_df %>% filter(AGS == g) %>% pull(wk_name)
+    
+    # Visual-Metadaten hochladen
+    old_metadata <- dw_retrieve_chart_metadata(dw_id) 
+    # Neuen Listeneintrag mit den visualize-Metadaten unter der id generieren
+    dat <- old_metadata$content$metadata$data
+    # 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(dw_id, data = dat, visualize = viz)
+
+    
+    title <- paste0(gemeinde_name, ": Landesstimmen")
+    intro <- paste0("Zweitstimmen in ",gemeinde_name,", alle Wahllisten, in der Reihenfolge vom Wahlzettel. ",
+                    "Werte in Klammern geben die Differenz zur letzten Wahl 2018 an.")
+    # Metadaten anlegen
+    forced_meta <- list()
+    forced_meta[["title"]] <- title
+    forced_meta[["describe"]][["intro"]] <- 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"]] <- notes_text_auszaehlung(0,0,as_datetime(startdatum) - days(1))
+      
+    # 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
+    part_list_df <- parteien_listen_df %>%
+      mutate(stimmen = 0) %>%
+      mutate(prozent = "0,0% (+0)") %>% 
+      mutate(wk = wk) %>% 
+      select(partei,stimmen,prozent,wk) 
+    write_csv(kand_list_df,paste0("livedaten/",
+                                  fname,
+                                  ".csv"))
+    #---------- Letzte Aktion: Neu publizieren ----
+    dw_publish_chart(dw_id)
+  }
+}
 
-# Lies s
-source_meta <- dw_retrieve_chart_metadata("p6i6a")
 
-viz[["columns"]][["stimmen"]][["customColorBarBackground"]]
+# Lies s
 
 
 #
@@ -170,12 +258,6 @@ copy_visuals <- function(dw_source,dw_id_v) {
 #' 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) {
@@ -248,11 +330,11 @@ aktualisiere_gemeinden_landesstimmen <- function(live_df) {
   
 }
 
-aktualisiere_staedte_landesstimmen {
+aktualisiere_staedte_landesstimmen <- function(live_df){
   
 }
 
-aktualisiere_hessen_landesstimmen {
+aktualisiere_hessen_landesstimmen <- function(live_df){
   
 }
 

R/lies_konfiguration.R

@@ -262,4 +262,8 @@ direktkandidaten_df <- kandidaten_alle_df %>%
          Geburtsjahr, Geburtsort, Beruf,
          Listenplatz, Check_id)
 
+#--- MISC ---
+# Kassel, Darmstadt, Frankfurt, Wiesbaden - die KF mit mehr als einem Wahlkreis
+# Offenbach wird als Gemeinde in einem Wahlkreis behandelt (der halt nur eine Gemeinde hat)
+staedte_v <- c("611000","411000","412000","414000")
          
\ No newline at end of file

R/main.R

@@ -22,6 +22,9 @@ setwd(this.path::this.dir())
 # Aus dem R-Verzeichnis eine Ebene rauf
 setwd("..")
 
+# Deutsche Zahlen, Daten, Datumsangaben
+Sys.setlocale(locale = "de_DE")
+
 # Lies Kommandozeilen-Parameter: 
 # (Erweiterte Funktion aus dem R.utils-Paket)
 TEST = TRUE
@@ -62,7 +65,16 @@ 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")
+check = tryCatch(
+  { # Bibliotheken
+    source("R/lies_aktuellen_stand.R")
+    source("R/aktualisiere_grafiken.R")
+  },
+  warning = function(w) {teams_warning(w,title=paste0(wahl_name,": Bibliotheksfunktionen?"))},
+  error = function(e) {teams_warning(e,title=paste0(wahl_name,": Bibliotheksfunktionen?"))}
+)  
+
+
 
 #---- MAIN ----
 # Vorbereitung
@@ -89,6 +101,7 @@ if (DO_PREPARE_MAPS) {
   } 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))
+  gemeinde
 } 
 
 # Schleife.

R/messaging.R

@@ -9,18 +9,19 @@ library(teamr)
 #' 
 #' Kommunikation mit Teams
 #' 
-#' Webhook wird als URL im Environment gespeichert. Wenn nicht dort, dann Datei im Nutzerverzeichnis ~/key/ einlesen.
+#' Webhook wird als URL im Environment gespeichert. Wenn nicht dort, dann Datei 
+#' webhook_ltwhe.key 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)
+if (Sys.getenv("WEBHOOK_LTWHE") == "") {
+  t_txt <- read_file("~/key/webhook_ltwhe.key")
+  Sys.setenv(WEBHOOK_LTWHE= t_txt)
 }
 
-teams_meldung <- function(...,title="OB-Wahl-Update") {
+teams_meldung <- function(...,title="ltwhe-Update") {
   cc <- teamr::connector_card$new(hookurl = t_txt)
   if (TEST) {title <- paste0("TEST: ",title) }
   cc$title(paste0(title," - ",lubridate::with_tz(lubridate::now(),