Skip to content

Commit

Permalink
Merge pull request #86 from imperialCHEPI/plots_tests
Browse files Browse the repository at this point in the history 
Sync plots with data processing
  • Loading branch information
@SaranjeetKaur
SaranjeetKaur authored Nov 18, 2024
2 parents 5bc795b + c1d8816 commit f467654
Show file tree
Hide file tree
Showing 14 changed files with 245 additions and 200 deletions.
6 changes: 3 additions & 3 deletions R/data-process.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
#' ```r
#' # Example of using all functions together
#' data <- readRDS("data.rds")
#' data_weighted <- gen_data_mean(data)
#' data_weighted <- gen_data_weighted(data)
#' data_weighted_rf_wide_collapse <- gen_data_weighted_rf(data_weighted)
#' data_weighted_ds_wide_collapse <- gen_data_weighted_ds(data_weighted)
#' data_weighted_burden_wide_collapse <- gen_data_weighted_burden(data_weighted)
Expand Down Expand Up @@ -266,7 +266,7 @@ gen_data_weighted_burden <- function(data_weighted) {
)
)

data_weighted_burden_wide_collapse <- data_weighted_burden_wide |>
data_weighted_bd_wide_collapse <- data_weighted_burden_wide |>
dplyr::group_by(
dplyr::across(
dplyr::all_of(config$group)
Expand All @@ -285,7 +285,7 @@ gen_data_weighted_burden <- function(data_weighted) {
.groups = "drop"
)

return(data_weighted_burden_wide_collapse)
return(data_weighted_bd_wide_collapse)
}

#' Perform data smoothing
Expand Down
94 changes: 47 additions & 47 deletions R/health-plots.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,39 +3,39 @@
#' Generates a line plot of a specified risk factor over time, grouped by source.
#'
#' @param riskft A character string specifying the risk factor to plot.
#' Options are: "bmi", "ei", "fat", "obese", "protein", "sodium".
#' @param data_mean_weighted A data frame with weighted mean values for various metrics.
#' Options are: "bmi", "energyintake", "fat", "obesity", "protein", "sodium".
#' @param data_weighted A data frame with weighted values for various metrics.
#' @return A ggplot object representing the specified plot.
#' @export
riskfactors <- function(riskft, data_mean_weighted) {
riskfts <- c("bmi", "ei", "fat", "obese", "protein", "sodium")
riskfactors <- function(riskft, data_weighted) {
riskfts <- c("bmi", "energyintake", "fat", "obesity", "protein", "sodium")

if (!(riskft %in% riskfts)) {
stop("Invalid risk factor. Choose from: 'bmi', 'ei', 'fat', 'obese', 'protein', 'sodium'.")
stop("Invalid risk factor. Choose from: 'bmi', 'energyintake', 'fat', 'obesity', 'protein', 'sodium'.")
}

y_label <- switch(riskft,
bmi = "BMI (weighted)",
ei = "Energy intake (weighted)",
energyintake = "Energy intake (weighted)",
fat = "Fat (weighted)",
obese = "Obesity (weighted)",
obesity = "Obesity (weighted)",
protein = "Protein (weighted)",
sodium = "Sodium (weighted)"
)

y_value <- switch(riskft,
bmi = "weighted_bmi",
ei = "weighted_energyintake",
energyintake = "weighted_energyintake",
fat = "weighted_fat",
obese = "weighted_obesity",
obesity = "weighted_obesity",
protein = "weighted_protein",
sodium = "weighted_sodium"
)

ggplot2::ggplot(
data = data_mean_weighted,
data = data_weighted,
ggplot2::aes(
x = data_mean_weighted$time,
x = data_weighted$time,
y = get(y_value),
group = source
)
Expand Down Expand Up @@ -114,14 +114,14 @@ riskfactors_diff <- function(riskft_diff,
ggplot2::aes(
x = data_weighted_rf_wide_collapse$time,
y = get(y_value),
colour = data_weighted_rf_wide_collapse$income
#colour = data_weighted_rf_wide_collapse$income
)
) +
ggplot2::geom_line(linewidth = 1) +
ggplot2::geom_ribbon(
ggplot2::aes(
ymin = y_min,
ymax = y_max
ymin = get(y_min),
ymax = get(y_max)
),
alpha = 0.2
) +
Expand Down Expand Up @@ -231,27 +231,27 @@ inc_cum <- function(inc,
)

y_value <- switch(inc,
asthma = "cumdiff_inc_asthma_mean",
ckd = "cumdiff_inc_ckd_mean",
diabetes = "cumdiff_inc_db_mean",
ischemia = "cumdiff_inc_ihd_mean",
stroke = "cumdiff_inc_stroke_mean"
asthma = "diff_inc_asthma_mean",
ckd = "diff_inc_ckd_mean",
diabetes = "diff_inc_db_mean",
ischemia = "diff_inc_ihd_mean",
stroke = "diff_inc_stroke_mean"
)

y_min <- switch(inc,
asthma = "cumdiff_inc_asthma_min",
ckd = "cumdiff_inc_ckd_min",
diabetes = "cumdiff_inc_db_min",
ischemia = "cumdiff_inc_ihd_min",
stroke = "cumdiff_inc_stroke_min"
asthma = "diff_inc_asthma_min",
ckd = "diff_inc_ckd_min",
diabetes = "diff_inc_db_min",
ischemia = "diff_inc_ihd_min",
stroke = "diff_inc_stroke_min"
)

y_max <- switch(inc,
asthma = "cumdiff_inc_asthma_max",
ckd = "cumdiff_inc_ckd_max",
diabetes = "cumdiff_inc_db_max",
ischemia = "cumdiff_inc_ihd_max",
stroke = "cumdiff_inc_stroke_max"
asthma = "diff_inc_asthma_max",
ckd = "diff_inc_ckd_max",
diabetes = "diff_inc_db_max",
ischemia = "diff_inc_ihd_max",
stroke = "diff_inc_stroke_max"
)

plot_title <- switch(inc,
Expand All @@ -266,14 +266,14 @@ inc_cum <- function(inc,
data = data_weighted_ds_wide_collapse,
ggplot2::aes(data_weighted_ds_wide_collapse$time,
y = get(y_value),
colour = data_weighted_ds_wide_collapse$income
#colour = data_weighted_ds_wide_collapse$income
)
) +
ggplot2::geom_line(linewidth = 1) +
ggplot2::geom_ribbon(
ggplot2::aes(
ymin = y_min,
ymax = y_max
ymin = get(y_min),
ymax = get(y_max)
),
alpha = 0.2
) +
Expand All @@ -298,14 +298,14 @@ inc_cum <- function(inc,
#'
#' @param burden A character string specifying the burden of disease to plot.
#' Options are: "daly", "dalycum", "yld", "yll".
#' @param data_weighted_burden_wide_collapse A data frame with differences between intervention and baseline values for burden of disease.
#' @param data_weighted_bd_wide_collapse A data frame with differences between intervention and baseline values for burden of disease.
#' @param scale_y_continuous_limits A numeric vector specifying the limits of the scales for continuous y aesthetics.
#' @param scale_y_continuous_breaks A numeric vector specifying the breaks of the scales for continuous y aesthetics.
#' @param scale_y_continuous_labels A numeric vector specifying the labels of the scales for continuous y aesthetics.
#' @return A ggplot object representing the specified plot.
#' @export
burden_disease <- function(burden,
data_weighted_burden_wide_collapse,
data_weighted_bd_wide_collapse,
scale_y_continuous_limits = NULL,
scale_y_continuous_breaks = ggplot2::waiver(),
scale_y_continuous_labels = ggplot2::waiver()) {
Expand Down Expand Up @@ -351,18 +351,18 @@ burden_disease <- function(burden,
)

ggplot2::ggplot(
data = data_weighted_burden_wide_collapse,
data = data_weighted_bd_wide_collapse,
ggplot2::aes(
x = data_weighted_burden_wide_collapse$time,
x = data_weighted_bd_wide_collapse$time,
y = get(y_value),
colour = data_weighted_burden_wide_collapse$income
#colour = data_weighted_bd_wide_collapse$income
)
) +
ggplot2::geom_line(linewidth = 1) +
ggplot2::geom_ribbon(
ggplot2::aes(
ymin = y_min,
ymax = y_max
ymin = get(y_min),
ymax = get(y_max)
),
alpha = 0.2
) +
Expand Down Expand Up @@ -412,26 +412,26 @@ life_exp <- function(diff, data_ple_wide) {
#' Creates a combined plot of several metrics.
#'
#' @param metrics A list specifying the metrics to plot.
#' @param data_mean_weighted A data frame with weighted mean values for various metrics.
#' @param data_weighted A data frame with weighted values for various metrics.
#' @param data_mean_weighted_rf_wide A data frame containing the weighted mean values of risk factors.
#' @param data_mean_weighted_inc_wide A data frame containing the weighted mean values of incidences.
#' @param data_weighted_burden_wide_collapse A data frame with differences between intervention and baseline values for burden of disease.
#' @param data_weighted_bd_wide_collapse A data frame with differences between intervention and baseline values for burden of disease.
#' @param data_ple_wide A data frame containing the life expectancy.
#' @param output_file Name of the output PDF as a string
#' @return A combined ggplot object arranged in a grid.
#' @export
combine_plots <- function(metrics,
data_mean_weighted = NULL,
data_weighted = NULL,
data_mean_weighted_rf_wide = NULL,
data_mean_weighted_inc_wide = NULL,
data_weighted_burden_wide_collapse = NULL,
data_weighted_bd_wide_collapse = NULL,
data_ple_wide = NULL,
output_file) {
plots <- list()

if (!is.null(metrics$risk_factors) && !is.null(data_mean_weighted)) {
if (!is.null(metrics$risk_factors) && !is.null(data_weighted)) {
for (riskft in metrics$risk_factors) {
plots <- c(plots, list(riskfactors(riskft, data_mean_weighted)))
plots <- c(plots, list(riskfactors(riskft, data_weighted)))
}
}

Expand All @@ -453,9 +453,9 @@ combine_plots <- function(metrics,
}
}

if (!is.null(metrics$burden_disease) && !is.null(data_weighted_burden_wide_collapse)) {
if (!is.null(metrics$burden_disease) && !is.null(data_weighted_bd_wide_collapse)) {
for (burden in metrics$burden_disease) {
plots <- c(plots, list(burden_disease(burden, data_weighted_burden_wide_collapse)))
plots <- c(plots, list(burden_disease(burden, data_weighted_bd_wide_collapse)))
}
}

Expand Down
43 changes: 40 additions & 3 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ devtools::install_github("imperialCHEPI/healthgpsrvis")

## Example

This is a basic example which shows you how to solve a common problem:
This is an example to create the weighted data using the package:

```{r example}
library(healthgpsrvis)
Expand All @@ -57,8 +57,45 @@ data_weighted <- gen_data_weighted(data)
# Generate the weighted data for the risk factors
data_weighted_rf_wide_collapse <- gen_data_weighted_rf(data_weighted)
# Summarise the weighted data for the risk factors
summary(data_weighted_rf_wide_collapse)
# View structure of the weighted data for the risk factors
str(data_weighted_rf_wide_collapse)
```

To plot a risk factor (say, "bmi") for the weighted data, you can use the following code:

```{r riskfactor_plot}
# Plot the risk factor "bmi"
riskfactors("bmi", data_weighted)
```

To plot the difference in the risk factor (say, "bmi") for the weighted data, you can use the following code:

```{r riskfactors_diff_plot}
# Plot of difference in the risk factor "bmi"
riskfactors_diff("bmi",
data_weighted_rf_wide_collapse,
scale_y_continuous_limits = c(-0.148, 0),
scale_y_continuous_breaks = c(-0.148, -0.074, 0),
scale_y_continuous_labels = c(-0.148, -0.074, 0))
```

To plot cumulative incidence difference for, say, "diabetes", you can use the following code:

```{r inc_cum_plot}
data_weighted_ds_wide_collapse <- gen_data_weighted_ds(data_weighted)
inc_cum("diabetes",
data_weighted_ds_wide_collapse,
scale_y_continuous_limits = c(-4424000, 0),
scale_y_continuous_breaks = c(-4424000, -4084000, -3743000, -3403000, -3063000, -2722000, -2382000, -2042000, -1701000, -1361000, -1021000, -681000, -340000, 0),
scale_y_continuous_labels = scales::comma(c(-4424000, -4084000, -3743000, -3403000, -3063000, -2722000, -2382000, -2042000, -1701000, -1361000, -1021000, -681000, -340000, 0))
)
```

To plot burden of disease for, say, "yld", you can use the following code:

```{r burden_disease_plot}
data_weighted_bd_wide_collapse <- gen_data_weighted_burden(data_weighted)
burden_disease("yld", data_weighted_bd_wide_collapse)
```

<!--
Expand Down
Loading

0 comments on commit f467654

Please sign in to comment.