#' @title Stelt de slechtste curves en afwijkende metingen grafisch voor in een
#' rapport
#'
#' @description
#' De functie genereert een validatierapport (`.html`-bestand) in de working
#' directory (of opgegeven directory) met informatie en grafieken van de te
#' controleren modellen. De afwijkende metingen en curvedelen zijn in rood
#' aangeduid; boven de curve is het probleem ook woordelijk beschreven.
#'
#' Deze functie rendert het bestand `Validatierapport.Rmd`, dat afhankelijk van
#' de opgegeven variabele `TypeRapport` voor elke boomsoort-domeincombinatie als
#' child `DomeincurveDynamisch.Rmd` of `Domeincurve.Rmd` toevoegt.
#'
#'
#' @param SlechtsteModellen Lijst van de slechtste modellen, dit zijn modellen
#' met hoge RMSE, afwijkende vorm (op basis van extremen en buigpunten) en/of
#' modellen met afwijkende metingen. Deze dataframe moet volgende velden
#' bevatten: `BMS` (boomsoort), `DOMEIN_ID` en `Reden` (= tekstuele opsomming
#' van afwijkingen, om weer te geven boven grafiek).
#' @param AfwijkendeMetingen Lijst met afwijkende metingen (dataframe zoals
#' gegenereerd door de functie `afwijkendeMetingen()`).
#' @param Dataset Dataset met gemeten waarden en geschatte waarde voor
#' domeinmodel en Vlaams model (inclusief `RMSE`)
#' @param Bestandsnaam Een naam voor het validatierapport (`.html`-bestand) dat
#' gegenereerd wordt, bestaande uit een string die eindigt op `.html`
#' @param TypeRapport Default is "Dynamisch", waarbij de figuren in het
#' `.html`-bestand kunnen worden aangepast (meetgegevens weergeven door muis
#' erover te bewegen (inclusief `ID` als deze in de dataset meegegeven is),
#' items uit legende wegklikken, grafiek inzoomen,...). Een andere optie is
#' "Statisch", waarbij de figuren vast zijn.
#' @param Uitbreidingsrapport Gaat het over een validatierapport voor
#' `validatie.uitbreiding()`?
#' Default is `FALSE`, wat betekent dat het validatierapport de standaard layout
#' heeft voor de validatierapporten, met afwijkingen in rood en standaard
#' informatie die getoond wordt.
#' In het validatierapport voor `validatie.uitbreiding()` is de uitbreiding
#' die gevalideerd moet worden, in blauw weergegeven. Ook wijkt de weergegeven
#' informatie iets af van de standaard.
#' @inheritParams initiatie
#'
#' @return De functie genereert in de working directory (of opgegeven directory)
#' een rapport (`.html`) met de te controleren modellen. Hierin wordt per model
#' (boomsoort-domeincombinatie) de volgende algemene informatie vermeld:
#' boomsoort, domein (en ID), aantal metingen, RMSE, bruikbaar interval en de
#' mogelijke problemen die bij het model optreden.
#'
#' Daaronder wordt telkens grafisch volgende info weergegeven:
#' - een puntenwolk die de metingen voorstelt (geen individuele metingen,
#' maar een jitter)
#' - curve van het Vlaams model (als beschikbaar, dus niet voor het lokaal
#' model)
#' - curve van het domeinmodel
#' - grenzen van het bruikbaar interval (curves eindigen bij de
#' klassenmiddens die overeenkomen met deze grenzen)
#' - afwijkende metingen: in rood (andere metingen in zwart)
#' - afwijkende deel van een curve in rood (rest van curve in zwart)
#'
#' Bij de keuze voor een uitbreidingsrapport (argument
#' `Uitbreidingsrapport = TRUE`) wijkt het rapport af:
#' - algemene informatie: de RMSE is vervangen door de variabelen
#' DiffMediaan, DiffMin en DiffMax
#' - kleur van grafiek: geen afwijkingen in rood, wel is de uitbreiding
#' weergegeven in blauw (zowel jitter van metingen als curve)
#'
#' @export
#'
#' @importFrom dplyr %>% inner_join mutate left_join select distinct filter
#' bind_rows group_by arrange ungroup summarise desc
#' @importFrom rlang .data
#' @importFrom rmarkdown render
#' @importFrom assertthat assert_that noNA is.flag has_name
#'
validatierapport <-
function(SlechtsteModellen, AfwijkendeMetingen, Dataset,
Bestandsnaam = "Validatie.html",
TypeRapport = c("Dynamisch", "Statisch"),
Uitbreidingsrapport = FALSE,
verbose = TRUE, PathWD = getwd()) {
TypeRapport <- match.arg(TypeRapport)
assert_that(inherits(SlechtsteModellen, "data.frame"))
assert_that(has_name(SlechtsteModellen, "BMS"))
if (has_name(SlechtsteModellen, "Omtrek_Buigpunt")) {
assert_that(inherits(SlechtsteModellen$Omtrek_Buigpunt, "numeric"))
}
assert_that(has_name(SlechtsteModellen, "Reden"))
if (has_name(SlechtsteModellen, "Omtrek_Extr_Hoogte")) {
assert_that(inherits(SlechtsteModellen$Omtrek_Extr_Hoogte, "numeric"))
}
assert_that(inherits(AfwijkendeMetingen, "data.frame"))
assert_that(has_name(AfwijkendeMetingen, "BMS"))
assert_that(has_name(AfwijkendeMetingen, "DOMEIN_ID"))
assert_that(has_name(AfwijkendeMetingen, "C13"))
assert_that(inherits(AfwijkendeMetingen$C13, "numeric"))
assert_that(has_name(AfwijkendeMetingen, "HOOGTE"))
assert_that(inherits(AfwijkendeMetingen$HOOGTE, "numeric"))
assert_that(has_name(AfwijkendeMetingen, "Status"),
msg = "De opgegeven dataframe heeft geen veld met naam Status")
if (!all(AfwijkendeMetingen$Status %in%
c("Niet gecontroleerd", "Te controleren", "Goedgekeurd", NA))) {
stop("De kolom Status in de dataframe heeft niet voor alle records een
geldige waarde. Zorg dat enkel de waarden 'Niet gecontroleerd',
'Te controleren' en 'Goedgekeurd' voorkomen, NA is ook toegelaten.")
}
if (Uitbreidingsrapport) {
invoercontrole(Dataset, "afgeleidedata", Uitbreiding = TRUE)
} else {
invoercontrole(Dataset, "afgeleidedata")
}
assert_that(has_name(Dataset, "H_D_finaal"))
assert_that(inherits(Dataset$H_D_finaal, "numeric"))
assert_that(has_name(Dataset, "rmseD"))
assert_that(inherits(Dataset$rmseD, "numeric"))
assert_that(has_name(Dataset, "maxResid"))
assert_that(inherits(Dataset$maxResid, "numeric"))
assert_that(has_name(Dataset, "ID"))
assert_that(is.logical(Uitbreidingsrapport))
assert_that(is.flag(verbose))
assert_that(noNA(verbose))
assert_that(is.character(Bestandsnaam))
if (!grepl(".html$", Bestandsnaam)) {
stop("De bestandnaam moet eindigen op '.html'")
}
assert_that(is.character(TypeRapport))
TypeRapport <- tolower(TypeRapport)
assert_that(TypeRapport %in% c("dynamisch", "statisch"))
Selectie <- Dataset %>%
inner_join(
SlechtsteModellen,
by = c("BMS", "DOMEIN_ID")
) %>%
left_join(
AfwijkendeMetingen %>%
filter(.data$Status != "Goedgekeurd") %>%
select("BMS", "DOMEIN_ID", "C13", "HOOGTE") %>%
distinct() %>%
mutate(TeControlerenAfwijking = TRUE),
by = c("BMS", "DOMEIN_ID", "C13", "HOOGTE")
) %>%
mutate(
TeControlerenAfwijking =
factor(ifelse(is.na(.data$TeControlerenAfwijking),
FALSE, .data$TeControlerenAfwijking),
levels = c(FALSE, TRUE),
labels = c("OK", "Te controleren"))
)
#om curves bij afwijkingen een andere kleur te geven (enkel nodig waar
#buigpunten berekend zijn)
if (has_name(Selectie, "Omtrek_Buigpunt")) {
Selectie2 <- Selectie %>%
mutate(
Omtrek_BP = (((.data$Omtrek_Buigpunt * 100) %/% 10) * 10 + 5) / 100,
Omtrek_Max = (((.data$Omtrek_Extr_Hoogte * 100) %/% 10) * 10 + 5) / 100,
CurveSlecht =
ifelse(!is.na(.data$Omtrek_BP) & (.data$Omtrek <= .data$Omtrek_BP),
TRUE, FALSE),
CurveSlecht =
ifelse(!is.na(.data$Omtrek_Max) & (.data$Omtrek >= .data$Omtrek_Max),
TRUE, .data$CurveSlecht)
)
Selectie <- Selectie2 %>%
filter(
.data$Omtrek == .data$Omtrek_BP | .data$Omtrek == .data$Omtrek_Max
) %>%
mutate(
CurveSlecht = FALSE
) %>%
bind_rows(
Selectie2
)
} else {
Selectie$CurveSlecht <- FALSE
}
Selectie$CurveSlecht <-
factor(Selectie$CurveSlecht, levels = c(FALSE, TRUE),
labels = c("OK", "Te controleren"))
Selectie <- Selectie %>%
arrange(desc(.data$maxResid))
render(system.file("Validatierapport.Rmd", package = "dhcurve"),
output_file = Bestandsnaam,
output_dir = PathWD,
quiet = TRUE,
encoding = "UTF-8")
if (verbose) {
message(sprintf("Het rapport is opgeslagen in de working directory: %s",
getwd()))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.