---
title: "Courts and crime: flow, time, outcomes, place and case mix"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Courts and crime: flow, time, outcomes, place and case mix}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r courts-and-crime-setup, include = FALSE}
# the vignette runs in full in GitHub CI and for the package tarball (NOT_CRAN), on r-universe
# (MY_UNIVERSE), on the package website (IN_PKGDOWN) and in an interactive session; when CRAN
# re-builds it in its check, none of these is set and only this chunk runs
if (!interactive() && !any(nzchar(Sys.getenv(c("NOT_CRAN", "MY_UNIVERSE", "IN_PKGDOWN"))))) {
  knitr::knit_exit()
}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 8, fig.height = 4.5)
library(rmoriebricklayer)
ext <- function(f) read.csv(system.file("extdata", f, package = "rmoriebricklayer"))
```

Court and police statistics are published as counts: cases received and disposed each month,
shares disposed within so many months, incidents with a date and a place. This vignette works
through the questions those counts are asked to answer, on the Ontario Court of Justice's
criminal statistics and the Toronto Police Service's open data (see `?justice-data` for every
file and its source). Each section uses the excerpt shipped with the package; the full tables,
every edition and every court, load from the data hub:

```{r courts-and-crime-hub, eval = FALSE}
clearance <- dload("ocj_statistics/clearance_rate_criminal")
offences  <- dload("ocj_statistics/offence_based_criminal")
mci       <- dload("tps_open_data/major_crime_indicators_open_data_0")
```

## Is the court keeping up? Case flow and clearance

A court keeps up when it disposes of as many cases as it receives. `caseflow()` turns the
monthly counts into the clearance rate (disposed per case received) with an exact interval,
its rolling twelve-month value, and, from the pending count, how many months the inventory
would take to clear at the recent pace.

```{r courts-and-crime-flow}
f <- ext("ocj_flow_ontario.csv")
cf <- caseflow(f$received, f$disposed, pend = f$pending, prd = f$month)
cf[c(1, 12, 24), c("period", "received", "disposed", "clearance", "rolclr", "pertoclear")]
plot(cf)
```

Over these 24 months the court disposed of `r format(sum(f$disposed), big.mark = ",")` cases
against `r format(sum(f$received), big.mark = ",")` received, a clearance rate of
`r sprintf("%.3f", sum(f$disposed) / sum(f$received))`. The monthly rate swings well beyond its
interval -- summer months clear less -- which is why the rolling rate is the one to read.

## How long do cases take? A life table from banded times

The Court publishes the share of cases disposed within 10 months, 10 to 15, 15 to 18 and over
18. `lifetbl()` reads those bands directly and gives the share still open at each band edge,
with a Greenwood interval, and the median.

```{r courts-and-crime-life}
d <- ext("ocj_time_to_disposition.csv")
last <- nrow(d)
shares <- unlist(d[last, c("under_10", "m10_15", "m15_18", "over_18")])
lt <- lifetbl(c("Under 10 Months", "Between 10-15 Months", "Between 15-18 Months", "Over 18 Months"),
                 events = shares * f$disposed[last])
lt
plot(lt)
```

The median of `r sprintf("%.1f", attr(lt, "median"))` months assumes cases are spread evenly
within the first band; the published average for the month is `r d$avg_days[last]` days. Only
disposed cases are in these statistics, so the table describes the cases that ended, not every
case received.

## How do cases end? The mix of outcomes

```{r courts-and-crime-mix}
x <- ext("ocj_dispositions.csv")
mix <- dispmix(x[, -(1:2)], prd = x$year, scores = x$year)
mix$trend[, c("outcome", "statistic", "pholm", "change")]
plot(mix)
```

Every share comes with Goodman's simultaneous interval (in `mix$shares`). With a few hundred
thousand cases a year every trend is "significant"; the `change` column says how large each
shift is. The years are the scores, so the gaps at 2020 and 2023 (see `?justice-data`) are
spaced as they should be.

## Is a change in the clearance rate real? Simpson's paradox and case mix

An aggregate clearance rate is a weighted average of the rates of its parts -- offence groups,
courts -- weighted by their share of the work. It can fall while most parts improve, if the work
shifts toward the parts that clear more slowly. Demers and Rossmo (2015) found 210 such
reversals in fifteen years of clearance rates for Canada's fifty largest police services.
`clrdcmp()` splits a change exactly into the change in the parts' rates and the
change in the mix (Kitagawa, 1955), and tests the within-part change with a Mantel-Haenszel
rate ratio.

```{r courts-and-crime-simpson, fig.height = 4.8}
g <- ext("ocj_offence_groups.csv")
g <- g[g$year %in% c(2014, 2022), ]
cd <- clrdcmp(g$disposed, g$received, g$offence_group, g$year)
cd
plot(cd)
# a group's share of the cases received in a year, as a percentage
caseshare <- function(group, yr) {
  sprintf("%.0f%%", 100 * sum(g$received[g$offence_group == group & g$year == yr]) / sum(g$received[g$year == yr]))
}
```

Between 2014 and 2022 the province-wide clearance rate moved by
`r sprintf("%+.4f", cd$overall$change)`. Held at a fixed mix it moved by
`r sprintf("%+.4f", cd$overall$rateeff)`; the shift of work contributed
`r sprintf("%+.4f", cd$overall$mixeff)`. Crimes against the person, the group with the lowest
clearance rate in both years, grew from `r caseshare("Crimes Against the Person", 2014)` to
`r caseshare("Crimes Against the Person", 2022)` of the cases received, and federal-statute cases,
the group with the highest rate in 2022, fell from `r caseshare("Federal Statute", 2014)` to
`r caseshare("Federal Statute", 2022)`. `r cd$simpson$up` of the `r cd$simpson$parts` groups cleared a
larger share in 2022 and `r cd$simpson$down` a smaller one. The crude ratio's interval includes 1;
the Mantel-Haenszel ratio within offence groups is
`r sprintf("%.4f (%.4f to %.4f)", cd$rateratio$ratio[2], cd$rateratio$lower[2], cd$rateratio$upper[2])`.
Read alone, the aggregate would say nothing changed; within the groups, taken together, clearance
improved, though not in every group.

The grouping matters, and so does the pair of years. By court, with Toronto's courthouses
taken together (they were consolidated in 2023), comparing 2012 with 2024:

```{r courts-and-crime-courts}
c <- ext("ocj_courts.csv")
c <- aggregate(cbind(received, disposed) ~ year + court_series, c, sum)
c <- c[c$year %in% c(2012, 2024), ]
c <- c[c$court_series %in% names(which(table(c$court_series) == 2)), ]
cc <- clrdcmp(c$disposed, c$received, c$court_series, c$year)
cc$overall
cc$simpson$type
```

Here the aggregate (`r sprintf("%+.4f", cc$overall$change)`) and the rate at a fixed mix
(`r sprintf("%+.4f", cc$overall$rateeff)`) move the same way: no reversal, and
`r cc$simpson$down` of `r cc$simpson$parts` courts cleared a smaller share in 2024. A
decomposition does not always find a paradox; it says which way the parts moved and how much
the mix did.

## Where do incidents cluster? Kernel density

`crmdens()` estimates the density of incidents in incidents per square kilometre and
outlines the smallest areas holding half and nine-tenths of them.

```{r courts-and-crime-density, fig.height = 5.5}
b <- ext("tps_break_enter_d14_2024.csv")
kd <- crmdens(b$lon, b$lat, ngrid = 150)
kd
plot(kd)
```

## Do incidents repeat nearby, soon after? The Knox test

Break-ins close in space and time to an earlier one are the near-repeat pattern. The Knox test
compares the pairs close in both with the number expected if the dates were shuffled among the
places; the expectation is exact, and a permutation test gives each cell's p-value.

```{r courts-and-crime-knox}
b <- b[!is.na(b$lon), ]
kn <- knoxtst(b$lon, b$lat, as.Date(b$occ_date), spcbands = c(100, 200, 400),
                tmbands = c(7, 14, 28), nsim = 199, seed = 1)
kn
plot(kn)
```

## Do the hot spots last?

A hot spot that stays put is a place problem; one that moves is not. `hotpers()`
counts the incidents in grid cells each period, reports the share of places that holds half of
them, which cells are hot (the busiest 5% of the cells with any incident), and how much each
period's hot spots overlap the previous period's:

```{r courts-and-crime-hotspots, fig.width = 9, fig.height = 4}
h <- hotpers(b$lon, b$lat, quarters(as.Date(b$occ_date)), cell = 0.3)
h
plot(h)
```

The hot set is the busiest `r h$hotk` cells and every cell tied with the last of them. When a
tie would make more than twice that many cells hot, the counts do not single those cells out, so
the tied group is left out and counted under `tiedout`: a quarter can then show fewer hot cells
than `r h$hotk`, a smaller hot share, and an overlap with its neighbours that cannot be computed
(left blank)`r if (any(h$periods$tiedout > 0)) sprintf(", as in %s here", paste(h$periods$period[h$periods$tiedout > 0], collapse = " and ")) else ""`.


Pairs of break-ins within 100 metres and a week of each other occur
`r sprintf("%.2f", kn$table$ratio[1])` times as often as chance would give.

## Indigenous life expectancy

`lifetbl()` works from counts of events in age intervals. Where only published
summaries exist, as for Indigenous life expectancy, the comparison is made on the
published estimates and their intervals instead:

```{r courts-and-crime-indigenous-courts, eval = TRUE}
le <- indiex("lifeexp")
le[le$period == "2016/2021", c("group", "estimate", "lower", "upper")]
```

## References

Demers, S. and Rossmo, D. K. (2015). Simpson's paradox in Canadian police clearance rates.
*Canadian Journal of Criminology and Criminal Justice*, 57(3), 424-434.

Kitagawa, E. M. (1955). Components of a difference between two rates. *Journal of the
American Statistical Association*, 50(272), 1168-1194.

Knox, E. G. (1964). The detection of space-time interactions. *Journal of the Royal Statistical
Society, Series C*, 13(1), 25-30.