+ Näytä koodi- Piilota koodi
# Tämä on koodi Op_fi5889 sivulla [[Ruori]]
library(OpasnetUtils)
library(tidyverse)
library(treemap)
library(plotly)
#objects.latest("Op_en6007", code_name = "hnh2035") # [[OpasnetUtils/Drafts]] pushIndicatorGraph
##### Finnish translations
transl <- as_tibble(opbase.data("Op_fi3944", subset="Tautiluokittelu")) %>% # [[Tautitaakka Suomessa]]
mutate(Id=as.integer(as.character(Id)))
BS <- 24
palet <- c(
'#a6cee3','#1f78b4','#b2df8a','#33a02c','#fb9a99','#e31a1c','#fdbf6f',
'#ff7f00','#cab2d6','#6a3d9a','#ffff99','#b15928', # First 12 colours from Colorbrewer Paired.
'cyan2','cyan4','plum1','plum4', 'darkslategray4','darkslategray1','firebrick3'
)
###################### Graphs for the Tautitaakka auttaa hahmottamaan ... article
# DALYs by causes (risks not included)
dc <-
as_tibble(opasnet.csv("2/2d/IHME_Fin_Risks_by_Cause.zip", wiki="opasnet_en",
unzip="IHME-GBD_2017_DATA-8ce9adcf-1.csv",sep=",",dec=".",header=TRUE)) %>%
left_join(transl[transl$Type=="Cause",], by=c("cause_id"="Id")) %>%
mutate(cause_name = Result) %>% # transl combines some entries from cause_name to Name (in Finnish: Result)
# "Neglected tropical diseases and malaria",
# "HIV/AIDS and sexually transmitted infections",
# "Enteric infections" >> "Other infectious diseases"
filter(measure_name=="DALYs (Disability-Adjusted Life Years)" & metric_name=="Number" & year == 2017) %>%
group_by(cause_name) %>%
summarise(value=sum(val)) %>%
mutate(cause_name = factor(cause_name, levels=cause_name[order(value)])) %>%
mutate(valy = value/1000 + ifelse(value<250000, 20, -40)) # unit kDALY/a
plot_cause <- ggplot(dc2, aes(x=cause_name,weight=value/1000,fill=cause_name, label=round(value/1000)))+
geom_bar(position="stack")+geom_text(aes(y=valy))+coord_flip()+
guides(fill=FALSE)+
scale_fill_manual(values = rev(palet))+
labs(
title="Tautitaakka Suomessa syittäin 2017",
x="Tauti tai haitta",
y="Tautitaakka (tuhatta DALYa vuodessa)")
plot_cause
# ggsave("Tautitaakka Suomessa 2017.svg", width=8, height=5) # Png conversion: 300 pixels/inch, font size 4 times larger
############## DALYs by causes and risks
dcr <- as_tibble(
opasnet.csv("2/2d/IHME_Fin_Risks_by_Cause.zip", wiki="opasnet_en",
unzip="IHME-GBD_2017_DATA-8c9ca17f-1.csv",sep=",",dec=".",header=TRUE)
) %>%
left_join(transl[transl$Type=="Cause",], by=c("cause_id"="Id")) %>%
filter(measure_name=="DALYs (Disability-Adjusted Life Years)" & metric_name=="Number" & year == 2017) %>%
# mutate(cause_name = factor(Result, levels=dc2$cause_name)) %>% # transl combines some entries from cause_name to Name (in Finnish: Result)
left_join(transl[transl$Type=="Risk",], by=c("rei_id"="Id"))
dcr <- dcr %>%
mutate(
cause_name=factor(Result.x,levels=levels(dc$cause_name)),
rei_name=factor(Result.y, levels = aggregate(dcr["val"],dcr["Result.y"],sum) %>% transmute(Result.y[order(val)]) %>% pull())) %>%
group_by(rei_name, cause_name, Luokka.y) %>%
summarise(val = sum(val))
# mutate(rei_name = factor(rei_name, levels= dcr2$rei_name)) # transl combines some entries from cause_name to Name (in Finnish: Result)
# Strange discrepancy in two sources from IHME: especially in cardiovascular diseases.
# Reason not known, use dcr anyway; because errors not found.
# ihme <- read.csv("C:/Users/jtue/AppData/Local/Temp/download(1).csv")
# ihme <- ihme[ihme$Measure=="DALYs",]
# sum(ihme$Value)
# [1] 911630.9
# sum(dcr$val)
# [1] 1205234
# View(
# merge(
# aggregate(ihme["Value"], by=ihme["Cause.of.death.or.injury"], FUN=sum),
# aggregate(dcr["val"], by=dcr["cause_name"], FUN=sum),
# by.x=c("Cause.of.death.or.injury"), by.y=c("cause_name")
# )
# )
plot_risk <- ggplot(dcr, aes(x=rei_name, weight=val/1000, fill=cause_name))+geom_bar()+coord_flip()+
scale_fill_manual(values = rev(palet)[-8])+ # Skin diseases missing, so remove that colour
guides(fill = guide_legend(reverse=TRUE, title=NULL, keyheight=0.8))+
theme_gray(base_size=11)+ theme(legend.position=c(0.83,0.29)) +
labs(
title = "Tautitaakka Suomessa 2017 tunnettujen riskitekijöiden mukaan",
x="Riskitekijä", y="Tautitaakka (tuhatta DALYa vuodessa)")
plot_risk
# ggsave("Tautitaakka Suomessa 2017 riskitekijöittäin.svg", width=8, height=6) # Png conversion: 300 pixels/inch, font size 4 times larger
ruori <- data.frame(
Luokka.y = c(rep("Ympäristö",3),rep("Ravitsemus",4),rep("Ympäristö",3)),
rei_name = c(
"Aflatoksiini",
"Lyijy",
"Dioksiini",
"Tyydyttyneet rasvat",
"Suola",
"Hedelmien liian vähäinen saanti",
"Kasvisten liian vähäinen saanti",
"Norovirus",
"Listeria",
"Toksoplasma"
),
val = c(
8,
6,
22,
8190,
27062,
35314,
27778,
1,
660,
432
),
lower = c(
6,
NA,
NA,
5857,
1330,
20197,
13740,
NA,
330,
270
),
upper = c(
13,
NA,
NA,
11125,
65542,
53635,
44716,
NA,
880,
702
)
)
dcr$rei_name <- as.character(dcr$rei_name)
# Subtract Ruori results from IHME background
dcr$val[dcr$rei_name=="Ravitsemusriskit" & dcr$cause_name=="Sydän- ja verisuonitaudit"] <-
dcr$val[dcr$rei_name=="Ravitsemusriskit" & dcr$cause_name=="Sydän- ja verisuonitaudit"] - sum(ruori$val[ruori$Luokka.y=="Ravitsemus"])
dcr$val[dcr$rei_name=="Muut ympäristöriskit" & dcr$cause_name=="Syöpä"] <-
dcr$val[dcr$rei_name=="Muut ympäristöriskit" & dcr$cause_name=="Syöpä"] - sum(ruori$val[ruori$Luokka.y=="Ympäristö"])
dcr <- rbind(dcr[colnames(dcr)!="cause_name"],ruori[!colnames(ruori) %in% c("upper","lower")])
dcr$rei_name[dcr$rei_name=="Ravitsemusriskit"] <- "Muut ravitsemusriskit"
pdf("Tautitaakka riskitekijöittäin.pdf", width=11.67, height=4.27)
treemap(dcr, index=c("Luokka.y","rei_name"),vSize="val",
title=paste0("Tunnettujen riskitekijöiden tautitaakka Suomessa 2017 (",
round(sum(dcr$val),-3)," DALY)"),
align.labels=list(c("center","top"),c("center","center")),
aspRatio = 2, border.col = "gray")
dev.off()
tmp <- ruori %>%
filter(rei_name %in% c("Aflatoksiini","Lyijy","Dioksiini","Norovirus","Listeria","Toksoplasma")) %>%
rename(Altiste=rei_name) %>%
mutate(Altiste = factor(Altiste, levels=ruori$rei_name[order(ruori$val)]))
thlBarPlot(tmp, xvar=Altiste, yvar=val)+
coord_flip()+geom_errorbar(data=tmp, aes(ymin=lower, ymax=upper), width=0.25, size=0.7)+
labs(
title="Ruorissa tutkittujen riskien tautitaakka",
subtitle = "Tautitaakka mikrobiologisille ja kemiallisille epäpuhtauksille (DALYa vuodessa)")
ggsave("Mikrobiologiset ja kemialliset riskit Ruorissa.svg", width=8, height=5)
tmp <- ruori %>%
filter(!rei_name %in% c("Aflatoksiini","Lyijy","Dioksiini","Norovirus","Listeria","Toksoplasma")) %>%
rename(Altiste=rei_name) %>%
mutate(Altiste = factor(Altiste, levels=ruori$rei_name[order(ruori$val)]))
thlBarPlot(tmp, xvar=Altiste, yvar=val)+
coord_flip()+geom_errorbar(data=tmp, aes(ymin=lower, ymax=upper), width=0.25, size=0.7)+
labs(
title="Ruorissa tutkittujen riskien tautitaakka",
subtitle = "Tautitaakka ravitsemusriskeille (DALYa vuodessa)")
ggsave("Ravitsemusriskit Ruorissa.svg", width=8, height=5)
####################################
# Katso sivut [[:op_en:Goherr assessment]] ja [[:op_en:Health effects of Baltic herring and salmon: a benefit-risk assessment]]
objects.get('155401096341')
groups <- function(o) {
o$Group <- paste(o$Gender, o$Ages)
o$Group <- factor(o$Group, levels = c(
"Female 18-45",
"Male 18-45",
"Female >45",
"Male >45"
))
return(o)
}
varit12 <- c(
'#2f62ad', # THL-värit, koko väripaletti. Nro 2
'#7cd0d8', # 4
'#571259', # 9
'#5faf2c', # 11
'#bf4073', # 14
'#3b007f', # 18
'#16994a', # 20
'#cccc72', # 22
'#0e1e47', # 3
'#25a5a2', # 5
'#cc7acc', # 7
'#244911' # 12
)
#### Burden of disease
# Figure 5. from Goherr assessment manuscript
if(FALSE) tmp <- groups(BoD * info) else tmp <- groups(BoDRaw * info)
tmp <- oapply(
tmp[!grepl("TWI", tmp$Resp) & tmp$Background=="Yes",],
INDEX=c("Resp","Group","Country","Cons.policy","Background"),
mean
)@output
# levels(tmp$Group)
# [1] "Female 18-45" "Male 18-45" "Female >45" "Male >45"
levels(tmp$Group) <- c("Naiset 18-45","Miehet 18-45","Naiset >45","Miehet >45")
#levels(tmp$Resp)
#[1] "Stroke" "Heart (CHD)" "Cancer" "Child's IQ" "Infertility"
#[6] "Tooth defect" "Dioxin TWI" "TWI 2018" "Vitamin D intake"
levels(tmp$Resp) <- c("Aivohalvaus","Sepelvaltimotauti","Syöpä","Lapsen ÄO","Hedelmättömyys",
"Hammasvaurio","","","D-vitamiini")
fig22 <- ggplot(tmp[tmp$Country=="FI" & tmp$Cons.policy=="BAU",],
aes(x=Group, weight=Result, fill=Resp))+
geom_bar()+facet_grid(Cons.policy ~ Country)+
theme_grey(base_size=BS-8)+
theme(
legend.position = "bottom"
# axis.text.x = element_text(angle = -90)
)+
labs(
title="Itämeren kalan aiheuttama tautitaakka Suomessa ryhmittäin",
y = "Tautitaakka (DALY/a)",
fill="",
x=""
)+
scale_fill_manual(values=varit12[-(7:8)])
fig22
ggsave("Itämeren kalan tautitaakka Suomessa.svg", width=8, height=5)
######### Figure 6.
tmp <- groups(BoDRaw * info)
#> levels(tmp$Resp)
#[1] "Stroke" "Heart (CHD)" "Cancer" "Child's IQ" "Infertility"
#[6] "Tooth defect" "Dioxin TWI" "TWI 2018" "Vitamin D intake"
levels(tmp$Resp) <- c("Aivohalvaus","Sepelvaltimotauti","Syöpä","Lapsen ÄO","Hedelmättömyys",
"Hammasvaurio","TWI 2001","TWI 2018","D-vitamiini")
tmp@output <- rbind(
cbind(tmp@output,Focusgroup = "Kaikki"),
cbind(tmp@output[tmp$Group=="Female 18-45",],Focusgroup = "Nuoret naiset")
)
tmp <- oapply(
tmp[tmp$Cons.policy=="BAU" & tmp$Country=="FI",],
INDEX=c("Resp","Background","Focusgroup","Country"),
mean
)@output
tmp <- rbind(
cbind(
Objective="Kokonaisterveys, oletus",
tmp[tmp$Background=="Yes" & !grepl("TWI",tmp$Resp),]
),
cbind(
Objective="Kokonaisterveys, taustatta",
tmp[tmp$Background=="No" & !grepl("TWI",tmp$Resp),]
),
cbind(
Objective=tmp$Resp,
tmp
)[grepl("TWI",tmp$Resp),]
)
sums <- aggregate(tmp["Result"], by=tmp[c("Objective","Focusgroup","Country")],sum)
fig22b <- ggplot(tmp, aes(x=Objective, weight=Result))+
geom_bar(aes(fill=Resp))+facet_grid(Country ~ Focusgroup)+
theme_grey(base_size=BS-8)+
theme(
legend.position = "bottom",
axis.text.x = element_text(angle = -15, hjust=0.5)
)+
geom_text(data=sums, size=6, aes(label=round(Result,-2),y=pmax(200,Result+200)))+
labs(
title="Tautitaakka eri tavoitteiden näkökulmasta",
y = "Tautitaakka (DALY/a)",
fill="",
x=""
)+
scale_fill_manual(values=varit12)
fig22b
ggsave("Itämeren kalan tautitaakka eri näkökulmista.svg", width=10, height=7)
############################ Health care costs
dat <- scrape.webtable(
"https://en.wikipedia.org/wiki/List_of_countries_by_total_health_expenditure_per_capita",
6)
colnames(dat) <- c("Country","Y2000","Y2005","Y2010","Y2015")
dat$Y2015 <- as.numeric(gsub(",","",as.character(dat$Y2015)))
dat$Country <- as.character(dat$Country)
dat$Country[match(c(
"Iran (Islamic Republic of)",
"Lao People's Democratic Republic",
"United Republic of Tanzania",
"United States of America",
"Venezuela (Bolivarian Republic of)",
"Viet Nam"
),dat$Country)] <- c("Iran","Laos","Tanzania","United States","Venezuela","Vietnam")
dat2 <- read.csv("C:/Users/jtue/AppData/Local/Temp/IHME-GBD_2017_DATA-96ba4b83-1.csv")
levels(dat2$location_name)[match(c(
"The Bahamas","The Gambia"),levels(dat2$location_name))] <- c("Bahamas","Gambia")
dat3 <- merge(dat,dat2, by.x="Country",by.y="location_name", all=TRUE)
dat3$label <- ifelse(dat3$Country %in% c("Finland","Sweden","United States","Poland"), dat3$Country, " ")
tmp <- dat3[dat3$metric_name=="Rate" & dat3$cause_name=="All causes",]
tmp$label[match(c("Finland","Sweden","United States","Poland"),tmp$label)] <- c("Suomi","Ruotsi", "USA","Puola")
ggplot(tmp, aes(x=Y2015,y=val/100000, label=label, colour=label))+
geom_point()+geom_text()+
labs(
title="Tautitaakka terveysmenojen funktiona maittain 2015",
y="Tautitaakka per henkilö (DALY)",
x="Terveydenhuoltomenot per henkilö (USD)"
)
ggsave("Tautitaakka terveysmenojen funktiona maittain.svg", width=9, height=5)
pl <- plot_ly(tmp, x=~Y2015, y=~val/100000,type="scatter", mode="markers", hovertext=~Country) %>% #, text=~label,color=~label) %>%
layout(
title="Tautitaakka terveysmenojen funktiona maittain 2015",
xaxis=list(title="Terveydenhuoltomenot per henkilö (USD)"),
yaxis=list(title="Tautitaakka per henkilö (DALY)")
)
pl
# pushIndicatorGraph(pl, 103)#, API_KEY= apikey)
| |