### Skript zur automatischen Erstellung von Sammlungsetiketten
### Erstellt von Toni Kasiske
### Datum: 24.01.2025
## Benötigt wird eine Tabelle mit folgenden Angaben/Spalten: Land, Ort, Zusatz zum Ort, Koordinaten, 
## Datum, Zusatz zum Datum/Methode, Sammler, Sammlungsnummer, ggf. Bemerkung
## Spalten können fehlende Angaben enthalten
## Gewünschte Informationen/Spalten können angepasst werden (Funktion generate_labels() weist die Informationen den jeweiligen Spalten in der Tabelle zu)




# Pakete laden ------------------------------------------------------------
pacman::p_load(patchwork,  # plot_layout()
               ggplot2,  # ggplot()
               gridExtra,
               readxl,  # read_excel()
               tidyverse,
               cowplot)   # plot_grid()


# Daten laden und vorbereiten ---------------------------------------------
data <- read_excel("Sammlung.xlsx")  # hier muss der passende Verweis zur Tabelle gesetzt werden
data[data == "NA"] <- NA  # NA wird aus der xlsx als Text gelesen. Hiermit in reale NA umwandeln

data <- data[data$Bemerkung == "kein Schild" &
               !is.na(data$Bemerkung),]   # hier kann spezifiziert werden, für welche Tiere man ein Etikett möchte (bspw. alle mit einem bestimmten Eintrag in der Bemerkungs-Spalte)

# Funktion um das Datumsformat anzupassen (meine Excel enthalt teilweise das korrekte Datum, teilweise aber auch nur das Jahr als Text formatiert)
process_dates <- function(dates) {
  sapply(dates, function(date) {
    if (grepl("^\\d{5}$", date)) {   # wandelt Einträge mit 5 Zahlen (excel-Datum als Text) in Datum dd.mm.yyyy um
      format(as.Date(as.numeric(date), origin = "1899-12-30"), "%d.%m.%Y")
    } else {
      date   # andere Einträge bleiben unformatiert
    }
  })
}
data <- data %>%
  mutate(Datum_Processed = process_dates(Datum))  # Datum mit Funktion umwandeln

unique(data$Land)
data <- data %>%  # Land abkürzen
  mutate(Land_kurz = case_when(
    Land == "Deutschland" ~ "DE",
    Land == "Italien" ~ "IT",
    Land == "England" ~ "UK",
    Land == "Schweiz" ~ "CH",
    Land == "Österreich" ~ "AT",
    Land == "Griechenland" ~ "GR",
    Land == "Niederlande" ~ "NL",
    Land == "Tschechien" ~ "CZ",
    Land == "Frankreich" ~ "FR",
    TRUE ~ Land
  ) )
unique(data$Land_kurz)  # für jedes Land Abkürzung vorhanden? Falls nicht, Zeilen davor ergänzen


# Funktionen --------------------------------------------------------------
# Funktion um einzelnes Etikett zu generieren
# Einzelne zeilen generieren, indem NAs ignoriert werden und Text zusammen gefügt wird
create_label <- function(ort, ort_zusatz, koordinaten, datum, datum_zusatz, sammler, land, number) {
  zeile1 <- ifelse(is.na(ort), ifelse(is.na(land), "", land), ifelse(is.na(land), ort, paste0(ort, ", ", land)))
  zeile2 <- ifelse(is.na(ort_zusatz), "", ort_zusatz)
  zeile3 <- ifelse(is.na(koordinaten), "", koordinaten)
  zeile4 <- ifelse(is.na(datum_zusatz), as.character(datum), paste0(as.character(datum), ", ", datum_zusatz))
  zeile5 <- ifelse(is.na(sammler), "", paste0("leg. ", sammler))
  number <- number
  
  # Zeilen zu Text zusammenfügen
  zeilen <- c(zeile1, zeile2, zeile3, zeile4, zeile5)
  non_empty_lines <- Filter(function(x) x != "", zeilen)  # Leere Zeilen ignorieren
  text <- paste(non_empty_lines, collapse = "\n")  # Zeilen mit Umbruch zusammenfügen
  
  # Schriftgröße abhängig der längsten Zeile
  max_zeichen <- max(nchar(non_empty_lines))
  base_size <- ifelse(max_zeichen < 11, 2.8,
                      ifelse(max_zeichen < 18, 1.9,
                             ifelse(max_zeichen < 23, 1.5,
                                    ifelse(max_zeichen < 26, 1.3,
                                           ifelse(max_zeichen < 30, 1.2, 1.18)
                                    ))))

  # Erstellen der Etiketten
  p <- ggplot() +
    annotate("text", x = 0.5 - (2/25.4), y = 0.5, label = text, size = base_size, hjust = 0.5, vjust = 0.5) +
    geom_segment(aes(x = 1 - (2 / 25.4), xend = 1 - (2 / 25.4), y = 0, yend = 1), color = "black", size = 0.2) +    # Horizontale Linie 2mm links neben rechtem Rand
    annotate("text", x = 1 - (0.7 / 25.4), y = 0.5, label = number, size = 1.25, angle = 90, hjust = 0.5) +  # Nummer des Tiers in der Sammlung
    theme_void() +
    theme(plot.margin = margin(0.5, 0.5, 0.6, 0.5, "mm"),
          #plot.background = element_rect(color = "black", size = 0.6),  # Äußerer Rand
          panel.background = element_rect(color = "black", fill = NA, size = 0.6)) +  # Innerer Rand
    coord_fixed(ratio = 1 / 1.6, xlim = c(0, 1), ylim = c(0, 1))  # Aspect ratio beibehalten (Rechteck 1:1.6)
  return(p)
}

# Liste mit Etiketten generieren. Hier werden die jeweiligen Inputvariablen (Spalten) definiert. Die Namen der Spalten können hier angepasst werden
generate_labels <- function(data, output_file) {
  label_plots <- lapply(1:nrow(data), function(i) {
    row <- data[i, ]
    create_label(
      ort = row$Ort,
      ort_zusatz = row$`Zusatz Ort`,
      koordinaten = row$Koordinaten,
      datum = row$Datum_Processed,
      datum_zusatz = row$`Zusatz Datum`,
      sammler = row$Sammler,
      land = row$Land_kurz,
      number = row$Nummer
    )
  })
  
  label_grid <- marrangeGrob(label_plots, nrow = 22, ncol = 10, top = NULL)  # 22 Etiketten per Zeile, 10 per Spalte
  
  # Save to PDF
  ggsave(output_file, label_grid, width = 8.27, height = 11.69, units = "in")  # A4 Seite in Inches (muss beim Druck an Ränder angepasst werden!)
  
}



# Etiketten erzeugen ------------------------------------------------------
Stand <- format(Sys.Date(), "%Y%m%d")  # Heutiges Datum
generate_labels(data, paste0("Etiketten_", Stand, ".pdf"))   # Hier muss der Pfad eingefügt werden, wo es abgespeichert werden soll