Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Include a method for removing outbreak related observations. @telkamp7 #6

Merged
merged 1 commit into from
Nov 9, 2023
Merged

Include a method for removing outbreak related observations. @telkamp7 #6

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 27 additions & 3 deletions R/aeddo.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,6 @@
#' )
#' # Print the results
#' print(aeddo_results)
# TODO: #2 Include a method for removing outbreak related observations.
# @telkamp7
aeddo <- function(
data,
formula = formula(),
Expand All @@ -77,6 +75,11 @@ aeddo <- function(
method = "BFGS") {
# TODO: #3 Provide some checks for function inputs. @telkamp7

# TODO: #5 Require a unique identifier for each data point. @telkamp7
# Make an explicit index to uniquely identify the observations
data <- data %>%
dplyr::mutate(index = dplyr::row_number())

# Count the number of observations
n_observation <- dplyr::count(data) %>%
purrr::pluck("n")
Expand All @@ -95,15 +98,31 @@ aeddo <- function(
class = "aedseo"
)

# Initilize past_outbreaks if we want to omit outbreak related observations
if(exclude_past_outbreaks == TRUE) {
past_outbreaks <- tibble::as_tibble(
lapply(data, function(col) col[0])
)
}

# Loop over the observations to perform windowed estimation
for (i in 1:(n_observation - k)) {
# Extract data point for this estimation window
window_data <- data %>%
dplyr::filter(dplyr::row_number() %in% 1:(i + k - 1))
dplyr::filter(dplyr::row_number() %in% i:(i + k - 1))
# ... and the reference data
reference_data <- data %>%
dplyr::filter(dplyr::row_number() == i + k)

# Exclude past observations, if they were deemed an outbreak
# Turned on by 'excludePastOutbreaks = TRUE'
if(exclude_past_outbreaks == TRUE){
if(nrow(past_outbreaks) > 0){
window_data <- window_data %>%
dplyr::setdiff(past_outbreaks)
}
}

# Extract the observation at reference time point
reference_y <- reference_data %>%
purrr::pluck("y")
Expand Down Expand Up @@ -170,6 +189,11 @@ aeddo <- function(
u_probability = u_probability,
outbreak_alarm = outbreak_alarm
)

if(exclude_past_outbreaks == TRUE & outbreak_alarm == TRUE){
past_outbreaks <- past_outbreaks %>%
dplyr::bind_rows(reference_data)
}
}

return(results)
Expand Down