## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
Sys.setenv(OMP_THREAD_LIMIT = 1) # Reducing core use, to avoid accidental use of too many cores
library(Colossus)
library(data.table)
library(parallel)

## ----eval=TRUE----------------------------------------------------------------
apples <- c(0, 1, 2, 3, 4, 5, 6, 2, 2, 3, 4, 2, 1, 5, 6, 4, 2)
oranges <- c(1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 1, 3, 2, 2, 1)
rip <- c(0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1)
hands <- c(1, 1, 2, 3, 2, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 2, 2)
table <- data.table::data.table(
  apples = apples,
  oranges = oranges,
  rip = rip,
  hands = hands
)

## ----eval=TRUE----------------------------------------------------------------
# Suppose we want the categories to change by two:
categ <- "0/2/4/6/8"
# This would form bins like:
# [0,2), [2,4), etc.
# An entry with a value of 2 would be assigned to the second bin

# Suppose we wanted the first bin to be fully inclusive
categ <- "0]2/4/6/8"
# Now the first bin is: [0,2]
# An entry with a value of 2 would be assigned to the first bin only

# A named version might look like
categ <- "0 / low 2 / middle 4 / high 6 / extreme 8"
# This names the bins: low, middle, high, and extreme
# The default is a string representation of the bin

## ----eval=TRUE----------------------------------------------------------------
# Suppose we want the categories to change by two:
categ <- list(
  upper = c(2, 4, 6, 8),
  lower = c(0, 2, 4, 6)
)
# The version with an inclusive upper bound would be:
categ <- list(
  upper = c("2]", 4, 6, 8),
  lower = c(0, 2, 4, 6)
)

# We can also name categories
categ <- list(
  upper = c(2, 4, 6, 8),
  lower = c(0, 2, 4, 6),
  name = c("low", "middle", "high", "extreme")
)

## ----eval=TRUE----------------------------------------------------------------
apple_category <- "0/3/5]7"

orange_category <- list(
  lower = c(-1, 3, 6),
  upper = c(3, 6, 10),
  name = c("few", "good", "excessive")
)

# Finally we combine them into a list. The list names should be column
# names that the categories will be applied to.
categ <- list(
  apples = apple_category,
  oranges = orange_category
)
# We could also rename a category using `column AS new_name` in the list names.
# This is demonstrated later in the vignette.

## ----eval=TRUE----------------------------------------------------------------
# We might want two events to be summarized, the 'rip' and 'hands' columns.
# The first we can take the sum of, and name the summary 'dropped'
# The second we can just take a mean of
# This creates the event list, once again with list names
# matching columns in the data.
event <- list(rip = "count AS dropped", hands = "mean")

## ----eval=TRUE----------------------------------------------------------------
# We take our table, and apply the categorizations and event summaries
# The result has two values: 'df' and 'bounds'
# df is the final grouped table, with the categories and summaries
# bounds is a description of the category levels applied
Event_Count_Gen(table, categ, event)

## ----eval=TRUE----------------------------------------------------------------
# We can start by making some fake data
# a and b are arbitrary factors
# c might be the event status we are interested in
a <- c(0, 1, 2, 3, 4, 5, 6, 2, 2, 3, 4, 2, 1, 5, 6, 4, 2)
b <- c(1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 1, 3, 2, 2, 1)
c <- c(0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1)

# Next we define columns for the calendar dates of each interval
# In this case we are defining day, month, and year
d <- c(1, 1, 2, 2, 1, 1, 2, 2, 3, 3, 3, 4, 4, 2, 1, 1, 2)
e <- c(1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1)
f <- c(
  1900, 1900, 1900, 1900, 1900, 1900, 1900, 1900, 1900,
  1900, 1900, 1900, 1900, 1900, 1900, 1900, 1900
)
g <- c(4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 5, 5, 5, 4, 4, 4, 4)
h <- c(6, 4, 4, 6, 6, 6, 4, 4, 4, 6, 6, 6, 6, 4, 4, 4, 4)
i <- c(
  1901, 1902, 1903, 1904, 1905, 1906, 1907, 1903, 1904,
  1903, 1904, 1910, 1903, 1904, 1903, 1904, 1910
)

# Finally we have our table that we want to group.
table <- data.table::data.table(
  a = a, b = b, c = c,
  d = d, e = e, f = f,
  g = g, h = h, i = i
)

## ----eval=TRUE----------------------------------------------------------------
# Our person-years are described by calendar dates
# We have entry and exit lists, each with the columns that
# correspond to the day/month/year.
# We also include a unit, to say we want our final person-years
# in terms of years, instead of days or months.
pyr <- list(
  entry = list(year = "f", month = "e", day = "d"),
  exit = list(year = "i", month = "h", day = "g"),
  unit = "years"
)

## ----eval=TRUE----------------------------------------------------------------
# A calendar category assumes we have a list with days, months, and years
# Yearly categories might look like:
calendar_categ <- list(year = c(2000, 2001, 2002))
# This will define categories going from (1/1/2000 - 12/31/2000), (1/1/2001 - 12/31/2001), etc.

# Alternatively we might want to categorize by duration since a reference date
# In this case our list has an additional value for categories, or upper/lower limits
# For an age based calendar time category, our day/month/year are reference columns not vectors of dates
# Suppose we wanted to categorize by above/below 50 years since entry
age_categ <- list(year = "f", categories = "0 / 50 / 100")


# We add this to our time categories by assigning it a name
# We can use the standard "column AS new_name" notation, new_name defaults to column_category
# How the name is used depends on the categorization
# Both will use 'new_name' as the category name
# Age based categories will use 'column' to define an average duration in the interval
time_categ <- list("calendar" = calendar_categ, "age" = age_categ)
# This will create three new columns in the data

## ----eval=TRUE----------------------------------------------------------------
# The non-time categories are defined as previously shown.
categ <- list(
  a = "-1/3/5]7",
  b = list(
    lower = c(-1, 3, 6), upper = c(3, 6, 10),
    name = c("low", "medium", "high")
  )
)

# The time categories follow a similar structure.
# We have a list with names that correspond to columns,
# and entries that give category limits.
# Our calendar categories are defined between each of these dates,
# upper bound exclusive.

# Time categories make a new column for the category, which should not be in the data.
time_scale <- list(`time_bin` = list(
  day = c(1, 1, 1),
  month = c(1, 1, 1),
  year = c(1899, 1903, 1910)
))

## ----eval=TRUE----------------------------------------------------------------
# Summaries follow the person-count table notation for events.
# We apply some summary to an existing column.
# The name should be the column, and we can use 'AS'
# to rename the summary as needed.
summary <- list(b = "weighted_mean AS b_weighted")

## ----eval=TRUE----------------------------------------------------------------
# Events in a person-time table are assumed to occur at the end
# of the interval.
# Events are automatically added to the summary list as a sum.
events <- list("c AS cases")

## ----eval=TRUE----------------------------------------------------------------
# We run the analysis just like the event_count data
# Here we are also setting fcount to true, to return the first at risk in each group
# We get the same returned value, the table and summary of category boundaries
print(Event_Time_Gen(table, pyr, time_scale, categ, summary, events, fcount = T))

# We can also change the units in our person-years
pyr <- list(
  entry = list(year = "f", month = "e", day = "d"),
  exit = list(year = "i", month = "h", day = "g"),
  unit = "days"
)
print(Event_Time_Gen(table, pyr, time_scale, categ, summary, events))

## ----eval=TRUE----------------------------------------------------------------
# Repeating the same non-time categories and event statuses
a <- c(0, 1, 2, 3, 4, 5, 6, 2, 2, 3, 4, 2, 1, 5, 6, 4, 2)
b <- c(1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 1, 3, 2, 2, 1)
c <- c(0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1)

# Instead of calendar dates, we may have entry and exit duration
d <- c(1, 1, 2, 2, 10, 10, 15, 15, 20, 20, 30, 30, 40, 40, 50, 50, 60)
e <- c(11, 11, 22, 22, 30, 30, 45, 45, 50, 50, 60, 60, 70, 70, 80, 80, 90)

table <- data.table::data.table(
  a = a, b = b, c = c,
  d = d, e = e
)

# When we have duration instead of calendar dates, our person-year
# list should only have a single entry, instead of lists of columns.
pyr <- list(entry = "d", exit = "e")

## ----eval=TRUE----------------------------------------------------------------
# Once again, our non-time categories are defined the same
categ <- list(
  "a" = "-1/-1/3/5]7",
  "b AS b_bin" = list(lower = c(-1, -1, 3, 6), upper = c(-1, 3, 6, "]10"))
)

# Here we are defining the duration categories to use.
# This will create two columns, 'time' and 'time_bin'.
# 'time' is the average duration between the entry and exit duration.
# 'time_bin' is the category value.
# We can use 'time' to find the average duration in each group.
time_scale <- list("time AS time_bin" = "0 / 10 / 50 / 100")

## ----eval=TRUE----------------------------------------------------------------
summary <- list("c" = "count AS cases", "a" = "mean", "b" = "weighted_mean")
events <- list("c")

# Everything else runs the same, and gives similar outputs.
# Except now the time category boundaries are not based on dates.
print(Event_Time_Gen(table, pyr, time_scale, categ, summary, events))