R/nelson.R

In msberends/certedata: Tools for Data Analysis at Certe

# ==================================================================== #
# TITLE                                                                #
# Tools for Data Analysis at Certe                                     #
#                                                                      #
# AUTHORS                                                              #
# Berends MS (m.berends@certe.nl)                                      #
# Meijer BC (b.meijer@certe.nl)                                        #
# Hassing EEA (e.hassing@certe.nl)                                     #
#                                                                      #
# COPYRIGHT                                                            #
# (c) 2019 Certe Medische diagnostiek & advies - https://www.certe.nl  #
#                                                                      #
# LICENCE                                                              #
# This R package is free software; you can redistribute it and/or      #
# modify it under the terms of the GNU General Public License          #
# version 2.0, as published by the Free Software Foundation.           #
# This R package is distributed in the hope that it will be useful,    #
# but WITHOUT ANY WARRANTY; without even the implied warranty of       #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         #
# GNU General Public License for more details.                         #
# ==================================================================== #

#' Tekst van Nelson regels
#'
#' Dit geeft de uitleg van iedere Nelson regel.
#' @param rule Nelson regel
#' @param min.run Standaard is de standaardwaarde volgens Nelson. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @keywords nelson
#' @export
nelson.text <- function(rule, min.run = nelson.defaultminrun(rule)) {
  if (rule == 1) {
    tekst <- 'Detecteer waarnemingen >3 sd'
  }
  if (rule == 2) {
    tekst <- 'Detecteer reeks van >= {n} waarnemingen aan dezelfde kant van het gemiddelde'
  }
  if (rule == 3) {
    tekst <- 'Detecteer strikte toename of afname bij >= {n} waarnemingen op een rij'
  }
  if (rule == 4) {
    tekst <- 'Detecteer {n} waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname'
  }
  if (rule == 5) {
    tekst <- 'Detecteer {n-1} van de {n} >2 sd van gemiddelde in dezelfde richting'
  }
  if (rule == 6) {
    tekst <- 'Detecteer {n-1} van de {n} >1 sd van gemiddelde in dezelfde richting'
  }
  if (rule == 7) {
    tekst <- 'Detecteer >= {n} waarnemingen op een rij binnen 1 sd van het gemiddelde'
  }
  if (rule == 8) {
    tekst <- 'Detecteer >= {n} waarnemingen op een rij allen buiten 1sd'
  }
  tekst <- gsub('{n-1}', min.run - 1, tekst, fixed = TRUE)
  tekst <- gsub('{n}', min.run, tekst, fixed = TRUE)
  tekst
}

#' Standaardwaarde voor \code{min.run}
#'
#' Bepaal de standaardwaarde van \code{min.run} volgens Nelson per regel.
#' @param rule Nelson regel
#' @keywords nelson
#' @export
nelson.defaultminrun <- function(rule) {
  switch(rule,
         '1' = 3,
         '2' = 9,
         '3' = 6,
         '4' = 14,
         '5' = 3,
         '6' = 5,
         '7' = 15,
         '8' = 8
  )
}

#' Nelson QC regel 1
#'
#' Detecteer waarnemingen >3 sd.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param s Standaard is \code{sd(x)}. Standaardafwijking.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule1 <- function(x, m = mean(x), s = sd(x)) {
  which(abs((x - m) / s) >= 3)
}

#' Nelson QC regel 2
#'
#' Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(2)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule2 <- function(x, m = mean(x), min.run = nelson.defaultminrun(2)) {
  n <- length(x)
  counts <- sign(x - m)
  result <- counts
  for (runlength in 2:min.run)
    result <- result + c(counts[runlength:n], rep(0, runlength - 1))
  which(abs(result) >= min.run)
}

#' Nelson QC regel 3
#'
#' Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij.
#' @param x Gegevensreeks
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(3)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule3 <- function(x, min.run = nelson.defaultminrun(3)) {
  # Between 6 waarnemingen you have 5 instances of increasing or decreasing. Therefore min.run - 1.
  n <- length(x)
  signs <- sign(c(x[-1], x[n]) - x)
  counts <- signs
  for (rl in 2:(min.run - 1)) {
    counts <- counts + c(signs[rl:n], rep(0, rl - 1))
  }
  which(abs(counts) >= min.run - 1)
}

#' Nelson QC regel 4
#'
#' Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(4)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @param direction.mean Standaard is \code{FALSE}. Met \code{TRUE} test deze functie op 14 waarnemingen op een rij alternerend in richting van het gemiddelde.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule4 <- function(x, m = mean(x), min.run = nelson.defaultminrun(4), direction.mean = FALSE) {
  n <- length(x)
  if (direction.mean == TRUE) {
    signs <- sign(x - m)
  } else {
    signs <- sign(c(x[-1],x[n]) - x)
  }
  counts <- signs
  fac <- -1
  for (rl in 2:min.run) {
    counts <- counts + fac * c(signs[rl:n], rep(0, rl - 1))
    fac <- -fac
  }
  counts <- abs(counts)
  which(counts >= min.run)
}

#' Nelson QC regel 5
#'
#' Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param s Standaard is \code{sd(x)}. Standaardafwijking.
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(5)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule5 <- function(x, m = mean(x), s = sd(x), min.run = nelson.defaultminrun(5)) {
  n <- length(x)
  pos <- 1 * ((x - m) / s > 2)
  neg <- 1 * ((x - m) / s < -2)
  poscounts <- pos
  negcounts <- neg
  for (rl in 2:min.run) {
    poscounts <- poscounts + c(pos[rl:n], rep(0, rl - 1))
    negcounts <- negcounts + c(neg[rl:n], rep(0, rl - 1))
  }
  counts <- apply(cbind(poscounts, negcounts), 1, max)
  which(counts >= min.run - 1)
}

#' Nelson QC regel 6
#'
#' Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param s Standaard is \code{sd(x)}. Standaardafwijking.
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(6)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule6 <- function(x, m = mean(x), s = sd(x), min.run = nelson.defaultminrun(6)) {
  n <- length(x)
  pos <- 1 * ((x - m) / s > 1)
  neg <- 1 * ((x - m) / s < -1)
  poscounts <- pos
  negcounts <- neg
  for (rl in 2:min.run) {
    poscounts <- poscounts + c(pos[rl:n], rep(0, rl - 1))
    negcounts <- negcounts + c(neg[rl:n], rep(0, rl - 1))
  }
  counts <- apply(cbind(poscounts, negcounts), 1, max)
  which(counts >= min.run - 1)
}

#' Nelson QC regel 7
#'
#' Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param s Standaard is \code{sd(x)}. Standaardafwijking.
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(7)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule7 <- function(x, m = mean(x), s = sd(x), min.run = nelson.defaultminrun(7)) {
  n <- length(x)
  within <- 1 * (abs((x - m) / s) < 1)
  counts <- within
  for (rl in 2:min.run)
    counts <- counts + c(within[rl:n], rep(0, rl - 1))
  which(counts >= min.run)
}

#' Nelson QC regel 8
#'
#' Detecteer >= 8 waarnemingen op een rij allen buiten 1sd.
#' @param x Gegevensreeks
#' @param m Standaard is \code{mean(x)}. Gemiddelde.
#' @param s Standaard is \code{sd(x)}. Standaardafwijking.
#' @param min.run Standaard is \code{\link{nelson.defaultminrun}(8)}. Minimaal aantal opeenvolgende waarnemingen waaraan de regel moet voldoen.
#' @section Alle Nelson QC regels:
#' \itemize{
#'  \item{\code{\link{nelson.rule1}}: Detecteer waarnemingen >3 sd}
#'  \item{\code{\link{nelson.rule2}}: Detecteer reeks van >= 9 waarnemingen aan dezelfde kant van het gemiddelde}
#'  \item{\code{\link{nelson.rule3}}: Detecteer strikte toename of afname bij >= 6 waarnemingen op een rij}
#'  \item{\code{\link{nelson.rule4}}: Detecteer 14 waarnemingen op een rij alternerend in richting van het gemiddelde, of alternerend in toename en afname}
#'  \item{\code{\link{nelson.rule5}}: Detecteer 2 van de 3 >2 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule6}}: Detecteer 4 van de 5 >1 sd van gemiddelde in dezelfde richting}
#'  \item{\code{\link{nelson.rule7}}: Detecteer >= 15 waarnemingen op een rij binnen 1 sd van het gemiddelde}
#'  \item{\code{\link{nelson.rule8}}: Detecteer >= 8 waarnemingen op een rij allen buiten 1sd}
#' }
#' @keywords nelson
#' @export
nelson.rule8 <- function(x, m = mean(x), s = sd(x), min.run = nelson.defaultminrun(8)) {
  n <- length(x)
  outofrange <- 1 * (abs((x - m) / s) > 1)
  counts <- outofrange
  for (rl in 2:min.run)
    counts <- counts + c(outofrange[rl:n], rep(0, rl - 1))
  which(counts >= min.run)
}


#' Kwaliteitsanalyse o.b.v. Nelson, Westgard of anders
#'
#' Met deze functie kan een gegevensreeks getoetst worden op kwaliteitsregels. Daarnaast wordt getoetst of er een significante lineaire trend bestaat.
#' @rdname qc
#' @param x Gegevensreeks.
#' @param dates Standaard is \code{rep(NA, length(x))}. Datums van gegevenswaarden.
#' @param m Standaard is \code{mean(x)}. Gemiddelde van \code{x} dat gebruikt wordt in de kwaliteitsregels.
#' @param s Standaard is \code{sd(x)}. Standaardafwijking van \code{x} dat gebruikt wordt in de kwaliteitsregels.
#' @param round Standaard is \code{2}. Aantal decimalen waarop alle getallen afgerond worden.
#' @param type Standaard is \code{"Nelson"}. Geldige opties zijn \code{"Nelson"}, \code{"Westgard"}, \code{"AIAG"}, \code{"Montgomery"} of \code{"Healthcare"}. Zie \strong{Rules list} (onderaan) voor meer informatie.
#' @param text.show Standaard is \code{TRUE}. Tekstanalyse weergeven.
#' @param plot.show Standaard is \code{TRUE}. Grafiek weergeven met gemiddelde (zie \code{\link[certedata]{mean}}), EWMA (zie \code{\link{ewma}}), 1-3x de standaardafwijking (zie \code{\link[certedata]{sd}}) en de waarnemingen met eventueel overtreden kwaliteitsregels.
#' @param title Standaard is \code{paste("Kwaliteitscontrole volgens", type)}. Titel van de toets en de grafiek. Tekst tussen sterretjes wordt cursief gemaakt.
#' @param subtitle Standaard is \code{""}. Ondertitel van de grafiek. Tekst tussen sterretjes wordt cursief gemaakt.
#' @param subtitle.colour Standaard is \code{colourpicker("certeblauw")}. Zie ook \code{\link{colourpicker}}. Kleur van de ondertitel.
#' @param plot.withoutrule1 Standaard is \code{FALSE}. Als regel 1 overtreden wordt (zie \code{\link{nelson.rule1}}), de plot opnieuw weergeven met data zonder deze waarnemingen.
#' @param plot.print Standaard is \code{TRUE}. De grafiek direct printen met de functie \code{print}. Met \code{FALSE} wordt de grafiek als ggplot-model geretourneerd.
#' @param x.lbl Standaard is \code{"Waarneming"}. De tekst op de x-as.
#' @param y.lbl Standaard is \code{"Waarde"}. De tekst op de y-as.
#' @param markdown Standaard is \code{FALSE}. Tekstanalyse afdrukken in markdown-formaat met \code{\link{tbl_markdown}}.
#' @param force Standaard is \code{FALSE}. Bij grote afwijkingen wordt de analyse gestaakt. Gebruik deze optie om de analyse te forceren.
#' @param ... Parameters die doorgegeven worden aan \code{qc.test}.
#' @section Rules list:
#' Voor parameter \code{type}: \cr
#'   \tabular{lccccc}{
#'     \emph{Nelson (N), Westgard (W), AIAG (A), Montgomery (M), Healthcare (H):}             \tab  N \tab  W \tab  A \tab  M \tab  H\cr
#'     ---------------------------------------------------------------------------------------\tab ----- \tab ----- \tab ----- \tab  ----- \tab -----\cr
#'     \strong{#1} Waarnemingen >3 sd                                                         \tab  1 \tab  1 \tab  1 \tab  1 \tab  1\cr
#'     \strong{#2} Reeks van >= \code{n} waarnemingen aan dezelfde kant van het gemiddelde    \tab  9 \tab  9 \tab  7 \tab  8 \tab  8\cr
#'     \strong{#3} Strikte toename of afname bij >=\code{n} waarnemingen op een rij           \tab  6 \tab  - \tab  6 \tab  6 \tab  6\cr
#'     \strong{#4} \code{n} waarnemingen op een rij alternerend (gemiddelde of toename/afname)\tab 14 \tab -  \tab 14 \tab 14 \tab - \cr
#'     \strong{#5} \code{n}-1 van de \code{n} >2 sd van gemiddelde in dezelfde richting       \tab  3 \tab  3 \tab  3 \tab  3 \tab  3\cr
#'     \strong{#6} \code{n}-1 van de \code{n} >1 sd van gemiddelde in dezelfde richting       \tab  5 \tab  5 \tab  5 \tab  5 \tab - \cr
#'     \strong{#7} >=\code{n} waarnemingen op een rij binnen 1 sd van het gemiddelde          \tab 15 \tab  - \tab 15 \tab 15 \tab 15\cr
#'     \strong{#8} >=\code{n} waarnemingen op een rij allen buiten 1sd                        \tab  8 \tab  - \tab  8 \tab  8 \tab -
#'   }
#'   Bron: \url{https://www.qimacros.com/control-chart/nelson-juran-rules.jpg}
#' @keywords nelson westgard qcc qc
#' @export
qc.test <- function(x,
                    dates = rep(NA, length(x)),
                    m = mean(x),
                    s = sd(x),
                    round = 2,
                    type = 'Nelson',
                    text.show = TRUE,
                    plot.show = TRUE,
                    title = paste('Kwaliteitscontrole volgens', type),
                    subtitle = '',
                    subtitle.colour = colourpicker("certeblauw"),
                    plot.withoutrule1 = FALSE,
                    plot.print = TRUE,
                    x.lbl = 'Waarneming',
                    y.lbl = 'Waarde',
                    markdown = FALSE,
                    force = FALSE) {

  if (text.show == FALSE & plot.show == FALSE) {
    stop('`text.show` or `plot.show` must be TRUE.')
  }
  if (!tolower(type) %in% tolower(c('Nelson', 'Westgard', 'AIAG', 'Montgomery', 'Healthcare'))) {
    stop('Invalid type: ', type, '.')
  }
  if (length(boxplot.stats(x)$out) > 30 & force == FALSE) {
    stop('Data contains ', format2(length(boxplot.stats(x)$out)), ' outliers.',
         '\nUse `force = TRUE` to force analysis.')
  }
  if (length(boxplot.stats(x)$out) / length(x) > 0.1 & force == FALSE) {
    stop('Data consists of ', format2(percent = TRUE, x = length(boxplot.stats(x)$out) / length(x)), '% outliers.',
         '\nUse `force = TRUE` to force analysis.')
  }
  if (length(x) > 250 & force == FALSE) {
    stop('Data consists of ', format2(length(x)), ' observations.',
         '\nUse `force = TRUE` to force analysis.')
  }

  hasdates <- !identical(dates, rep(NA, length(x)))
  data <- x
  markdown.vet <- ''
  markdown.cursief <- ''
  markdown.kop4 <- ''
  if (markdown == TRUE) {
    markdown.vet <- '**'
    markdown.cursief <- '*'
    markdown.kop4 <- '#### '
  }
  n.nelson1 <- NA
  n.totaal <- 0

  symbool.gesloten <- 16
  symbool.open <- 1

  colour.list <- colourpicker('rainbow', length = 8)

  # printfunctie voor alle toetsen en plottoevoegingen
  printen <- function(regelnr, afw, minimaal.aantal) {
    if (length(afw) > 0) {
      n.totaal <<- n.totaal + length(afw)
      if (regelnr == 1) {
        n.nelson1 <<- afw
        resultaat <- tibble::tibble('Waarneming' = afw,
                                    'Waarde' = format2(x[afw], round))
        if (hasdates) {
          resultaat <- cbind(resultaat, 'Datum' = format2(dates[afw], 'dd-mm-yy'))
        }
        if (plot.show == TRUE) {
          grfk <<- grfk + geom_point(data = data.frame(x = afw,
                                                       y = data[afw]),
                                     colour = colour.list[regelnr],
                                     shape = symbool.open,
                                     size = 3,
                                     stroke = 1.5)
        }
      } else {
        # x2 <- character(2)
        # dates2 <- character(2)
        # for (i in 1:length(afw)) {
        #   afw.laatste <- afw[i] + minimaal.aantal - 1
        #   x2[i] <- paste(format2(x[afw[i]:afw.laatste], round), collapse = ' / ')
        #   if (hasdates) {
        #     dates2[i] <- paste(format2(dates[afw[i]:afw.laatste], 'dd-mm-yy'), collapse = ' / ')
        #   }
        # }
        resultaat <- tibble::tibble('Waarnemingen' = paste(afw, 't/m', afw + minimaal.aantal - 1),
                                    '1e waarde' = format2(x[afw], round))
        if (hasdates) {
          # resultaat <- cbind(resultaat, 'Datums' = dates2)
          resultaat <- cbind(resultaat, '1e datum' = format2(dates[afw], 'dd-mm-yy'))
        }
        if (plot.show == TRUE) {
          for (i in 1:length(afw)) {
            # voor elke afwijking the lijn plotten
            mx <- min(afw[i] + minimaal.aantal - 1, length(x))
            grfk <<- grfk + geom_line(data = data.frame(x = afw[i]:mx,
                                                        y = data[afw[i]:mx]),
                                      size = 1,
                                      colour = colour.list[regelnr])
            for (j in afw[i]:mx) {
              # voor elke lijn de punten plotten
              yval <- data[j]
              symbool <- symbool.open
              if (j == afw[i]) {
                # eerste punt van iedere lijn met gesloten punt beginnen
                symbool <- symbool.gesloten
                # cijfer van de fout plotten
                y.afstand = max(m + 3 * s, max(data)) - min(m - 3 * s, min(data))
                grfk <<- grfk +
                  geom_point(data = data.frame(x = j,
                                               y = yval + (0.03 * y.afstand)),
                             colour = 'gray25',
                             #color = colour.list[regelnr],
                             shape = symbool.open,
                             size = 4.5) +
                  geom_text(data = data.frame(x = j,
                                              y = yval + (0.03 * y.afstand)),
                            label = regelnr,
                            hjust = 0.5,
                            vjust = 0.25,
                            colour = 'gray25',
                            #colour = colour.list[regelnr],
                            size = 3)
              }
              grfk <<- grfk + geom_point(data = data.frame(x = j,
                                                           y = yval),
                                         colour = colour.list[regelnr],
                                         shape = symbool,
                                         size = 2.5)
            }
          }
        }
      }

      if (text.show == TRUE) {
        cat(paste0(markdown.kop4,
                   '#',
                   regelnr,
                   ': ',
                   nelson.text(regelnr, minimaal.aantal),
                   ' ',
                   markdown.cursief,
                   '(kleur: ',
                   colour.name(colour.list[regelnr]),
                   ')',
                   markdown.cursief))
        if (markdown == FALSE) {
          cat('\n')
          print.data.frame(resultaat, row.names = FALSE, right = FALSE)
        } else {
          tbl_markdown(resultaat, align = 'c', format.dates = 'd mmm yyyy')
        }
        cat('\n')
      }
    }
  }

  fit <- lm(x ~ c(1:length(x)))
  var.p <- summary(fit)$coefficients[2, 4]
  if (var.p < 0.05) {
    signtoets <- 'Ja'
  } else {
    signtoets <- 'Nee'
  }
  var.F <- summary(fit)$fstatistic['value']
  var.R2 <- summary(fit)$r.squared

  header <- paste(paste0('\n', markdown.vet, title, markdown.vet),
                  '\n\nAantal waarnemingen:  ', length(x),
                  '\nGemiddelde:           ', format2(mean(x), round),
                  '\nStandaardafwijking:   ', format2(sd(x), round),
                  '\nVariatieco\u00EBffici\u00EBnt:  ', format2(cv(x), round),
                  '\nSpreidingsco\u00EBffici\u00EBnt:', format2(cqv(x), round),
                  '\nLineair significant:  ', paste0(markdown.vet, signtoets, markdown.vet,
                                                     ' (p = ',
                                                     format2(var.p, round),
                                                     '; F = ',
                                                     format2(var.F, round),
                                                     '; R^2 = ',
                                                     format2(var.R2, round),
                                                     ')'),
                  '\n')
  if (markdown == TRUE) {
    header <- gsub('R^2', 'R^2^', header, fixed = TRUE)
    header <- gsub('\n', '\n\n',  header, fixed = TRUE)
  }
  if (text.show == TRUE) {
    cat(header)
  }

  # plot maken nog voor het testen
  if (plot.show == TRUE) {
    # if (hasdates & length(dates[is.na(dates)]) == 0) {
    #   grfk <-
    #     ggplot(data.frame(x = dates, y = data), aes(x = x, y = y))
    # } else {
    #   grfk <-
    #     ggplot(data.frame(x = c(1:length(data)), y = data), aes(x = x, y = y))
    # }

    if (grepl('*.*', title)) {
      # expressie van maken met hulpfunctie
      title <- markdown.italic(title)
    }
    if (grepl('*.*', subtitle)) {
      # expressie van maken met hulpfunctie
      subtitle <- markdown.italic(subtitle)
    }

    grfk <-
      ggplot(data.frame(x = c(1:length(data)), y = data), aes(x = x, y = y)) +
      theme_certe(subtitle.colour = ifelse(grepl('(LET OP: zonder ).*(waarneming\\(en\\) >3 sd.)', subtitle),
                                           'red',
                                           subtitle.colour)) +
      theme(panel.grid.minor.y = element_blank()) +
      labs(title = title,
           subtitle = subtitle,
           x = x.lbl,
           y = y.lbl) +
      scale_y_continuous(
        limits = c(
          min(m - 3 * s, min(data)),
          max(m + 3 * s, max(data))),
        labels = format.number) +

      # waarnemingen:
      geom_point(colour = 'darkgray', shape = 4) +
      # EWMA:
      geom_ribbon(aes(ymin = m, ymax = ewma(y, 0.9)), fill = rgb(0, 1, 0, 0.2)) +
      geom_line(aes(x = x, y = ewma(y, 0.9)), size = 0.25, colour = rgb(0, 0.5, 0, 0.5)) +
      # gemiddelde, bovenop EWMA plotten:
      geom_hline(yintercept = m, size = 0.75, colour = rgb(0, 0.5, 0)) +
      # 1sd:
      geom_hline(yintercept = m + s, size = 0.75, colour = 'orange', linetype = 3) +
      geom_hline(yintercept = m - s, size = 0.75, colour = 'orange', linetype = 3) +
      # 2sd:
      geom_hline(yintercept = m + 2 * s, size = 0.75, colour = 'orange', linetype = 2) +
      geom_hline(yintercept = m - 2 * s, size = 0.75, colour = 'orange', linetype = 2) +
      # 3sd:
      geom_hline(yintercept = m + 3 * s, size = 0.75, colour = 'red', linetype = 2) +
      geom_hline(yintercept = m - 3 * s, size = 0.75, colour = 'red', linetype = 2)

    if (var.p < 0.05) {
      # met 95% betrouwbaarheidsinterval (level = 0.95) en foutmarges (se = TRUE)
      grfk <- grfk +
        geom_smooth(colour = rgb(0, 170, 240, maxColorValue = 255),
                    size = 0.75,
                    level = 0.95,
                    method = "lm",
                    se = TRUE,
                    alpha = 0.15,
                    fill = rgb(0, 170, 240, maxColorValue = 255))
    }
  }

  if (text.show == TRUE) {
    cat(paste0('\n', markdown.cursief, 'Toetsen:', markdown.cursief, '\n\n'))
  }

  if (tolower(type) == tolower('Nelson')) {
    printen(1, nelson.rule1(x, m, s), 1)
    printen(2, nelson.rule2(x, m, 9), 9)
    printen(3, nelson.rule3(x, 6), 6)
    printen(4, nelson.rule4(x, m, 14, FALSE), 14)
    printen(5, nelson.rule5(x, m, s, 3), 3)
    printen(6, nelson.rule6(x, m, s, 5), 5)
    printen(7, nelson.rule7(x, m, s, 15), 15)
    printen(8, nelson.rule8(x, m, s, 8), 8)
  } else if (tolower(type) == tolower('Westgard')) {
    printen(1, nelson.rule1(x, m, s), 1)
    printen(2, nelson.rule2(x, m, 9), 9)
    printen(5, nelson.rule5(x, m, s, 3), 3)
    printen(6, nelson.rule6(x, m, s, 5), 5)
  } else if (tolower(type) == tolower('AIAG')) {
    printen(1, nelson.rule1(x, m, s), 1)
    printen(2, nelson.rule2(x, m, 7), 7)
    printen(3, nelson.rule3(x, 6), 6)
    printen(4, nelson.rule4(x, m, 14, FALSE), 14)
    printen(5, nelson.rule5(x, m, s, 3), 3)
    printen(6, nelson.rule6(x, m, s, 5), 5)
    printen(7, nelson.rule7(x, m, s, 15), 15)
    printen(8, nelson.rule8(x, m, s, 8), 8)
  } else if (tolower(type) == tolower('Montgomery')) {
    printen(1, nelson.rule1(x, m, s), 1)
    printen(2, nelson.rule2(x, m, 8), 8)
    printen(3, nelson.rule3(x, 6), 6)
    printen(4, nelson.rule4(x, m, 14, FALSE), 14)
    printen(5, nelson.rule5(x, m, s, 3), 3)
    printen(6, nelson.rule6(x, m, s, 5), 5)
    printen(7, nelson.rule7(x, m, s, 15), 15)
    printen(8, nelson.rule8(x, m, s, 8), 8)
  } else if (tolower(type) == tolower('Healthcare')) {
    printen(1, nelson.rule1(x, m, s), 1)
    printen(2, nelson.rule2(x, m, 8), 8)
    printen(3, nelson.rule3(x, 6), 6)
    printen(5, nelson.rule5(x, m, s, 3), 3)
    printen(7, nelson.rule7(x, m, s, 15), 15)
  }

  if (text.show == TRUE & n.totaal == 0) {
    cat('Geen afwijkingen gevonden.\n')
  }

  if (plot.show == TRUE) {
    suppressWarnings(
      if (plot.print == TRUE) {
        print(grfk)
      } else {
        # hiermee is het onderstaande deel (zonder Nelson #1) niet meer ter sprake,
        # maar kunnen de functies qc.test() en plot2.qcc() wel gevolgd worden door plot2.save()
        return(grfk)
      }
    )
    if (plot.withoutrule1 == TRUE & !identical(NA, n.nelson1)) {
      x <- x[-n.nelson1]
      dates <- dates[-n.nelson1]
      plot2.qcc(x = x,
                dates = dates,
                m = m,
                s = s,
                round = round,
                type = type,
                title = title,
                subtitle = paste('LET OP: zonder', length(n.nelson1), 'waarneming(en) >3 sd.'),
                x.lbl = x.lbl,
                y.lbl = y.lbl,
                colour.list = colour.list,
                force = TRUE
      )
    }
  }

}

#' @rdname qc
#' @export
nelson.test <- function(x, ...) {
  qc.test(x, ..., type = 'Nelson')
}

#' @rdname qc
#' @export
westgard.test <- function(x, ...) {
  qc.test(x, ..., type = 'Westgard')
}