Skip to content

Commit f714fa4

Browse files
mrustlmrustl
authored
Merge pull request #14 from KWB-R/dev
Release v0.2.1
2 parents ad81e60 + 53df48b commit f714fa4

10 files changed

Lines changed: 201 additions & 45 deletions

‎DESCRIPTION‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ Type: Package
22
Package: kwb.pilot
33
Title: Importing, Aggregating and Visualising Data From KWB
44
Pilot Plants
5-
Version: 0.2.0
5+
Version: 0.2.1
66
Authors@R:
77
c(person(given = "Michael",
88
family = "Rustler",
@@ -43,7 +43,7 @@ Imports:
4343
ggforce (>= 0.3.2),
4444
htmlwidgets (>= 1.5.3),
4545
janitor (>= 2.0.1),
46-
kwb.nextcloud,
46+
kwb.nextcloud (>= 0.2.0),
4747
kwb.utils (>= 0.7.0),
4848
leaflet (>= 2.0.3),
4949
lubridate (>= 1.7.9.2),
@@ -59,7 +59,7 @@ Imports:
5959
stringr (>= 1.4.0),
6060
tidyr (>= 1.1.2),
6161
tibble (>= 3.0.4),
62-
tidyselect,
62+
tidyselect (>= 1.1.1),
6363
xml2 (>= 1.3.2),
6464
withr (>= 2.3.0),
6565
xts (>= 0.12.1)
@@ -68,13 +68,13 @@ Suggests:
6868
knitr (>= 1.30),
6969
remotes (>= 2.2.0),
7070
testthat (>= 3.0.1),
71-
usethis
71+
usethis (>= 2.0.1)
7272
VignetteBuilder:
7373
knitr
7474
Remotes:
7575
github::kwb-r/kwb.nextcloud,
7676
github::kwb-r/kwb.utils
7777
Encoding: UTF-8
7878
LazyData: true
79-
RoxygenNote: 7.1.1
79+
RoxygenNote: 7.1.2
8080
Config/testthat/edition: 3

‎NAMESPACE‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,6 @@ importFrom(htmlwidgets,saveWidget)
100100
importFrom(janitor,clean_names)
101101
importFrom(kwb.nextcloud,download_files)
102102
importFrom(kwb.nextcloud,list_files)
103-
importFrom(kwb.utils,assignGlobally)
104103
importFrom(kwb.utils,catAndRun)
105104
importFrom(kwb.utils,stringList)
106105
importFrom(lubridate,ceiling_date)
@@ -141,6 +140,7 @@ importFrom(utils,capture.output)
141140
importFrom(utils,download.file)
142141
importFrom(utils,read.csv)
143142
importFrom(utils,read.csv2)
143+
importFrom(utils,write.csv)
144144
importFrom(withr,with_dir)
145145
importFrom(xml2,read_html)
146146
importFrom(xts,align.time)

‎NEWS.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,8 @@
1+
# [kwb.pilot 0.2.1]
2+
3+
* MBR4.0: bugfix as data format changed from `de` to `en` for download from webportal
4+
of Martin Systems
5+
16
# [kwb.pilot 0.2.0]
27

38
* Add functions for project [MBR 4.0](https://https://www.kompetenz-wasser.de/en/project/mbr40/)

‎R/import_operation_berlin_t.R‎

Lines changed: 74 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -69,45 +69,99 @@ import_lab_data_berlin_t <- function(xlsx_path = package_file("shiny/berlin_t/da
6969
#' "raw_data_dir" will not be used
7070
#' @param meta_file_path path to metadata file (default:
7171
#' kwb.pilot:::package_file("shiny/berlin_t/data/parameter_site_metadata.csv"))
72+
#' @param locale locale (default: \code{\link[readr]{locale}}(tz = "CET"))
73+
#' @param col_types col_types (default: \code{\link[readr]{cols}})
7274
#' @return data.frame with imported PENTAIR operational data
7375
#' @import tidyr
74-
#' @importFrom readr read_tsv
76+
#' @importFrom readr cols locale read_tsv
7577
#' @importFrom magrittr "%>%"
7678
#' @importFrom data.table rbindlist
79+
#' @importFrom kwb.utils catAndRun
80+
#' @importFrom utils write.csv
7781
#' @export
7882
read_pentair_data <- function(raw_data_dir = package_file("shiny/berlin_t/data/operation"),
7983
raw_data_files = NULL,
80-
meta_file_path = package_file("shiny/berlin_t/data/parameter_site_metadata.csv")) {
81-
meta_data <- read.csv(
82-
file = meta_file_path, header = TRUE, sep = ",", dec = ".",
83-
stringsAsFactors = FALSE
84-
)
85-
86-
meta_data$ParameterLabel <- sprintf_columns("%s (%s)", meta_data, columns = c(
87-
"ParameterName", "ParameterUnit"
88-
))
89-
84+
meta_file_path = package_file("shiny/berlin_t/data/parameter_site_metadata.csv"),
85+
locale = readr::locale(tz = "CET"),
86+
col_types = readr::cols()) {
87+
9088
xls_files <- if (is.null(raw_data_files)) {
9189
list_full_xls_files(raw_data_dir)
9290
} else {
9391
raw_data_files
9492
}
95-
93+
94+
if(file.exists(meta_file_path)) {
95+
96+
meta_data <- read.csv(
97+
file = meta_file_path, header = TRUE, sep = ",", dec = ".",
98+
stringsAsFactors = FALSE
99+
)
100+
96101
columns <- c("TimeStamp", meta_data$ParameterCode[meta_data$ZeroOne == 1])
97-
102+
98103
raw_list <- lapply(xls_files, FUN = function(xls_file) {
99104
print(paste("Importing raw data file:", xls_file))
100-
tmp <- readr::read_tsv(file = xls_file, locale = readr::locale(tz = "CET"))
105+
tmp <- readr::read_tsv(file = xls_file, locale = locale,
106+
col_types = col_types)
101107
relevant_paras <- names(tmp)[names(tmp) %in% columns]
102108
tmp[, relevant_paras]
109+
110+
df_tidy <- data.table::rbindlist(l = raw_list, use.names = TRUE, fill = TRUE)
111+
112+
113+
gather_cols <- setdiff(names(df_tidy), "TimeStamp")
114+
103115
})
116+
117+
} else {
104118

105-
gather_cols <- setdiff(names(raw_list[[1]]), "TimeStamp")
106-
107-
df_tidy <- data.table::rbindlist(l = raw_list, use.names = TRUE) %>%
108-
tidyr::gather_("ParameterCode", "ParameterValue", gather_cols) %>%
109-
dplyr::rename_(DateTime = "TimeStamp") %>%
110-
dplyr::left_join(y = meta_data %>% select_(.dots = "-ZeroOne")) %>%
119+
raw_list <- lapply(xls_files, FUN = function(xls_file) {
120+
print(paste("Importing raw data file:", xls_file))
121+
tmp <- readr::read_tsv(file = xls_file,
122+
locale = locale,
123+
col_types = col_types)
124+
})
125+
126+
df_tidy <- data.table::rbindlist(l = raw_list, use.names = TRUE, fill = TRUE)
127+
128+
gather_cols <- setdiff(names(df_tidy), "TimeStamp")
129+
130+
meta_data <- tibble::tibble(ParameterCode = gather_cols,
131+
ParameterName = gather_cols,
132+
ParameterUnit = "",
133+
SiteCode = "",
134+
SiteName = "",
135+
ZeroOne = 1
136+
)
137+
138+
meta_path <- file.path(raw_data_dir, "parameter_site_metadata_dummy.csv")
139+
140+
msg_text <- sprintf("No metadata file provided. Generating and exporting dummy metadata file to '%s'.",
141+
meta_path)
142+
143+
kwb.utils::catAndRun(messageText = msg_text, expr = {
144+
write.csv(meta_data, file = meta_path, row.names = FALSE)
145+
})
146+
147+
148+
}
149+
150+
meta_data$ParameterLabel <- sprintf_columns("%s (%s)", meta_data, columns = c(
151+
"ParameterName", "ParameterUnit"))
152+
153+
df_tidy <- data.table::rbindlist(l = raw_list, use.names = TRUE, fill = TRUE)
154+
155+
156+
gather_cols <- setdiff(names(df_tidy), "TimeStamp")
157+
158+
159+
df_tidy <- df_tidy %>%
160+
tidyr::pivot_longer(cols = tidyselect::all_of(gather_cols),
161+
names_to = "ParameterCode",
162+
values_to = "ParameterValue") %>%
163+
dplyr::rename(DateTime = "TimeStamp") %>%
164+
dplyr::left_join(y = meta_data %>% dplyr::select(-tidyselect::matches("ZeroOne"))) %>%
111165
as.data.frame()
112166

113167
df_tidy$Source <- "online"

‎R/read_fst.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ read_fst <- function(path, tz = "CET", col_datetime = "DateTime", ...) {
1818
#' Load fst data for shiny app
1919
#'
2020
#' @param fst_dir directory of fst files to be loaded
21-
#' @importFrom kwb.utils assignGlobally
2221
#' @export
2322
load_fst_data <- function(fst_dir) {
2423
print("### Step 4: Loading data ##########################")
@@ -28,7 +27,9 @@ load_fst_data <- function(fst_dir) {
2827
step_assign <- function(title, varname, filename) {
2928
step_no <<- step_no + 1L
3029
print(sprintf("### %d): %s", step_no, title))
31-
kwb.utils::assignGlobally(varname, read_fst(file.path(fst_dir, filename)))
30+
assign(x = varname,
31+
value = read_fst(file.path(fst_dir, filename)),
32+
envir = .GlobalEnv)
3233
}
3334

3435
step_assign("Raw data", "siteData_raw_list", "siteData_raw_list.fst")

‎R/read_mbr4.R‎

Lines changed: 59 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,36 @@
11
#' Read MBR4.0 tsv data
22
#' @param path path to tsv file to be imported
3+
#' @param locale locale (default: \code{\link[readr]{locale}}(tz = "CET",
4+
#' decimal_mark = ",", grouping_mark = "."))
5+
#' @param col_types col_types (default: \code{\link[readr]{cols}}(
6+
#' .default = \code{\link[readr]{col_double}},
7+
#' zustand = \code{\link[readr]{col_character}},
8+
#' meldungen = \code{\link[readr]{col_character}},
9+
#' Zeitstempel = \code{\link[readr]{col_datetime}}(format = "%d.%m.%Y %H:%M")
10+
#' )
311
#' @param dbg print debug messages (default: FALSE)
412
#' @param ... additional arguments passed to \link[readr]{read_tsv}
513
#' @return Reads MBR4.0 tsv data
614
#' @importFrom readr read_tsv locale cols col_double col_character col_datetime
715

816
read_mbr4_tsv <- function(path,
17+
locale = readr::locale(tz = "CET",
18+
decimal_mark = ",",
19+
grouping_mark = "."),
20+
col_types = readr::cols(
21+
.default = readr::col_double(),
22+
zustand = readr::col_character(),
23+
meldungen = readr::col_character(),
24+
Zeitstempel = readr::col_datetime(format = "%d.%m.%Y %H:%M")
25+
),
926
dbg = FALSE,
1027
...) {
11-
28+
1229
import_raw <- function() {
1330
readr::read_tsv(
1431
file = path,
15-
locale = readr::locale(
16-
date_format = "en",
17-
time_format = "en",
18-
tz = "CET",
19-
decimal_mark = ",",
20-
grouping_mark = "."
21-
),
22-
col_types = readr::cols(
23-
.default = readr::col_double(),
24-
zustand = readr::col_character(),
25-
meldungen = readr::col_character(),
26-
Zeitstempel = readr::col_datetime(format = "")
27-
),
32+
locale = locale,
33+
col_types = col_types,
2834
trim_ws = TRUE,
2935
...
3036
) %>%
@@ -104,6 +110,14 @@ read_mbr4 <- function(latest_url = Sys.getenv("MBR40_URL"),
104110
#' key value pair "MBR40_URL" = "download-url-martin-systems") so
105111
#' that this function works automatically
106112
#' @param target_dir directory to download data (default: tempdir())
113+
#' @param locale locale (default: \code{\link[readr]{locale}}(tz = "CET",
114+
#' decimal_mark = ".", grouping_mark = ","))
115+
#' @param col_types col_types (default: \code{\link[readr]{cols}}(
116+
#' .default = \code{\link[readr]{col_double}},
117+
#' zustand = \code{\link[readr]{col_character}},
118+
#' meldungen = \code{\link[readr]{col_character}},
119+
#' Zeitstempel = \code{\link[readr]{col_datetime}}(format = "%Y-%m-%d %H:%M:%S")
120+
#' )
107121
#' @param dbg print debug messages (default: FALSE)
108122
#' @param ... additional arguments passed to \link[readr]{read_tsv}
109123
#' @return tibble with imported MBR4.0 tsv data (~ last four weeks)
@@ -116,6 +130,15 @@ read_mbr4 <- function(latest_url = Sys.getenv("MBR40_URL"),
116130
#' str(mbr4_data_latest)
117131
read_mbr4_latest <- function(url = Sys.getenv("MBR40_URL"),
118132
target_dir = tempdir(),
133+
locale = readr::locale(tz = "CET",
134+
decimal_mark = ".",
135+
grouping_mark = ","),
136+
col_types = readr::cols(
137+
.default = readr::col_double(),
138+
zustand = readr::col_character(),
139+
meldungen = readr::col_character(),
140+
Zeitstempel = readr::col_datetime(format = "%Y-%m-%d %H:%M:%S")
141+
),
119142
dbg = FALSE,
120143
...) {
121144

@@ -126,7 +149,9 @@ read_mbr4_latest <- function(url = Sys.getenv("MBR40_URL"),
126149
destfile = target_path, quiet = !dbg
127150
)
128151

129-
read_mbr4_tsv(path = target_path,
152+
read_mbr4_tsv(path = target_path,
153+
locale = locale,
154+
col_types = col_types,
130155
dbg = dbg,
131156
...)
132157

@@ -137,6 +162,14 @@ read_mbr4_latest <- function(url = Sys.getenv("MBR40_URL"),
137162
#' @param dir directory on Nextcloud containing file (default:
138163
#' "projects/MBR4.0/Exchange/Rohdaten/Online_export")
139164
#' @param target_dir directory to download data (default: tempdir())
165+
#' @param locale locale (default: \code{\link[readr]{locale}}(tz = "CET",
166+
#' decimal_mark = ",", grouping_mark = "."))
167+
#' @param col_types col_types (default: \code{\link[readr]{cols}}(
168+
#' .default = \code{\link[readr]{col_double}},
169+
#' zustand = \code{\link[readr]{col_character}},
170+
#' meldungen = \code{\link[readr]{col_character}},
171+
#' Zeitstempel = \code{\link[readr]{col_datetime}}(format = "%d.%m.%Y %H:%M")
172+
#' )
140173
#' @param url url of Nextcloud (default: Sys.getenv("NEXTCLOUD_URL"))
141174
#' @param user username of Nextcloud (default: Sys.getenv("NEXTCLOUD_USER"))
142175
#' @param pw password of Nextcloud (default: Sys.getenv("NEXTCLOUD_USER"))
@@ -154,6 +187,15 @@ read_mbr4_archived <- function(
154187
file = "MBR_export_",
155188
dir = "projects/MBR4.0/Exchange/Rohdaten/Online_export",
156189
target_dir = tempdir(),
190+
locale = readr::locale(tz = "CET",
191+
decimal_mark = ",",
192+
grouping_mark = "."),
193+
col_types = readr::cols(
194+
.default = readr::col_double(),
195+
zustand = readr::col_character(),
196+
meldungen = readr::col_character(),
197+
Zeitstempel = readr::col_datetime(format = "%d.%m.%Y %H:%M")
198+
),
157199
url = Sys.getenv("NEXTCLOUD_URL"),
158200
user = Sys.getenv("NEXTCLOUD_USER"),
159201
pw = Sys.getenv("NEXTCLOUD_USER"),
@@ -183,6 +225,8 @@ read_mbr4_archived <- function(
183225
target_dir = target_dir)
184226

185227
read_mbr4_tsv(path = archived_path,
228+
locale = locale,
229+
col_types = col_types,
186230
dbg = dbg,
187231
...)
188232
}

‎man/read_mbr4_archived.Rd‎

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

‎man/read_mbr4_latest.Rd‎

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

0 commit comments

Comments
 (0)