Skip to content

Commit d5db93f

Browse files
ma-z-amma-z-am
committed
Add MiSa plot option
1 parent b896a87 commit d5db93f

6 files changed

Lines changed: 202 additions & 19 deletions

File tree

‎NAMESPACE‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
# Generated by roxygen2: do not edit by hand
22

33
export(Berlin_add_boarder)
4+
export(Berlin_add_catchments)
45
export(Berlin_add_waterbodies)
56
export(QSIM_prepare)
67
export(QSIM_prepare_multiple)
7-
export(add_catchments)
88
export(add_coloredRivers)
99
export(add_districts)
1010
export(add_inflow)
@@ -36,11 +36,13 @@ importFrom(grDevices,dev.new)
3636
importFrom(grDevices,dev.off)
3737
importFrom(grDevices,png)
3838
importFrom(grDevices,rgb)
39+
importFrom(graphics,abline)
3940
importFrom(graphics,legend)
4041
importFrom(graphics,lines)
4142
importFrom(graphics,par)
4243
importFrom(graphics,points)
4344
importFrom(graphics,polygon)
45+
importFrom(graphics,text)
4446
importFrom(methods,as)
4547
importFrom(methods,is)
4648
importFrom(stats,quantile)

‎R/add_polygons.R‎

Lines changed: 77 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -22,24 +22,94 @@ load_geo <- function(region, Rdata_file){
2222
#' Add Berlin combined sewer catchments to a map
2323
#'
2424
#' Polygons are drawn in different types of gray
25+
#' @param plot_names If TRUE, names of the districts will be included in the plot
26+
#' @param highlight_catchments Character vector containing the catchments names
27+
#' of catchments to be highlighted
28+
#' @param highlight_style Either "shaded" (default) or a specific color, which
29+
#' cab also be defined by [rgb()]
2530
#'
26-
#' @importFrom graphics polygon
31+
#' @importFrom graphics polygon abline text
2732
#' @export
2833
#'
29-
add_catchments <- function(){
30-
34+
Berlin_add_catchments <- function(
35+
plot_names = FALSE, highlight_catchments = NULL, highlight_style = "shaded"
36+
){
3137
ezg <- NULL
3238
load(file.path(system.file(package = "qsimVis"),
3339
"extdata/berlin_data/catch_polygon.RData"))
3440

41+
if(plot_names){
42+
ezg_namePositions <- lapply(ezg, function(loc_df) {
43+
data.frame("x" = mean(loc_df[,1]), "y" = mean(loc_df[,2]))
44+
})
45+
46+
ezg_namePositions$`Bln II`$y <- ezg_namePositions$`Bln II`$y - 0.01
47+
ezg_namePositions$`Bln III`$x <- ezg_namePositions$`Bln III`$x + 0.01
48+
ezg_namePositions$`Bln III`$y <- ezg_namePositions$`Bln III`$y - 0.003
49+
ezg_namePositions$`Bln IIIa`$x <- ezg_namePositions$`Bln IIIa`$x - 0.01
50+
ezg_namePositions$`Bln IIIa`$y <- ezg_namePositions$`Bln IIIa`$y - 0.04
51+
ezg_namePositions$`Bln VIII`$x <- ezg_namePositions$`Bln VIII`$x + 0.005
52+
ezg_namePositions$`Bln VIII`$y <- ezg_namePositions$`Bln VIII`$y + 0.005
53+
ezg_namePositions$`Bln IX`$x <- ezg_namePositions$`Bln IX`$x + 0.005
54+
ezg_namePositions$`Bln IX`$y <- ezg_namePositions$`Bln IX`$y + 0.005
55+
ezg_namePositions$`Bln IX`$y <- ezg_namePositions$`Bln IX`$y + 0.005
56+
ezg_namePositions$`Bln XI`$x <- ezg_namePositions$`Bln XI`$x - 0.013
57+
ezg_namePositions$`Chb I`$y <- ezg_namePositions$`Chb I`$y - 0.005
58+
ezg_namePositions$`Chb Ia`$y <- ezg_namePositions$`Chb Ia`$y + 0.02
59+
ezg_namePositions$`Chb Ia`$x <- ezg_namePositions$`Chb Ia`$x - 0.08
60+
ezg_namePositions$`Chb III`$y <- ezg_namePositions$`Chb III`$y + 0.002
61+
ezg_namePositions$`Ruh`$x <- ezg_namePositions$`Ruh`$x + 0.015
62+
ezg_namePositions$`Spa1`$x <- ezg_namePositions$`Spa1`$x - 0.008
63+
ezg_namePositions$`Wil`$y <- ezg_namePositions$`Wil`$y + 0.01
64+
}
65+
66+
if(length(highlight_catchments) > 0L){
67+
wrong_names <- !(highlight_catchments %in% names(ezg))
68+
if(any(wrong_names)){
69+
warning(paste(highlight_catchments[wrong_names], collapse = ", "),
70+
": no defined catchment name(s) -> will not be highlighted")
71+
}
72+
}
73+
74+
# colCircle <- rep(paste0("gray",c(60,70,80,90)), 10)
75+
# for(i in seq_along(ezg)){
76+
# col <- colCircle[i]
77+
# polygon(
78+
# x = ezg[[i]][,1],
79+
# y = ezg[[i]][,2],
80+
# col = col)
81+
# }
3582
colCircle <- rep(paste0("gray",c(60,70,80,90)), 10)
3683
for(i in seq_along(ezg)){
3784
col <- colCircle[i]
38-
polygon(
39-
x = ezg[[i]][,1],
40-
y = ezg[[i]][,2],
41-
col = col)
85+
shading <- NULL
86+
if(names(ezg)[i] %in% highlight_catchments){
87+
if(highlight_style == "shaded"){
88+
shading <- 30
89+
} else {
90+
col <- highlight_style
91+
}
92+
}
93+
polygon(x = ezg[[i]][,1], y = ezg[[i]][,2], col = col, density = shading)
94+
if(plot_names){
95+
text(x = ezg_namePositions[[i]]$x, y = ezg_namePositions[[i]]$y,
96+
labels = names(ezg_namePositions)[i])
97+
98+
}
99+
42100
}
101+
102+
if(plot_names){
103+
lines(
104+
x = c(ezg_namePositions$`Chb Ia`$x + 0.012, min(ezg$`Chb Ia`[,1]) + 0.004),
105+
y = c(ezg_namePositions$`Chb Ia`$y - 0.002, max(ezg$`Chb Ia`[,2]) - 0.002))
106+
lines(
107+
x = c(ezg_namePositions$`Bln IIIa`$x, mean(ezg$`Bln IIIa`[,1]) + 0.0005),
108+
y = c(ezg_namePositions$`Bln IIIa`$y + 0.002, mean(ezg$`Bln IIIa`[,2])))
109+
}
110+
abline(v = par("usr")[1:2])
111+
abline(h = par("usr")[3:4])
112+
43113
}
44114

45115
#' Add Berlin districts to a map

‎inst/extdata/scripts/misa/misa_id_table.csv‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
"qsimVis_ID";"verknet_BWaStrIdNr";"Bezeichnung";"model_IDs";"size_type"
2+
"BSK";"5401";"Berlin-Spandauer (Schifffahrts)kanal";"BSSK";1
3+
"CVK";"5404";"Charlottenburger Verbindungskanal (zur Spree)";"CVK";1
4+
"HOW";"5801";"Havel-Oder-Wasserstraße";"HOW";1
5+
"LWK";"6504";"Landwehrkanal";"Lwk, LwKo";1
6+
"Neukoellner_Schifffahrtskanal";"NA";"Neuköllner Schifffahrts-Kanal";"NSK";1
7+
"Panke";"NA";"Panke";"Pa,Pa2";2
8+
"SOW";"6501";"Spree-Oder-Wasserstraße";"OSK,SOW,SedS";1
9+
"SpK";"6507";"Spreekanal";"SpK,Spk";1
10+
"UHW";"6701";"Untere Havel-Wasserstraße (Spandau - Plaue)";"UHW";1
11+
"WHK";"5403";"Westhafenkanal";"WHK";1

‎inst/extdata/scripts/misa/read_and_plotMiSa.R‎

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
1+
# Documentation of aggregation and visualization of Qsim results
2+
3+
project_path <-"Y:/wGB/Projects/2023_MISA5"
4+
data_path <- "Data-Work packages/AP2_Szenarienrechnung/berechnungen"
5+
scenario_name <- "S8"
6+
7+
# load scenario data
8+
load(file = file.path(
9+
project_path,
10+
data_path,
11+
scenario_name,
12+
"5_assessment_output",
13+
paste0("misa_tool_", scenario_name, ".RData"))
14+
)
15+
# add site info
16+
df_aggr$qsim_site <- gsub(pattern = "_", replacement = "__", x = df_aggr$qsim_site)
17+
site_info <- lapply(df_aggr$qsim_site, qsimVis::site_info_from_qsimID)
18+
site_info <- do.call(rbind, lapply(site_info, as.data.frame))
19+
df_aggr <- cbind(df_aggr, site_info)
20+
21+
# Select data
22+
output_column <- "hours.below_1.5"
23+
classBreaks <- c(0, 25, 50, 100, 200, 300, Inf)
24+
colorVector <- NULL # -> MisaColor
25+
LegendTitle <- "Unterschreitungsdauer in h (1,5 mg/L)"
26+
27+
#
28+
# Combine river stretch and simulations data
29+
mapping_table <- read.table(
30+
file = system.file(package = "qsimVis",
31+
"extdata/scripts/misa/misa_id_table.csv"),
32+
header = TRUE,
33+
sep = ";")
34+
35+
rivers <- qsimVis::prepare_rivers(
36+
mapping_table = mapping_table,
37+
aggregated_data = df_aggr,
38+
value_column = output_column,
39+
path_manual = system.file(package = "qsimVis", "extdata/manually_added_rivers"),
40+
gap_filling = "interpolation"
41+
)
42+
43+
# add classes and colors
44+
rivers <- qsimVis::value_to_classes(
45+
river_list = rivers,
46+
classBreaks = classBreaks,
47+
colorVector = colorVector
48+
)
49+
50+
# plot data
51+
# qsimVis::plot_empty_map(rivers = rivers_ext, plot_toner = FALSE)
52+
qsimVis::plot_empty_map(
53+
bbox = list(c(13.18, 13.47),
54+
c(52.45, 52.57))
55+
)
56+
57+
58+
# catchments <- c("Bln IX", "Bln VII", "Bln IV", "Bln V", "Bln VII", "Bln I", "Bln II", "Nkn I", "Nkn II")
59+
catchments <- NULL
60+
# qsimVis::Berlin_add_boarder()
61+
qsimVis::Berlin_add_waterbodies(bg_color = "lightblue")
62+
qsimVis::Berlin_add_catchments(
63+
plot_names = TRUE,
64+
highlight_catchments = catchments,
65+
highlight_style = "beige"
66+
)
67+
68+
69+
# Add colored Rivers
70+
qsimVis::add_coloredRivers(
71+
ext_rivers = rivers
72+
)
73+
74+
qsimVis::add_river_legend(
75+
ext_rivers = rivers,
76+
LegendTitle = LegendTitle,
77+
LegendLocation = "top", cex = 0.8
78+
)
79+
80+
# Write output table
81+
# writexl::write_xlsx(x = output, path = file.path(path, "Viewer_Skript", "output_table.xlsx"))
82+
83+
84+
85+
86+
87+

‎man/Berlin_add_catchments.Rd‎

Lines changed: 24 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/add_catchments.Rd‎

Lines changed: 0 additions & 11 deletions
This file was deleted.

0 commit comments

Comments
 (0)