---
title:  | 
        | <font color="blue"> litteR - Analysis of Litter Data</font>
        | <font size="1"><i> &copy; 2018-2021 D.J.J. Walvoort & W.M.G.M Van Loon. [MIT-license](https://opensource.org/licenses/MIT). `r sprintf("litteR version: %s (%s)", packageVersion("litteR"), packageDate("litteR"))`</i></font>
date:   | 
        | `r format(Sys.time())`
        | 
        |
pagetitle: "litteR-report"
output:
  html_document:
    toc: true
    toc_depth: 4
    toc_float: false
editor_options: 
  chunk_output_type: console
params:
  file_stats:
    label: "Name report:"
    value: ""
    placeholder: "Enter name of stats output file"
    input: file
  file_data: 
    label: "Input file:"
    value: ""
    placeholder: "Enter name of litter file"
    input: file
  file_settings: 
    label: "Settings file:"
    value: ""
    placeholder: "Enter name of settings file"
    input: file
  file_types: 
    label: "Type file:"
    value: ""
    placeholder: "Enter name of file with type and group definitions"
    input: file
  percentage_total_count: 
    label: "Percentage of total count:"
    value: 80
    min: 50
    max: 100 
    step: 1
    width: 200
    input: numeric
  date_min:
    label: "First date to analyse"
    value: "2011-01-01"
    startview: year
    min: "1990-01-01"
    max: "2050-12-31"
    format: "yyyy-mm-dd"
    width: 200
    input: date
  date_max:
    label: "Final date to analyse"
    value: "2017-12-31"
    startview: year
    min: "1990-01-01"
    max: "2050-12-31"
    format: "yyyy-mm-dd"
    width: 200
    input: date
  figure_quality:
    label: "figure quality"
    value: "low"
    input: text
  cutoff_count_axis:
    label: "cutoff vertical count axis in plots"
    value: 100
    min: 1
    max: 100 
    step: 1
    width: 200
    input: numeric
  location_code:
    label: "location code"
    value: ""
    input: text
  region_code:
    label: "region code"
    value: ""
    input: text
  group_code:
    label: "group_code"
    value: ""
    input: text
  type_name:
    label: "type code"
    value: ""
    input: text
---



```{r, include=FALSE, message=FALSE, warning=FALSE}
# Coding convention
# To make scripts readable and consistent, we adhere to the packages and 
# programming style of the tidyverse (www.tidyverse.org)

knitr::opts_knit$set(
  progress = FALSE, 
  verbose = FALSE
)

# make sure all table columns are visible
options(dplyr.width = Inf, warning.length = 8000)

# attach packages to R's search path
suppressPackageStartupMessages({
  library(rlang)     # tidyverse versions of base/core functions
  library(dplyr)     # grammar of data manipulation
  library(purrr)     # functional programming tools
  library(tidyr)     # tidy data
  library(ggplot2)   # grammar of graphics
  library(fs)        # file system
  library(knitr)     # dynamic report generation
  library(litteR)    # litter analysis
  library(readr)     # writing CSV-files
  library(stringr)   # common string operations
})
```



```{r include=FALSE, purl=FALSE}
# figure quality
FIGURE_QUALITY <- params %>%
  chuck("figure_quality")

# global knitr-settings (defaults)
opts_chunk$set(
    comment = NULL,
    echo = FALSE,
    dpi = c(low = 72, high = 300)[FIGURE_QUALITY]
)

```


```{r}
logger$info("Checking parameters in settings file")

# files
FILE_SETTINGS <- params %>%
  pluck("file_settings", .default = "")
FILE_DATA <- params %>%
  pluck("file_data", .default = "")
FILE_TYPES <- params %>%
  pluck("file_types", .default = "")
FILE_STATS <- params %>%
  pluck("file_stats", .default = "")

# period to analyse
DATE_FROM <- params %>%
    chuck("date_min")
DATE_TO <- params %>%
    chuck("date_max")

# percentage of total count
PERCENTAGE_TOTAL_COUNT <- params %>%
  chuck("percentage_total_count")

# location_code, type name, and group code
LOCATION_CODE <- params %>%
  pluck("location_code")
REGION_CODE <- params %>%
  pluck("region_code")
TYPE_NAME <- params %>%
  pluck("type_name")
GROUP_CODE <- params %>%
  pluck("group_code")

if ((length(LOCATION_CODE) == 1L) && (LOCATION_CODE == "")) {
    LOCATION_CODE <- NULL
}
if ((length(REGION_CODE) == 1L) && (REGION_CODE == "")) {
    REGION_CODE <- NULL
}
if ((length(TYPE_NAME) == 1L) && (TYPE_NAME == "")) {
    TYPE_NAME <- NULL
}
if ((length(GROUP_CODE) == 1L) && (GROUP_CODE == "")) {
    GROUP_CODE <- NULL
}

# cutoff count axis in plots
CUTOFF_COUNT_AXIS <- params %>%
    pluck("cutoff_count_axis", .default = 100)

if (!(CUTOFF_COUNT_AXIS %>% between(0, 100))) {
    logger$error("cutoff count axis in YAML-file should be between 0% and 100%")
}

```


## Introduction

This tool performs the following types of data analysis on beach litter data, or any other type of litter data: data quality control, outlier analysis, descriptive statistics, and trend analysis.

This report can best be viewed with the latest versions of web browsers like Google Chrome, Mozilla Firefox, Chromium, or Safari. Its contents does not render well in some versions of Microsoft's Internet Explorer.



## Settings

- period: from `r DATE_FROM` to `r DATE_TO`
- percentage of total count to analyse: `r PERCENTAGE_TOTAL_COUNT`%
- files:
    - project directory: `r sQuote(path_dir(FILE_DATA))`
    - settings: `r sQuote(path_file(FILE_SETTINGS))`
    - data: `r sQuote(path_file(FILE_DATA))`
    - types: `r sQuote(path_file(FILE_TYPES))`
- location codes: `r if (is_null(LOCATION_CODE)) {"not specified"} else {enumerate(sQuote(LOCATION_CODE))}`
- region codes: `r if (is_null(REGION_CODE)) {"not specified"} else {enumerate(sQuote(REGION_CODE))}`
- group codes: `r if (is_null(GROUP_CODE)) {"not specified"} else {enumerate(sQuote(GROUP_CODE))}`
- type names: `r if (is_null(TYPE_NAME)) {"not specified"} else {enumerate(sQuote(TYPE_NAME))}`
- figure quality: `r sQuote(FIGURE_QUALITY)`
- cutoff count axis in plots: `r CUTOFF_COUNT_AXIS`%





<br/>
<br/>

```{r}
logger$info("Entering data quality control section")
```

## Data Quality Control

In this section, litter data will be read and validated. Warnings will be printed if they occur. See also the log-file for more details.


```{r}
# type_file
d_type <- FILE_TYPES %>%
  read_litter_types(logger)

# read and validate input file
d_ltr <- FILE_DATA %>%
  read_litter(logger, type_names = d_type %>% pull("type_name")) %>%
  filter(date %>% between(DATE_FROM, DATE_TO))

if ((nrow(d_ltr) == 0L)) {
  logger$error("No data available in the period settings between {DATE_FROM} and {DATE_TO}")
}
```

```{r}
# regional analysis requested?
REGIONAL_ANALYSIS <- "region_code" %in% names(d_ltr)
```

```{r}

logger$info(str_glue("Computing group totals"))
d_grp <- d_type %>%
  pull("group_code") %>%
  unique %>%
  map_df(function(x) {
    d_type %>%
      filter(group_code == x) %>%
      select(type_name) %>%
      left_join(d_ltr, by = "type_name") %>%
      group_by(location_code, date, .RECORD_ID) %>%
      summarise(count = sum(count), .groups = "drop") %>%
      filter(!are_na(count)) %>%
      mutate(type_name = x)})

logger$info(str_glue("Computing relative group totals (relative w.r.t. TC)"))
d_grp <- d_grp %>% 
  filter(type_name == "TC") %>%
  select(location_code, date, .RECORD_ID, TC = count) %>%
  right_join(d_grp, by = c("location_code", "date", ".RECORD_ID")) %>%
  mutate(rel_count = 100 * count / TC) %>%
  select(-TC)

logger$info(str_glue("Determining top {PERCENTAGE_TOTAL_COUNT}% litter..."))
d <- d_grp %>%
  filter(type_name == "TC") %>%
  select(location_code, date, TC = count) %>%
  group_by(location_code) %>%
  summarise(sum_TC = sum(TC), .groups = "drop") %>%
  left_join(d_ltr, by = "location_code") %>%
  group_by(location_code, sum_TC, type_name) %>%
  summarise(sum_count = sum(count), .groups = "drop") %>%
  arrange(location_code, desc(sum_count)) %>%
  group_by(location_code) %>%
  mutate(rel_count = 100 * cumsum(sum_count) / sum_TC) %>%
  mutate(topx = rel_count < (PERCENTAGE_TOTAL_COUNT + 0.001)) %>%
  ungroup %>%
  select(location_code, type_name, topx)

# adding relative counts to litter types
d_ltr <- d_grp %>%
  filter(type_name == "TC") %>%
  select(location_code, date, .RECORD_ID, TC = count) %>%
  right_join(d_ltr, by = c("location_code", "date", ".RECORD_ID")) %>%
  mutate(rel_count = 100 * count / TC) %>%
  select(-TC) %>%
  arrange(location_code, date, desc(rel_count)) 

# adding topx% to litter types
d_ltr <- d_ltr %>%
  left_join(d, by = c("location_code", "type_name"))

# adding litter types to litter groups
d_ltr <- d_ltr %>%
  bind_rows(d_grp)

# add region_code to litter groups
lut <- d_ltr %>%
    distinct(location_code, region_code) %>%
    filter(!are_na(region_code))
d_ltr <- d_ltr %>%
    select(-region_code) %>%
    left_join(lut, by = "location_code")

```



```{r, child=system.file("app", "litter-outlier.Rmd", package = "litteR")}
```

```{r, child=system.file("app", "litter-stats.Rmd", package = "litteR")}
```

```{r, child=system.file("app", "litter-stats-regional.Rmd", package = "litteR"), eval=isTRUE(REGIONAL_ANALYSIS)}
```

```{r, child=system.file("app", "litter-no-regional-analysis.Rmd", package = "litteR"), eval=!isTRUE(REGIONAL_ANALYSIS)}
```

```{r, child=system.file("app", "litter-trend.Rmd", package = "litteR")}
```

```{r, child=system.file("app", "litter-trend-regional.Rmd", package = "litteR"), eval=isTRUE(REGIONAL_ANALYSIS)}
```

```{r, child=system.file("app", "litter-no-regional-trend-analysis.Rmd", package = "litteR"), eval=!isTRUE(REGIONAL_ANALYSIS)}
```


<br/>
<br/>

## Session Information

```{r}
logger$info("Adding session information.")
sessionInfo()
```