Skip to content

minor warning fix #65

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

Open
TTRustam wants to merge 1 commit into
base: master
Choose a base branch
from
Open

minor warning fix #65

Show file tree
Hide file tree
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
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ License: file LICENSE
LazyLoad: yes
LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.2
RoxygenNote: 7.3.3
Depends:
R (>= 4.1),
ggplot2
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,6 @@ export(lt_flexible_chunk)
export(lt_plot)
export(lt_summary)
export(lt_summary_chunk)
export(movepop)
export(odap_opag)
export(plot_compare_rates)
export(plot_histogram)
Expand Down Expand Up @@ -109,6 +108,7 @@ importFrom(dplyr,last)
importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
importFrom(dplyr,n)
importFrom(dplyr,pick)
importFrom(dplyr,pull)
importFrom(dplyr,reframe)
importFrom(dplyr,rename)
Expand Down
14 changes: 9 additions & 5 deletions R/input_diagnostics.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,15 @@
#' @description Check the age heaping for 5 or 1 year data.
#' @param data data.frame. User file from the read_data command with the minimum data on `Exposures`, `Death` and `Age`. Data can be both in 5 and 1 year age intervals
#' @param y character.Variable name for which the heaping should be checked `Deaths` or `Exposures`.
#' @return A data.frame with 2 columns `method` - the method used for age heaping evaluation and `result` - the resulting heaping measure
#' @return A data.frame with 3 columns `method` - the method used for age heaping evaluation, `result` - the resulting heaping measure, and `.id` - user specified groups identifier (if missing is set to "all")
#' @importFrom tibble tibble
#' @importFrom tidyr unnest pivot_longer
#' @importFrom tidyselect all_of
#' @importFrom stringr str_detect
#' @importFrom dplyr bind_rows left_join join_by
#' @importFrom dplyr bind_rows left_join select group_nest mutate pull group_by
#' @importFrom rlang .data
#' @importFrom DemoTools check_heaping_roughness check_heaping_bachi check_heaping_myers check_heaping_sawtooth
#' @importFrom purrr map map2
#' @importFrom DemoTools is_single check_heaping_roughness check_heaping_bachi check_heaping_myers check_heaping_sawtooth
#' @export
#' @examples
#' \dontrun{
Expand Down Expand Up @@ -154,8 +158,8 @@ check_heaping_general <- function(data, y) {
Value = pull(.x, !!sym(y)),
Age = .x$Age,
ageMin = 30)),
"res" = map2(.x = roughness,
.y = sawtooth, ~
"res" = map2(.x = .data$roughness,
.y = .data$sawtooth, ~
bind_rows(
classify(
x = .x,
Expand Down
76 changes: 39 additions & 37 deletions R/odap.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
#' @param year Numeric vector of years to filter by (default \code{1971}).
#' @param sex Character scalar indicating sex to filter by, e.g., \code{"M"} or \code{"F"} (default \code{"M"}).
#' @param i18n Optional internationalization object for translating plot labels and titles (default \code{NULL}).
#' @importFrom dplyr filter arrange across select mutate group_by reframe ungroup full_join group_nest
#' @importFrom dplyr filter arrange across select mutate group_by reframe ungroup full_join group_nest pick
#' @importFrom tibble as_tibble
#' @importFrom DemoTools lt_single_mx OPAG groupAges
#' @importFrom tidyr pivot_longer
Expand Down Expand Up @@ -159,7 +159,7 @@ odap_opag <- function(data_in = NULL,
conditional_filter("country_code", country_code) %>%
conditional_filter("name", name) %>%
conditional_filter("year", year) %>%
conditional_filter("sex", sex) %>%
conditional_filter("sex", sex) %>%
select(any_of(c("name", "country_code", "sex", "year", "age", "nlx")))
# Rename nlx back to nLx for consistency with downstream code
if("nlx" %in% names(nLx)) {
Expand All @@ -184,36 +184,38 @@ odap_opag <- function(data_in = NULL,

}

# add env solution
suppressPackageStartupMessages(library(latest_wpp, character.only = TRUE))
data("mx1dt", package = latest_wpp)

env <- new.env()
data("mx1dt", package = latest_wpp, envir = env)

nLx <- mx1dt %>%
nLx <- env$mx1dt %>%
as_tibble() %>%
select(-.data$mxB) %>%
select(-c("mxB")) %>%
conditional_filter("country_code", country_code) %>%
conditional_filter("name", name) %>%
conditional_filter("year", year) %>%
pivot_longer(
cols = c(.data$mxM, .data$mxF),
names_to = "sex",
cols = c("mxM", "mxF"),
names_to = "sex",
values_to = "mx"
) %>%
mutate(sex = substr(.data$sex, 3, 3)) %>%
conditional_filter("sex", sex)

group_vars <- intersect(c("name","country_code","sex","year"), names(nLx))

nLx <- nLx %>%
group_by(across(all_of(intersect(c("name", "country_code", "sex", "year"), names(.))))) %>%
nLx <- nLx %>%
group_by(across(any_of(c("name", "country_code", "sex", "year")))) %>%
reframe(
lt_single_mx(nMx = .data$mx, Age = .data$age), .groups = "drop") %>%
select(.data$name,
.data$country_code,
.data$sex,
.data$year,
age = .data$Age,
.data$AgeInt,
.data$nLx)
lt_single_mx(nMx = .data$mx,
Age = .data$age), .groups = "drop") %>%
select("name",
"country_code",
"sex",
"year",
"age" = "Age",
"AgeInt",
"nLx")
#
# nLx <- nLx %>%
# as_tibble() %>%
Expand All @@ -237,7 +239,7 @@ odap_opag <- function(data_in = NULL,
conditional_filter("country_code", country_code) %>%
conditional_filter("name", name) %>%
conditional_filter("year", year) %>%
conditional_filter("sex", sex) %>%
conditional_filter("sex", sex) %>%
select(any_of(c("name", "country_code", "sex", "year", "age", "AgeInt", "nLx")))

}
Expand All @@ -261,17 +263,15 @@ odap_opag <- function(data_in = NULL,


nLx <- nLx %>%
group_by(across(all_of(intersect(c("name", "country_code", "sex", "year"), names(.))))) %>%
group_by(across(any_of(c("name", "country_code", "sex", "year")))) %>%
reframe({
dat <- pick(everything())
age_vals <- seq(0, max(dat$age), by = age_spacing)
nLx_vals <- groupAges(Value = dat$nLx, Age = dat$age, N = age_spacing)
tibble(age = age_vals, nLx = nLx_vals)
})

} else {
}


# ---------------------------------------------------------------------------- #
# Part 3: Now we have user data and reference data and we can use the OPAG function
Expand Down Expand Up @@ -359,21 +359,23 @@ odap_opag <- function(data_in = NULL,
Pop_vals <- .x$pop
nLx_vals <- .x$nLx
OPAG(
Pop = Pop_vals,
Age_Pop = Age_vals,
nLx = nLx_vals,
Age_nLx = Age_vals,
Age_fit = Age_fit,
AgeInt_fit = AgeInt_fit,
Pop = Pop_vals,
Age_Pop = Age_vals,
nLx = nLx_vals,
Age_nLx = Age_vals,
Age_fit = Age_fit,
AgeInt_fit = AgeInt_fit,
Redistribute_from = Redistribute_from,
OAnew = OAnew,
method = method
OAnew = OAnew,
method = method
)
}),
plots = map2(.data$data, .data$results, function(.x, .y) {
old <- tibble(pop = .x$pop, age = .x$age) %>%
old <- tibble(pop = .x$pop,
age = .x$age) %>%
filter(.data$age > Redistribute_from)
new <- tibble(pop = .y$Pop_out, age = .y$Age_out) %>%
new <- tibble(pop = .y$Pop_out,
age = .y$Age_out) %>%
filter(.data$age > Redistribute_from)

# Note: translated text variables (title_text, age_text, etc.)
Expand All @@ -383,21 +385,21 @@ odap_opag <- function(data_in = NULL,
# Rename columns to translated versions for hover tooltips (following lifetable pattern)
names(old)[names(old) == "age"] <- age_text
names(old)[names(old) == "pop"] <- pop_text
old[[type_text]] <- original_text
old[[type_text]] <- original_text

names(new)[names(new) == "age"] <- age_text
names(new)[names(new) == "pop"] <- pop_text
new[[type_text]] <- redistributed_text
new[[type_text]] <- redistributed_text


# Create named vector for colors using translated keys
color_values <- c("black", "red")
color_values <- c("black", "red")
names(color_values) <- c(original_text, redistributed_text)

# Build plot using .data[[]] for runtime evaluation (NOT !!sym())
ggplot() +
geom_point(data = old, aes(x = .data[[age_text]], y = .data[[pop_text]], color = .data[[type_text]]), size = 2) +
geom_line(data = new, aes(x = .data[[age_text]], y = .data[[pop_text]], color = .data[[type_text]]), linewidth = 1) +
geom_line( data = new, aes(x = .data[[age_text]], y = .data[[pop_text]], color = .data[[type_text]]), linewidth = 1) +
scale_color_manual(name = type_text, values = color_values) +
labs(x = age_text, y = pop_text, title = title_text) +
theme_minimal(base_size = 14) +
Expand Down
2 changes: 1 addition & 1 deletion man/check_heaping_general.Rd
View file
Open in desktop

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

100 changes: 0 additions & 100 deletions man/movepop.Rd
View file
Open in desktop

This file was deleted.