fixed preprocessing scripts #712

data/parameters_.ini

@@ -0,0 +1,61 @@
+[Settings]
+shb_id=15
+tau=1
+
+[Seed settings]
+seedmethod=background
+nseed=1
+hrp=34
+use_fixed_seed=0
+seed_value=1592587926
+
+[Fit settings]
+nsteps=7
+nParticLimit=1000
+nSim=10000000
+kernelFactor=0.1
+
+[Tolerance settings]
+Key1=0.3
+Key2=0.2
+Key3=0.15
+Key4=0.10
+Key5=0.09
+Key6=0.08
+Key7=0.07
+Key8=0.06
+Key9=0.05
+Key10=0.03
+
+[Fixed parameters]
+totN_hcw=112974
+day_shut=23
+T_lat=4.0  
+juvp_s=0.1
+T_inf=1.5
+T_rec=5.0
+T_sym=7.0
+T_hos=5
+K=100000
+inf_asym=0.3	
+
+[Priors settings]
+nPar=8
+prior_pinf_shape1=3.0
+prior_pinf_shape2=9.0
+prior_phcw_shape1=3.0
+prior_phcw_shape2=3.0
+prior_chcw_mean=42
+prior_d_shape1=3.0
+prior_d_shape2=3.0
+prior_q_shape1=3.0
+prior_q_shape2=3.0
+prior_ps_shape1=9.0
+prior_ps_shape2=3.0
+prior_rrd_shape1=1.0
+prior_rrd_shape2=1.0
+prior_lambda_shape1=1e-9
+prior_lambda_shape2=1e-6
+
+[Prediction Configuration]
+n_sim_steps=1000

doc/.Rhistory

@@ -0,0 +1,137 @@
+library(dplyr)
+library(readr)
+library(tidyr)
+library(readxl)
+library(lubridate)
+#======================
+# Settings
+#======================
+do.write = F
+WATTY62DATA <- "https://raw.githubusercontent.com/watty62/Scot_covid19/master/data/processed/regional_cases.csv"
+WATTY62POP <- "https://raw.githubusercontent.com/watty62/Scot_covid19/master/data/processed/HB_Populations.csv"
+WATTY62DEATHS <- "https://raw.githubusercontent.com/watty62/Scot_covid19/master/data/processed/regional_deaths.csv"
+scot_pop <- read_csv(file =WATTY62POP , col_types = cols()) %>%
+mutate(hcw_per_rata = Population/sum(Population))
+scot_tot_pop = as.data.frame(list(`Name` = "Scotland",`Population` = sum(scot_pop$Population)))%>%
+mutate(hcw_per_rata = Population/sum(Population)) %>%
+mutate_if(is.factor,as.character)
+scot_pop <- bind_rows(scot_pop,scot_tot_pop)
+scot_deaths <- read_csv(file = WATTY62DEATHS, col_types = cols())
+scot_deaths[scot_deaths == "x"] <- -999
+scot_deaths <- scot_deaths %>%
+rename(`Scotland`= `Grand Total`) %>%
+mutate(Date = lubridate::dmy(Date))
+scot_data <- read_csv(file = WATTY62DATA, col_types = cols()) %>%
+rename(`Scotland`= `Grand Total`) %>%
+mutate(Date = lubridate::dmy(Date),
+Area = "Scotland")
+temp <- right_join(scot_pop %>% select(Name,Population),as.data.frame(t(
+as.matrix(
+scot_data %>% filter(Date <= max(scot_data$Date)) %>%
+select(-Date,-Area)))) %>% tibble::rownames_to_column(), by = c("Name"="rowname")) %>%
+select(-Name)
+colnames(temp) <- (1:ncol(temp))-2
+order_row= as.data.frame(t(
+as.matrix(
+scot_data %>% filter(Date <= max(scot_data$Date)) %>%
+select(-Date,-Area)))) %>% tibble::rownames_to_column() %>% select(rowname)
+#formating  the death data (HPS) for model input
+dtemp <- left_join(scot_data %>% select(Date),scot_deaths,by="Date") %>%
+replace(is.na(.),0)
+dtemp <- right_join(scot_pop %>% select(Name,Population),as.data.frame(t(
+as.matrix(
+dtemp %>% filter(Date <= max(scot_data$Date)) %>%
+select(-Date)))) %>% tibble::rownames_to_column(), by = c("Name"="rowname")) %>%
+select(-Name) %>%
+mutate_if(is.factor,as.character) %>%
+mutate_if(is.character,as.numeric)
+colnames(dtemp) <- (1:ncol(dtemp))-2
+dtemp
+#formating  the death data (HPS) for model input
+dtemp <- left_join(scot_data %>% select(Date),scot_deaths,by="Date") %>%
+replace(is.na(.),0)
+dtemp <- right_join(scot_pop %>% select(Name,Population),as.data.frame(t(
+as.matrix(
+dtemp %>% filter(Date <= max(scot_data$Date)) %>%
+select(-Date)))) %>% tibble::rownames_to_column(), by = c("Name"="rowname")) %>%
+select(-Name) %>%
+mutate_if(is.factor,as.character) %>%
+mutate_if(is.character,as.numeric)
+colnames(dtemp) <- (1:ncol(dtemp))-2
+#all location
+polymoduk=read_xlsx("./data/contact_matrices_152_countries/MUestimates_all_locations_2.xlsx",
+sheet="United Kingdom of Great Britain",col_names = c("00-04","05-09","10-14","15-19","20-24","25-29","30-34","35-39",
+"40-44","45-49","50-54","55-59","60-64","65-69","70-74","75+")) %>%
+mutate(from = c("00-04","05-09","10-14","15-19","20-24","25-29","30-34","35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74","75+"),
+group_age = ifelse(from %in% c("00-04","05-09","10-14","15-19"),"Under20",
+ifelse(from %in% c("20-24","25-29"),"20-29",
+ifelse(from %in% c("30-34","35-39"),"30-39",
+ifelse(from %in% c("40-44","45-49"),"40-49",
+ifelse(from %in% c("50-54","55-59"),"50-59",
+ifelse(from %in% c("60-64","65-69"),"60-69",
+ifelse(from %in% c("70-74","75+"),"Over70",NA)))))))) %>%
+mutate(`Under20` = (`00-04`+`05-09`+`10-14`+`15-19`)/4,
+`20-29` = (`20-24`+`25-29`)/2,
+`30-39` =(`30-34`+`35-39`)/2,
+`40-49` = (`40-44`+`45-49`)/2,
+`50-59` = (`50-54`+`55-59`)/2,
+`60-69` = (`60-64`+`65-69`)/2,
+`Over70` = (`70-74`+`75+`)/2,
+`HCW`= (`25-29`+`30-34`+`35-39`+`40-44`+`45-49`+`50-54`)/6) %>%
+ungroup() %>%
+select(group_age,`Under20`,`20-29`,`30-39`,`40-49`,`50-59`,`60-69`,`Over70`,`HCW`) %>%
+group_by(group_age) %>%
+summarise_at(vars(-group_cols()),mean) %>%
+ungroup() %>%
+mutate(group_age = factor(group_age,levels = c("Under20","20-29","30-39","40-49","50-59","60-69","Over70","HCW"))) %>%
+arrange(group_age) %>%
+select(-group_age)
+polymoduk_HCW=read_xlsx("./data/contact_matrices_152_countries/MUestimates_all_locations_2.xlsx",
+sheet="United Kingdom of Great Britain",col_names = c("00-04","05-09","10-14","15-19","20-24","25-29","30-34","35-39",
+"40-44","45-49","50-54","55-59","60-64","65-69","70-74","75+")) %>%
+mutate(from = c("00-04","05-09","10-14","15-19","20-24","25-29","30-34","35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74","75+"),
+group_age = ifelse(from %in% c("25-29","30-34","35-39","40-44","45-49","50-54"),"HCW",NA)) %>%
+drop_na() %>%
+mutate(`Under20` = (`00-04`+`05-09`+`10-14`+`15-19`)/4,
+`20-29` = (`20-24`+`25-29`)/2,
+`30-39` =(`30-34`+`35-39`)/2,
+`40-49` = (`40-44`+`45-49`)/2,
+`50-59` = (`50-54`+`55-59`)/2,
+`60-69` = (`60-64`+`65-69`)/2,
+`Over70` = (`70-74`+`75+`)/2,
+`HCW`= (`25-29`+`30-34`+`35-39`+`40-44`+`45-49`+`50-54`)/6) %>%
+ungroup() %>%
+select(group_age,`Under20`,`20-29`,`30-39`,`40-49`,`50-59`,`60-69`,`Over70`,`HCW`) %>%
+group_by(group_age) %>%
+summarise_at(vars(-group_cols()),mean) %>%
+ungroup() %>%
+mutate(group_age = factor(group_age,levels = c("Under20","20-29","30-39","40-49","50-59","60-69","Over70","HCW"))) %>%
+arrange(group_age) %>%
+select(-group_age)
+waifw_norm = bind_rows(polymoduk, polymoduk_HCW)
+#======================
+# age-structured parameters
+#======================
+#fixed age-structured probabilities
+cfr_byage=data.frame(
+#assume HCW similar to 20-59
+agegroup=colnames(waifw_norm),
+p_h=c(0.143,	0.1141,	0.117,	0.102,	0.125,	0.2,	0.303,	0.114525), #https://www.ecdc.europa.eu/sites/default/files/documents/RRA-seventh-update-Outbreak-of-coronavirus-disease-COVID-19.pdf
+cfr=c(0.001,	0.002,	0.002	,0.004,	0.013,	0.036,	0.114,	0.00525) #https://www.eurosurveillance.org/content/10.2807/1560-7917.ES.2020.25.12.2000256. NOTE: case defined as infected individuals (either symptomatic or asymptomatic)
+) %>%
+mutate(p_d=cfr/p_h) #convert p(d) to p(d|h)
+temp
+dtemp
+scot_deaths
+#formating  the death data (HPS) for model input
+dtemp <- left_join(scot_data %>% select(Date),scot_deaths,by="Date") %>%
+replace(is.na(.),0)
+dtemp <- right_join(scot_pop %>% select(Name,Population),as.data.frame(t(
+as.matrix(
+dtemp %>% filter(Date <= max(scot_data$Date)) %>%
+select(-Date)))) %>% tibble::rownames_to_column(), by = c("Name"="rowname")) %>%
+select(-Name) %>%
+mutate_if(is.factor,as.character) %>%
+mutate_if(is.character,as.numeric)
+dtemp
+dtemp[,30:59]