---
title: "Population reduction (IUCN Criterion A)"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Population reduction (IUCN Criterion A)}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

```{r setup}
library(redlist)
```

## What criterion A measures

Criterion A looks at how much a population has shrunk. In the guidelines a
reduction is a decline in the number of mature individuals of at least a stated
percentage over a set period, three generations or ten years, whichever is
longer. The decline need not still be going on. This is different from the
continuing decline used in criteria B and C, which is about a trend that is
likely to carry on.

`rl_reduction()` computes that percentage from a series of population estimates,
and `rl_overall_reduction()` combines several subpopulations into one figure for
the taxon. Neither needs an internet connection, so the examples below run as
you read them.

## From two estimates

The simplest case has two counts. Suppose a species with a 20 year generation
length was estimated at 20000 individuals in 1961 and 14000 in 1981, and we are
assessing it in 2001. The three generation window then runs from 1941 to 2001,
so we extrapolate back to 1941 and forward to 2001.

```{r two-point-exp}
rl_reduction(
  population = c(20000, 14000),
  time = c(1961, 1981),
  generation_length = 20,
  model = "exponential",
  assessment_year = 2001
)
```

The arguments:

* `population` and `time` are the counts and the years they refer to, as two
  vectors of the same length.
* `generation_length` is the generation length in years. If you do not have it,
  `rl_generation_length()` can estimate it from life history data.
* `model` is the shape of the decline. `"exponential"` assumes a constant
  proportional rate, which suits a threat that takes a fixed fraction each year,
  such as a steady harvest rate. `"linear"` assumes a constant number of
  individuals lost each year, which suits a fixed amount of habitat cleared
  annually.
* `assessment_year` is the year treated as the present. Here the data end in
  1981 but the assessment is made in 2001, so we say so. Left out, it defaults
  to the most recent year in `time`.
* `years` sets the window length. Left out, it is the longer of three
  generations or ten years.

The result gives the fitted sizes at the start and end of the window
(`n_start`, `n_present`), the reduction as a proportion and a percentage, and a
threshold flag. The choice of model matters. The same data read as a linear
decline give a larger figure, because a fixed yearly loss is a growing share of
a shrinking population.

```{r two-point-lin}
rl_reduction(
  population = c(20000, 14000),
  time = c(1961, 1981),
  generation_length = 20,
  model = "linear",
  assessment_year = 2001
)
```

When you cannot choose between the patterns, running both gives a plausible
range for the reduction, which is the honest way to report it.

## From several estimates

With more than two counts, the same call fits a regression through all of them,
which smooths out year to year variation. Exponential uses a log-linear fit,
linear uses a straight line. The reduction is still read over the most recent
window.

```{r multi}
years <- 2000:2020
counts <- round(10000 * 0.97^(0:20))
rl_reduction(counts, years, generation_length = 7)
```

## Reading the category

The `category_a` column reports the most threatened band the reduction reaches:
`"CR"`, `"EN"`, `"VU"`, or `NA` when it reaches none, including the case of an
increase. The thresholds depend on the subcriterion.

| subcriterion | VU | EN | CR |
|---|---|---|---|
| A1 | 50% | 70% | 90% |
| A2, A3, A4 | 30% | 50% | 80% |

A1 applies when the causes are reversible, understood, and have ceased, so it
uses higher thresholds. The default is A2. Set `subcriterion` to change it.

```{r subcriterion}
r <- rl_reduction(c(20000, 14000), c(1961, 1981),
                  generation_length = 20, assessment_year = 2001)
c(A2 = r$category_a,
  A1 = rl_reduction(c(20000, 14000), c(1961, 1981),
                    generation_length = 20, assessment_year = 2001,
                    subcriterion = "A1")$category_a)
```

Keep in mind that this flag is the magnitude threshold only. A full criterion A
listing also depends on the subcriterion conditions, such as whether the causes
are understood and reversible, so treat the column as a guide rather than a
verdict.

## Continuing decline for criterion C1

Criterion C1 needs an estimated continuing decline rather than a reduction, but
the calculation is the same. The difference is the window: one, two, or three
generations depending on the category. Set `years` to that window.

```{r c1}
# a one generation decline for the Vulnerable threshold under C1
rl_reduction(counts, years, generation_length = 7, years = 7)
```

## Combining subpopulations

For a widely distributed taxon the reduction should be worked out for each
subpopulation and then combined, weighted by the size of each subpopulation at
the start of the window. `rl_overall_reduction()` does the weighting. Give it any
two of `past`, `present`, and `reduction` for each subpopulation and it fills in
the third.

```{r overall}
overall <- rl_overall_reduction(
  past = c(10000, 8000, 12000),
  present = c(5000, 9000, 2000),
  subpopulation = c("Pacific", "Atlantic", "Indian")
)
overall
```

The overall reduction is the change in the summed population. Note that a simple
average of the three subpopulation reductions would be wrong here, because the
Indian Ocean subpopulation was the largest and fell the most, so it carries more
weight. The per subpopulation breakdown is kept alongside the result.

```{r overall-parts}
attr(overall, "subpopulations")
```

When a subpopulation has only a known reduction and a recent count, pass those
two and the past size is recovered from them, which matches the way the
guidelines complete such a table.

```{r overall-mixed}
rl_overall_reduction(
  present = c(4403, 9074, 1312),
  reduction = c(0.50, -0.179, 0.70)
)
```