6 Data for Visualizer Shiny
We need this function for calculating PAF from Odd Ratio.
## PAF ODDS RATIO Function -----
## Give only decimals in parameters
# OR = Odds Ratio
# PD = having a disease, prevalence
# PE = exposed, sleep apnea prevalence
# (PE_ = unexposed)
paf_or <- function(OR, PD, PE){
PD = PD * 100
PE = PE * 100
PE_ = 100 - PE
VALUE1 = (PD * (1 - OR) + PE_ + OR * PE + sqrt( (PD * (1 - OR) + PE_ + OR * PE )^2 - 4 * PE_ * (1 - OR) *PD )) / (2 * PE_ * (1 - OR))
VALUE2 = (PD * (1 - OR) + PE_ + OR * PE - sqrt( (PD * (1 - OR) + PE_ + OR * PE )^2 - 4 * PE_ * (1 - OR) *PD )) / (2 * PE_ * (1 - OR))
VALUE <- ifelse(VALUE1 <= 100 & VALUE1 >= 0, VALUE1, VALUE2)
PAF = 1 - ((100 * VALUE) / PD)
return(PAF)
}6.1 Calculating main dataset
6.1.2 OSA rates
## Fixed multiplier values are calculated from original Armeni article table.
dosa <- osanew
slapnea_prevalence_female <- dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Moderate-Severe"]
slapnea_prevalence_male <- dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Moderate-Severe"]
# dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Moderate-Severe"] <- slapnea_prevalence_female / 100
dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Moderate"] <- 0.5342 * (slapnea_prevalence_female)
dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Severe"] <- 0.4658 * (slapnea_prevalence_female)
# dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Moderate-Severe"] <- slapnea_prevalence_male / 100
dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Moderate"] <- 0.4004 * (slapnea_prevalence_male)
dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Severe"] <- 0.5996 * (slapnea_prevalence_male)
dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Mild"] <- (slapnea_prevalence_male) / 1.44
dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Mild"] <- (slapnea_prevalence_female) / 0.6206897
dosa$osa_rate[dosa$gender == "Both" & dosa$OSA_severity=="Moderate-Severe"] <- (dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Moderate-Severe"] * population$pop_female + dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Moderate-Severe"] * population$pop_male) / population$pop_both
dosa$osa_rate[dosa$gender == "Both" & dosa$OSA_severity=="Moderate"] <- (dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Moderate"] * population$pop_female + dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Moderate"] * population$pop_male) / population$pop_both
dosa$osa_rate[dosa$gender == "Both" & dosa$OSA_severity=="Severe"] <- (dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Severe"] * population$pop_female + dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Severe"] * population$pop_male) / population$pop_both
dosa$osa_rate[dosa$gender == "Both" & dosa$OSA_severity=="Mild"] <- (dosa$osa_rate[dosa$gender == "Female" & dosa$OSA_severity=="Mild"] * population$pop_female + dosa$osa_rate[dosa$gender == "Male" & dosa$OSA_severity=="Mild"] * population$pop_male) / population$pop_both
## COMPARED TO FIXED ITALY VALUES AND ITS OK!6.1.3 Condition Prevalences and PAF
## Prevalences and OSA rates added
d <- prevalences %>%
mutate(OSA_severity = ifelse(OSA_severity == "Overall", "Moderate-Severe", OSA_severity),
prevalence = ifelse(is.na(ihme), prevalence_base_italy, ihme)) %>%
left_join(dosa, by = c("location_name", "OSA_severity", "gender")) %>%
left_join(money_correction, by = "location_name")
## Hard coding change, because Armeni used population of daytime sleepiness, we need to use fixed osa rate. This is estimated
d$osa_rate[d$condition == "Car accidents"] <- 0.06885
d$osa_rate[d$condition == "Work accidents"] <- 0.06885
## Calculate PAFs
d <- d %>%
group_by(location_name) %>%
mutate(
## PAF calculation for Risk Ratio or Odds Ratio:
PAFRR = ifelse(!is.na(RR), (osa_rate * (RR - 1) / (osa_rate * (RR - 1) + 1)), NA),
PAFOR = ifelse(!is.na(OR), paf_or(OR, prevalence, osa_rate), NA),
PAF = ifelse(is.na(PAFOR), ifelse(!is.na(PAFRR), PAFRR, 0), PAFOR),
## Prevalents per conditions
prevalent_cases = ifelse(gender=="Both", prevalence * pop_both, ifelse(gender=="Female", prevalence * pop_female, prevalence * pop_male)),
prevalent_cases_influenced_osa = PAF * prevalent_cases,
## Costs per conditions
direct_cost = prevalent_cases_influenced_osa * direct_healthcare_cost,
direct_non_healthcare_cost = prevalent_cases_influenced_osa * direct_nonhealthcare_cost,
productivity_lost_cost = prevalent_cases_influenced_osa * productivity_losses_cost
) %>%
mutate(direct_cost = ifelse(is.na(direct_cost), 0 , direct_cost),
direct_non_healthcare_cost = ifelse(is.na(direct_non_healthcare_cost), 0 , direct_non_healthcare_cost),
productivity_lost_cost = ifelse(is.na(productivity_lost_cost), 0 , productivity_lost_cost),
total_costs = direct_cost + direct_non_healthcare_cost + productivity_lost_cost) # cHeCK
# d %>%
# filter(location_name == "Finland") -> temp
# write.csv(temp, "temp_finland.csv")## Calculater sums per country
## TODO add money index
d <- d %>%
group_by(location_name, pop_female, pop_male, pop_both, index) %>%
summarise(direct_cost = sum(direct_cost, na.rm = T),
direct_non_healthcare_cost = sum(direct_non_healthcare_cost, na.rm = T),
productivity_lost_cost = sum(productivity_lost_cost, na.rm = T)) %>%
## OSA absolute values with separated moderate/severe calculation (OSA population to divide costs to).
mutate(
absolute_value_severe_moderate = ( (pop_female * dosa$osa_rate[dosa$OSA_severity == "Moderate-Severe" & dosa$gender == "Female" & dosa$location_name == location_name]) + (pop_male * dosa$osa_rate[dosa$OSA_severity == "Moderate-Severe" & dosa$gender == "Male"& dosa$location_name == location_name])),
absolute_value_mild = (pop_female * dosa$osa_rate[dosa$OSA_severity == "Mild" & dosa$gender == "Female"& dosa$location_name == location_name] + pop_male * dosa$osa_rate[dosa$OSA_severity == "Mild" & dosa$gender == "Male"& dosa$location_name == location_name] ),
## Costs per patients
patient_direct_cost = direct_cost / absolute_value_severe_moderate,
patient_nonhealthcare_cost = direct_non_healthcare_cost / absolute_value_severe_moderate,
patient_productivity_cost = productivity_lost_cost / absolute_value_severe_moderate,
patient_total_cost = patient_direct_cost + patient_nonhealthcare_cost + patient_productivity_cost,
index = ifelse(is.na(index), 1, index)
)## `summarise()` has grouped output by 'location_name', 'pop_female', 'pop_male', 'pop_both'. You can override using the `.groups` argument.## Write to calculation database
saveRDS(d, file = "data/slapnea22.RDS")
## Write to calculation database
# saveRDS(slapnea22_eurostat, file = "data/slapnea22_eurostat.RDS")6.2 Map data
## Data for map
# Read this shape file with the rgdal library.
library(rgdal)
world_spdf <- readOGR(
dsn= paste0(getwd(),"/data/map/") ,
layer="TM_WORLD_BORDERS_SIMPL-0.3",
verbose=FALSE
)
## Countries in our data
countries <- unique(d$location_name)
## Countries in world data
# sort(world_spdf$NAME)
## Rename few countries in world data and subset
world_spdf$NAME[world_spdf$NAME == "The former Yugoslav Republic of Macedonia"] <- "Macedonia"
world_spdf$NAME[world_spdf$NAME == "Republic of Moldova" ] <- "Moldova"
europe_spdf <- subset(world_spdf, world_spdf$NAME %in% countries)
# countries[!countries %in% europe_spdf$NAME]
## Write to calculation database
saveRDS(europe_spdf, file = "data/europe_spdf.RDS")