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

phe_sii nest and unnest tidyr 1.0 changes #28

Merged
merged 4 commits into from
Aug 29, 2019
Merged

phe_sii nest and unnest tidyr 1.0 changes #28

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
96b4aab
phe_sii nest and unnest functions updated to use legacy functions fro…
emmaclegg Aug 23, 2019
3b842c5
phe_sii updated to use tidyr v1.0 nest and unnest functions
emmaclegg Aug 28, 2019
367441e
updated NAMESPACE following phe_sii update
emmaclegg Aug 28, 2019
2c02bd2
tidyr v1.0 dependency removed in DESCRIPTION
emmaclegg Aug 28, 2019
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
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: PHEindicatormethods
Type: Package
Version: 1.1.4
Version: 1.1.5
Title: Common Public Health Statistics and their Confidence Intervals
Description: Functions to calculate commonly used public health statistics and
their confidence intervals using methods approved for use in the production
Expand Down
3 changes: 3 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
## PHEindicatormethods v1.1.5
phe_sii function updated to be compatible with nest and unnest functions from tidyr version 1.0

## PHEindicatormethods v1.1.4
No significant changes.
Removed confusing line of commented out code from phe_life_expectancy calculation
Expand Down
255 changes: 129 additions & 126 deletions R/SII_function.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -92,6 +92,8 @@
#' has input to the function (value_type, multiplier, CI_confidence, CI_method); character string
#' either "full" or "standard"; default "full"
#'
#' @section Notes: this function is using nest and unnest functions from tidyr version 1.0.0.
#'
#' @references
#' [1] Low A & Low A. Measuring the gap: quantifying and comparing local health inequalities.
#' Journal of Public Health; 2004;26:388-395. \cr \cr
Expand Down Expand Up @@ -364,138 +366,139 @@ phe_sii <- function(data, quantile, population, # compulsory fields
# Perform regression to calculate SII and extract model parameters
popsSII_model <- pops_prep_ab %>%
group_by(!!! syms(grouping_variables)) %>%
tidyr::nest() %>% # create nested table
# perform linear model
mutate(model = purrr::map(data, ~ stats::lm(yvals ~ sqrt_a + b_sqrt_a - 1, data = .))) %>%
tidyr::nest() %>% # create nested table
# perform linear model
mutate(model = purrr::map(data, function(df) stats::lm(yvals ~ sqrt_a + b_sqrt_a - 1, data = df))) %>%
# extract model coefficients
tidyr::unnest(model %>% purrr::map(broom::tidy)) %>%
# remove unecessary fields
select(-std.error, -statistic, -p.value) %>%
# create columns for each parameter
tidyr::spread(key = term, value = estimate) %>%
# Extract SII and RII values
mutate(sii = b_sqrt_a,
rii = (sqrt_a + b_sqrt_a)/sqrt_a) %>%
# remove unnecesary fields
select(grouping_variables, sii, rii)


# join on dataset with confidence limits and reliability stats
if (length(grouping_variables) > 0) {
# (grouped dataset)
popsSII_model <- popsSII_model %>%
left_join(sim_CI, by = grouping_variables)
} else {
# ungrouped dataset
popsSII_model <- popsSII_model %>%
cbind(sim_CI)
}


# Part 3 - Choose and format output fields --------------------------------

# Case 1 - user requests reliability stats, SII only
if (reliability_stat == TRUE) {

if(rii == FALSE) {

# apply multiplicative factor to outputs, return SII only
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl
,SII_MAD = abs(multiplier) * sii_MAD)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl
,SII_MAD = abs(multiplier) * sii_MAD)
}
} else {
# Case 2 - user requests reliability stats, SII and RII
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl
,SII_MAD = abs(multiplier) * sii_MAD
,RII = 1/rii
,RII_lowerCL = 1/rii_uppercl
,RII_upperCL = 1/rii_lowercl
,RII_MAD = rii_MAD)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl
,SII_MAD = abs(multiplier) * sii_MAD
,RII = rii
,RII_lowerCL = rii_lowercl
,RII_upperCL = rii_uppercl
,RII_MAD = rii_MAD)
}
}

message(paste0("For guidance on how to interpret the Mean Average Difference ",
"(MAD) figures, see the phe_sii accompanying vignette"))
} else {
# Case 3 - no reliability stats, SII only
if(rii == FALSE) {

# apply multiplicative factor to outputs - return SII only
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl)
}
mutate(model = purrr::map(model, broom::tidy)) %>%
tidyr::unnest(model) %>%
# remove unecessary fields
select(-std.error, -statistic, -p.value) %>%
# create columns for each parameter
tidyr::spread(key = term, value = estimate) %>%
# Extract SII and RII values
mutate(sii = b_sqrt_a,
rii = (sqrt_a + b_sqrt_a)/sqrt_a) %>%
# remove unnecesary fields
select(grouping_variables, sii, rii)


# join on dataset with confidence limits and reliability stats
if (length(grouping_variables) > 0) {
# (grouped dataset)
popsSII_model <- popsSII_model %>%
left_join(sim_CI, by = grouping_variables)
} else {
# ungrouped dataset
popsSII_model <- popsSII_model %>%
cbind(sim_CI)
}


# Part 3 - Choose and format output fields --------------------------------

# Case 1 - user requests reliability stats, SII only
if (reliability_stat == TRUE) {

if(rii == FALSE) {

# apply multiplicative factor to outputs, return SII only
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl
,SII_MAD = abs(multiplier) * sii_MAD)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl
,SII_MAD = abs(multiplier) * sii_MAD)
}
} else {
# Case 2 - user requests reliability stats, SII and RII
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl
,SII_MAD = abs(multiplier) * sii_MAD
,RII = 1/rii
,RII_lowerCL = 1/rii_uppercl
,RII_upperCL = 1/rii_lowercl
,RII_MAD = rii_MAD)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl
,SII_MAD = abs(multiplier) * sii_MAD
,RII = rii
,RII_lowerCL = rii_lowercl
,RII_upperCL = rii_uppercl
,RII_MAD = rii_MAD)
}
}

} else {
# Case 4 - no reliability stats, SII and RII
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl
,RII = 1/rii
,RII_lowerCL = 1/rii_uppercl
,RII_upperCL = 1/rii_lowercl)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl
,RII = rii
,RII_lowerCL = rii_lowercl
,RII_upperCL = rii_uppercl)
}
}
}
message(paste0("For guidance on how to interpret the Mean Average Difference ",
"(MAD) figures, see the phe_sii accompanying vignette"))
} else {
# Case 3 - no reliability stats, SII only
if(rii == FALSE) {

# apply multiplicative factor to outputs - return SII only
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl)
}

} else {
# Case 4 - no reliability stats, SII and RII
if (multiplier < 0) {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_uppercl
,SII_upperCL = multiplier * sii_lowercl
,RII = 1/rii
,RII_lowerCL = 1/rii_uppercl
,RII_upperCL = 1/rii_lowercl)
} else {
popsSII_model <- popsSII_model %>%
mutate(SII = multiplier * sii
,SII_lowerCL = multiplier * sii_lowercl
,SII_upperCL = multiplier * sii_uppercl
,RII = rii
,RII_lowerCL = rii_lowercl
,RII_upperCL = rii_uppercl)
}
}
}

# remove unnecessary fields
popsSII_model <- popsSII_model %>%
select(-sii_lowercl, -sii_uppercl, -sii_MAD,
-rii_lowercl, -rii_uppercl, -rii_MAD,
-sii, -rii)
# remove unnecessary fields
popsSII_model <- popsSII_model %>%
select(-sii_lowercl, -sii_uppercl, -sii_MAD,
-rii_lowercl, -rii_uppercl, -rii_MAD,
-sii, -rii)

if(type == "full") {
if(type == "full") {

popsSII_model <- popsSII_model %>%
# add arguments to output dataset
mutate(indicator_type = ifelse(value_type == 0, "normal",
ifelse(value_type == 1, "rate", "proportion")),
multiplier = multiplier,
CI_confidence = confidence,
CI_method = paste("simulation ", repetitions, " reps"))
popsSII_model <- popsSII_model %>%
# add arguments to output dataset
mutate(indicator_type = ifelse(value_type == 0, "normal",
ifelse(value_type == 1, "rate", "proportion")),
multiplier = multiplier,
CI_confidence = confidence,
CI_method = paste("simulation ", repetitions, " reps"))

}
}

# return output dataset
return(popsSII_model)
Expand Down
4 changes: 4 additions & 0 deletions man/phe_sii.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.