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) # um Legenden automatisch zu platzieren
#library(scales) # um Tausendertrennzeichen einzuführen
library(prettyunits) # um Einheiten zu formatieren
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)
#library(webshot2) # für Screenshots
library(RPostgres) # installation funktionert nachdem via muon libpq-dev installiert wurde
library(config) # um Datenbankonfiguration zu verstecken
library(todor) # um Todos zu erstellen - siehe RStudio, Addins find active ... todos
```{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)
```
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
```{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"
)
```
# Datenimport
## von Sachgebietsdatenbank consgdb
### Trakteckenanzahl
# qu_trackt_eckenanzahl <- "select --distinct bftw.anat
# count (distinct bfev.tnr) filter (where bfev.wa between 0 and 5) as ausschreibungstrakte,
# COUNT(distinct bfev.tnr) filter (where bfev.wa = 0) as nichtwaldtrakte -- Anzahl der Traktnummern mit bfev.wa = 0
# ,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(bfev.enr) filter (where bfev.wa between 0 and 5 and bftw.anat between 1901 and 1916) as begutachtungsecken
# ,count(bfev.enr) filter (where bfev.wa between 0 and 5 and bftw.anat between 1901 and 1911) as ausschreibungsecke -- siehe bwi_meta.k3_login
# ,count(bfev.enr) filter (where bfev.wa between 0 and 5 and bftw.anat between 1912 and 1916) as lfebearbeitungsecke
# ,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 oder ungewiss = x3_tr_status icode=3
# and bftw.anat between 1901 and 1916;"
# trackt_eckenanzahl <- dbGetQuery(consgdb, qu_trackt_eckenanzahl)
# trackt_eckenanzahl
# # Speichere das Ergebnis als RDS-Datei
# saveRDS(trackt_eckenanzahl, "../data/trackt_eckenanzahl.rds")
# Lade die RDS-Datei
trackt_eckenanzahl <- readRDS("../data/trackt_eckenanzahl.rds")
# ist als View erstellt
# v_top_wzp <- dbGetQuery(consgdb,
# "SELECT *
# FROM bwi_2022.v_top_wzp;"
# )
# v_top_wzp
# # # Speichere das Ergebnis als RDS-Datei
# saveRDS(v_top_wzp, "../data/v_top_wzp.rds")
# Lade die RDS-Datei
v_top_wzp <- readRDS("../data/v_top_wzp.rds")
```{r}
# Definieren der Levels für Altersklassen
altersklassen_levels <- c("1 - 20 Jahre", "21 - 40 Jahre", "41 - 60 Jahre",
"61 - 80 Jahre", "81 - 100 Jahre", "101 - 120 Jahre",
"121 - 140 Jahre", "141 - 160 Jahre", "> 160 Jahre")
# Labels für die Altersklassen (optional, für schönere Achsenbeschriftungen)
altersklassen_labels <- c("I\n1 - 20 Jahre", "II\n21 - 40 Jahre", "III\n41 - 60 Jahre",
"IV\n61 - 80 Jahre", "V\n81 - 100 Jahre", "VI\n101 - 120 Jahre",
"VII\n121 - 140 Jahre", "VIII\n141 - 160 Jahre", "IX\n> 160 Jahre")
# Optional: Definieren der Levels für Brusthöhendurchmesser
bhd_levels <- levels <- c("ab 90 cm", "80,0 - 89,9 cm", "70,0 - 79,9 cm", "60,0 - 69,9 cm", "50,0 - 59,9 cm",
"40,0 - 49,9 cm", "30,0 - 39,9 cm", "20,0 - 29,9 cm" , "10,0 - 19,9 cm", "7,0 - 9,9 cm")
```
```{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ächenänderung
```{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_waldfläche.xlsx")
ver_waldfl <- lapply(ver_waldfl_sheet_names, function(sheet) {
read_excel("../data/ver_waldfläche.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(ver_waldfl) <- ver_waldfl_sheet_names
Loading
Loading full blame...