# Helper function:
age_adjust <- function(count, pop, rate = NULL, stdpop){
if (missing(count) & !missing(pop) & is.null(rate)) {
count <- rate * pop
}
if (missing(pop) & !missing(count) & is.null(rate)) {
pop <- count/rate
pop[!is.finite(pop)] <- 0
}
if (is.null(rate) & !missing(count) & !missing(pop)){
rate <- count/pop
rate[!is.finite(rate)] <- 0
}
cruderate <- sum(count)/sum(pop)
stdwt <- stdpop/sum(stdpop)
dsr <- sum(stdwt * rate)
tibble(`crude_rate` = cruderate, `std_rate` = dsr)
}
# Import
SUDA2_raw <-
statgl_url("SUXA2", lang = "da") %>%
statgl_fetch(.eliminate_rest = FALSE) %>%
as_tibble() %>%
rename(Aborter = value)
# Tidy
SUDA_2 <-
SUDA2_raw %>%
as_tibble() %>%
spread(enhed, Aborter) %>%
mutate_at(c(1, 2), strtoi)
# Standardize
SUDA_2_2000 <- SUDA_2 %>% filter(tid == 2000) %>% pull(Middelfolketal)
SUDA2_std <-
SUDA_2 %>%
group_by(tid) %>%
summarise(age_adjust(Aborter, Middelfolketal, stdpop = SUDA_2_2000) * 1000)
# Plot
SUDA2_std %>%
ggplot(aes(x = tid, y = std_rate)) +
geom_line(size = 2, color = statgl:::statgl_cols("darkblue"))+
theme_statgl() +
theme(plot.margin = margin(10, 10, 10, 10)) +
labs(
title = sdg3$figs$fig1$title[language],
x = " ",
y = sdg3$figs$fig1$y_lab[language],
subtitle = sdg3$figs$fig1$sub[language]
)
# Import
BEXDT5A_raw <-
statgl_url("BEXDT5A", lang = language) %>%
statgl_fetch(
type = "E",
age = c(0, 1),
.col_code = TRUE) %>%
as_tibble()
# Transform
BEXDT5A <-
BEXDT5A_raw %>%
separate(time, into = c("startaar", "slutaar"), sep = " - ") %>%
mutate(slutaar = slutaar %>% as.numeric %>% make_date()) %>%
select(-3)
# Plot
BEXDT5A %>%
ggplot(aes(
x = slutaar,
y = value,
color = age
)) +
geom_line(size = 2) +
scale_y_continuous(labels = scales::unit_format(
suffix = " ",
big.mark = ".",
decimal.mark = ","
)) +
theme_statgl() +
scale_color_statgl() +
labs(
title = sdg3$figs$fig2$title[language],
subtitle = sdg3$figs$fig2$sub[language],
x = sdg3$figs$fig2$x_lab[language],
y = BEXDT5A[[1]][1],
color = sdg3$figs$fig2$color[language],
caption = sdg3$figs$fig2$cap[language]
)
# Import
BEXDT5A_raw <-
statgl_url("BEXDT5A", lang = language) %>%
statgl_fetch(
type = "E",
age = c(0, 1),
residence = 1:2,
.col_code = TRUE) %>%
as_tibble()
# Transform
BEXDT5A <-
BEXDT5A_raw %>%
separate(time, into = c("startaar", "slutaar"), sep = " - ") %>%
mutate(slutaar = as.numeric(slutaar) %>% make_date()) %>%
select(-4)
# Plot
BEXDT5A %>%
ggplot(aes(
x = slutaar,
y = value,
color = age
)) +
geom_line(size = 2) +
facet_wrap(~ residence) +
scale_y_continuous(labels = scales::unit_format(
suffix = " ",
big.mark = ".",
decimal.mark = ","
)) +
theme_statgl() +
theme(plot.margin = margin(10, 10, 10, 10)) +
scale_color_statgl(
reverse = TRUE,
guide = guide_legend(reverse = TRUE)
) +
labs(
title = sdg3$figs$fig3$title[language],
subtitle = sdg3$figs$fig3$sub[language],
x = sdg3$figs$fig3$x_lab[language],
y = BEXDT5A[[1]][1],
color = sdg3$figs$fig3$color[language],
caption = sdg3$figs$fig3$cap[language]
)
# Helper function:
age_adjust <- function(count, pop, rate = NULL, stdpop){
if (missing(count) & !missing(pop) & is.null(rate)) {
count <- rate * pop
}
if (missing(pop) & !missing(count) & is.null(rate)) {
pop <- count/rate
pop[!is.finite(pop)] <- 0
}
if (is.null(rate) & !missing(count) & !missing(pop)){
rate <- count/pop
rate[!is.finite(rate)] <- 0
}
cruderate <- sum(count)/sum(pop)
stdwt <- stdpop/sum(stdpop)
dsr <- sum(stdwt * rate)
tibble(`crude_rate` = cruderate, `std_rate` = dsr)
}
# Import
BEDBBDM1_raw <-
statgl_url("BEXBBDM1", lang = "da") %>%
statgl_fetch(
type = px_all(),
age = px_all(),
.col_code = TRUE) %>%
as_tibble() %>%
rename(c(
"alder" = 1,
"art" = 2,
"tid" = 3,
"Dødsfald" = 4
))
BEDBBM1 <- BEDBBDM1_raw %>% as_tibble() %>% spread(art, Dødsfald) %>%
mutate_at(1:2, strtoi)
BEDBBM1_2000 <- BEDBBM1 %>% filter(tid == 2000) %>% pull(Middelfolketal)
BEDBBM1_std <- BEDBBM1 %>%
group_by(tid) %>%
summarise(age_adjust(Døde, Middelfolketal, stdpop = BEDBBM1_2000) * 1000) %>%
ungroup()
BEDBBM1_std %>%
ggplot(aes(
x = tid,
y = std_rate
)) +
geom_line(size = 2, color = statgl:::statgl_cols("darkblue")) +
theme_statgl() +
labs(
title = sdg3$figs$fig4$title[language],
subtitle = sdg3$figs$fig4$sub[language],
y = sdg3$figs$fig4$y_lab[language]
)
# Helper function:
age_adjust <- function(count, pop, rate = NULL, stdpop){
if (missing(count) & !missing(pop) & is.null(rate)) {
count <- rate * pop
}
if (missing(pop) & !missing(count) & is.null(rate)) {
pop <- count/rate
pop[!is.finite(pop)] <- 0
}
if (is.null(rate) & !missing(count) & !missing(pop)){
rate <- count/pop
rate[!is.finite(rate)] <- 0
}
cruderate <- sum(count)/sum(pop)
stdwt <- stdpop/sum(stdpop)
dsr <- sum(stdwt * rate)
tibble(`crude_rate` = cruderate, `std_rate` = dsr)
}
# Import
BEDBBDM1_raw <-
statgl_url("BEXBBDM1", lang = "da") %>%
statgl_fetch(
type = px_all(),
age = px_all(),
gender = c("M", "K"),
.col_code = TRUE) %>%
as_tibble() %>%
rename(c(
"alder" = 1,
"art" = 2,
"køn" = 3,
"tid" = 4,
"Dødsfald" = 5
))
BEDBBDM1 <- BEDBBDM1_raw %>% as_tibble() %>% spread(art, Dødsfald) %>%
mutate_at(c(1, 3), strtoi)
BEDBBDM1_2000 <- BEDBBDM1 %>% arrange(tid, køn, alder) %>% filter(tid == 2000) %>% pull(Middelfolketal)
BEDBBDM1_std <- BEDBBDM1 %>% group_by(tid, køn) %>% arrange(alder) %>%
summarise(age_adjust(Døde, Middelfolketal, stdpop = BEDBBDM1_2000) * 1000) %>%
ungroup()
BEDBBDM1_std %>%
ggplot(aes(
x = tid,
y = std_rate,
color = køn
)) +
geom_line(size = 2) +
theme_statgl() +
scale_color_statgl(reverse = TRUE) +
labs(
title = sdg3$figs$fig5$title[language],
subtitle = sdg3$figs$fig5$sub[language],
color = " ",
x = " ",
y = sdg3$figs$fig5$y_lab[language]
)
# Import
TUB01_raw <-
read_csv(
"http://pxweb.fujitsu.dk/sq/1417044b-c578-4c3a-a97d-5056b117ad52",
locale = locale(encoding = "latin1")) %>%
as_tibble()
# Transform
TUB01 <-
TUB01_raw %>%
mutate(
sex = sex %>% str_replace("Men", sdg3$figs$fig5$groups$group1[language] %>% unlist()),
sex = sex %>% str_replace("Women", sdg3$figs$fig5$groups$group2[language] %>% unlist()),
year = year %>% make_date()
)
# Plot
TUB01 %>%
ggplot(aes(
x = year,
y = Greenland,
color = sex
)) +
geom_line(size = 2) +
expand_limits(y = 0) +
theme_statgl() +
scale_color_statgl(reverse = TRUE) +
labs(
title = sdg3$figs$fig6$title[language],
subtitle = sdg3$figs$fig6$sub[language],
x = " ",
y = sdg3$figs$fig6$y_lab[language],
color = " ",
caption = sdg3$figs$fig6$cap[language]
)
# Import
SUDLDM2_raw <-
read_csv(paste0("https://bank.stat.gl:443/sq/3efbaaab-3db0-4b90-8f7b-18c556afe4e4", "?lang=", language),
locale = locale(encoding = "latin1"))
BEDSTM1_raw <-
read_csv(paste0("https://bank.stat.gl:443/sq/e8c2ed7c-ed03-471b-87e1-40d658b78bd4", "?lang=", language))
# Transform
Selvmord <-
SUDLDM2_raw %>%
left_join(BEDSTM1_raw) %>%
rename(
"cause" = 1,
"time" = 2,
"suicide" = 3,
"population" = 4
) %>%
mutate(rate = suicide / population * 10^5,
time = time %>% make_date())
# Plot
Selvmord %>%
ggplot(aes(
x = time,
y = rate,
color = statgl:::statgl_cols("darkblue")
)) +
geom_line(size = 2) +
theme_statgl() + scale_color_statgl() +
theme(legend.position = "none") +
labs(
title = Selvmord[[1]][1],
x = " ",
y = sdg3$figs$fig7$y_lab[language],
caption = sdg3$figs$fig7$cap[language]
)
# Import, dødelighed
BEXBBDM1_raw <-
statgl_url("BEXBBDM1", lang = language) %>%
statgl_fetch(
age = 0:4,
type = "D",
.col_code = TRUE
) %>%
as_tibble()
# Import, levendefødte
BEXBBLK1_raw <-
statgl_url("BEXBBLK1", lang = language) %>%
statgl_fetch(
type = "L",
.col_code = TRUE
) %>%
as_tibble()
child_mortality <-
BEXBBDM1_raw %>%
spread(2, 4) %>%
spread(1, 3) %>%
mutate(sum = `0` + `1` + `2` + `3` + `4`) %>%
select(-(2:6)) %>%
left_join(BEXBBLK1_raw %>% spread(1, 3)) %>%
rename(
"mortality" = 2,
"population" = 3
) %>%
mutate(rate = mortality / population * 1000,
time = time %>% make_date())
# Plot
child_mortality %>%
ggplot(aes(
x = time,
y = rate,
color = statgl:::statgl_cols("darkblue")
)) +
geom_line(size = 2, color = statgl:::statgl_cols("darkblue")) +
expand_limits(y = 0) +
theme_statgl() +
labs(
title = sdg3$figs$fig8$title[language],
subtitle = sdg3$figs$fig8$sub[language],
x = " ",
y = sdg3$figs$fig8$y_lab[language],
caption = sdg3$figs$fig8$cap[language]
)
# Import
ALXALK1_raw <-
statgl_url("ALXALK1", lang = language) %>%
statgl_fetch(
unit = 1,
type = 0:2,
category = 1,
.col_code = TRUE
) %>%
as_tibble()
# Transform
ALXALK1 <-
ALXALK1_raw %>%
mutate(time = time %>% make_date())
# Plot
ALXALK1 %>%
ggplot(aes(
x = time,
y = value,
fill = type
)) +
geom_area() +
theme_statgl() +
scale_fill_statgl(palette = "autumn") +
labs(
title = sdg3$figs$fig9$title[language],
subtitle = sdg3$figs$fig9$sub[language],
x = " ",
y = sdg3$figs$fig9$y_lab[language],
fill = sdg3$figs$fig9$fill[language],
caption = sdg3$figs$fig9$cap[language]
)
# Import
ALXTOB2_raw <-
statgl_url("ALXTOB2", lang = language) %>%
statgl_fetch(
unit = 3,
type = 0:1,
.col_code = TRUE
) %>%
as_tibble()
# Transform
ALXTOB2 <-
ALXTOB2_raw %>%
mutate(time = time %>% make_date())
# Plot
ALXTOB2 %>%
ggplot(aes(
x = time,
y = value,
fill = type
)) +
geom_area() +
theme_statgl() +
theme(plot.margin = margin(10, 10, 10, 10)) +
scale_fill_statgl(palette = "autumn") +
scale_y_continuous(labels = scales::comma_format(
decimal.mark = ",",
big.mark = "."
)) +
labs(
title = sdg3$figs$fig10$title[language],
subtitle = sdg3$figs$fig10$sub[language],
x = " ",
y = sdg3$figs$fig10$y_lab[language],
fill = sdg3$figs$fig10$fill[language],
caption = sdg3$figs$fig10$cap[language]
)
# Import
OFXOA1_raw <-
statgl_url("OFXOA1", lang = language) %>%
statgl_fetch(
`inventory variable` = px_all(),
.col_code = TRUE
) %>%
as_tibble()
# Transform
OFXOA1 <-
OFXOA1_raw %>%
mutate(
time = time %>% make_date(),
value = value * 10^-3
)
# Plot
OFXOA1 %>%
ggplot(aes(
x = time,
y = value,
fill = `inventory variable`
)) +
geom_col(position = "dodge") +
theme_statgl() +
scale_fill_statgl(reverse = TRUE) +
labs(
title = sdg3$figs$fig11$title[language],
x = " ",
y = sdg3$figs$fig11$y_lab[language],
fill = " ",
caption = sdg3$figs$fig11$cap[language]
)
# Import
BEDLL1_raw <-
statgl_url("BEXLL1", lang = language) %>%
statgl_fetch(
time = px_all(),
weight = 0:9,
.col_code = TRUE
) %>%
as_tibble()
# Transform
BEDLL1 <-
BEDLL1_raw %>%
mutate(
time = time %>% as.numeric(),
weight = weight %>% str_remove("gram") %>% trimws(),
weight = weight %>% factor(levels = unique(weight))
) %>%
filter(time %in% quantile(time)[-1])
# Plot
BEDLL1 %>%
ggplot(aes(
x = weight,
y = value,
fill = time
)) +
geom_col() +
facet_wrap(~ time) +
coord_flip() +
theme_statgl() +
scale_color_statgl() +
theme(legend.position = "none") +
labs(
title = sdg3$figs$fig12$title[language],
x = sdg3$figs$fig12$x_lab[language],
y = sdg3$figs$fig12$y_lab[language],
caption = sdg3$figs$fig12$cap[language]
)