Skip to content
Snippets Groups Projects
librarys-datimport.qmd 16.4 KiB
Newer Older
::: content-hidden
# librarys Farben und Daten {.hidden .unnumbered .unlisted}

```{r librarys, include=FALSE}
library(readxl)
library(ggplot2)
library(treemapify)
library(treemap)
library(ggrepel)
library(stats)
library(corrplot)
library(tidyverse)
library(feather) # um Daten zu speichern
library(tidyr)
library(scales)
library(RColorBrewer)  # Für eine breite Palette von Farben
library(patchwork) # um Diagramme nebeneinander darzustellen
library(knitr)
library(flextable)
library(kableExtra)
library(xtable) # für LaTeX-Tabellen
library(quarto)
Wiebke Torsten's avatar
Wiebke Torsten committed
#library(webshot2) # für Screenshots
library(RPostgres) # installation funktionert nachdem via muon libpq-dev installiert wurde 
library(config) # um Datenbankonfiguration zu verstecken
Wiebke Torsten's avatar
Wiebke Torsten committed
```{r}
# config.yml ist in faircloud/3-2-bwi/Auswertung/R_bwi/

# Verbindung herstellen
# convwm <- dbConnect(RPostgreSQL::PostgreSQL(),
#                     host="db03.simplex4data.de",
#                     port=5432,
#                     user="twiebke",
#                     dbname="projekt_lfb",
#                     password="rechtshelfeschmerzendamals")
# Konfiguration für eine spezifische Datenbank laden
config <- config::get(file = "config.yml")
db_config <- config$databases$sgdb
consgdb <- DBI::dbConnect(RPostgres::Postgres(),
                 host=db_config$host,
                 port=db_config$port,
                 dbname=db_config$dbname,
                 user=db_config$user,
                 password=db_config$password)
```


```{r farben, include=FALSE}
# Benutzerdefinierte Farben für die Layer
ba_farben <- c("Eiche (Quercus)" = "#ffffcc",
               "Eiche" = "#ffffcc",
               "Eichen-Typ"  = "#ffffcc",
               "Buche (Fagus)" = "#ccfe64",
               "Buche" = "#ccfe64",
               "Buchen-Typ" = "#ccfe64",
               "Esche (Fraxinus)" = "#fed976",
               "Eschen-Typ" = "#fed976",
               "Ahorn (Acer)" = "#fd8d3c",
               "sonst. Lb hoher Lebensdauer" = "#fc4e2a",
               "andere Lb hoher Lebensdauer" = "#fc4e2a",
               "Typ sonst. Laubbäume mit hoher Lebensdauer" = "#fc4e2a", 
               "Erle (Alnus)" = "#8c96c6",
               "Erlen-Typ" = "#8c96c6",
               "Birke (Betula)" = "#e0ecf4",
               "Birken-Typ" = "#e0ecf4",
               "sonst. Lb niedriger Lebensdauer" = "#88419d",
               "andere Lb niedriger Lebensdauer" = "#88419d",
               "Typ sonst. Laubbäume mit niedriger Lebensdauer"= "#88419d",
               "alle Laubbäume" = "#ae017e",
               "Fichte (Picea)" = "#7f7f7f",
               "Fichte" = "#7f7f7f",
               "Fichten-Typ"  = "#7f7f7f",
               "Tanne (Abies)" = "#a6bddb",
               "Tanne" = "#a6bddb",
               "Tannen-Typ"  = "#a6bddb",
               "Douglasie (Pseudotsuga)" = "#67a9cf",
               "Douglasie" = "#67a9cf",
               "Douglasien-Typ" = "#67a9cf",
               "Kiefer (Pinus)" = "#e4ce4c", 
               "Kiefer" = "#e4ce4c",
               "Kiefern-Typ"  = "#e4ce4c",
               "Lärche (Larix)" = "#f4a6a4",
               "Lärche" = "#f4a6a4",
               "Lärchen-Typ" = "#f4a6a4",
               "alle Nadelbäume" = "#02818a",
               "Typ mit mehreren gleichrangigen Baumarten" ="#006d2c",
               "Lücke" = "#dcdcdc",
               "Blöße" = "#edf8fb",
               "Nichtholzboden" = "#b2e2e2",
               "Holzboden" = "#66c2a4",
               "bestockter Holzboden" = "#2ca25f",
               "Wald" = "#006d2c",
               "stehend, ganzer Baum" = "goldenrod1",
               "stehend, Bruchstück (Höhe ab 130 cm)" = "goldenrod2",
               "stehend" = "goldenrod3",
               "liegend, ganzer Baum mit Wurzelanlauf" = "darkseagreen1",
               "liegend, Stammstück mit Wurzelanlauf" = "darkseagreen2",
               "liegend, Teilstück ohne Wurzelanlauf" = "darkseagreen3",
               "liegend" = "darkseagreen4",                           
               "Wurzelstock (Höhe < 130 cm)" = "#88419d",
               "Abfuhrrest (aufgeschichtet)" = "#ae017e",
               "alle Totholztypen" = "#67a9cf"  
)
```

Wiebke Torsten's avatar
Wiebke Torsten committed
# Datenimport 

## von Sachgebietsdatenbank consgdb

```{r}
# # Das Problem wird der h3index sein 
qu_trackt_eckenanzahl <-  "select --distinct bftw.anat 
	COUNT(distinct bfev.tnr) filter (where bfev.wa between 1 and 5) as waldtrakte,	-- Anzahl der Traktnummern mit bfev.wa zwischen 1 und 5
	COUNT(distinct bfev.tnr) filter (where bfev.wa = 0) as nichtwaldtrakte 	-- Anzahl der Traktnummern mit bfev.wa = 0
    ,count(bfev.enr) filter (where bfev.wa between 1 and 5) as waldecke
from
	bwi_2022.b3f_ecke_vorkl bfev
	--join bwi_admin.lospunkt l on l.tnr = bfev.tnr
join bwi_2022.b3f_tnr_vorkl bftv on 	bftv.tnr = bfev.tnr
join bwi_2022.b3f_tnr_work bftw on	bftw.tnr = bfev.tnr
where
	bftv.trstatus between 1 and 3 -- waldtrakte
	and bftw.anat between 1901 and 1916;"
trackt_eckenanzahl <- dbGetQuery(consgdb, qu_trackt_eckenanzahl) 
trackt_eckenanzahl

```

```{r}
## Dickster Baum

qu_ba_bhd <-  "SELECT distinct wzp.tnr, 
       wzp.enr, 
       wzp.ba, 
       x3.langd AS ba_name, 
       wzp.m_bhd,
       wzp.m_bhd / 10.0 as bhd_cm,
       wzp.al_ba AS alter
FROM bwi_2022.b3v_wzp wzp
JOIN bwi_meta.x3_ba x3 
    ON wzp.ba = x3.icode
WHERE wzp.m_bhd IS NOT null
  AND wzp.pk < 6
  AND wzp.pk <> 4
ORDER BY wzp.m_bhd DESC
Limit 1;"
ba_bhd <- dbGetQuery(consgdb, qu_ba_bhd) 
ba_bhd
```



## Waldfläche {.hidden .unnumbered .unlisted}

```{r imp_waldfl, include=FALSE}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
waldfl_sheet_names <- excel_sheets("../data/Waldfl_Ba.xlsx")
waldfl_ba <- lapply(waldfl_sheet_names, function(sheet) {
  read_excel("../data/Waldfl_Ba.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(waldfl_ba) <- waldfl_sheet_names
```

### Waldflächenanteile

```{r}
# Daten umformen und rangieren
waldflant <- waldfl_ba$waldanteil22 %>% 
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Kategorie",
               values_to = "Anteil")

# Filter, nach Anteil sortieren und fortlaufende Rangfolge erstellen
waldflant <- waldflant %>%
  filter(Land != "Deutschland (alle Länder)") %>%
  arrange(desc(Anteil * (Kategorie == "Wald"))) %>%  # Sortiert nach Anteil der Kategorie "Wald" absteigend
  group_by(Kategorie) %>%
  mutate(Anteilsrang = ifelse(Kategorie == "Wald", row_number(), NA)) %>% # Fortlaufende Rangfolge für Wald
  ungroup()


# Zeilen anzeigen
waldflant
```

### Waldfläche \[ha\] nach Land und Waldspezifikation

```{r}
# Daten in Long-Format bringen
waldfl_spez_long <- waldfl_ba$waldfl22spez %>%
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Kategorie",
               values_to = "Fläche")
waldfl_spez_long <- waldfl_spez_long %>%
  replace_na(list(Fläche = 0))
# Prozentwerte der Kategorien berechnen
waldfl_spez_long <- waldfl_spez_long %>%
  left_join((waldfl_spez_long %>%
              filter(Kategorie %in% c("bestockter Holzboden", "Blöße", "Nichtholzboden")) %>%
              group_by(Land) %>%
              mutate(Prozent = round((Fläche / sum(Fläche) * 100),2)) %>%
              ungroup() %>%
              select(Land, Kategorie, Prozent)), by = c("Land", "Kategorie"))  %>%
  left_join(waldfl_spez_long %>%
              filter(Kategorie %in% c("Wald", "Holzboden")) %>%
              spread(key = Kategorie, value = Fläche) %>%
              mutate(Holzboden_Anteil = round((Holzboden / Wald) * 100, 2)) %>%
              select(Land, Holzboden_Anteil), by = "Land") %>%
  mutate(Prozent = ifelse(Kategorie == "Holzboden", Holzboden_Anteil, Prozent)) %>%
  select(-Holzboden_Anteil) %>%
  replace_na(list(Prozent = 100)) 
# Filter, nach Anteil sortieren und fortlaufende Rangfolge erstellen
waldfl_spez_long <- waldfl_spez_long %>%
  filter(Land != "Deutschland (alle Länder)") %>%
  arrange(desc(Fläche * (Kategorie == "Wald"))) %>%  # Sortiert nach Fläche der Kategorie "Wald" absteigend
  group_by(Kategorie) %>%
  mutate(Flächenrang = ifelse(Kategorie == "Wald", row_number(), NA)) %>% # Fortlaufende Rangfolge für Wald
  ungroup()
 waldfl_spez_long
```

### Waldfläche Begehbarkeit

```{r}
# waldfl_begeh22 <- waldfl_ba$bb_waldfl_begehbar_waldspez22 %>%
#   pivot_longer(cols = -c(Begehbarkeit,Einheit),
#                names_to = "Waldspezifikation",
#                values_to = "Fläche")
# waldfl_begeh22
```

### Traktecken Begehbarkeit

```{r}
waldecke_begeh22 <- waldfl_ba$bb_ecken_begehbar_waldspez22 %>%
  pivot_longer(cols = -c(Begehbarkeit,Einheit),
               names_to = "Waldspezifikation",
               values_to = "Ecken")
waldecke_begeh22
```

### Waldfläche Eigentum

```{r imp_waldfl_eig, include=FALSE}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
waldfleig_sheet_names <- excel_sheets("../data/Waldfl_eig.xlsx")
waldfl_eig <- lapply(waldfleig_sheet_names, function(sheet) {
  read_excel("../data/Waldfl_eig.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(waldfl_eig) <- waldfleig_sheet_names
```

```{r}
#Daten umstrukturieren
waldfl22_eig_long <- waldfl_eig$waldfl22_eig %>%
  pivot_longer(cols = -c(Land, Einheit, `alle Eigentumsarten`),
               names_to = "Eigentumsart",
               values_to = "Fläche") %>%
  replace_na(list(Fläche = 0))

# Berechnung der Prozentwerte für alle Kategorien
waldfl22_eig_long <- waldfl22_eig_long %>%
  group_by(Land) %>%
  mutate(Prozent = round((Fläche / `alle Eigentumsarten`) * 100, 2))

# Erstellen der Gruppen
waldfl22_eig_long <- waldfl22_eig_long %>%
  mutate(
    Gruppe = case_when(
      Eigentumsart %in% c("Staatswald (Bund)", "Staatswald (Land)", "Körperschaftswald") ~ "Öffentlicher Wald",
      Eigentumsart %in% c("Privatwald, bis 20 ha", "Privatwald, über 20 bis 1000 ha", "Privatwald, über 1000 ha") ~ "Privatwald",
      TRUE ~ Eigentumsart
    )
  )
waldfl22_eig_long
```

### Veränderung Waldfläche Eigentum

```{r}
# Daten umstrukturieren
ver_waldfl22_eig_long <- waldfl_eig$ver_waldfl22_eig %>%
  pivot_longer(cols = -c(Land, Einheit, `alle Eigentumsarten`),# `Öffentlicher Wald`, `Privatwald`),
               names_to = "Eigentumsart",
               values_to = "Fläche") %>%
  replace_na(list(Fläche = 0))
ver_waldfl22_eig_long
```

## Baumarten Standflächen ha

```{r}
#Daten für 2022 vorbereiten
waldfl22_ba_long <- waldfl_ba$waldfl_ba_standfl_22 %>%
  #filter(Land == "Brandenburg") %>%
  pivot_longer(cols = -c(Land, Einheit, `alle Baumarten`
                         # , "alle Baumarten",
                         # "alle Laubbäume","alle Nadelbäume",
                         # "andere Lb hoher Lebensdauer",
                         # "andere Lb niedriger Lebensdauer"
                         ),
               names_to  = "Ba_Wa",
               values_to = "Fläche")
# waldfl22_ba_long
# Berechnung der Prozentwerte für alle Kategorien
waldfl22_ba_long <- waldfl22_ba_long %>%
  group_by(Land) %>%
  mutate(Prozent = round((Fläche / `alle Baumarten`) * 100, 2)) %>%
  ungroup() %>%
# Zuordnung der Farben zu den Daten
  mutate(Farbe = ba_farben[match(Ba_Wa, names(ba_farben))])
waldfl22_ba_long
```

### Vorrat {.hidden .unnumbered .unlisted}

```{r imp_vor, include=FALSE}
# # Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# # Namen der Blätter automatisch auslesen
# vor_sheet_names <- excel_sheets("../Vorrat.xlsx")
# vor <- lapply(vor_sheet_names, function(sheet) {
#   read_excel("../Vorrat.xlsx", sheet = sheet, skip = 5, na = "NaN")
# })
# # Namen der Liste anpassen
# names(vor) <- vor_sheet_names
```

### Abgang/Nutzung

```{r}
abgang_nutz_sheet_names <- excel_sheets("../data/abgang_nutzung.xlsx") 
abgang_nutz <- lapply(abgang_nutz_sheet_names, function(sheet) {
  read_excel("../data/abgang_nutzung.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
names(abgang_nutz) <- abgang_nutz_sheet_names
```

### Abgang

```{r}
ausgesbest <- abgang_nutz$ausg_best_land_bagr_22 %>%
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Ba_Gruppe",
               values_to = "Abgang")
ausgesbest
```

## Abgangsgrund

```{r}
abgangsgrund <- abgang_nutz$abgangsgrund_bb_bagr_22 %>%
  pivot_longer(cols = -c(Abgangsgrund, Einheit),
               names_to = "Ba_Gruppe",
               values_to = "Vorrat") %>%
  mutate(Vorrat = replace_na(Vorrat, 0)) # Ersetzt NA in der Spalte Vorrat durch 0

```

### Veränderungsrechnung {.hidden .unnumbered .unlisted}

#### Waldflächenänderung {.hidden .unnumbered .unlisted}

```{r imp_ver_waldfl, include=FALSE}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
ver_waldfl_sheet_names <- excel_sheets("../data/Veränderung_der_Waldfläche.xlsx")
ver_waldfl <- lapply(ver_waldfl_sheet_names, function(sheet) {
  read_excel("../data/Veränderung_der_Waldfläche.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(ver_waldfl) <- ver_waldfl_sheet_names
```

##### Waldflächenänderung long

```{r ver-waldfl, include=FALSE}
# Daten vorbereiten
# Veränderung Waldfläche
ver_waldfl_long <- ver_waldfl$ver_waldfl_waldspez_hb_nhb_2022 %>%
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Kategorie",
               values_to = "Veränderungen") %>%
  replace_na(list("Veränderungen"= 0))
#ver_waldfl_long
```

##### Standflächenänderung long

```{r}
# Daten für Waldfl in Long-Format bringen
ver_stndfl_long <- ver_waldfl$ver_stndfl_ba_22 %>%
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Kategorie",
               values_to = "Veränderungen") %>%
  #filter(Land != "Deutschland (alle Länder)") %>%
  replace_na(list(Veränderungen = 0))
ver_stndfl_long
```

##### Prozentstandflächenänderung

```{r}
ver_standfl_prozent <- ver_waldfl$ver_proz_waldfl_ba_standfl_22 %>%
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Kategorie",
               values_to = "Veränderungen") %>%
  #filter(Land != "Deutschland (alle Länder)") %>%
  replace_na(list(Veränderungen = 0))
ver_standfl_prozent
```

#### Vorratsänderung {.hidden .unnumbered .unlisted}

```{r imp_ver_vor, include=FALSE}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
ver_vor_sheet_names <- excel_sheets("../data/Veränderung_des_Vorrates.xlsx")
ver_vor <- lapply(ver_vor_sheet_names, function(sheet) {
  read_excel("../data/Veränderung_des_Vorrates.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(ver_vor) <- ver_vor_sheet_names
```

##### Grundflächenänderung

```{r}
# Daten in Long-Format bringen
ver_vor_long <- ver_vor$ver_gf_ba_22 %>%
  pivot_longer(cols = -c(Land, Einheit),
               names_to = "Ba_Gruppen",
               values_to = "Veränderungen")
ver_vor_long <- ver_vor_long %>%
  replace_na(list(Veränderungen = 0))
```



### Struktur und Verjüngung {.hidden .unnumbered .unlisted}

```{r imp_strukt, include=FALSE}
Wiebke Torsten's avatar
Wiebke Torsten committed
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
strukt_sheet_names <- excel_sheets("../data/Struktur_Verj.xlsx")
strukt <- lapply(strukt_sheet_names, function(sheet) {
  read_excel("../data/Struktur_Verj.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(strukt) <- strukt_sheet_names
```

### Totholz {.hidden .unnumbered .unlisted}

```{r imp_struktur_tot, include=FALSE}
Schmidt Sebastian's avatar
Schmidt Sebastian committed
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
tot_sheet_names <- excel_sheets("../data/struktur_tot.xlsx")
Schmidt Sebastian's avatar
Schmidt Sebastian committed
tot <- lapply(tot_sheet_names, function(sheet) {
Schmidt Sebastian's avatar
Schmidt Sebastian committed
  read_excel("../data/struktur_tot.xlsx", sheet = sheet, skip = 5, na = c("NaN"))
})
# Namen der Liste anpassen
names(tot) <- tot_sheet_names
```

### Naturnähe, Stammschaden und öko. Baummerkmale {.hidden .unnumbered .unlisted}

```{r imp_naturnaehe, include=FALSE}
# # Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# # Namen der Blätter automatisch auslesen
# naturnaehe_sheet_names <- excel_sheets("../struktur_naturnaehe_schad.xlsx")
# naturnaehe <- lapply(naturnaehe_sheet_names, function(sheet) {
#   read_excel("../struktur_naturnaehe_schad.xlsx", sheet = sheet, skip = 5, na = "NaN")
# })
# # Namen der Liste anpassen
# names(naturnaehe) <- naturnaehe_sheet_names
```

### Zeitpläne

```{r}
# zeitplan_sheet_names <- excel_sheets("../zeitplanung.xlsx")
# zeitplan <- lapply(zeitplan_sheet_names, function(sheet) {
#   read_excel("../zeitplanung.xlsx", sheet = sheet, skip = 5 
#              #,na = ""# "NaN"
#              )
# })
# names(zeitplan) <- zeitplan_sheet_names
```
:::