"...src/main/java/git@git.fairkom.net:hosting/faircommons.git" did not exist on "f0ceb7b3f37303bc32a2aecc45bcda82d3474ee2"
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)
```
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
```{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 Baumarten" = "#d9d9d9",
"Nadelbäume" = "#02818a",
"Laubbäume ohne Eiche" = "#B5529E"
)
```
## Eigentumsaten
```{r}
# Definiere eine benutzerdefinierte Farbpalette
farben_fuer_eigentumsarten <- c(
"alle Eigentumsarten" = "#d9d9d9",
"Staatswald (Bund)" = "#0a15b4",
"Staatswald (Land)" = "#5586b4",
"Körperschaftswald" = "#85aeb4",
"Privatwald" = "#58aa41"
)
```
"zweischichtig" = "#78c679",
"mehrschichtig" = "#31a354",
"mehrschichtig oder plenterartig" = "#006837",
"alle Arten von Bestockungsaufbau" = "#c2e699"
)
```
## Eigentumasartorder
```{r}
# Definiere eine benutzerdefinierte Reihenfolge für die Eigentumsart
eigentuemsart_order <- c("Staatswald (Bund)", "Staatswald (Land)", "Körperschaftswald", "Öffentlicher Wald",
"Privatwald, bis 20 ha",
"Privatwald, über 20 bis 1000 ha",
"Privatwald, über 1000 ha",
"Privatwald", "alle Eigentumsarten")
```
# 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
```
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
### 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
```
##### 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 = "Baumartengruppe",
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
```
```{r imp_ver_vor1, 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_vorrates.xlsx")
ver_vor <- lapply(ver_vor_sheet_names, function(sheet) {
read_excel("../data/ver_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_gf_ba_22 <- ver_vor$ver_gf_ba_22 %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Ba_Gruppen",
values_to = "Veränderungen")
ver_gf_ba_22 <- ver_gf_ba_22%>%
replace_na(list(Veränderungen = 0))
```
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
### 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 dtl
```{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
```
### Baumarten Eig Standflächen ha brb bb_waldfl_ba_eg_standfl_22
```{r}
#Daten für 2022 vorbereiten
bb_waldfl_ba_eg_standfl_22 <- waldfl_ba$bb_waldfl_ba_eg_standfl_22 %>%
#filter(Land == "Brandenburg") %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Ba_Wa",
values_to = "Fläche")
# waldfl22_ba_long
# Berechnung der Prozentwerte für alle Kategorien
bb_waldfl_ba_eg_standfl_22 <- bb_waldfl_ba_eg_standfl_22 %>%
group_by(Eigentumsart) %>%
mutate(Prozent = round((Fläche / Fläche[Ba_Wa=="alle Baumarten"]) * 100, 2)) %>%
ungroup() %>%
# Zuordnung der Farben zu den Daten
mutate(Farbe = ba_farben[match(Ba_Wa, names(ba_farben))])
bb_waldfl_ba_eg_standfl_22
```
`
### Waldflächen Standflächen ha bb (und Veränderung?)
```{r}
bb_stndfl_ba_22 <- waldfl_ba$bb_stndfl_ba_22 %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Fläche") %>%
replace_na(list(Fläche = 0)) #%>%
bb_stndfl_ba_22$Altersklasse <- factor(bb_stndfl_ba_22$Altersklasse,
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", "Angabe fehlt", "alle Baumaltersklassen"),
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","Lücke/Blöße", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
bb_stndfl_ba_22$Baumartengruppe <- factor(bb_stndfl_ba_22$Baumartengruppe,
levels = bb_stndfl_ba_22 %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Fläche)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
# c("alle Baumarten", "alle Nadelbäume", "Kiefer (Pinus)", "alle Laubbäume" ,"Eiche (Quercus)", "Birke (Betula)", "Buche (Fagus)", "Erle (Alnus)", "sonst. Lb hoher Lebensdauer", "sonst. Lb niedriger Lebensdauer", "Lücke", "Fichte (Picea)", "Lärche (Larix)", "Douglasie (Pseudotsuga)", "Ahorn (Acer)", "Blöße", "Esche (Fraxinus)", "Tanne (Abies)"))
#distinct(bb_stndfl_ba_22, Baumartengruppe)
#levels(bb_stndfl_ba_22$Baumartengruppe)
```
```{r}
# um die level zu bestimmen:
bb_stndfl_ba_22 %>%
filter(Altersklasse == "alle Baumaltersklassen"
#& !Baumartengruppe %in% c("alle Baumarten", "alle Nadelbäume", "alle Laubbäume")
) %>%
arrange(desc(Fläche)) %>% # Sortiere nach Fläche in absteigender Reihenfolge
select(Baumartengruppe
, Fläche
) %>%
pull(Baumartengruppe)
```
### Waldflächenänderung Standflächen ha bb
```{r}
ver_bb_stndfl_ba_22 <- ver_waldfl$ver_bb_stndfl_ba_22 %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Veränderung") %>%
replace_na(list(Veränderung = 0))
#
ver_bb_stndfl_ba_22$Altersklasse <- factor(ver_bb_stndfl_ba_22$Altersklasse,
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", "Angabe fehlt", "alle Baumaltersklassen"),
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","Lücke/Blöße", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
ver_bb_stndfl_ba_22$Baumartengruppe <- factor(ver_bb_stndfl_ba_22$Baumartengruppe,
levels = ver_bb_stndfl_ba_22 %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Veränderung)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
## Vorrat und Vorratsänderung
### Vorrat
```{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("../data/Vorrat.xlsx")
vor <- lapply(vor_sheet_names, function(sheet) {
read_excel("../data/Vorrat.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(vor) <- vor_sheet_names
```
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
### Vorratsänderung
```{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_vorrates.xlsx")
ver_vor <- lapply(ver_vor_sheet_names, function(sheet) {
read_excel("../data/ver_vorrates.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(ver_vor) <- ver_vor_sheet_names
```
### Vorrat Baumarten und Altersklassen - v.a. reell
```{r}
vorrat_ba_sheet_names <- excel_sheets("../data/vorrat_ba.xlsx")
vorrat_ba <- lapply(vorrat_ba_sheet_names, function(sheet) {
read_excel("../data/vorrat_ba.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
names(vorrat_ba) <- vorrat_ba_sheet_names
```
### Veränderung Vorrat Baumarten und Altersklassen - v.a. reell
```{r}
ver_vorrat_ba_sheet_names <- excel_sheets("../data/ver_vorrat_ba.xlsx")
ver_vorrat_ba <- lapply(ver_vorrat_ba_sheet_names, function(sheet) {
read_excel("../data/ver_vorrat_ba.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
names(ver_vorrat_ba) <- ver_vorrat_ba_sheet_names
```
#### Stammzahl
```{r}
stammzahl <- vor$stammzahl %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Stammzahl") %>%
replace_na(list(Stammzahl = 0))
```
#### Vorrat Baumarten und Altersklassen - rechnerischer Reinbestand
##### vor_ideell_eig_ba_ha
```{r vor_ideell_eig_ba_ha}
vor_ideell_eig_ba_ha <- vor$vor_ideell_eig_ba_ha %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0))
```
##### ver_vor_ideell_eig_ba_ha
```{r}
ver_vor_ideell_eig_ba_ha <- ver_vor$ver_vor_ideell_eig_ba_ha %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorratsänderung") %>%
replace_na(list(Veränderung = 0))
```
##### vor_bb_bag_ak_ha
```{r}
vor_bb_bag_ak_ha <- vor$vor_bb_bag_ak_ha %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) #%>%
#
vor_bb_bag_ak_ha$Altersklasse <- factor(vor_bb_bag_ak_ha$Altersklasse,
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", "Angabe fehlt", "alle Baumaltersklassen"),
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","Lücke/Blöße", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
vor_bb_bag_ak_ha$Baumartengruppe <- factor(vor_bb_bag_ak_ha$Baumartengruppe,
levels = vor_bb_bag_ak_ha %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorrat)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```
#### vor_reell_bb_allba_qm_ha bhd, Anteil, Veränderung
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
```{r}
vor_anteil_ver_reell_bb_allba_qm_ha <- vorrat_ba$vor_reell_bb_allba_qm_ha %>%
pivot_longer(cols = c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Volumen") %>%
replace_na(list(Volumen = 0)) %>%
mutate(Altersklasse = factor(Altersklasse, levels = altersklassen_levels, labels = altersklassen_labels)) %>% # Altersklassen als Faktor
inner_join(
vorrat_ba$`vor_reell_bb_allba_qm_%` %>%
pivot_longer(cols = c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Anteil") %>%
replace_na(list(Anteil = 0)) %>%
mutate(Altersklasse = factor(Altersklasse, levels = altersklassen_levels, labels = altersklassen_labels)), # Gleiche Ordnung in der zweiten Tabelle
by = c("Brusthöhendurchmesser", "Altersklasse")
) %>%
inner_join(
ver_vorrat_ba$ver_vor_reell_bb_allba_qm_ha %>%
pivot_longer(cols = c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Veränderung") %>%
replace_na(list(Veränderung = 0)) %>%
mutate(Altersklasse = factor(Altersklasse, levels = altersklassen_levels, labels = altersklassen_labels)), # Gleiche Ordnung in der dritten Tabelle
by = c("Brusthöhendurchmesser", "Altersklasse")
) %>%
mutate(Brusthöhendurchmesser = factor(Brusthöhendurchmesser, levels = bhd_levels)) # Optional: BHD als Faktor
```
#### Vorrat Baumarten und Altersklassen - reell
```{r}
vor_reell_bb_ba_akl_qm_ha <- vorrat_ba$vor_reell_bb_ba_akl_qm_ha %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) #%>%
#
vor_reell_bb_ba_akl_qm_ha$Altersklasse <- factor(vor_reell_bb_ba_akl_qm_ha$Altersklasse,
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", "alle Baumaltersklassen"),
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", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
vor_reell_bb_ba_akl_qm_ha$Baumartengruppe <- factor(vor_reell_bb_ba_akl_qm_ha$Baumartengruppe,
levels = vor_reell_bb_ba_akl_qm_ha %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorrat)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
##### vor_reell_bb_hbst_ba_akl_qm_ha
```{r}
vor_reell_bb_hbst_ba_akl_qm_ha <- vorrat_ba$vor_reell_bb_hbst_ba_akl_qm_ha %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) #%>%
#
vor_reell_bb_hbst_ba_akl_qm_ha$Altersklasse <- factor(vor_reell_bb_hbst_ba_akl_qm_ha$Altersklasse,
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", "alle Baumaltersklassen"),
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", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
vor_reell_bb_hbst_ba_akl_qm_ha$Baumartengruppe <- factor(vor_reell_bb_hbst_ba_akl_qm_ha$Baumartengruppe,
levels = vor_reell_bb_hbst_ba_akl_qm_ha %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorrat)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
##### vor_rel_bb_hbst_ln_ne0_ba_akl_q
```{r}
vor_rel_bb_hbst_ln_ne0_ba_akl_q <- vorrat_ba$vor_rel_bb_hbst_ln_ne0_ba_akl_q %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) #%>%
#
vor_rel_bb_hbst_ln_ne0_ba_akl_q$Altersklasse <- factor(vor_rel_bb_hbst_ln_ne0_ba_akl_q$Altersklasse,
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", "alle Baumaltersklassen"),
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", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
vor_rel_bb_hbst_ln_ne0_ba_akl_q$Baumartengruppe <- factor(vor_rel_bb_hbst_ln_ne0_ba_akl_q$Baumartengruppe,
levels = vor_rel_bb_hbst_ln_ne0_ba_akl_q %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorrat)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
##### vor_reell_bb_ba_akl_kqm
```{r}
vor_reell_bb_ba_akl_kqm <- vorrat_ba$vor_reell_bb_ba_akl_kqm %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) #%>%
#
vor_reell_bb_ba_akl_kqm$Altersklasse <- factor(vor_reell_bb_ba_akl_kqm$Altersklasse,
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", "alle Baumaltersklassen"),
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", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
vor_reell_bb_ba_akl_kqm$Baumartengruppe <- factor(vor_reell_bb_ba_akl_kqm$Baumartengruppe,
levels = vor_reell_bb_ba_akl_kqm %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorrat)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```
##### vor_reell_bb_eigentum_ba_kqm
```{r}
vor_reell_bb_eigentum_ba_kqm <- vorrat_ba$vor_reell_bb_eigentum_ba_kqm %>%
pivot_longer(-c(`Eigentumsart`,`Einheit`),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) %>%
# Eigentumsart als Factor mit der benutzerdefinierten Reihenfolge setzen
mutate(Eigentumsart = factor(Eigentumsart, levels = eigentuemsart_order)) %>%
# Baumartengruppe nach Vorrat sortieren und als Factor setzen
group_by(Eigentumsart) %>%
mutate(Baumartengruppe = factor(Baumartengruppe, levels = Baumartengruppe[order(Vorrat, decreasing = TRUE)])) %>%
ungroup()
```{r}
vor_reell_bb_hbst_eiggr_ba_qm_h <- vorrat_ba$vor_reell_bb_hbst_eiggr_ba_qm_h %>%
pivot_longer(-c(`Eigentumsart`,`Einheit`),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) %>%
# Eigentumsart als Factor mit der benutzerdefinierten Reihenfolge setzen
mutate(Eigentumsart = factor(Eigentumsart, levels = eigentuemsart_order)) %>%
# Baumartengruppe nach Vorrat sortieren und als Factor setzen
group_by(Eigentumsart) %>%
mutate(Baumartengruppe = factor(Baumartengruppe, levels = Baumartengruppe[order(Vorrat, decreasing = TRUE)])) %>%
ungroup()
```
##### vor_reell_bb_eiggr_ba_qm_h
```{r}
vor_reell_bb_eiggr_ba_qm_h <- vorrat_ba$vor_reell_bb_eiggr_ba_qm_h %>%
pivot_longer(-c(`Eigentumsart`,`Einheit`),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) %>%
# Eigentumsart als Factor mit der benutzerdefinierten Reihenfolge setzen
mutate(Eigentumsart = factor(Eigentumsart, levels = eigentuemsart_order)) %>%
# Baumartengruppe nach Vorrat sortieren und als Factor setzen
group_by(Eigentumsart) %>%
mutate(Baumartengruppe = factor(Baumartengruppe, levels = Baumartengruppe[order(Vorrat, decreasing = TRUE)])) %>%
ungroup()
#### Veränderung Vorrat Baumarten und Altersklassen - reell
```{r}
vervor_reell_bb_hbst_eiggr_baha <- ver_vorrat_ba$vervor_reell_bb_hbst_eiggr_baha %>%
pivot_longer(-c(`Eigentumsart`,`Einheit`),
names_to = "Baumartengruppe",
values_to = "Vorratsänderung") %>%
replace_na(list(Veränderung = 0))
```
##### ver_vor_reell_bb_ba_akl_qm_ha
```{r}
ver_vor_reell_bb_ba_akl_qm_ha <- ver_vorrat_ba$ver_vor_reell_bb_ba_akl_qm_ha %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorratsänderung") %>%
replace_na(list(Vorratsänderung = 0)) #%>%
#
ver_vor_reell_bb_ba_akl_qm_ha$Altersklasse <- factor(ver_vor_reell_bb_ba_akl_qm_ha$Altersklasse,
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", "alle Baumaltersklassen"),
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", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
ver_vor_reell_bb_ba_akl_qm_ha$Baumartengruppe <- factor(ver_vor_reell_bb_ba_akl_qm_ha$Baumartengruppe,
levels = ver_vor_reell_bb_ba_akl_qm_ha %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorratsänderung)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```
##### ver_vor_reell_bb_ba_akl_kqm
```{r}
ver_vor_reell_bb_ba_akl_kqm <- ver_vorrat_ba$ver_vor_reell_bb_ba_akl_kqm %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorratsänderung") %>%
replace_na(list(Vorratsänderung = 0)) #%>%
#
ver_vor_reell_bb_ba_akl_kqm$Altersklasse <- factor(ver_vor_reell_bb_ba_akl_kqm$Altersklasse,
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", "alle Baumaltersklassen"),
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", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
ver_vor_reell_bb_ba_akl_kqm$Baumartengruppe <- factor(ver_vor_reell_bb_ba_akl_kqm$Baumartengruppe,
levels = ver_vor_reell_bb_ba_akl_kqm %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorratsänderung)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```{r}
vor_ver_vor <- vor$vor_land_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0)) %>%
inner_join(
ver_vor$ver_vor_land_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Veränderungen") %>%
replace_na(list(Veränderungen = 0)),
by = c("Land", "Baumartengruppe", "Einheit")
)
```
##### Veränderung Vorrat Baumarten und Altersklassen - rechnerischer Reinbestand
```{r}
ver_vor_bb_bag_ak_ha <- ver_vor$ver_vor_bb_bag_ak_ha %>%
pivot_longer(c(`1 - 20 Jahre`:`alle Baumaltersklassen`),
names_to = "Altersklasse",
values_to = "Vorratsänderung") %>%
replace_na(list(Vorratsänderung = 0))
#
ver_vor_bb_bag_ak_ha$Altersklasse <- factor(ver_vor_bb_bag_ak_ha$Altersklasse,
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", "Angabe fehlt", "alle Baumaltersklassen"),
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","Lücke/Blöße", "alle Baumaltersklassen"))
#Setze die Baumartengruppe als Faktor und ordne die Levels nach Fläche
ver_vor_bb_bag_ak_ha$Baumartengruppe <- factor(ver_vor_bb_bag_ak_ha$Baumartengruppe,
levels = ver_vor_bb_bag_ak_ha %>%
filter(Altersklasse == "alle Baumaltersklassen") %>%
arrange(desc(Vorratsänderung)) %>%
distinct(Baumartengruppe) %>% # Stellt sicher, dass keine doppelten Baumartengruppen vorhanden sind
pull(Baumartengruppe))
```
#### Vorrat Baumarten und Altersklassen
<!--TODO: irgendwie passen die Daten nicht -->
```{r}
# TODO: Daten für 2022 ...
bb_vor_bhd_akl_22_long <- vor$bb_vor_bhd_akl_22 %>%
filter(Baumart == "all") %>%
select(-Einheit, -Baumart, -'alle Baumaltersklassen') %>%
filter(Brusthöhendurchmesser != "alle BHD-Stufen") %>%
pivot_longer(
cols = `1 - 20 Jahre`:`> 160 Jahre`, # Angepasst an deine tatsächlichen Spaltennamen
names_to = "Altersklasse",
values_to = "Volumen"
) %>%
mutate(Volumen = replace_na(Volumen, 0))
#bb_vor_bhd_akl_22_long
```
## Zuwachs
```{r}
zuw_sheet_names <- excel_sheets("../data/zuwachs.xlsx")
zuw <- lapply(zuw_sheet_names, function(sheet) {
read_excel("../data/zuwachs.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(zuw) <- zuw_sheet_names
```
### zuw_eig_bag_ha_a
```{r}
zuw_eig_bag_ha_a <- zuw$zuw_eig_bag_ha_a %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Zuwachs") %>%
replace_na(list(Zuwachs = 0))
```
### Zuwachs Länder-Baumartengruppe-m³/ha*a
```{r}
zuw_land_bagr_qm_ha_a <- zuw$zuw_land_bagr_qm_ha_a %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Zuwachs") %>%
replace_na(list(Zuwachs = 0))
```{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
```
### nutz_eig_bag_ha_a
```{r}
nutz_eig_bag_ha_a <- abgang_nutz$nutz_eig_bag_ha_a %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Nutzung") %>%
replace_na(list(Nutzung = 0))
```
```{r}
ausg_best_land_bagr_22 <- abgang_nutz$ausg_best_land_bagr_22 %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorratausgeschieden")
# war ausgesbest
### Abgang real
```{r}
ausg_bestreell_land_bagr_22 <- abgang_nutz$ausg_bestreell_land_bagr_22 %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorratausgeschieden")
```
```{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
```
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
### abgang_bb_grund_bagr_kqm
```{r}
abgang_bb_grund_bagr_kqm <- abgang_nutz$abgang_bb_grund_bagr_kqm %>%
pivot_longer(cols = -c(Abgangsgrund, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0))
abgang_bb_grund_bagr_kqm <- abgang_bb_grund_bagr_kqm %>%
group_by(Baumartengruppe) %>% # Gruppiere nach Baumartengruppe
mutate(
Gesamt_vorrat_baumart = sum(Vorrat[Abgangsgrund == "alle Abgangsgründe"], na.rm = TRUE), # Summe aller Abgangsgründe für diese Baumartengruppe
Anteil = (Vorrat / Gesamt_vorrat_baumart) * 100 # Berechne den Anteil pro Abgangsgrund
) %>%
ungroup() %>%
select(-Gesamt_vorrat_baumart) # Entferne die temporäre Spalte, wenn sie nicht mehr benötigt wird
```
### abgang_bb_hbst_grund_bagr_kqm
```{r}
abgang_bb_hbst_grund_bagr_kqm <- abgang_nutz$abgang_bb_hbst_grund_bagr_kqm %>%
pivot_longer(cols = -c(Abgangsgrund, Einheit),
names_to = "Baumartengruppe",
values_to = "Vorrat") %>%
replace_na(list(Vorrat = 0))
```
### Nutzung
```{r}
nutz_land_qm_ha_ideell <- abgang_nutz$nutz_land_qm_ha_ideell %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Nutzung") %>%
replace_na(list(Nutzung = 0))
```
## Struktur
### Waldaufbau
```{r}
stuktbeim_sheet_names <- excel_sheets("../data/strukt_beim_besttyp.xlsx")
struktbeim <- lapply(stuktbeim_sheet_names, function(sheet) {
read_excel("../data/strukt_beim_besttyp.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
names(struktbeim) <- stuktbeim_sheet_names
```
### Waldaufbauveränderung
```{r}
ver_stuktbeim_sheet_names <- excel_sheets("../data/ver_strukt_beim_besttyp.xlsx")
ver_struktbeim <- lapply(ver_stuktbeim_sheet_names, function(sheet) {
read_excel("../data/ver_strukt_beim_besttyp.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
names(ver_struktbeim) <- ver_stuktbeim_sheet_names
```
#### ver_bestyp_eig_bb_ha
```{r}
ver_bestyp_eig_bb_ha <- ver_struktbeim$ver_bestyp_eig_bb_ha %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Bestockungstyp",
values_to = "Waldflächenänderung") %>%
replace_na(list(Waldflächenänderung = 0))
```
#### bestyp_eig_bb_ha
```{r}
bestyp_eig_bb_ha <- struktbeim$bestyp_eig_bb_ha %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Bestockungstyp",
values_to = "Waldfläche") %>%
replace_na(list(Waldfläche = 0))
```
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
#### Land-Bestockungsaufbau ha-proz
```{r}
# Ergebnistabellen zusammenführen und neue Datenzeile "mehrschichtig" aus Summe hinzufügen
land_bestaufbau <-
struktbeim$land_bestaufbau_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Bestockungsaufbau",
values_to = "Fläche") %>%
inner_join(
struktbeim$land_bestaufbau_proz %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Bestockungsaufbau",
values_to = "Anteil"), by = c("Land", "Bestockungsaufbau")) %>%
filter(Bestockungsaufbau %in% c("zweischichtig", "mehrschichtig oder plenterartig")) %>%
group_by(Land, Einheit.x, Einheit.y) %>%
summarise(
Bestockungsaufbau = "mehrschichtig",
Fläche = sum(Fläche),
Anteil = sum(Anteil),
.groups = "drop"
) %>%
bind_rows(struktbeim$land_bestaufbau_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Bestockungsaufbau",
values_to = "Fläche") %>%
inner_join(
struktbeim$land_bestaufbau_proz %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Bestockungsaufbau",
values_to = "Anteil"), by = c("Land", "Bestockungsaufbau"))
)
```
#### Waldtyp-Bestockungsaufbau ha-proz
waldtyp_bestaufbau_bb_ha_proz_ver <- struktbeim$waldtyp_bestaufbau_bb_ha %>%
pivot_longer(cols = -c("Laub-/Nadel-Waldtyp", Einheit),
names_to = "Bestockungsaufbau",
values_to = "Fläche") %>%
inner_join(
struktbeim$waldtyp_bestaufbau_bb_proz %>%
pivot_longer(cols = -c("Laub-/Nadel-Waldtyp", Einheit),
names_to = "Bestockungsaufbau",
values_to = "Anteil"), by = c("Laub-/Nadel-Waldtyp","Bestockungsaufbau")) %>%
inner_join(ver_struktbeim$ver_waldtyp_bestaufbau_bb_ha %>%
pivot_longer(cols = -c("Laub-/Nadel-Waldtyp", Einheit),
names_to = "Bestockungsaufbau",
values_to = "Veränderung"), by = c("Laub-/Nadel-Waldtyp","Bestockungsaufbau"))
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
#### ver-Land-Bestockungsaufbau ha-proz
```{r}
ver_land_bestaufbau_ha <-
ver_struktbeim$ver_land_bestaufbau_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Bestockungsaufbau",
values_to = "Fläche") %>%
filter(Bestockungsaufbau %in% c("zweischichtig", "mehrschichtig oder plenterartig")) %>%
group_by(Land, Einheit) %>%
summarise(
Bestockungsaufbau = "mehrschichtig",
Fläche = sum(Fläche),
.groups = "drop"
) %>%
bind_rows(ver_struktbeim$ver_land_bestaufbau_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Bestockungsaufbau",
values_to = "Fläche")
)
```
### Verjüngung
```{r imp_strukt, include=FALSE}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
strukt_sheet_names <- excel_sheets("../data/struktur_verj.xlsx")
struktjung <- lapply(strukt_sheet_names, function(sheet) {
read_excel("../data/struktur_verj.xlsx", sheet = sheet, skip = 5, na = "NaN")
#### jung_bb_eig_nba_hb
```{r}
jung_bb_eig_nba_hb <- struktjung$jung_bb_eig_nba_hb %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Anzahl") %>%
mutate(Anzahl = replace_na(Anzahl, 0)) %>%
group_by(Eigentumsart) %>%
mutate(Gesamtanzahl = Anzahl[Baumartengruppe == "alle Baumarten"]) %>%
ungroup() %>%
mutate(Anteil = round((Anzahl / Gesamtanzahl) * 100, 2))
```
```{r}
jungbestfl <- struktjung$verj_ha %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Jungbestockung",
values_to = "Fläche") %>%
replace_na(list(Fläche = 0))
jungbestfl
```
# Anteil der Fläche an der Gesamtfläche Wald+Nichtwald [%] nach Land und Bestockungsschicht der Jungbestockung
jungbestant <- struktjung$verj_anteil %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Jungbestockung",
#### Jungbestandsfläche join Waldfläche und Landesflächenanteil
```{r}
jungbestflant <- jungbestfl %>%
inner_join(waldfl_spez_long, by = "Land", suffix = c("_jungfl", "_waldfl")) %>%
filter(!Kategorie %in% c("Blöße", "Nichtholzboden")) %>%
mutate(Waldflächenanteil = round((Fläche_jungfl / Fläche_waldfl) * 100, 2)) %>%
inner_join(jungbestant, by = c("Land", "Jungbestockung")) %>%
select(Land, Jungbestockung, Fläche_jungfl, Kategorie, Fläche_waldfl, Waldflächenanteil, Landesanteil)
```
```{r bb_jungbest_22, include=FALSE}
# Daten vorbereiten
# Baumartenanteile Jungbestockung Gesamtwald!
jungbest_ba_22_long <- struktjung$bb_jungbest_art_22 %>%
names_to = "Baumartengruppe",
values_to = "Waldfläche") %>%
replace_na(list(Waldfläche = 0))
#### Verjüngungspflanzen pro Hektar
```{r}
jung_ba_22 <- struktjung$jung_ba_22 %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Anzahl")
```
#### Verjüngungskreis - Verbissprozent Baumarten
```{r}
nproz_verb_ba_bb <- struktjung$jung_nproz_verb_ba_bb %>%
pivot_longer(cols = -c(Baumartengruppe,Einheit, "mit oder ohne Verbiss"),
names_to = "Verbissart",
values_to = "Verbissprozent")
```
#### Verjüngungskreis - Verbissprozent Eigentum
```{r}
jung_bb_eig_proz <- struktjung$jung_bb_eig_proz %>%
pivot_longer(cols = -c(Eigentumsart,Einheit, "mit oder ohne Verbiss"),
names_to = "Verbissart",
values_to = "Verbissprozent")
```
#### Verjüngungskreis - nBA pro Hektar
```{r}
jung_nha_verb_ba_bb <- struktjung$jung_nha_verb_ba_bb %>%
pivot_longer(cols = -c(Baumartengruppe,Einheit, "mit oder ohne Verbiss"),
names_to = "Verbissart",
values_to = "nBA")
```
#### Veränderung Jung
```{r}
verjung_sheet_names <- excel_sheets("../data/ver_jung.xlsx")
verjung <- lapply(verjung_sheet_names, function(sheet) {
read_excel("../data/ver_jung.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(verjung) <- verjung_sheet_names
```
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
##### Veränderung Jungbestockung
```{r}
ver_waldflindex_jung_bestschicht <- verjung$ver_waldflindex_jung_bestschich %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Jungbestockung",
values_to = "Indexänderungen") %>%
replace_na(list(Flächenänderungen = 0))
ver_waldflindex_jung_bestschicht
```
```{r}
ver_jungbestfl <- verjung$ver_waldfl_jung_bestschicht %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Jungbestockung",
values_to = "Flächenänderungen") %>%
replace_na(list(Flächenänderungen = 0)) %>%
inner_join(ver_waldflindex_jung_bestschicht, by = c("Land", "Jungbestockung"), suffix = c("_ver", "_index")) %>%
mutate(Veränderungsanteil = Indexänderungen - 100)
ver_jungbestfl
```
```{r bb_ver_jungbest_22, include=FALSE}
# Daten vorbereiten
# Veränderung Baumartenanteile Jungbestockung Gesamtwald!
ver_jungbest_ba_22_long <- verjung$bb_ver_jungbest_art_22 %>%
filter(Verjüngungsart == "alle Verjüngungsarten") %>%
pivot_longer(cols = -c(Einheit, Verjüngungsart, "alle Baumarten"),
names_to = "Baumartengruppe",
values_to = "Waldfläche") %>%
replace_na(list(Waldfläche = 0))
```
```{r imp_struktur_tot, include=FALSE}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
tot_sheet_names <- excel_sheets("../data/struktur_tot.xlsx")
read_excel("../data/struktur_tot.xlsx", sheet = sheet, skip = 5, na = c("NaN"))
})
# Namen der Liste anpassen
names(tot) <- tot_sheet_names
### Veränderung Totholz
```{r}
ver_tot_sheet_names <- excel_sheets("../data/ver_tot.xlsx")
ver_tot <- lapply(ver_tot_sheet_names, function(sheet) {
read_excel("../data/ver_tot.xlsx", sheet = sheet, skip = 5, na = c("NaN"))
})
# Namen der Liste anpassen
names(ver_tot) <- ver_tot_sheet_names
```
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
#### tot_bb_eig_bag22
```{r}
tot_bb_eig_bag22 <- tot$tot_bb_eig_bag22 %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Totholzvorrat") %>%
replace_na(list(Totholzvorrat = 0)) %>%
mutate(farben = ba_farben[match(Baumartengruppe, names(ba_farben))])
```
#### ver_tot_bb_eig_bag22
```{r}
ver_tot_bb_eig_bag22 <- ver_tot$ver_tot_bb_eig_bag22 %>%
pivot_longer(cols = -c(Eigentumsart, Einheit),
names_to = "Baumartengruppe",
values_to = "Totholzvorrat") %>%
replace_na(list(Totholzvorrat = 0)) %>%
mutate(farben = ba_farben[match(Baumartengruppe, names(ba_farben))])
```
#### Totholz m³/ha*a Land-Baumartengruppe - reell
```{r}
tot_land_qm_ha_reell <- tot$tot_land_qm_ha_reell %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Totholz") %>%
replace_na(list(Totholz = 0)) %>%
mutate(farben = ba_farben[match(Baumartengruppe, names(ba_farben))])
```
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
#### Veränderung Totholz m³/ha*a Land-Baumartengruppe - reell
```{r}
ver_tot_land_qm_ha_reell <- ver_tot$ver_tot_land_qm_ha_reell %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Veränderungen")
```
#### Veränderung Waldfläche mit Totholz Index BWI2012=100 Land-Baumartengruppe - reell
```{r}
ver_tot_index_2012_2022 <- ver_tot$ver_tot_index_waldfl_2012_2022 %>%
pivot_longer(cols = -c(Land, Einheit),
names_to = "Baumartengruppe",
values_to = "Indexänderungen")
```
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
### 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
```
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
## Weham
### weham_data
```{r}
# Excel-Datei einlesen und NaN-Werte als "nan" behandeln
# Namen der Blätter automatisch auslesen
weham_data_sheetnames <- excel_sheets("../data/weham_data.xlsx")
weham_data <- lapply(weham_data_sheetnames, function(sheet) {
read_excel("../data/weham_data.xlsx", sheet = sheet, skip = 5, na = "NaN")
})
# Namen der Liste anpassen
names(weham_data) <- weham_data_sheetnames
```
## Steuerungsdaten
```{r}
steuerungsparameter <- weham_data$"Steuerungsparameter"
steuerungsparameter
```
## Durchforstungsmodelle
```{r}
# Daten laden
durchforstung <- read.csv("../data/Durchforstung.csv", stringsAsFactors = FALSE, sep = ";")