diff --git a/R/mktrends.R b/R/mktrends.R index 2d0900c..173b2fe 100644 --- a/R/mktrends.R +++ b/R/mktrends.R @@ -6,7 +6,7 @@ #' uitbijters worden verwijderd met \code{rmoutlier} #' #' @param i put/filter naam waarvoor de statistiek berekend wordt -#' @param x data.frame van lmgsubset met kolom 'instantie' voor de meetinstantie +#' @param x data.frame van lmgsubset #' @param dw.plot geeft aan om de relevante drempelwaarde in de grafiek wordt geplot #' @param trim als TRUE, dan worden uitbijters verwijderd (trimmed) #' @param trimFactor factor van \code{rmoutlier} @@ -30,7 +30,7 @@ mktrends <- function(i, x, trim = FALSE, trimfactor = 1.5, param <- x$parameter[which(x$putfilter == i)[1]] # subset d, only interested in time serie, i.e. jr and # concentration - d <- x %>% select(putfilter, meetjaar, waarde, detectielimiet, instantie, eenheid) %>% + d <- x %>% select(putfilter, meetjaar, waarde, detectielimiet, eenheid) %>% mutate(jr = meetjaar - min(meetjaar)) %>% arrange(jr) %>% filter(putfilter == i) @@ -43,10 +43,10 @@ mktrends <- function(i, x, trim = FALSE, trimfactor = 1.5, # wijs de reeks af als er minder dan 5 metingen en minder dan 4 waarnemingen (waarde > RG) zijn if (nrow(d) < 5) { - return(print("Meetreeks kleiner dan 5 metingen")) + return(NA) } if (nrow(d[d$detectielimiet < 1, ]) < 4) { - return(print("Minder dan 4 metingen boven detectie")) + return(NA) } # remove outliers @@ -87,7 +87,7 @@ mktrends <- function(i, x, trim = FALSE, trimfactor = 1.5, p <- ggplot(d, aes(jr, waarde, colour = detectielimiet)) p <- p + geom_line(colour = "grey") - p <- p + geom_point(aes(shape = Instantie)) + scale_shape_manual(values=c(16, 17)) + p <- p + geom_point() if(dw.plot) { p <- p + geom_hline(aes(yintercept = dw, linetype = "drempelwaarde"), colour = "red") p <- p + geom_hline(aes(yintercept = 0.75 * dw, linetype = "75% drempelwaarde"), colour = "orange") diff --git a/R/plot_all.R b/R/plot_all.R index e05af70..36cf475 100644 --- a/R/plot_all.R +++ b/R/plot_all.R @@ -5,7 +5,7 @@ #' ongeacht het aantal metingen. #' #' @param i put/filter naam waarvoor de statistiek berekend wordt -#' @param x data.frame van lmgsubset, met een kolom 'instantie' waarin de meetinstantie wordt aangegeven +#' @param x data.frame van lmgsubset #' @param trim als TRUE, dan worden uitbijters verwijderd (trimmed) #' @param trimFactor factor van \code{rmoutlier} #' @param dw.plot geeft aan om de relevante drempelwaarde in de grafiek wordt geplot @@ -16,48 +16,52 @@ #' @export #' -plot_all = function (i, x, trim = FALSE, trimfactor = 1.5, dw.plot = TRUE, - rpDL = TRUE, replacefactor = 0.5) -{ - dw <- x$norm[1] - param <- x$parameter[1] - d <- x %>% select(putfilter, meetjaar, waarde, detectielimiet,instantie, - eenheid) %>% mutate(jr = meetjaar - min(meetjaar)) %>% - arrange(jr) %>% filter(putfilter == i) - d <- na.omit(d) - if (rpDL) { - d <- d %>% replaceDL(replaceval = replacefactor) - } - if (trim) { - d <- mutate(d, waarde = rmoutlier(d[["Waarde"]], - factor = trimfactor, na.rm = TRUE)) - } - d <- na.omit(d) - n <- nrow(d) - d <- d %>% mutate(detectielimiet = ifelse(detectielimiet == +plot_all <- function (i, x, trim = FALSE, trimfactor = 1.5, dw.plot = TRUE, + rpDL = TRUE, replacefactor = 0.5) { + + dw <- x$norm[1] + param <- x$parameter[1] + d <- x %>% select(putfilter, meetjaar, waarde, detectielimiet, eenheid) %>% + mutate(jr = meetjaar - min(meetjaar)) %>% + arrange(jr) %>% + filter(putfilter == i) + + d <- na.omit(d) + + if (rpDL) { + d <- d %>% replaceDL(replaceval = replacefactor) + } + if (trim) { + d <- mutate(d, waarde = rmoutlier(d[["Waarde"]], + factor = trimfactor, na.rm = TRUE)) + } + + d <- na.omit(d) + n <- nrow(d) + d <- d %>% mutate(detectielimiet = ifelse(detectielimiet == 1, "< RG", "waarneming")) - - p <- ggplot(d, aes(jr, waarde, colour = detectielimiet)) - p <- p + geom_line(colour = "grey") - p <- p + geom_point(aes(shape = instantie)) + scale_shape_manual(values=c(16, 17)) - if (dw.plot) { - p <- p + geom_hline(aes(yintercept = dw, linetype = "drempelwaarde"), - colour = "red") - p <- p + geom_hline(aes(yintercept = 0.75 * dw, linetype = "75% drempelwaarde"), - colour = "orange") - } - p <- p + theme(legend.position = "none", axis.text.x = element_text(angle = 90, - hjust = 1)) - p <- p + scale_x_continuous(breaks = d$jr, labels = d$meetjaar) - p <- p + labs(x = "Jaar", y = paste("Concentratie", - param, strsplit(x$eenheid[1], " ")[[1]][1]), - title = paste("Metingen in filter", i)) - p <- p + theme(plot.title = element_text(hjust = 0.5), - legend.position = "bottom") - p <- p + scale_color_manual(name = "", values = c(`< RG` = "red", - waarneming = "black")) - p <- p + scale_linetype_manual(name = "", values = c(2, - 2), guide = guide_legend(override.aes = list(color = c("orange", - "red")))) - return(p) -} \ No newline at end of file + + p <- ggplot(d, aes(jr, waarde, colour = detectielimiet)) + p <- p + geom_line(colour = "grey") + #p <- p + geom_point(aes(shape = instantie)) + scale_shape_manual(values=c(16, 17)) + if (dw.plot) { + p <- p + geom_hline(aes(yintercept = dw, linetype = "drempelwaarde"), + colour = "red") + p <- p + geom_hline(aes(yintercept = 0.75 * dw, linetype = "75% drempelwaarde"), + colour = "orange") + } + p <- p + theme(legend.position = "none", axis.text.x = element_text(angle = 90, + hjust = 1)) + p <- p + scale_x_continuous(breaks = d$jr, labels = d$meetjaar) + p <- p + labs(x = "Jaar", y = paste("Concentratie", + param, strsplit(x$eenheid[1], " ")[[1]][1]), + title = paste("Metingen in filter", i)) + p <- p + theme(plot.title = element_text(hjust = 0.5), + legend.position = "bottom") + p <- p + scale_color_manual(name = "", values = c(`< RG` = "red", + waarneming = "black")) + p <- p + scale_linetype_manual(name = "", values = c(2, + 2), guide = guide_legend(override.aes = list(color = c("orange", + "red")))) + return(p) +} diff --git a/R/toetsNormoverschrijding.R b/R/toetsNormoverschrijding.R index 9f39bdf..69aa65c 100644 --- a/R/toetsNormoverschrijding.R +++ b/R/toetsNormoverschrijding.R @@ -33,7 +33,7 @@ toetsNormoverschrijding <- function(d, toetsnorm = 0.75) { - # testSerie(d) + testSerie(d) param <- d$parameter[1] n.tot <- nrow(d) diff --git a/R/toetsStatistiek.R b/R/toetsStatistiek.R index a27eb9f..1a2dba6 100644 --- a/R/toetsStatistiek.R +++ b/R/toetsStatistiek.R @@ -27,7 +27,7 @@ toetsStatistiek <- function(d) { - # testSerie(d) + testSerie(d) param <- d$parameter[1] nrm <- d$norm[1]