scripts/testing.R
In Geidelberg/cotonou:
# to debug:
# open terminal in the folder
# R- d valgrind
require(ggplot2)
require(reshape2)
#######################################################################
########################## run this if not going on cluster ###########
#######################################################################
odin::odin_package(".") # looks for any models inside inst/odin
devtools::load_all()
#
devtools::test()
#########################################################################################
#############################################################################################
#############################################################################################
# _ _ _ _ _ _ ____ _ _
# | | / \ | | | | \ | |/ ___| | | |
# | | / _ \| | | | \| | | | |_| |
# | |___ / ___ \ |_| | |\ | |___| _ |
# |_____/_/ \_\___/|_| \_|\____|_| |_|
#
#############################################################################################
#############################################################################################
#############################################################################################
# ____ _ _ _ _ _ ___ ____ _ _
# | _ \| | | | \ | | | | / _ \ / ___| / \ | |
# | |_) | | | | \| | | | | | | | | / _ \ | |
# | _ <| |_| | |\ | | |__| |_| | |___ / ___ \| |___
# |_| \_\\___/|_| \_| |_____\___/ \____/_/ \_\_____|
#
parameters <- lhs_parameters(1, par_seq = par_seq_default, condom_seq = condom_seq_default, groups_seq = groups_seq_default, years_seq = years_seq_default, set_pars = best_set_default, ranges = ranges_default, time = time_default)
result = run_model_for_tests(number_simulations = 1, time = time_default, parameters = parameters)[[1]]
result$rate_leave_pro_FSW
result$rate_leave_pro_FSW_weight_by_PrEP
result$rate_move_out_PrEP
result$rate_move_out
result$new_people_in_group_FSW_only[,c(1)] == result$new_people_in_group_FSW_only_test[,c(1)]
result$frac_N
parameters <- lapply(parameters, function(x) {x$rate_move_out_PrEP[1] = 0; return(x)})
result = run_model_for_tests(number_simulations = 1, time = time_default, parameters = parameters)[[1]]
result$new_people_in_group_FSW_only[,c(1)] == result$new_people_in_group_FSW_only_test[,c(1)]
ART_data_points_lazymcmc = data.frame(time = c(2017, 2017, 2015),
variable = c("Men", "Women","Pro FSW"),
x = c(3908, 9784, 49))#,
# N = c(19988, 207))
parameters = cotonou::lhs_parameters(number_simulations, set_pars = best_set, Ncat = 9, time = time,
ranges = ranges, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq)
res = lapply(parameters, cotonou::return_outputs, cotonou::main_model, time = time, outputs = outputs)
# likelihood_list = lapply(res, cotonou::likelihood_lazymcmc, time = time, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points, PrEP_fitting = PrEP_fitting)
x = res[[1]]
# ART_data_points_with_numbers_reduced$N = c(, , 207)
# 2017 MEN ART COVERAGE
# NUM
# (2369 + 5223)/2 # littoral, L + O + A
#
# # DENOM
# (3500 + 3500 + 1900 + 3100)/2
#
#
# # 2017 WOMEN ART COVERAGE
# # NUM
# (6155 + 13050)/2 # littoral, L + O + A
#
# # DENOM
# (3800 + 3800 + 3000 + 5000)/2
# audit report 2017, by site table:
# 3908 men and 9784 women = 13692 total
# ranges of coverage give 0.57 to 0.80 coverage in 2017
# average is 0.685
# this makes denominator of 13692/0.685 = 19988
# ____ __ ____ _ _ _ _ _
# | _ \ _ _ _ __ / _|_ __ ___ _ __ ___ / ___(_) |_| | | |_ _| |__
# | |_) | | | | '_ \ | |_| '__/ _ \| '_ ` _ \ | | _| | __| |_| | | | | '_ \
# | _ <| |_| | | | | | _| | | (_) | | | | | | | |_| | | |_| _ | |_| | |_) |
# |_| \_\\__,_|_| |_| |_| |_| \___/|_| |_| |_| \____|_|\__|_| |_|\__,_|_.__/
#
# __ _____ _____ _ _ _____ ___ _____
# \ \ / /_ _|_ _| | | | | ___|_ _|_ _|
# \ \ /\ / / | | | | | |_| | | |_ | | | |
# \ V V / | | | | | _ | | _| | | | |
# \_/\_/ |___| |_| |_| |_| |_| |___| |_|
# remove.packages("cotonou")
# rm(list = ls())
require(ggplot2)
require(reshape2)
# devtools::install_github("geidelberg/cotonou")
odin::odin_package(".") # looks for any models inside inst/odin
devtools::load_all()
devtools::test()
tbefore = Sys.time()
number_simulations = 1
batch_size = 1
epi_start = 1986
# epi_end = 2030
epi_end = 2017
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm", "n_y_comm", "n_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
# time <- seq(epi_start, epi_end, length.out = (epi_end - epi_start + 0.5)*2)
# time <- seq(epi_start, epi_end, length.out = (epi_end - epi_start + 1/12)*12)
# ranges etc from cotonou cluster etc
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR = 0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
nu = 0.022,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
# fraction_F = 0.5,
fraction_F = 0.515666224,
epsilon_1985 = 0.08,
epsilon_1992 = 0.08,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = 0.9 * 0.523, # infectiousness RR when on ART (efficacy ART assuimed 90% * % undetectable which is 52.3%)
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
# gamma01 = 0.4166667, #years
# gamma04 = 4.45, #years
#
alpha01 = rep_len(0, 9),
alpha11 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = 0.03,
alpha04 = 0.07,
alpha05 = 2,
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
# alpha23 = rep_len(0.05, 9),
# alpha24 = rep_len(0.08, 9),
# alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
# alpha33 = rep_len(0.05, 9),
# alpha34 = rep_len(0.08, 9),
# alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
# alpha43 = rep_len(0.05, 9),
# alpha44 = rep_len(0.08, 9),
# alpha45 = rep_len(0.27, 9),
test_rate_prep = c(4, 0, 0, 0, 0, 0, 0, 0, 0),
sigma = c(0.82, 0, 0, 0, 0, 0, 0, 0, 0),
prep_intervention_t = c(1985, 2015, 2016, 2017),
prep_intervention_y = matrix(c(rep(0, 9), 1, rep(0, 9-1), 1, rep(0, 9-1), rep(0, 9)), ncol = 9, byrow = T),
PrEPOnOff = 0,
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
# zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
# testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
# 0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
# 0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
# 0.142, 0.142, 0.142, 0.142, 0.142, 0.142, 0, 0, 0, # 2006 0.653/8 slope
# 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0, 0, 0, # 2008 3*0.653/8
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0, # 2012 7*0.653/8
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0, # 2013
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0, # 2015
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0), # 2016
# nrow = 9, ncol = 9, byrow = T),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0.118, 0.118, 0.118, 0.08125, 0.08125, 0, 0, 0, # 2005 0.142*5/6 0.0975*5/6
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
# ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
# 0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
# 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
# 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0, 0, 0),
# nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
# phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
# phi3 = c(0.105360516, rep_len(0.025,8)),
# phi4 = c(0.105360516, rep_len(0.025,8)),
# phi5 = c(0.105360516, rep_len(0.025,8)),
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2002 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2002, 2008, 2011, 2015, 2016),
n_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_comm_2016 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_t_comm = c(1985, 2002, 2015, 2016),
n_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2002 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_t_noncomm = c(1985, 1998, 2002, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
dropout_rate_not_FSW = 0.025,
replaceDeaths = 0,
movement = 1,
ART_recruit_rate_rest = 0.25,
ART_recruit_rate_FSW = 0.25,
ART_reinit_rate_FSW = 0.2,
ART_reinit_rate_rest = 0.2
)
# ranges ------------------------------------------------------------------
ranges = rbind(
# rate_move_out_PrEP_FSW = c(1,2),
PrEPOnOff = c(1,1),
testing_prob_men_2006 = c(0.0975, 0.21),
testing_prob_men_2008 = c(0.1, 0.26),
testing_prob_men_2012 = c(0.058, 0.26), # NOTE 0.26 is from MICHEL 2008
testing_prob_women_2006 = c(0.142, 0.4),
testing_prob_women_2008 = c(0.21, 0.54),
testing_prob_women_2012 = c(0.331, 0.513),
ART_init_ratio_MF = c(1, 3),
infected_FSW_incoming = c(1,1),
n_y_noncomm_1998_GPF_GPM = c(34, 44),
n_y_noncomm_2011_GPF_GPM = c(29, 38),
prev_non_ben_fsw_1993 = c(0.027, 0.163),
# prev_non_ben_fsw_1993 = c(0.12, 0.20),
# prev_non_ben_fsw_2015 = c(0.03, 0.157),
prev_non_ben_fsw_2015 = c(0, 0.046),
# prev_non_ben_fsw_2015 = c(0.10, 0.157), # high
# prev_non_ben_fsw_2015 = c(0.03, 0.046),
# MISC
# init_clientN_from_PCR = c(0,0),
who_believe_comm = c(0, 1),
# # growth rates
# epsilon_1985 = c(0.08, 0.08),
# epsilon_1992 = c(0.08, 0.08),
# epsilon_2002 = c(0.06, 0.07),
# epsilon_2013 = c(0.04, 0.06),
# epsilon_2016 = c(0.04, 0.06),
epsilon_1985 = c(0.059, 0.059),
epsilon_1992 = c(0.048, 0.058),
epsilon_2002 = c(0.027, 0.027),
epsilon_2013 = c(0.027, 0.027),
epsilon_2016 = c(0.027, 0.027),
# DEMOGRAPHIC
fraction_F = c(0.512, 0.52), # fraction of population born female
# frac_women_ProFSW = c(0.0024, 0.0036), # fraction of women that are professional FSW
frac_women_ProFSW = c(0.0024, 0.00715), # fraction of women that are professional FSW
frac_women_LowFSW = c(1, 2), # relative abundance of low FSW relative to pro FSW
frac_men_client = c(0.066, 0.3), # fraction of men that are clients
frac_women_virgin = c(0.079, 0.2), # fraction of women that are virgins
frac_men_virgin = c(0.070, 0.17), # fraction of men that are virgins
# prev_init_FSW = c(0.0132, 0.1), # initial prevalence of FSW
prev_init_FSW = c(0.0132, 0.0659), # initial prevalence of FSW
prev_init_rest = c(0.000313, 0.00294), # initial prevalence of the other groups
muF = c(0.0187, 0.02), # female mortality
muM = c(0.0194, 0.022), # male mortality
# rate_leave_pro_FSW = c(0, 0.125),
rate_leave_pro_FSW = c(0, 0.33), # rate of exit of professional sex work
# rate_leave_low_FSW = c(0, 1), # rate of exit of low level sex work
fraction_FSW_foreign = c(0.5, 0.9),
# fraction_FSW_foreign = c(0.1, 0.5),
rate_leave_client = c(0, 0.295), # rate of exit of clients
# rate_leave_client = c(0, 0.2), # rate of exit of clients
rate_enter_sexual_pop_F = c(0.2, 0.5), # rate of entering sexual population women
rate_enter_sexual_pop_M = c(0.2, 0.5), # rate of entering sexual population men
fraction_sexually_active_15_F = c(0.119, 0.17), # fraction of 15 year old women sexually active
fraction_sexually_active_15_M = c(0.18, 0.35), # fraction of 15 year old men sexually active
# BEHAVIOURAL
# commercial partnerships
c_comm_1993_ProFSW = c(192, 1277),
c_comm_1995_ProFSW = c(192, 1277),
c_comm_2005_ProFSW = c(81, 562),
# c_comm_2015_ProFSW = c(71, 501),
c_comm_1993_LowFSW = c(26, 78),
c_comm_1998_Client = c(8.4, 32),
c_comm_2002_Client = c(11.1, 19.8),
# c_comm_2012_Client = c(11.8, 15),
# c_comm_2015_Client = c(14.5, 19.8),
#non commercial partnerships
c_noncomm_1985_ProFSW = c(0.31, 0.86),
c_noncomm_1985_LowFSW = c(0.41, 1.04),
c_noncomm_1985_Client = c(1.6, 3.3),
c_noncomm_1998_GPF = c(0.93, 0.99),
c_noncomm_2008_GPF = c(0.77, 0.82),
c_noncomm_1998_GPM = c(1.25, 1.43),
c_noncomm_2008_GPM = c(0.73, 0.84),
# sex acts per partnership comm
n_y_comm_1985_ProFSW_Client = c(1, 3.3),
# n_y_comm_1985_Client_ProFSW = c(1.45, 11.45),
# n_y_comm_1985_ProFSW_Client = c(1, 4),
# n_y_comm_2002_ProFSW_Client = c(1, 3),
n_y_comm_1985_LowFSW_Client = c(1, 1),
n_y_comm_1985_Client_LowFSW = c(1, 1),
# sex acts per partnership noncomm
n_y_noncomm_2002_ProFSW_Client = c(13, 20),
n_y_noncomm_2015_ProFSW_Client = c(38.2, 60),
# n_y_noncomm_1985_GPF_GPM = c(39, 100),
# n_y_noncomm_1985_GPM_GPF = c(19.4, 46.7),
#BETA
betaMtoF_baseline = c(0.0006, 0.00109), # baseline male to female transmission rate
RR_beta_FtM = c(0.53, 2), # RR for transmission female to male
# RR_beta_HSV2_comm_a = c(1.4, 2.1), # RR for commercial sex acts where the susceptible individual is infected HSV2
# RR_beta_HSV2_noncomm_a = c(2.2, 3.4), # RR for non commercial sex acts where the susceptible individual is infected HSV2
RR_beta_HSV2_a_FSW = c(0.9, 2.3),
RR_beta_HSV2_a_client = c(1.5, 2.2),
RR_beta_HSV2_a_GPF = c(1.8, 3.4),
RR_beta_HSV2_a_GPM = c(2.2, 4.3),
prev_HSV2_FSW = c(0.87, 0.94), # prevalence HSV2 in FSW
prev_HSV2_Client = c(0.18, 0.28), # prevalence HSV2 in clients
prev_HSV2_GPF = c(0.27, 0.32), # prevalence of HSV2 in GPF
prev_HSV2_GPM = c(0.098, 0.14), # prevalence of HSV2 in GPM
RR_beta_circum = c(0.34, 0.72), # RR for transmission if susceptible individual is circumcised
# Progression parameters
infect_acute = c(4.5, 18.8), # RR for transmission rate if infected is acute stage
infect_AIDS = c(4.5, 11.9), # RR for transmission rate if infected is in AIDS stage
ART_eff = c(0.96, 0.99), # infectiousness RR when on ART (efficacy ART assuimed 90% * % undetectable which is 52.3%)
viral_supp_y_1986_rest = c(0.424, 0.85),
viral_supp_y_2015_ProFSW = c(0.75, 0.85),
ec = c(0.58, 0.95), # condom efficacy
# eP1a = c(0.9, 0.9), # prep efficacy perfect adherence
# eP1b = c(0, 0.9), # prep efficacy intermediate adherence
# eP1c = c(0, 0), # prep efficacy poor adherence
SC_to_death = c(8.7, 12.3),
dur_primary_phase = c(0.25, 0.42),
dur_200_349 = c(2.3, 4.4),
dur_below_200 = c(0.58, 3.17),
alpha03 = c(0.01, 0.05),
alpha04 = c(0.03, 0.1),
ART_RR_prog = c(4.82, 10.23),
# intervention_testing_increase = c(1, 2),
# intervention_testing_increase = c(0.5, 2), # keep
intervention_testing_increase = c(0, 0),
RR_test_CD4200 = c(1, 5.4),
# ART_recruit_rate_FSW = c(0.5, 6),
# ART_recruit_rate_FSW = c(0.5, 1.5),
# ART_recruit_rate_FSW = c(0.5, 3),
ART_recruit_rate_FSW = c(0.25, 6),
# ART_recruit_rate_rest = c(0.5, 1.5),
# ART_recruit_rate_rest = c(0.5, 6),
ART_recruit_rate_rest = c(6, 12),
# intervention_ART_increase = c(0, 12),
# intervention_ART_increase = c(0, 24),
# intervention_ART_increase = c(0.5, 5), # keep
intervention_ART_increase = c(0, 0),
dropout_rate_not_FSW = c(0.0233, 0.11),
dropout_rate_FSW = c(0.0233, 0.11),
ART_reinit_rate_FSW = c(0.25, 1.5),
ART_reinit_rate_rest = c(0.25, 1.5),
# condoms
# fc_y_comm_1985_ProFSW_Client = c(0, 0),
# fc_y_comm_1985_ProFSW_Client = c(0.54, 0.69),
# fc_y_comm_1998_ProFSW_Client = c(0.54, 0.99),
fc_y_comm_1985_ProFSW_Client = c(0, 0.18),
fc_y_comm_1993_ProFSW_Client = c(0.18, 0.33),
fc_y_comm_1998_ProFSW_Client = c(0.4, 0.73),
fc_y_comm_2002_ProFSW_Client = c(0.61, 0.99),
fc_y_comm_2008_ProFSW_Client = c(0.86, 0.99),
fc_y_comm_1985_LowFSW_Client = 0,
fc_y_comm_2015_LowFSW_Client = c(0.25, 0.52),
fc_y_noncomm_1985_ProFSW_Client = 0,
fc_y_noncomm_2002_ProFSW_Client = c(0.19, 0.62),
fc_y_noncomm_1985_LowFSW_Client = 0,
fc_y_noncomm_2015_LowFSW_Client = c(0.138, 0.383),
# fc_y_noncomm_1985_GPF_GPM = 0,
fc_y_noncomm_1998_GPF_GPM = c(0.033, 0.05),
fc_y_noncomm_2011_GPF_GPM = c(0.16, 0.26)
)
# outputs -----------------------------------------------------------------
outputs = c("S0", "S1a", "S1b","HIV_positive_On_ART","prep_efficacious", "S1c", "S1d", "prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm", "ART_coverage_FSW", "ART_coverage_men", "ART_coverage_women", "ART_coverage_all", "rho", "n_comm", "n_noncomm", "fc_comm", "fc_noncomm", "N", "cumuHIVDeaths", "lambda_0", "lambda_1a", "lambda_1b", "lambda_1c", "lambda_1d", "HIV_positive")
CEA_outputs = unique(c(
"PrEP_reinit_OnOff_t",
"PrEP_reinit_OnOff_y",
"PrEP_reinit_OnOff",
"zeta_re",
"PrEPinitiations",
"testpar","pfFSW", "prop_FSW_I0_1", "prop_FSW_I0_2", "prop_FSW_I0_3", "prop_FSW_I0_4", "prop_FSW_I0_5","prev_non_ben_fsw_1993",
"prep_efficacious","prev_non_ben_fsw_2015",
"gamma32_without_supp",
"gamma33_without_supp",
"gamma34_without_supp",
"alpha33_without_supp",
"alpha34_without_supp",
"alpha35_without_supp",
"gamma32",
"gamma33",
"gamma34",
"alpha33",
"alpha34",
"alpha35",
"viral_supp", "new_acute_infected","pfFSW", "above_500_by_group", "FSW_eligible", "GP_eligible","eP1a_effective", "eP1b_effective", "eP1c_effective","mu","sigma", "prep_offered","TasPinitiations",
"prep_offered", "TasP_testing","cumu_PrEP_dropouts",
"cost_Initiation_of_ART_study_FSW",
"cost_Initiation_of_ART_government_FSW",
"cost_1_year_of_ART_study_FSW",
"cost_1_year_of_ART_government_FSW",
"cost_Initiation_ART_rest_of_population",
"cost_1_year_of_ART_rest_of_population",
"cost_FSW_initiation_ART_Patient_costs",
"cost_FSW_1_year_ART_Patient_costs",
"cost_Initiation_of_PrEP_study",
"cost_1_year_PrEP_perfect_adherence_study",
"cost_1_year_PrEP_intermediate_adherence_study",
"cost_1_year_PrEP_non_adherence_study",
"cost_Initiation_of_PrEP_government",
"cost_1_year_PrEP_perfect_adherence_government",
"cost_1_year_PrEP_intermediate_adherence_government",
"cost_1_year_PrEP_non_adherence_government",
"cost_PREP_initiation_Patient_costs",
"cost_PREP_1_year_ART_Patient_costs",
"W0", "W1", "W2", "W3", "Number_DALY_W1","Number_DALY_W2", "Number_DALY_W3", "FSW_On_PrEP_all_cats", "PrEPinitiations", "PrEPinitiations1a",
"PrEPinitiations1b", "PrEPinitiations1c", "pc_susceptible_FSW_On_PrEP", "pc_all_FSW_On_PrEP", "Number_Susceptibles",
"HIV_positive_On_ART", "HIV_positive_Diagnosed_Off_ART", "Primary_Off_ART",
"CD4_above_500_Off_ART", "CD4_350_500_Off_ART", "CD4_200_350_Off_ART", "CD4_below_200_Off_ART", "cumuDeaths_On_ART", "HIV_positive", "ec", "cumuARTinitiations","cumuARTREinitiations", "rate_leave_pro_FSW","tau_intervention",
"testing_prob", "tau", "N", "S0", "S1a", "S1b", "S1c", "S1d", "I01", "I11", "I02", "I03", "I04",
"I05", "I22", "I23", "I24", "I25", "I32", "I33", "I34", "I35", "I42", "I43", "I44", "I45", "prev",
"frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client",
"prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm", "ART_coverage_FSW",
"ART_coverage_men", "ART_coverage_women", "ART_coverage_all", "rho", "n_comm", "n_noncomm", "fc_comm",
"fc_noncomm", "N", "cumuHIVDeaths", "lambda_sum_0", "lambda_sum_1a", "lambda_sum_1b", "lambda_sum_1c",
"lambda_sum_1d", "S0", "S1a", "S1b", "S1c", "S1d", "OnPrEP1a", "OnPrEP1b",
"OnPrEP1c", "ART_eligible_CD4_above_500", "ART_eligible_CD4_350_500","ART_eligible_CD4_200_349","ART_eligible_CD4_below_200",
"cumuAllDeaths", "cumuHIVDeaths", "cumuARTinitiations", "cumuARTREinitiations",
"OnPrEP", "ART_sex_ratio", "pc_S1b", "pc_S1a", "pc_S1c", "cumuInf",
"intervention_ART_increase", "testing_prob", "rho_intervention",
"ART_eligible_CD4_above_500", "ART_eligible_CD4_350_500", "ART_eligible_CD4_200_349",
"ART_eligible_CD4_below_200", "new_people_in_group_FSW_only", "rate_move_out", "rate_move_in",
"FSW_out", "FSW_in", "zeta", "tau", "prep_offering_rate", "intervention_testing_increase", "sigma",
"PrEPOnOff", "prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW",
"prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced",
"who_believe_comm", "ART_coverage_FSW", "ART_coverage_men", "ART_coverage_women", "ART_coverage_all",
"rho", "n_comm", "n_noncomm", "fc_comm", "fc_noncomm", "N", "cumuHIVDeaths", "lambda_0", "lambda_1a",
"lambda_1b", "lambda_1c", "lambda_1d"))
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.084, 100*0.043),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
# 100*0.091838441, 100*0.026704897),
100*0.055700329, 100*0.024043597),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.120857355, 100*0.069311506))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
prev_points_extended_low = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.084, 100*0.043),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0, 100*0),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.120857355, 100*0.069311506))
prev_points_FSW_only = data.frame(time = c(1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015
),
variable = c(rep("Pro FSW", 8)
),
value = c(53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7
),
lower = c(48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71
),
upper = c(58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01))
prev_points_FSW_only_even_less_2 = prev_points_FSW_only[c(1, 4, 6, 8),]
prev_points_FSW_Cotonou_centrale_lower_bound = prev_points_FSW_only_even_less_2
prev_points_FSW_Cotonou_centrale_lower_bound[prev_points_FSW_Cotonou_centrale_lower_bound$time == 2015,"lower"] = 13.79
prev_points_FSW_Cotonou_centrale_lower_bound$x = c(195, 74, 122, 116)
prev_points_FSW_Cotonou_centrale_lower_bound$N = c(366, 190, 417, 620)
prev_points_FSW_Cotonou_centrale_lower_bound_mid_year = prev_points_FSW_Cotonou_centrale_lower_bound
prev_points_FSW_Cotonou_centrale_lower_bound_mid_year$time = prev_points_FSW_Cotonou_centrale_lower_bound_mid_year$time + 0.5
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
# frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male", "Low-level FSW"),
# min = c(0.001237599, 0.1509*(1-0.515666224), 0.07896475*0.515666224, 0.07039551*(1-0.515666224), 2*0.001237599),
# max = c(0.007374027, 0.40 * (1-0.515666224), 0.2*0.515666224, 0.17*(1-0.515666224), 5*0.007374027))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"),
min = c(0.001237599, 0.074*(1-0.515666224), 0.07896475*0.515666224, 0.07039551*(1-0.515666224), 0.0048*0.516, 1),
max = c(0.0143*0.515666224/2, 0.3 * (1-0.515666224), 0.2*0.515666224, 0.17*(1-0.515666224), 0.0143*0.516, 5))
frac_N_discard_points_no_FSW_LB = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"),
min = c(0, 0.074*(1-0.515666224), 0.07896475*0.515666224, 0.07039551*(1-0.515666224), 0.0048*0.516, 1),
max = c(0.0143*0.515666224/2, 0.3 * (1-0.515666224), 0.2*0.515666224, 0.17*(1-0.515666224), 0.0143*0.516, 5))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
# ART coverage data points ------------------------------------------------
ART_data_points = data.frame(time = c(2011, 2012, 2013, 2014, 2015, 2016, 2017,
2012, 2014, 2015, 2016, 2017
),
Lower = c(0.33, 0.42, 0.44, 0.39, 0.44, 0.51, 0.57,
0.09, 0.14, 0.2, 0.50, 0.56
),
Upper = c(0.52, 0.66, 0.69, 0.61, 0.69, 0.8, 0.8,
0.13, 0.2, 0.28, 0.7, 0.79
),
variable = c("All", "All", "All", "All", "All", "All", "All",
"Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
ART_data_points_extra = data.frame(time = c(2011, 2012, 2013, 2014, 2015, 2016, 2017,
2012, 2014, 2015, 2016, 2017, 2017.5
),
Lower = c(0.33, 0.42, 0.44, 0.39, 0.44, 0.51, 0.57,
0.08, 0.14, 0.2, 0.50, 0.56, 0.8
),
Upper = c(0.52, 0.66, 0.69, 0.61, 0.69, 0.8, 0.8,
0.11, 0.2, 0.28, 0.7, 0.79, 0.9
),
variable = c("All", "All", "All", "All", "All", "All", "All",
"Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
ART_data_points_FSW = ART_data_points[c(8, 9, 10, 11, 12),]
ART_data_points_FSW_last_2 = ART_data_points[c(11, 12),]
ART_data_points_first_and_last_FSW = ART_data_points[c(8, 12),]
# first and last GP, first FSW and 2016, 2017 FSW
ART_data_points_1611 = ART_data_points[c(1, 7, 8, 11, 12),]
# first and last GP, all fsw before intervention
ART_data_points_1911 = ART_data_points[c(1, 7, 8, 9, 10),]
# NUMBERS OF FSW ON ART
ART_data_points_with_numbers = data.frame(time = c(2011, 2017,
2012, 2014, 2015, 2016, 2017
),
Lower = c(0.33, 0.57,
27, 34, 42, 45, 62
),
Upper = c(0.52, 0.8,
37, 46, 56, 83, 107
),
variable = c("All", "All",
"Numbers FSW", "Numbers FSW", "Numbers FSW", "Numbers FSW", "Numbers FSW"))
# PrEP_fitting ------------------------------------------------
# PrEP_fitting = data.frame(time = c(2016, 2017, 2016, 2017, 2016, 2017),
# group = c("S1a", "S1a", "S1b", "S1b", "S1c", "S1c"),
# lower = c(50, 40, 50, 40, 50, 40),
# point = c(55, 45, 50, 40, 50, 40),
# upper = c(61, 66, 61, 66, 61, 66)
#
#
# )
#
# PrEP_fitting = data.frame(time = c(2016, 2017),
# group = c("S1a", "S1a"),
# lower = c(50, 40),
# point = c(55, 45),
# upper = c(61, 66)
#
#
# )
PrEP_fitting = NULL
#
#
# ART_data_points_FSW = data.frame(time = c(2010, 2013, 2014, 2015, 2016, 2017
# ),
# Lower = c(0.07, 0.13, 0.17, 0.50, 0.56, 0.80
#
# ),
# Upper = c(0.10, 0.18, 0.24, 0.7, 0.79, 0.9
#
# ),
# variable = c("Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
# ART_data_points_FSW_last_3 = data.frame(time = c(2015, 2016, 2017
# ),
# Lower = c(0.50, 0.56, 0.80
#
# ),
# Upper = c(0.7, 0.79, 0.9
#
# ),
# variable = c("Pro FSW", "Pro FSW", "Pro FSW"))
# ART_data_points_first_and_last = data.frame(time = c(2010, 2017
# ),
# Lower = c(0.07, 0.80
#
# ),
# Upper = c(0.10, 0.9
#
# ),
# variable = c("Pro FSW", "Pro FSW"))
# ART_data_points_all = data.frame(time = c(2010, 2011, 2012, 2013, 2014, 2015, 2016,
# 2010, 2011, 2012, 2013, 2014, 2015, 2016,
# 2010, 2011, 2012, 2013, 2014, 2015, 2016,
# 2010, 2013, 2014, 2015, 2016
# ),
# Lower = c(0.32, 0.4, 0.43, 0.38, 0.43, 0.49, 0.552,
# 0.32, 0.4, 0.43, 0.38, 0.43, 0.49, 0.552,
# 0.32, 0.4, 0.43, 0.38, 0.43, 0.49, 0.552,
# 7.5, 12.5, 17.4, 50.0, 56.1
#
# ),
# Upper = c(0.522449, 0.653061, 0.702041, 0.620408, 0.702041, 0.8, 0.8,
# 0.522449, 0.653061, 0.702041, 0.620408, 0.702041, 0.8, 0.8,
# 0.522449, 0.653061, 0.702041, 0.620408, 0.702041, 0.8, 0.8,
# 0.522449, 0.620408, 0.702041, 0.8, 0.8
#
# ),
# variable = c("Women", "Women", "Women", "Women", "Women", "Women", "Women",
# "Men", "Men", "Men", "Men", "Men", "Men", "Men",
# "All", "All", "All", "All", "All", "All", "All",
# "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
#####################################################
time_with_mid <- seq(epi_start, epi_end, length.out = (epi_end - epi_start + 0.5)*2)
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points,
# frac_N_discard_points = frac_N_discard_points_no_FSW_LB, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points, PrEP_fitting = PrEP_fitting)
# result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq,
# years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = CEA_outputs)
# result <- cotonou::just_parameters(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs)
#
# result
result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = seq(1986, 2035), ranges = ranges, outputs = CEA_outputs, prev_points = prev_points,
frac_N_discard_points = frac_N_discard_points_no_FSW_LB, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points, PrEP_fitting = PrEP_fitting)
# result[[3]] = result[[2]]
result[[3]][[1]]$zeta_re
result[[3]][[1]]$PrEP_reinit_OnOff
result[[3]][[1]]$PrEP_reinit_OnOff_t
result[[3]][[1]]$PrEP_reinit_OnOff_y
result[[3]][[1]]$PrEPinitiations
# test to explore the effect of incoming FSW prevalence into the model,
# and its interaction with the duration of sex work on the HIV incidence and prevalence of FSWs.
load("best_pars_combined.RData")
pars = result[[1]][[1]]
pars = modifyList(pars, best_pars_combined)
res_best_runs = cotonou::return_outputs(pars, cotonou::main_model, time = time, outputs = outputs, solving_method = "ode45")
res_best_runs = list(res_best_runs)
res_best_runs[[1]]$pfFSW
# ignore these ######################################
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N), function(x) (x[,1]/(x[,1] + x[,2] + x[,3] + x[,4] + x[,7])))), 2, cotonou::quantile_95)))
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N/x$frac_F), function(x) x[,1])), 2, cotonou::quantile_95)))
annual_client_volume_pro_FSW = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$c_comm[,1]}))))
colnames(annual_client_volume_pro_FSW) = c("time", as.character(seq(1, (length(annual_client_volume_pro_FSW[1,])-1))))
annual_client_volume_pro_FSW_melted = reshape2::melt(annual_client_volume_pro_FSW, id.vars = c("time"))
N_Pro_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1)])}))))
colnames(N_Pro_FSW) = c("time", as.character(seq(1, (length(N_Pro_FSW[1,])-1))))
N_Pro_FSW_melted = reshape2::melt(N_Pro_FSW, id.vars = c("time"))
colnames(N_Pro_FSW_melted) = c("time", "run", "value")
N_Low_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(2)])}))))
colnames(N_Low_FSW) = c("time", as.character(seq(1, (length(N_Low_FSW[1,])-1))))
N_Low_FSW_melted = reshape2::melt(N_Low_FSW, id.vars = c("time"))
colnames(N_Low_FSW_melted) = c("time", "run", "value")
N_Client = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5)])}))))
colnames(N_Client) = c("time", as.character(seq(1, (length(N_Client[1,])-1))))
N_Client_melted = reshape2::melt(N_Client, id.vars = c("time"))
colnames(N_Client_melted) = c("time", "run", "value")
Fraction_F = do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)) /
(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5, 6)])}), rowSums)) + do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)))
lambda_sum_0_ProFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,1]))))
lambda_sum_0_LowFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,2]))))
lambda_sum_0_GPF = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,3]))))
lambda_sum_0_FormerFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,4]))))
lambda_sum_0_Client = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,5]))))
lambda_sum_0_GPM = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,6]))))
lambda_sum_0_Virgin_Female = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,7]))))
lambda_sum_0_Virgin_Male = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,8]))))
lambda_sum_0_Former_FSW_Outside = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,9]))))
lambda_sum_0_indiv = rbind(lambda_sum_0_ProFSW, lambda_sum_0_LowFSW, lambda_sum_0_GPF,
lambda_sum_0_FormerFSW, lambda_sum_0_Client, lambda_sum_0_GPM)
lambda_sum_0_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"), each = length(time)), lambda_sum_0_indiv)
colnames(lambda_sum_0_indiv) = c("time", "variable", as.character(seq(1, length(lambda_sum_0_ProFSW[1,]))))
lambda_sum_0_indiv_melted = reshape2::melt(lambda_sum_0_indiv, id.vars = c("time", "variable"))
colnames(lambda_sum_0_indiv_melted) = c("time", "variable", "run", "value")
lambda_sum_0_indiv_melted$variable = factor(lambda_sum_0_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"))
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac_Active_FSW = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {100*(x$frac_N[,1] + x$frac_N[,2])})), 2, cotonou::quantile_95)))
Ratio_Low_Pro = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]})), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside, frac_Active_FSW, Ratio_Low_Pro)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"))
prev_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
prev_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)))
prev_LowFSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)))
prev_client_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)))
prev_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)))
prev_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)))
prev_indiv = rbind(prev_FSW_indiv, prev_LowFSW_indiv, prev_client_indiv, prev_women_indiv, prev_men_indiv)
prev_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)), prev_indiv)
colnames(prev_indiv) = c("time", "variable", as.character(seq(1, length(prev_FSW_indiv[1,]))))
prev_indiv_melted = reshape2::melt(prev_indiv, id.vars = c("time", "variable"))
colnames(prev_indiv_melted) = c("time", "variable", "run", "value")
prev_indiv_melted$variable = factor(prev_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
ART_coverage_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)), 2, cotonou::quantile_95))
ART_coverage_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)), 2, cotonou::quantile_95))
ART_coverage_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)), 2, cotonou::quantile_95))
ART_coverage_all = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)), 2, cotonou::quantile_95))
ART_coverage = rbind(ART_coverage_women, ART_coverage_men, ART_coverage_FSW, ART_coverage_all)
ART_coverage = data.frame(time, ART_coverage, rep(c("Women", "Men", "Pro FSW", "All"), each = length(time)))
colnames(ART_coverage) = c("time", "Lower", "Median", "Upper", "variable")
ART_coverage$variable = factor(ART_coverage$variable, levels = c("Pro FSW", "Women", "Men", "All"))
ART_coverage = ART_coverage[ART_coverage$variable == "All" | ART_coverage$variable == "Pro FSW",]
ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)))
ART_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)))
ART_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)))
ART_all_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)))
ART_indiv = rbind(ART_FSW_indiv, ART_all_indiv)
ART_indiv = data.frame(time, rep(c("Pro FSW", "All"), each = length(time)), ART_indiv)
colnames(ART_indiv) = c("time", "variable", as.character(seq(1, length(ART_FSW_indiv[1,]))))
ART_indiv_melted = reshape2::melt(ART_indiv, id.vars = c("time", "variable"))
colnames(ART_indiv_melted) = c("time", "variable", "run", "value")
ART_indiv_melted$variable = factor(ART_indiv_melted$variable, levels = c("Pro FSW", "All"))
# N of FSW on ART
N_ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$HIV_positive_On_ART[,1])))
N_ART_FSW_indiv = data.frame(time, rep(c("Pro FSW"), each = length(time)), N_ART_FSW_indiv)
colnames(N_ART_FSW_indiv) = c("time", "variable", as.character(seq(1, length(N_ART_FSW_indiv[1,])-2)))
N_ART_FSW_indiv_melted = reshape2::melt(N_ART_FSW_indiv, id.vars = c("time", "variable"))
colnames(N_ART_FSW_indiv_melted) = c("time", "variable", "run", "value")
# N on ART and N off ART diagnosed
Diagnosed_Off_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) x[,1]))))
Diagnosed_On_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) x[,1]))))
Diagnosed_Dropout_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) x[,1]))))
Diagnosed_FSW = data.frame(rbind(Diagnosed_Off_ART_FSW, Diagnosed_On_ART_FSW, Diagnosed_Dropout_ART_FSW),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_FSW) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_FSW[1,])-1))), "variable")
Diagnosed_FSW_melted = reshape2::melt(Diagnosed_FSW, id.vars = c("time", "variable"))
Diagnosed_FSW_melted$group = "FSW"
colnames(Diagnosed_FSW_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_On_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_Dropout_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_All = data.frame(rbind(Diagnosed_Off_ART_All, Diagnosed_On_ART_All, Diagnosed_Dropout_ART_All),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_All) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_All[1,])-1))), "variable")
Diagnosed_All_melted = reshape2::melt(Diagnosed_All, id.vars = c("time", "variable"))
Diagnosed_All_melted$group = "All"
colnames(Diagnosed_All_melted) = c("time", "variable", "run", "value", "group")
Diagnosed = rbind(Diagnosed_FSW_melted, Diagnosed_All_melted)
Diagnosed_Off_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_On_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Dropout_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Men = data.frame(rbind(Diagnosed_Off_ART_Men, Diagnosed_On_ART_Men, Diagnosed_Dropout_ART_Men),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Men) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Men[1,])-1))), "variable")
Diagnosed_Men_melted = reshape2::melt(Diagnosed_Men, id.vars = c("time", "variable"))
Diagnosed_Men_melted$group = "Men"
colnames(Diagnosed_Men_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_On_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Dropout_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Women = data.frame(rbind(Diagnosed_Off_ART_Women, Diagnosed_On_ART_Women, Diagnosed_Dropout_ART_Women),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Women) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Women[1,])-1))), "variable")
Diagnosed_Women_melted = reshape2::melt(Diagnosed_Women, id.vars = c("time", "variable"))
Diagnosed_Women_melted$group = "Women"
colnames(Diagnosed_Women_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Women_Men = rbind(Diagnosed_Women_melted, Diagnosed_Men_melted)
Diagnosed_Women_Men_ratio = data.frame(Diagnosed_Women_melted[,c("time", "variable", "run")],
value = Diagnosed_Women_melted$value/Diagnosed_Men_melted$value)
HIV_deaths = data.frame(time[-1], t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) x$cumuHIVDeaths), rowSums), diff) )))
colnames(HIV_deaths) = c("time", as.character(seq(1, (length(HIV_deaths[1,])-1))))
HIV_deaths_melted = reshape2::melt(HIV_deaths, id.vars = c("time"))
# fraction of groups in their genders -------------------------------------
pc_OfWomen_ProFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))
)))
pc_OfWomen_LowFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_Active_FSW = data.frame(time, t(100*(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) + do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_GPF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_FormerFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_Client = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfMen_GPM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfWomen_VF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_VM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
Ratio_Low_Pro = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]}))))
frac_by_gender = rbind(pc_OfWomen_ProFSW,
pc_OfWomen_LowFSW,
pc_OfWomen_GPF,
pc_OfWomen_FormerFSW,
pc_OfMen_Client,
pc_OfMen_GPM,
pc_OfWomen_VF,
pc_OfMen_VM,
pc_OfWomen_Active_FSW,
Ratio_Low_Pro
)
frac_by_gender = data.frame(frac_by_gender, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac_by_gender) = c("time",as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))), "variable")
frac_by_gender$variable = factor(frac_by_gender$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"))
frac_by_gender_melted = reshape2::melt(frac_by_gender, id.vars = c("time", "variable"))
colnames(frac_by_gender_melted) = c("time", "variable", "run", "value")
colnames(pc_OfWomen_ProFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))))
colnames(pc_OfWomen_LowFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_LowFSW[1,])-1))))
colnames(pc_OfWomen_Active_FSW) = c("time", as.character(seq(1, (length(pc_OfWomen_Active_FSW[1,])-1))))
colnames(pc_OfMen_Client) = c("time", as.character(seq(1, (length(pc_OfMen_Client[1,])-1))))
pc_OfWomen_ProFSW_melted = reshape2::melt(pc_OfWomen_ProFSW, id.vars = c("time"))
pc_OfWomen_LowFSW_melted = reshape2::melt(pc_OfWomen_LowFSW, id.vars = c("time"))
pc_OfWomen_Active_FSW_melted = reshape2::melt(pc_OfWomen_Active_FSW, id.vars = c("time"))
pc_OfMen_Client_melted = reshape2::melt(pc_OfMen_Client, id.vars = c("time"))
# condoms -----------------------------------------------------------------
condom_Pro_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,1,][,5]}))))
condom_Pro_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,1,][,5]}))))
condom_Pro_FSW = data.frame(time, rbind(condom_Pro_FSW_comm, condom_Pro_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Pro_FSW) = c("time", as.character(seq(1, (length(condom_Pro_FSW[1,])-2))), "variable")
condom_Pro_FSW_melted = reshape2::melt(condom_Pro_FSW, id.vars = c("time", "variable"))
colnames(condom_Pro_FSW_melted) = c("time", "variable", "run", "value")
condom_Low_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,2,][,5]}))))
condom_Low_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,2,][,5]}))))
condom_Low_FSW = data.frame(time, rbind(condom_Low_FSW_comm, condom_Low_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Low_FSW) = c("time", as.character(seq(1, (length(condom_Low_FSW[1,])-2))), "variable")
condom_Low_FSW_melted = reshape2::melt(condom_Low_FSW, id.vars = c("time", "variable"))
colnames(condom_Low_FSW_melted) = c("time", "variable", "run", "value")
condom_GPF_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,3,][,6]})))))
colnames(condom_GPF_noncomm) = c("time", as.character(seq(1, (length(condom_GPF_noncomm[1,])-1))))
condom_GPF_noncomm_melted = reshape2::melt(condom_GPF_noncomm, id.vars = c("time"))
condom_GPM_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,6,][,3]})))))
colnames(condom_GPM_noncomm) = c("time", as.character(seq(1, (length(condom_GPM_noncomm[1,])-1))))
condom_GPM_noncomm_melted = reshape2::melt(condom_GPM_noncomm, id.vars = c("time"))
# testing -----------------------------------------------------------------
testing_rate_ratio_F_M = data.frame(time, t((do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(3)])}))/do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(6)])})))))
colnames(testing_rate_ratio_F_M) = c("time", as.character(seq(1, (length(testing_rate_ratio_F_M[1,])-1))))
testing_rate_ratio_F_M_melted = reshape2::melt(testing_rate_ratio_F_M, id.vars = c("time"))
colnames(testing_rate_ratio_F_M_melted) = c("time", "run", "value")
Diagnosed_Women_Men_ratio_On_ART = Diagnosed_Women_Men_ratio[Diagnosed_Women_Men_ratio$variable == "Diagnosed On ART",]
testing_rate_ratio_F_M_Women_Men_ratio_On_ART = data.frame(x=testing_rate_ratio_F_M_melted$value, y=Diagnosed_Women_Men_ratio_On_ART$value)
ggplot() + geom_point(data = testing_rate_ratio_F_M_Women_Men_ratio_On_ART,
aes(x = x, y= y)) + theme_bw() + labs(x = "Probability of being tested in last year and knows the result ratio F:M",
y = "Ratio of F:M on ART")
# OUTCOMES ----------------------------------------------------------------
# next script
###
# res_best_runs
frac_N_discard_points_graph = frac_N_discard_points
frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio", c(2,3)] = frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio",c(2,3)]/100
#####################################################
prev_axes = data.frame(variable = c(rep("Pro FSW", 2),
rep("Clients", 2),
rep("Women", 2),
rep("Men", 2),
rep("Low-level FSW", 2)),
time = c(rep(c(1986, 2025), 5)),
value = c(0, 70, 0, 70, 0, 15, 0, 15, 0, 70)
)
prev_points_80s = prev_points_all[c(1,2,3),]
prev_points[prev_points$time == "2015", "lower"][1] = 13.79
# plot prevalence in each group indiv runs
g1=ggplot() + geom_line(data = prev_indiv_melted, aes(x = time, y = value, factor = variable, factor = run), alpha = 0.3) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
geom_point(data = prev_points_80s, aes(x = time, y = value), colour = "red")+
geom_blank(data = prev_axes, aes(x = time, y = value))+
theme(text = element_text(size=20))
g1
require(ggplot2)
prop_each_inf = lapply(res_best_runs, function(x) {
# list(x$I01[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I02[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I03[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I04[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I05[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]))
list(
(x$I01[,1] + x$I11[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I02[,1] + x$I22[,1] + x$I32[,1] + x$I42[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I03[,1] + x$I23[,1] + x$I33[,1] + x$I43[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I04[,1] + x$I24[,1] + x$I34[,1] + x$I44[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I05[,1] + x$I25[,1] + x$I35[,1] + x$I45[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1])
)
}
)
prop_each_inf = data.frame(time, do.call(rbind, lapply(prop_each_inf, function(x) {
t(do.call(rbind, x))
})), rep(1:length(res_best_runs), each = length(res_best_runs[[1]]$S0[,1])))
colnames(prop_each_inf) = c("time", c("Primary", "CD4 > 500", "CD4 350 - 500", "CD4 200 - 349", "CD4 < 200"), "run")
prop_each_inf_melted = reshape2::melt(prop_each_inf, id.vars = c("time", "run"))
ggplot(prop_each_inf_melted) + geom_line(aes(x = time, y = value, colour = variable, factor = as.character(run)), size = I(01.5)) + theme_bw() +
scale_colour_manual(values = c("#e41a1c", "#377eb8", "#4daf4a", "#984ea3", "#ff7f00")) +
geom_hline(yintercept = 0.031904762, col = "#e41a1c")+
geom_hline(yintercept = 0.235238095, col = "#377eb8")+
geom_hline(yintercept = 0.235238095, col = "#4daf4a")+
geom_hline(yintercept = 0.319047619, col = "#984ea3")+
geom_hline(yintercept = 0.178571429, col = "#ff7f00") + labs(y = "proportion in each stage of infection")
# varying!
# pars$pfFSW_y[2,1] <- 0.027
# pars$rate_leave_pro_FSW
# # pars$prev_non_ben_fsw_1993
# # pars$prev_non_ben_fsw_2015
#
# res_best_runs = cotonou::return_outputs(pars, cotonou::main_model, time = time, outputs = CEA_outputs)
#
# res_best_runs = list(res_best_runs)
pars = pars_keep
new_values = rbind(
rate_leave_pro_FSW = c(0.33, 0.33),
prev_non_ben_fsw_1993 = c(0.163, 0.163),
prev_non_ben_fsw_2015= c(0.034, 0.034),
fraction_FSW_foreign = c(0.9, 0.9)
)
x = pars
x = lapply(x[rownames(ranges)], function(y) {
if(length(y) == 9)
y = y[1] else y
})
x = x[-which(names(x) %in% rownames(new_values))]
combined_ranges = cbind(unlist(x[rownames(ranges)]), unlist(x[rownames(ranges)]))
combined_ranges = rbind(combined_ranges, new_values)
res_after_prep = cotonou::run_model(number_simulations = 1, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set,
time = time,
ranges = combined_ranges, outputs = CEA_outputs)[[2]]
median(unlist(lapply(res_after_prep, function(x) x$prev[which(time == 1993),1])))
median(unlist(lapply(res_after_prep, function(x) x$prev[which(time == 2015),1])))
median(unlist(lapply(res_after_prep, function(x) x$lambda_sum_0[which(time == 1993),1])))*100
median(unlist(lapply(res_after_prep, function(x) x$lambda_sum_0[which(time == 2015),1])))*100
res_after_prep[[1]]$pfFSW[which(time == 1993),1]
#
# ignore these ######################################
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N), function(x) (x[,1]/(x[,1] + x[,2] + x[,3] + x[,4] + x[,7])))), 2, cotonou::quantile_95)))
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N/x$frac_F), function(x) x[,1])), 2, cotonou::quantile_95)))
annual_client_volume_pro_FSW = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$c_comm[,1]}))))
colnames(annual_client_volume_pro_FSW) = c("time", as.character(seq(1, (length(annual_client_volume_pro_FSW[1,])-1))))
annual_client_volume_pro_FSW_melted = reshape2::melt(annual_client_volume_pro_FSW, id.vars = c("time"))
N_Pro_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1)])}))))
colnames(N_Pro_FSW) = c("time", as.character(seq(1, (length(N_Pro_FSW[1,])-1))))
N_Pro_FSW_melted = reshape2::melt(N_Pro_FSW, id.vars = c("time"))
colnames(N_Pro_FSW_melted) = c("time", "run", "value")
N_Low_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(2)])}))))
colnames(N_Low_FSW) = c("time", as.character(seq(1, (length(N_Low_FSW[1,])-1))))
N_Low_FSW_melted = reshape2::melt(N_Low_FSW, id.vars = c("time"))
colnames(N_Low_FSW_melted) = c("time", "run", "value")
N_Client = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5)])}))))
colnames(N_Client) = c("time", as.character(seq(1, (length(N_Client[1,])-1))))
N_Client_melted = reshape2::melt(N_Client, id.vars = c("time"))
colnames(N_Client_melted) = c("time", "run", "value")
Fraction_F = do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)) /
(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5, 6)])}), rowSums)) + do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)))
lambda_sum_0_ProFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,1]))))
lambda_sum_0_LowFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,2]))))
lambda_sum_0_GPF = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,3]))))
lambda_sum_0_FormerFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,4]))))
lambda_sum_0_Client = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,5]))))
lambda_sum_0_GPM = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,6]))))
lambda_sum_0_Virgin_Female = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,7]))))
lambda_sum_0_Virgin_Male = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,8]))))
lambda_sum_0_Former_FSW_Outside = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,9]))))
lambda_sum_0_indiv = rbind(lambda_sum_0_ProFSW, lambda_sum_0_LowFSW, lambda_sum_0_GPF,
lambda_sum_0_FormerFSW, lambda_sum_0_Client, lambda_sum_0_GPM)
lambda_sum_0_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"), each = length(time)), lambda_sum_0_indiv)
colnames(lambda_sum_0_indiv) = c("time", "variable", as.character(seq(1, length(lambda_sum_0_ProFSW[1,]))))
lambda_sum_0_indiv_melted = reshape2::melt(lambda_sum_0_indiv, id.vars = c("time", "variable"))
colnames(lambda_sum_0_indiv_melted) = c("time", "variable", "run", "value")
lambda_sum_0_indiv_melted$variable = factor(lambda_sum_0_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"))
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac_Active_FSW = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {100*(x$frac_N[,1] + x$frac_N[,2])})), 2, cotonou::quantile_95)))
Ratio_Low_Pro = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]})), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside, frac_Active_FSW, Ratio_Low_Pro)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"))
prev_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
prev_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)))
prev_LowFSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)))
prev_client_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)))
prev_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)))
prev_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)))
prev_indiv = rbind(prev_FSW_indiv, prev_LowFSW_indiv, prev_client_indiv, prev_women_indiv, prev_men_indiv)
prev_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)), prev_indiv)
colnames(prev_indiv) = c("time", "variable", as.character(seq(1, length(prev_FSW_indiv[1,]))))
prev_indiv_melted = reshape2::melt(prev_indiv, id.vars = c("time", "variable"))
colnames(prev_indiv_melted) = c("time", "variable", "run", "value")
prev_indiv_melted$variable = factor(prev_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
ART_coverage_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)), 2, cotonou::quantile_95))
ART_coverage_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)), 2, cotonou::quantile_95))
ART_coverage_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)), 2, cotonou::quantile_95))
ART_coverage_all = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)), 2, cotonou::quantile_95))
ART_coverage = rbind(ART_coverage_women, ART_coverage_men, ART_coverage_FSW, ART_coverage_all)
ART_coverage = data.frame(time, ART_coverage, rep(c("Women", "Men", "Pro FSW", "All"), each = length(time)))
colnames(ART_coverage) = c("time", "Lower", "Median", "Upper", "variable")
ART_coverage$variable = factor(ART_coverage$variable, levels = c("Pro FSW", "Women", "Men", "All"))
ART_coverage = ART_coverage[ART_coverage$variable == "All" | ART_coverage$variable == "Pro FSW",]
ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)))
ART_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)))
ART_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)))
ART_all_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)))
ART_indiv = rbind(ART_FSW_indiv, ART_all_indiv)
ART_indiv = data.frame(time, rep(c("Pro FSW", "All"), each = length(time)), ART_indiv)
colnames(ART_indiv) = c("time", "variable", as.character(seq(1, length(ART_FSW_indiv[1,]))))
ART_indiv_melted = reshape2::melt(ART_indiv, id.vars = c("time", "variable"))
colnames(ART_indiv_melted) = c("time", "variable", "run", "value")
ART_indiv_melted$variable = factor(ART_indiv_melted$variable, levels = c("Pro FSW", "All"))
# N of FSW on ART
N_ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$HIV_positive_On_ART[,1])))
N_ART_FSW_indiv = data.frame(time, rep(c("Pro FSW"), each = length(time)), N_ART_FSW_indiv)
colnames(N_ART_FSW_indiv) = c("time", "variable", as.character(seq(1, length(N_ART_FSW_indiv[1,])-2)))
N_ART_FSW_indiv_melted = reshape2::melt(N_ART_FSW_indiv, id.vars = c("time", "variable"))
colnames(N_ART_FSW_indiv_melted) = c("time", "variable", "run", "value")
# N on ART and N off ART diagnosed
Diagnosed_Off_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) x[,1]))))
Diagnosed_On_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) x[,1]))))
Diagnosed_Dropout_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) x[,1]))))
Diagnosed_FSW = data.frame(rbind(Diagnosed_Off_ART_FSW, Diagnosed_On_ART_FSW, Diagnosed_Dropout_ART_FSW),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_FSW) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_FSW[1,])-1))), "variable")
Diagnosed_FSW_melted = reshape2::melt(Diagnosed_FSW, id.vars = c("time", "variable"))
Diagnosed_FSW_melted$group = "FSW"
colnames(Diagnosed_FSW_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_On_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_Dropout_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_All = data.frame(rbind(Diagnosed_Off_ART_All, Diagnosed_On_ART_All, Diagnosed_Dropout_ART_All),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_All) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_All[1,])-1))), "variable")
Diagnosed_All_melted = reshape2::melt(Diagnosed_All, id.vars = c("time", "variable"))
Diagnosed_All_melted$group = "All"
colnames(Diagnosed_All_melted) = c("time", "variable", "run", "value", "group")
Diagnosed = rbind(Diagnosed_FSW_melted, Diagnosed_All_melted)
Diagnosed_Off_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_On_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Dropout_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Men = data.frame(rbind(Diagnosed_Off_ART_Men, Diagnosed_On_ART_Men, Diagnosed_Dropout_ART_Men),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Men) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Men[1,])-1))), "variable")
Diagnosed_Men_melted = reshape2::melt(Diagnosed_Men, id.vars = c("time", "variable"))
Diagnosed_Men_melted$group = "Men"
colnames(Diagnosed_Men_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_On_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Dropout_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Women = data.frame(rbind(Diagnosed_Off_ART_Women, Diagnosed_On_ART_Women, Diagnosed_Dropout_ART_Women),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Women) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Women[1,])-1))), "variable")
Diagnosed_Women_melted = reshape2::melt(Diagnosed_Women, id.vars = c("time", "variable"))
Diagnosed_Women_melted$group = "Women"
colnames(Diagnosed_Women_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Women_Men = rbind(Diagnosed_Women_melted, Diagnosed_Men_melted)
Diagnosed_Women_Men_ratio = data.frame(Diagnosed_Women_melted[,c("time", "variable", "run")],
value = Diagnosed_Women_melted$value/Diagnosed_Men_melted$value)
HIV_deaths = data.frame(time[-1], t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) x$cumuHIVDeaths), rowSums), diff) )))
colnames(HIV_deaths) = c("time", as.character(seq(1, (length(HIV_deaths[1,])-1))))
HIV_deaths_melted = reshape2::melt(HIV_deaths, id.vars = c("time"))
# fraction of groups in their genders -------------------------------------
pc_OfWomen_ProFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))
)))
pc_OfWomen_LowFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_Active_FSW = data.frame(time, t(100*(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) + do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_GPF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_FormerFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_Client = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfMen_GPM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfWomen_VF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_VM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
Ratio_Low_Pro = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]}))))
frac_by_gender = rbind(pc_OfWomen_ProFSW,
pc_OfWomen_LowFSW,
pc_OfWomen_GPF,
pc_OfWomen_FormerFSW,
pc_OfMen_Client,
pc_OfMen_GPM,
pc_OfWomen_VF,
pc_OfMen_VM,
pc_OfWomen_Active_FSW,
Ratio_Low_Pro
)
frac_by_gender = data.frame(frac_by_gender, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac_by_gender) = c("time",as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))), "variable")
frac_by_gender$variable = factor(frac_by_gender$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"))
frac_by_gender_melted = reshape2::melt(frac_by_gender, id.vars = c("time", "variable"))
colnames(frac_by_gender_melted) = c("time", "variable", "run", "value")
colnames(pc_OfWomen_ProFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))))
colnames(pc_OfWomen_LowFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_LowFSW[1,])-1))))
colnames(pc_OfWomen_Active_FSW) = c("time", as.character(seq(1, (length(pc_OfWomen_Active_FSW[1,])-1))))
colnames(pc_OfMen_Client) = c("time", as.character(seq(1, (length(pc_OfMen_Client[1,])-1))))
pc_OfWomen_ProFSW_melted = reshape2::melt(pc_OfWomen_ProFSW, id.vars = c("time"))
pc_OfWomen_LowFSW_melted = reshape2::melt(pc_OfWomen_LowFSW, id.vars = c("time"))
pc_OfWomen_Active_FSW_melted = reshape2::melt(pc_OfWomen_Active_FSW, id.vars = c("time"))
pc_OfMen_Client_melted = reshape2::melt(pc_OfMen_Client, id.vars = c("time"))
# condoms -----------------------------------------------------------------
condom_Pro_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,1,][,5]}))))
condom_Pro_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,1,][,5]}))))
condom_Pro_FSW = data.frame(time, rbind(condom_Pro_FSW_comm, condom_Pro_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Pro_FSW) = c("time", as.character(seq(1, (length(condom_Pro_FSW[1,])-2))), "variable")
condom_Pro_FSW_melted = reshape2::melt(condom_Pro_FSW, id.vars = c("time", "variable"))
colnames(condom_Pro_FSW_melted) = c("time", "variable", "run", "value")
condom_Low_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,2,][,5]}))))
condom_Low_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,2,][,5]}))))
condom_Low_FSW = data.frame(time, rbind(condom_Low_FSW_comm, condom_Low_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Low_FSW) = c("time", as.character(seq(1, (length(condom_Low_FSW[1,])-2))), "variable")
condom_Low_FSW_melted = reshape2::melt(condom_Low_FSW, id.vars = c("time", "variable"))
colnames(condom_Low_FSW_melted) = c("time", "variable", "run", "value")
condom_GPF_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,3,][,6]})))))
colnames(condom_GPF_noncomm) = c("time", as.character(seq(1, (length(condom_GPF_noncomm[1,])-1))))
condom_GPF_noncomm_melted = reshape2::melt(condom_GPF_noncomm, id.vars = c("time"))
condom_GPM_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,6,][,3]})))))
colnames(condom_GPM_noncomm) = c("time", as.character(seq(1, (length(condom_GPM_noncomm[1,])-1))))
condom_GPM_noncomm_melted = reshape2::melt(condom_GPM_noncomm, id.vars = c("time"))
# testing -----------------------------------------------------------------
testing_rate_ratio_F_M = data.frame(time, t((do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(3)])}))/do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(6)])})))))
colnames(testing_rate_ratio_F_M) = c("time", as.character(seq(1, (length(testing_rate_ratio_F_M[1,])-1))))
testing_rate_ratio_F_M_melted = reshape2::melt(testing_rate_ratio_F_M, id.vars = c("time"))
colnames(testing_rate_ratio_F_M_melted) = c("time", "run", "value")
Diagnosed_Women_Men_ratio_On_ART = Diagnosed_Women_Men_ratio[Diagnosed_Women_Men_ratio$variable == "Diagnosed On ART",]
testing_rate_ratio_F_M_Women_Men_ratio_On_ART = data.frame(x=testing_rate_ratio_F_M_melted$value, y=Diagnosed_Women_Men_ratio_On_ART$value)
ggplot() + geom_point(data = testing_rate_ratio_F_M_Women_Men_ratio_On_ART,
aes(x = x, y= y)) + theme_bw() + labs(x = "Probability of being tested in last year and knows the result ratio F:M",
y = "Ratio of F:M on ART")
# OUTCOMES ----------------------------------------------------------------
# next script
###
# res_best_runs
frac_N_discard_points_graph = frac_N_discard_points
frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio", c(2,3)] = frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio",c(2,3)]/100
#####################################################
# when is the peak?
lapply(result[[3]], function(x) {
time_with_mid[which(x$prev[,1] == max(x$prev[,1]))]
})
result[[3]][[1]]$new_acute_infected
them <-unlist( lapply(result[[3]], function(x)
{
if(x$prev[which(time == 1993),1] < 59 && x$prev[which(time == 1993),1] > 48 &&
x$prev[which(time == 2008),1] < 34 && x$prev[which(time == 2015),1] > 15.7100000 &&
x$prev[which(time == 2015),1] < 22.010000 &&
x$prev[which(time == 2002),1] < 50 &&
x$prev[which(time == 1998),3] < 4.772625)
x = 1 else x = 0
}))
result[[3]] <- result[[3]][them == 1]
FOI2012 <- median(unlist(lapply(result[[3]], function(x) x$lambda_sum_0[which(time == 2012),1])))
FOI2012
condom_Pro_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,1,][,5]}))))
condom_Pro_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,1,][,5]}))))
condom_Pro_FSW = data.frame(time, rbind(condom_Pro_FSW_comm, condom_Pro_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Pro_FSW) = c("time", as.character(seq(1, (length(condom_Pro_FSW[1,])-2))), "variable")
condom_Pro_FSW_melted = reshape2::melt(condom_Pro_FSW, id.vars = c("time", "variable"))
colnames(condom_Pro_FSW_melted) = c("time", "variable", "run", "value")
condom_Low_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,2,][,5]}))))
condom_Low_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,2,][,5]}))))
condom_Low_FSW = data.frame(time, rbind(condom_Low_FSW_comm, condom_Low_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Low_FSW) = c("time", as.character(seq(1, (length(condom_Low_FSW[1,])-2))), "variable")
condom_Low_FSW_melted = reshape2::melt(condom_Low_FSW, id.vars = c("time", "variable"))
colnames(condom_Low_FSW_melted) = c("time", "variable", "run", "value")
condom_GPF_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,3,][,6]})))))
colnames(condom_GPF_noncomm) = c("time", as.character(seq(1, (length(condom_GPF_noncomm[1,])-1))))
condom_GPF_noncomm_melted = reshape2::melt(condom_GPF_noncomm, id.vars = c("time"))
condom_GPM_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,6,][,3]})))))
colnames(condom_GPM_noncomm) = c("time", as.character(seq(1, (length(condom_GPM_noncomm[1,])-1))))
condom_GPM_noncomm_melted = reshape2::melt(condom_GPM_noncomm, id.vars = c("time"))
ggplot() + geom_line(data = condom_Pro_FSW_melted, aes(x = time, y = value, colour = variable, factor = run), alpha = 1) +
theme_bw() + labs(y = "Condom use of Pro FSW")
ggplot() + geom_line(data = condom_Low_FSW_melted, aes(x = time, y = value, colour = variable, factor = run), alpha = 1) +
theme_bw() + labs(y = "Condom use of Low level FSW")
ggplot() + geom_line(data = condom_GPF_noncomm_melted, aes(x = time, y = value, factor = variable), alpha = 1) +
theme_bw() + labs(y = "Condom use of GPF")
# ggplot() + geom_line(data = condom_GPM_noncomm_melted, aes(x = time, y = value, factor = variable), alpha = 1) +
# theme_bw() + labs(y = "Condom use of GPM")
# lapply(result[[2]], function(x) x$HIV_positive_On_ART[which(time == 2014),1])
#
# result[[3]][[1]]$S1a[32,]
#
# 22.6518633 - 55
# 22.6622749 - 45
# result[[3]] = result[[2]]
#
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = CEA_outputs,
# prev_points = prev_points_FSW_only_even_less_2,
# frac_N_discard_points = frac_N_discard_points_no_FSW_LB, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points_with_numbers, PrEP_fitting = PrEP_fitting)
#
# #
#
#
#
#
#
# result[[5]]
#
# length(result[[3]])
#
# result[[2]]
#
# result[[6]]
#
# (250-(6.628875e+01 + 8.712746e+01))^2
#
#
# result[[3]][[1]]
#
#
#
#
#
#
# data.frame(time, result[[2]][[1]]$OnPrEP1c)
#
#
# data.frame(time, result[[2]][[1]]$ART_eligible_CD4_below_200)
#
#
# result[[2]][[1]]$cumuHIVDeaths
#
#
#
#
#
#
#
#
#
# # test ranges
# frac_N_discard_points_test = data.frame(variable = c("Pro FSW"),
# min = c(0),
# max = c(1))
# ART_data_points_test = data.frame(time = c(2014),
# Lower = c(0),
# Upper = c(1),
# variable = c("Pro FSW"))
# prev_points_test = data.frame(time = c(2015),
# variable = c(rep("Pro FSW", 1)),
# value = c(0),
# lower = c(0),
#
# upper = c(1))
#
# Ntot_data_points_test = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
# point = c(10, 10, 10, 10, 10),
# lower = c(10, 10, 10, 10, 10),
# upper = c(10000000000, 10000000000, 10000000000, 10000000000, 10000000000),
# colour = c("data", "data", "data", "predicted", "predicted"))
#
#
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs,
# prev_points = prev_points_FSW_only_even_less_2, frac_N_discard_points = frac_N_discard_points_no_FSW_LB,
# Ntot_data_points = Ntot_data_points, ART_data_points = NULL, PrEP_fitting = PrEP_fitting)
#
# tafter = Sys.time()
# tafter-tbefore
#
#
# result[[1]]
#
#
# likelihood_list = lapply(res, cotonou::likelihood_rough, time = time, prev_points = prev_points_test, frac_N_discard_points = frac_N_discard_points_test, Ntot_data_points = Ntot_data_points_test, ART_data_points = ART_data_points_test)
#
# likelihood_list
#
#
#
# result = run_model_for_tests(parameters = result[[2]], number_simulations = 1, time = time)
#
#
#
#
# result[[3]] <- result[[2]]
#
#
# lapply(result[[1]], function(x) x$delete)
#
#
# lapply(result[[2]], function(x) x$c_comm_balanced)
# result[[2]][[3]]$frac_N
#
#
# mean(unlist(lapply(result[[2]], function(x) mean(x$c_comm_balanced[,5]))))
#
#
# result[[3]][[1]]$n_comm[4,,]
# result[[3]][[1]]$n_noncomm[12,,]
#
# result[[3]][[1]]$fc_comm[23,,]
# result[[3]][[1]]$fc_noncomm[23,,]
# with fit best runs
# unlist(lapply(result[[2]], function(x) x[[1]]))
#
# # removing those with too high betas
# beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
# result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1])
# unlist(result[[3]])
# ignore these ######################################
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac_Active_FSW = data.frame(time, t(apply(do.call(rbind, lapply(result[[3]], function(x) {100*(x$frac_N[,1] + x$frac_N[,2])})), 2, cotonou::quantile_95)))
Ratio_Low_Pro = data.frame(time, t(apply(do.call(rbind, lapply(result[[3]], function(x) {x$frac_N[,2]/ x$frac_N[,1]})), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside, frac_Active_FSW, Ratio_Low_Pro)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"))
prev_FSW = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
prev_FSW_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_FSW)))
prev_LowFSW_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_LowFSW)))
prev_client_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_client)))
prev_women_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_women)))
prev_men_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_men)))
prev_indiv = rbind(prev_FSW_indiv, prev_LowFSW_indiv, prev_client_indiv, prev_women_indiv, prev_men_indiv)
prev_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)), prev_indiv)
colnames(prev_indiv) = c("time", "variable", as.character(seq(1, length(prev_FSW_indiv[1,]))))
prev_indiv_melted = reshape2::melt(prev_indiv, id.vars = c("time", "variable"))
colnames(prev_indiv_melted) = c("time", "variable", "run", "value")
prev_indiv_melted$variable = factor(prev_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(result[[3]], function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
ART_coverage_women = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_women)), 2, cotonou::quantile_95))
ART_coverage_men = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_men)), 2, cotonou::quantile_95))
ART_coverage_FSW = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_FSW)), 2, cotonou::quantile_95))
ART_coverage_all = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_all)), 2, cotonou::quantile_95))
ART_coverage = rbind(ART_coverage_women, ART_coverage_men, ART_coverage_FSW, ART_coverage_all)
ART_coverage = data.frame(time, ART_coverage, rep(c("Women", "Men", "Pro FSW", "All"), each = length(time)))
colnames(ART_coverage) = c("time", "Lower", "Median", "Upper", "variable")
ART_coverage$variable = factor(ART_coverage$variable, levels = c("Pro FSW", "Women", "Men", "All"))
ART_coverage = ART_coverage[ART_coverage$variable == "All" | ART_coverage$variable == "Pro FSW",]
ART_FSW_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_FSW)))
ART_women_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_women)))
ART_men_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_men)))
ART_all_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_all)))
ART_indiv = rbind(ART_FSW_indiv, ART_all_indiv)
ART_indiv = data.frame(time, rep(c("Pro FSW", "All"), each = length(time)), ART_indiv)
colnames(ART_indiv) = c("time", "variable", as.character(seq(1, length(ART_FSW_indiv[1,]))))
ART_indiv_melted = reshape2::melt(ART_indiv, id.vars = c("time", "variable"))
colnames(ART_indiv_melted) = c("time", "variable", "run", "value")
ART_indiv_melted$variable = factor(ART_indiv_melted$variable, levels = c("Pro FSW", "All"))
frac_N_discard_points_graph = frac_N_discard_points
frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio", c(2,3)] = frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio",c(2,3)]/100
#####################################################
require(ggplot2)
# plot fraction in each group
# ggplot(frac) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
# theme_bw() + labs(y = "Percent in each group (%)") + facet_wrap(~variable, scales = "free") +
# geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15) +
# geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*min), size = I(0.5), color = "red", linetype = 1, alpha = 0.7) +
# geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*max), size = I(0.5), color = "red", linetype = 1, alpha = 0.7)
#
#
#
# # plot prevalence in each group
# ggplot(prev) + geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
# geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))
#
# # plot total population size
# ggplot(Ntot) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
# theme_bw() + labs(y = "Total population size of Grand Cotonou") +
# geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15) + geom_errorbar(data = Ntot_data_points, aes(x = time, ymax = upper, ymin = lower, color = colour), width = 2)
#
# # # plot ART_coverage in each group
# # ggplot(ART_coverage) + geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() +
# # facet_wrap(~variable) + labs(y = "ART coverage ") +
# # geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper), colour = "darkred")
#
# # # plot ART_coverage in all
# ggplot(ART_coverage) +
# geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() +
# facet_wrap(~variable) + labs(y = "ART coverage ") +
# geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper), colour = "darkred")
require(ggplot2)
# plot fraction in each group
ggplot(frac) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Percent in each group (%)") + facet_wrap(~variable, scales = "free") +
geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15) +
geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*min), size = I(0.5), color = "red", linetype = 1, alpha = 0.7) +
geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*max), size = I(0.5), color = "red", linetype = 1, alpha = 0.7)
prev_axes = data.frame(variable = c(rep("Pro FSW", 2),
rep("Clients", 2),
rep("Women", 2),
rep("Men", 2),
rep("Low-level FSW", 2)),
time = c(rep(c(1986, 2025), 5)),
value = c(0, 70, 0, 70, 0, 15, 0, 15, 0, 70)
)
prev_points_80s = prev_points_all[c(1,2,3),]
# plot prevalence in each group
ggplot() + geom_line(data = prev, aes(x = time, y = Median))+ geom_ribbon(data = prev, aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper)) +
geom_point(data = prev_points_80s, aes(x = time, y = value), colour = "red")+
geom_blank(data = prev_axes, aes(x = time, y = value))
# plot prevalence in each group indiv runs
ggplot() + geom_line(data = prev_indiv_melted, aes(x = time, y = value, factor = variable, factor = run), alpha = 0.3) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
geom_point(data = prev_points_80s, aes(x = time, y = value), colour = "red")+
geom_blank(data = prev_axes, aes(x = time, y = value))
# plot total population size
ggplot(Ntot) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Total population size of Grand Cotonou") +
geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15) + geom_errorbar(data = Ntot_data_points, aes(x = time, ymax = upper, ymin = lower, color = colour), width = 2)
ggplot(ART_coverage) +
geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() +
facet_wrap(~variable) + labs(y = "ART coverage ") +
geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper), colour = "darkred")
ggplot() + geom_line(data = ART_indiv_melted, aes(x = time, y = value, factor = variable, factor = run), alpha = 0.3) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "ART coverage") +
geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper))
# median_CF = ART_coverage[ART_coverage$variable == "Pro FSW", "Median"]
median_intervention =ART_coverage[ART_coverage$variable == "Pro FSW", "Median"]
median_CF * 100 / median_intervention
################################################################################################################################################################
################################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
parameters <- cotonou::lhs_parameters(number_of_prep_samples, set_pars = best_set, Ncat = 9, time = time,
ranges = combined_ranges, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq)
res = lapply(parameters, return_outputs, main_model, time = time, outputs = outputs)
likelihood_list = lapply(res, likelihood_rough, time = time, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points)
sorted_likelihood_list = sort(unlist(lapply(likelihood_list, function(x) x[[1]])))
best_runs = which(unlist(lapply(likelihood_list, function(x) x[[1]])) == max(sorted_likelihood_list))
################################################################################################################################################################
################################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
# _____ ___ _____ ____ ___ ____ ____ _____ _ _ _____ ___ ___ _ _ ___ _ _ _____ ___
# | ___|_ _|_ _| _ / ___/ _ \| _ \| _ \| ____| | / \|_ _|_ _/ _ \| \ | | |_ _| \ | | ___/ _ \
# | |_ | | | | _| |_ | | | | | | |_) | |_) | _| | | / _ \ | | | | | | | \| | | || \| | |_ | | | |
# | _| | | | | |_ _| | |__| |_| | _ <| _ <| |___| |___ / ___ \| | | | |_| | |\ | | || |\ | _|| |_| |
# |_| |___| |_| |_| \____\___/|_| \_\_| \_\_____|_____/_/ \_\_| |___\___/|_| \_| |___|_| \_|_| \___/
#
setwd("Q:\\cotonou_cluster")
folder <- "context_after_FSW_post"
options(didehpc.username = "eg1012")
# src <- provisionr::package_sources(github = c("richfitz/odin"))
src <- provisionr::package_sources(github = c("richfitz/odin"))
ctx <- context::context_save(folder, package_sources = src)
config <- didehpc::didehpc_config(cores = 8, template = "GeneralNodes", r_version = "3.3.2")
obj <- didehpc::queue_didehpc(ctx, config = config)
# run first
res_combined_top_fit = 0
res_best_runs_combined = list()
best_pars_combined = list()
task_list = obj$task_status()
task_list = task_list[task_list == "COMPLETE"]
task_list = names(task_list)
# # obj$
# ffff= obj$task_get("c6fdbbc1e0a71f61831efeec8c7a1ab2")$log()
for(i in 1:length(task_list))
{
res = obj$task_get(task_list[i])$result()
res_best_runs = lapply(res[[2]], return_outputs, main_model, time = time, outputs = outputs)
# to combine runs
if(res[[1]] > res_combined_top_fit) {
res_combined_top_fit = res[[1]];
res_best_runs_combined = res_best_runs
best_pars_combined = res[[2]];
} else if(res[[1]] == res_combined_top_fit) {
res_best_runs_combined[(length(res_best_runs_combined)+1):(length(res_best_runs_combined)+length(res_best_runs))] = res_best_runs
best_pars_combined[(length(best_pars_combined)+1):(length(best_pars_combined)+length(res[[2]]))] = res[[2]]
}
res[[1]]
}
res_best_runs = res_best_runs_combined
res_combined_top_fit
length(res_best_runs)
# CORRELATIONS WITH CLIENT PREVALENCE LOOPING THROUGH ALL OF PARAMETERS
year = 2000
cor_test_parm = function(y) {
param_ind = y
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
test = cor.test(x1, x2)
return(test[c("p.value", "estimate")])
}
ranges_with_range = names(ranges[which(ranges[,1] != ranges[,2]),1])
cor_test_results = lapply(as.list(ranges_with_range), cor_test_parm)
cor_test_results_sorted = cor_test_results[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
names(cor_test_results_sorted) = ranges_with_range[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
# parameters with biggest effect on client prevalence
head(do.call(rbind, cor_test_results_sorted), n = 10)
# which points fit? -------------------------------------------------------
# # WHICH POINTS ARE FITS TO FSW PREVALENCE? (POINTS 1 to 8)
# x3 = unlist(lapply(lapply(result_adjusted[[3]], function(x) x[[2]]), function(x) {
# if(!is.null(x))
# {
# return(sum(x < 9))
# } else
# {return (0)}
# }))
# # end of which points fit? -------------------------------------------------------
# WHICH POINTS ARE FITS TO CLIENT PREVALENCE? (POINTS 9 to 14)
x3 = unlist(lapply(lapply(result_adjusted[[3]], function(x) x[[2]]), function(x) {
if(!is.null(x))
{
return(sum(x > 8 & x < 15))
} else
{return (0)}
}))
# end of which points fit? -------------------------------------------------------
# CORRELATIONS WITH CLIENT PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin, who_believe_comm
year = 2000
param_ind = "c_noncomm_1998_Client"
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
correlation_with_fit = data.frame(x1, x2, x3)
cor.test(x1, x2)
ggplot(data = correlation_with_fit)+scale_color_gradient(low="darkgreen", high="red") + geom_point(aes(x = x2, y = x1, colour = x3, size = x3))+ labs(colour=" Number \n of \n CLIENT \n prevalence \n points \n fits", size = "") + theme_bw() + labs(y = param_dep, x = param_ind)
#histogram
ggplot() + aes(x2[x3 > 0])+ geom_histogram(binwidth = (diff(range(x2))/10), colour="black", fill="black") + theme_bw()
# posterior dist
# apply(do.call(rbind, lapply(result_adjusted[[1]][which(x3 > 0)], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))
# prior dist
# apply(do.call(rbind, lapply(result_adjusted[[1]], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))
# the percentage difference between the posterior and prior for all the pars that I vary in LHS, sorted
sort((apply(do.call(rbind, lapply(result_adjusted[[1]][which(x3 > 0)], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))
- apply(do.call(rbind, lapply(result_adjusted[[1]], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))) / apply(do.call(rbind, lapply(result_adjusted[[1]], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x))))
# _____ ___ _____ ____ ___ ____ ____ _____ _ _ _____ ___ ___ _ _ ___ _ _ _____ ___
# | ___|_ _|_ _| _ / ___/ _ \| _ \| _ \| ____| | / \|_ _|_ _/ _ \| \ | | |_ _| \ | | ___/ _ \
# | |_ | | | | _| |_ | | | | | | |_) | |_) | _| | | / _ \ | | | | | | | \| | | || \| | |_ | | | |
# | _| | | | | |_ _| | |__| |_| | _ <| _ <| |___| |___ / ___ \| | | | |_| | |\ | | || |\ | _|| |_| |
# |_| |___| |_| |_| \____\___/|_| \_\_| \_\_____|_____/_/ \_\_| |___\___/|_| \_| |___|_| \_|_| \___/
#
remove.packages("cotonou")
# rm(list = ls())
require(ggplot2)
require(reshape2)
devtools::install_github("geidelberg/cotonou")
number_simulations = 20
epi_start = 1986
epi_end = 2016
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
#####################################################
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR=0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
c(0, rep_len(0, 8)), ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2008, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1
)
# best_set end ----------------------------------------------------------------
# ranges and outputs ------------------------------------------------------------------
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.08, 0.08),
epsilon_2013 = c(0.08, 0.08),
epsilon_2016 = c(0.08, 0.08),
fraction_FSW_foreign = c(0.9, 0.9),
muF = c(0.01851852, 0.025),
muM = c(0.01851852, 0.025),
betaMtoF_noncomm = c(0.00144, 0.00626),
# betaMtoF_noncomm = c(0, 0),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
frac_women_ProFSW = c(0.0024, 0.0143),
# frac_women_LowFSW = c(0.0024, 0.0067),
frac_women_exFSW = c(0.0024, 0.0143),
frac_men_client = c(0.196, 0.4),
frac_women_virgin = c(0.0972973, 0.18),
frac_men_virgin = c(0.08840413, 0.1255),
fraction_sexually_active_15_F = c(0.1387868, 0.153),
fraction_sexually_active_15_M = c(0.2057087, 0.291),
rate_enter_sexual_pop_F = c(1/(20-15), 1/(17-15)),
rate_enter_sexual_pop_M = c(1/(20-15), 1/(17-15)),
# commercial partnerships
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(12, 17),
#non commercial partnerships
c_non_comm_1985_ProFSW = c(0.273, 0.468),
c_non_comm_2016_ProFSW = c(0.273, 0.468),
c_noncomm_1998_Client = c(1.2, 2.5),
c_noncomm_2015_Client = c(5, 9),
c_noncomm_1998_GPF = c(0.84, 1.05),
c_noncomm_2008_GPF = c(0.5, 1),
c_noncomm_1998_GPM = c(1.14, 1.46),
c_noncomm_2008_GPM = c(0.28, 1.24),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0.2173913, 0.4347826),
rate_leave_low_FSW = c(0.2173913, 0.4347826),
rate_leave_client = c(0.05, 0.2),
# rate_leave_client = 0,
# condoms
fc_y_comm_1985_ProFSW_Client = c(0, 0),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1985_GPM_GPF = 0,
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.05042017),
fc_y_noncomm_2011_GPM_GPF = c(0.161, 0.255)
)
outputs = c("prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male"),
min = c(0.001237599, 0.094735687, 0.050019624, 0.042621372),
max = c(0.007374027, 0.193733511, 0.09281992, 0.060783889))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
#####################################################
result <- cotonou::run_model_with_fit_for_correlations(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# removing those with too high betas
beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1], result[[3]][beta_not_above_1])
# WHICH POINTS ARE FITS TO FSW PREVALENCE? (POINTS 1 to 8)
x3 = unlist(lapply(lapply(result_adjusted[[3]], function(x) x[[2]]), function(x) {
if(!is.null(x))
{
return(sum(x < 9))
} else
{return (0)}
}))
# CORRELATIONS WITH CLIENT PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin, who_believe_comm
year = 2000
param_ind = "fc_y_comm_2002_ProFSW_Client"
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
correlation_with_fit = data.frame(x1, x2, x3)
cor.test(x1, x2)
ggplot(data = correlation_with_fit) + geom_point(aes(x = x2, y = x1, colour = x3)) + theme_bw() + labs(y = param_dep, x = param_ind)
# __ _____ _____ _ _ ___ _ _ _____ _____ ___ _____
# \ \ / /_ _|_ _| | | |/ _ \| | | |_ _| | ___|_ _|_ _|
# \ \ /\ / / | | | | | |_| | | | | | | | | | | |_ | | | |
# \ V V / | | | | | _ | |_| | |_| | | | | _| | | | |
# \_/\_/ |___| |_| |_| |_|\___/ \___/ |_| |_| |___| |_|
#
remove.packages("cotonou")
# rm(list = ls())
require(ggplot2)
require(reshape2)
devtools::install_github("geidelberg/cotonou")
number_simulations = 25
epi_start = 1986
epi_end = 2030
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
#####################################################
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR=0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = c(0, rep_len(0, 8)),
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2008, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1
)
# best_set end ----------------------------------------------------------------
# ranges and outputs ------------------------------------------------------------------
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.08, 0.08),
epsilon_2013 = c(0.08, 0.08),
epsilon_2016 = c(0.08, 0.08),
fraction_FSW_foreign = c(0.9, 0.9),
muF = c(0.01851852, 0.025),
muM = c(0.01851852, 0.025),
betaMtoF_noncomm = c(0.00144, 0.00626),
# betaMtoF_noncomm = c(0, 0),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
frac_women_ProFSW = c(0.0024, 0.0143),
# frac_women_LowFSW = c(0.0024, 0.0067),
frac_women_exFSW = c(0.0024, 0.0143),
frac_men_client = c(0.196, 0.4),
frac_women_virgin = c(0.0972973, 0.18),
frac_men_virgin = c(0.08840413, 0.1255),
fraction_sexually_active_15_F = c(0.1387868, 0.153),
fraction_sexually_active_15_M = c(0.2057087, 0.291),
rate_enter_sexual_pop_F = c(1/(20-15), 1/(17-15)),
rate_enter_sexual_pop_M = c(1/(20-15), 1/(17-15)),
# commercial partnerships
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(12, 17),
#non commercial partnerships
c_non_comm_1985_ProFSW = c(0.273, 0.468),
c_non_comm_2016_ProFSW = c(0.273, 0.468),
c_noncomm_1998_Client = c(1.2, 2.5),
c_noncomm_2015_Client = c(5, 9),
c_noncomm_1998_GPF = c(0.84, 1.05),
c_noncomm_2008_GPF = c(0.5, 1),
c_noncomm_1998_GPM = c(1.14, 1.46),
c_noncomm_2008_GPM = c(0.28, 1.24),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0.2173913, 0.4347826),
rate_leave_low_FSW = c(0.2173913, 0.4347826),
rate_leave_client = c(0.05, 0.2),
# rate_leave_client = 0,
# condoms
fc_y_comm_1985_ProFSW_Client = c(0, 0),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1985_GPM_GPF = 0,
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.05042017),
fc_y_noncomm_2011_GPM_GPF = c(0.161, 0.255)
)
outputs = c("prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male"),
min = c(0.001237599, 0.094735687, 0.050019624, 0.042621372),
max = c(0.007374027, 0.193733511, 0.09281992, 0.060783889))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
#####################################################
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# removing those with too high betas
beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1])
# CORRELATIONS WITH CLIENT PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin, who_believe_comm
year = 2000
param_ind = "fc_y_comm_2002_ProFSW_Client"
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
cor.test(x1, x2)
qplot(x = x2, y = x1) + theme_bw() + labs(y = param_dep, x = param_ind)
# CORRELATIONS WITH CLIENT PREVALENCE / FSW PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin
year = 2000
param_ind = "frac_men_virgin"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x["prev_FSW"])), function(x) x[which(time == year)])) /
unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x["prev_client"])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
cor.test(x1, x2)
qplot(x = x2, y = x1) + theme_bw() + labs(y = param_dep, x = "FSW prevalence / Client prevalence")
# CORRELATIONS WITH CLIENT PREVALENCE LOOPING THROUGH ALL OF PARAMETERS
year = 2000
cor_test_parm = function(y) {
param_ind = y
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
test = cor.test(x1, x2)
return(test[c("p.value", "estimate")])
}
ranges_with_range = names(ranges[which(ranges[,1] != ranges[,2]),1])
cor_test_results = lapply(as.list(ranges_with_range), cor_test_parm)
cor_test_results_sorted = cor_test_results[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
names(cor_test_results_sorted) = ranges_with_range[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
head(do.call(rbind, cor_test_results_sorted), n =10)
# PLOTS
# ignore these ######################################
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"))
prev_FSW = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(result[[2]], function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
#####################################################
# plot fraction in each group
ggplot(frac) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Percent in each group (%)") + facet_wrap(~variable, scales = "free") +
geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15) +
geom_hline(data = frac_N_discard_points, aes(yintercept = 100*min), size = I(0.5), color = "red", linetype = 1, alpha = 0.7) +
geom_hline(data = frac_N_discard_points, aes(yintercept = 100*max), size = I(0.5), color = "red", linetype = 1, alpha = 0.7)
# plot prevalence in each group
ggplot(prev) + geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))
# plot total population size
ggplot(Ntot) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Total population size of Grand Cotonou") +
geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15) + geom_errorbar(data = Ntot_data_points, aes(x = time, ymax = upper, ymin = lower, color = colour), width = 2)
# Below c'est
# ____ _ _ _ _ _
# | _ \ _ _ __ _(_) ___ _ ___ __ _ __ ( |_)_ __ ___ _ __ ___ _ __| |_ ___ __ _ _ _ ___ (_)
# | | | | | | | \ \ / / |/ _ \ | | \ \/ / | '_ \|/| | '_ ` _ \| '_ \ / _ \| '__| __/ _ \ / _` | | | |/ _ \| |
# | |_| | |_| | \ V /| | __/ |_| |> < | | | | | | | | | | | |_) | (_) | | | || __/ | (_| | |_| | (_) | |
# |____/ \__,_| \_/ |_|\___|\__,_/_/\_\ |_| |_| |_|_| |_| |_| .__/ \___/|_| \__\___| \__, |\__,_|\___/|_|
# |_| |_|
#
require(ggplot2)
require(reshape2)
number_simulations = 30
epi_start = 1986
epi_end = 2016
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
#####################################################
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR=0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = c(0, rep_len(0, 8)),
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2008, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1,
RR_beta_circum = 0.44,
prev_ratio_FSW_GPF = 1,
prev_ratio_Client_GPM = 1
)
# best_set end ----------------------------------------------------------------
# ranges and outputs ------------------------------------------------------------------
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.06, 0.07),
epsilon_2013 = c(0.04, 0.06),
epsilon_2016 = c(0.04, 0.06),
fraction_FSW_foreign = c(0.9, 0.9),
muF = c(0.01851852, 0.025),
muM = c(0.01851852, 0.025),
# betaMtoF_noncomm = c(0.00144, 0.00626),
betaMtoF_baseline = c(0.0006, 0.001),
# betaMtoF_noncomm = c(0, 0),
RR_beta_FtM = c(0.5, 2),
RR_beta_circum = c(0.34, 0.72),
prev_HSV2_FSW = c(0.8687271, 0.9403027),
prev_HSV2_Client = c(0.1, 0.8687271),
prev_HSV2_GPF = c(0.2666742, 0.3236852),
prev_HSV2_GPM = c(0.09843545, 0.14108970),
RR_beta_HSV2_comm = c(1.4, 2.1),
RR_beta_HSV2_noncomm = c(2.2, 3.4),
frac_women_ProFSW = c(0.0024, 0.0143),
# frac_women_LowFSW = c(0.0024, 0.0067),
frac_women_exFSW = c(0.0024, 0.0143),
frac_men_client = c(0.196, 0.4),
frac_women_virgin = c(0.0972973, 0.18),
frac_men_virgin = c(0.08840413, 0.1255),
fraction_sexually_active_15_F = c(0.1387868, 0.153),
fraction_sexually_active_15_M = c(0.2057087, 0.291),
rate_enter_sexual_pop_F = c(1/(20-15), 1/(17-15)),
rate_enter_sexual_pop_M = c(1/(20-15), 1/(17-15)),
# commercial partnerships
c_comm_1993_ProFSW = c(300, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 17),
c_comm_2015_Client = c(7, 17),
#non commercial partnerships
c_non_comm_1985_ProFSW = c(0.273, 0.468),
c_non_comm_2016_ProFSW = c(0.273, 0.468),
c_noncomm_1998_Client = c(1, 9),
c_noncomm_2015_Client = c(1, 9),
c_noncomm_1998_GPF = c(0.84, 1.05),
c_noncomm_2008_GPF = c(0.5, 1),
c_noncomm_1998_GPM = c(1.14, 1.46),
c_noncomm_2008_GPM = c(0.28, 1.24),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0, 1),
rate_leave_low_FSW = c(0, 1),
rate_leave_client = c(0, 0.2),
# rate_leave_client = 0,
# condoms
fc_y_comm_1985_ProFSW_Client = c(0, 0),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1985_GPM_GPF = 0,
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.05042017),
fc_y_noncomm_2011_GPM_GPF = c(0.161, 0.255)
)
outputs = c("prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male"),
min = c(0.001237599, 0.094735687, 0.050019624, 0.042621372),
max = c(0.007374027, 0.193733511, 0.09281992, 0.060783889))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
#####################################################
result <- cotonou::run_model_with_fit_for_correlations(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# removing those with too high betas
beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1], result[[3]][beta_not_above_1])
#
#
# likelihood_list = unlist(lapply(res, likelihood_rough))
# sorted_likelihood_list = sort(likelihood_list)
#
# # table(sorted_likelihood_list)
#
# best_runs = which(unlist(lapply(res, likelihood_rough)) == max(sorted_likelihood_list))
#
# out <- res[best_runs]
###
# THE DEMOGRAPHIC RESULTS OF BEST RUNS
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(0.67, 0.24,
100*0.195738802*(1-0.515666224), 20,
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.16*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
# demographic graphs ------------------------------------------------------
frac_N_best_runs = 100*do.call(rbind, lapply(res[best_runs], function(x) x$frac_N))
frac_N_best_runs = data.frame(time, frac_N_best_runs, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(frac_N_best_runs) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
frac_N_best_runs_melted = melt(frac_N_best_runs, id.vars = c("time", "replication"))
ggplot() + geom_line(data = frac_N_best_runs_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="Percent in each group (%)") +
facet_wrap(~variable, scales = "free") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
# facet_wrap(~variable, scales = "fixed") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
epsilon_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$epsilon)))
epsilon_best_runs = data.frame(time, epsilon_best_runs)
epsilon_best_runs_melted = melt(epsilon_best_runs, id.vars = "time")
ggplot() + geom_line(data = epsilon_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Growth rate")
Ntot_data_points = data.frame(time = c(1979, 1992, 2002, 2013, 2020, 2030), point = c(191106.1467, 404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65), colour = c("data", "data", "data", "data", "predicted", "predicted"))
Ntot_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$Ntot)))
Ntot_best_runs = data.frame(time, Ntot_best_runs)
Ntot_best_runs_melted = melt(Ntot_best_runs, id.vars = "time")
ggplot() + geom_line(data = Ntot_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Total population size") + geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15)
#output growth rate?????
growth_rate_out = melt(data.frame(time = time[-1], t(do.call(rbind, lapply(lapply(res[best_runs], function(x) x$Ntot), function(y) {
diff(y)/y[-length(y)]
})))), id.vars = "time")
ggplot(growth_rate_out) + geom_line(aes(x = time, y = value, factor = variable)) + theme_bw() +
labs(x="year",y="Output growth rate")
# end of demographic graphs ------------------------------------------------------
# prev graphs ------------------------------------------------------
all_binded = do.call(rbind, lapply(res[best_runs], function(x) {
return(matrix(c(x$prev_FSW, x$prev_LowFSW, x$prev_client, x$prev_women, x$prev_men), ncol = 5))
}))
all_binded[is.na(all_binded)] = 0
out = data.frame(time, all_binded, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(out) = c("time", "Pro FSW", "Low-level FSW", "Clients", "Women", "Men", "replication")
out_melted = melt(out, id.vars = c("time", "replication"))
ggplot() + geom_line(data = out_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
facet_wrap(~variable, scales = "free")
# end of prev graphs ------------------------------------------------------
# who believe etc ---------------------------------------------------------
max(sorted_likelihood_list)
# WHO BELIEVE?
who_believe = unlist(lapply(parameters[which(likelihood_list == max(likelihood_list))], function(x) x$who_believe_comm))
who_believe = ifelse(who_believe == 1, "Clients", "FSWs")
table(who_believe)
c_comm_out = melt(data.frame(years = rep(time, length(best_runs)), do.call(rbind, lapply(res[best_runs], function(x) {
if(x$who_believe_comm[1] == 1)
return(data.frame(c_comm_balanced = x$c_comm_balanced[,1], varies = "FSW"))
else
return(data.frame(c_comm_balanced = x$c_comm_balanced[,5], varies = "Client"))
})), replication = sort(rep(seq(1, length(best_runs), 1), length(time)))), id.vars = c("years", "replication", "varies"))
ggplot(c_comm_out) + geom_line(aes(x = years, y = value, factor = as.factor(replication))) + facet_wrap(~varies, scales = "free") + theme_bw() + labs(y = "commercial partner change rate")
## END OF TESTS
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
#############################################################################################
#############################################################################################
#############################################################################################
# ___ _ _ _ __ __
# / _ \| | __| | ___| |_ _ _ / _|/ _|
# | | | | |/ _` | / __| __| | | | |_| |_
# | |_| | | (_| | \__ \ |_| |_| | _| _|
# \___/|_|\__,_| |___/\__|\__,_|_| |_|
#
#############################################################################################
#############################################################################################
#############################################################################################
rm(list = ls())
require(ggplot2)
require(reshape2)
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(1986, 2016, length.out = 31)
# best_set ----------------------------------------------------------------
best_set = list(
fraction_sexually_active_15_F = 0,
fraction_sexually_active_15_M = 0,
init_clientN_from_PCR = 0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = c(0, rep_len(0, 8)),
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1998, 2008, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1
)
# best_set end ----------------------------------------------------------------
#######################################################################
##########################for local editing
#######################################################################
odin::odin_package(".") # looks for any models inside inst/odin
devtools::load_all()
##############################################################
parameters <- lhs_parameters(1, set_pars = best_set, Ncat = 9, time = time,
ranges = rbind(
fraction_sexually_active_15_F = 0.4,
fraction_sexually_active_15_M = 0.4,
fraction_FSW_foreign = 0.9,
betaMtoF_noncomm = c(0.00144, 0.00626), # c(0.00086, 0.00433),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(6, 12),
c_noncomm_1998_Client = c(1, 3),
c_noncomm_2015_Client = c(2, 6),
who_believe_comm = c(0, 1),
frac_women_ProFSW = c(0.0025, 0.0025),
init_clientN_from_PCR = c(1,1)
))
f <- function(p, gen, time) {
mod <- gen(user = p)
all_results <- mod$transform_variables(mod$run(time))
all_results[c("N", "prev", "c_comm_balanced", "c_noncomm_balanced", "c_comm", "c_noncomm", "prev_men")]
}
res = lapply(parameters, f, cotonou::main_model, time)
pars = parameters[[1]]
pars$frac_women_ProFSW
pars$N_init
sum(pars$N_init)
# library(cotonou)
#test
number_simulations = 1
# test
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
parameters <- lhs_parameters(number_simulations, set_pars = best_set, Ncat = 9, time = time,
ranges = rbind(
# betaMtoF_comm = c(0.00086, 0.0118844), # c(0.00086, 0.00433),
# betaFtoM_comm = c(0.00279 * 0.44, 0.02701 * 0.44),
betaMtoF_noncomm = c(0.00144, 0.00626), # c(0.00086, 0.00433),
# betaFtoM_noncomm = c(0.00279 * 0.44, 0.02701 * 0.44),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(6, 12),
c_noncomm_1998_Client = c(1, 3),
c_noncomm_2015_Client = c(2, 6),
fc_y_comm_1985_ProFSW_Client = c(0.5, 0.5),
fc_y_comm_1993_ProFSW_Client = c(1, 1),
fc_y_comm_1998_ProFSW_Client = c(0.01, 0.01),
fc_y_comm_2016_ProFSW_Client = c(0.3, 0.3),
fc_y_noncomm_1985_GPM_GPF = c(0.0, 0),
fc_y_noncomm_1998_GPM_GPF = c(0.2, 0.2),
fc_y_noncomm_2016_GPM_GPF = c(0, 0),
fc_y_noncomm_1985_ProFSW_Client = c(0.5, 0.5),
fc_y_noncomm_2015_ProFSW_Client = c(0.8, 0.8)
# fc_y_noncomm_2015_Client_GPF = c(1, 1)
))
# lapply(parameters, function(x) x$betaMtoF_noncomm)time <- seq(1986, 2016, length.out = 31)
f <- function(p, gen, time) {
mod <- gen(user = p)
all_results <- mod$transform_variables(mod$run(time))
all_results[c("prev", "c_comm_balanced", "c_noncomm_balanced", "c_comm", "c_noncomm", "fc_comm", "fc_noncomm")]
}
res = lapply(parameters, f, cotonou::main_model, time)
# #checking c_comm
# if(number_simulations == 1)
# ggplot(melt(data.frame(time, do.call(rbind, lapply(res, function(x) x$c_comm))), id.vars = "time"), aes(x = time, y = value)) + geom_line() + facet_wrap(~variable, scales = "free") + theme_bw()
graph_par = "fc_noncomm"
# plot function -----------------------------------------------------------
# checking fc
# DONT TRUST THE PLOTTING!!
par_gridplot2 = function(result, parm) {
require(plyr)
fc_df = aperm(result[parm][[1]], c(2, 3, 1))
fc_df_list = alply(fc_df, 3)
fc_df_list_applied = lapply(fc_df_list, function(x) {colnames(x) = rownames(x) = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
return(x)})
dat = data.frame(row =
rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"), 1, each = 9),
col =
rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"), 9),
value = unlist(lapply(fc_df_list_applied, c)),
year = unlist(sort(rep(time, 81))))
dat$row = factor(dat$row, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"))
dat$col = factor(dat$col, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"))
# dat$combination = factor(dat$combination, levels =
# unlist(lapply(fc_df_list, function(x) {
# tmp = expand.grid(colnames(x), rownames(x))
# return(paste(tmp[,2], tmp[,1], sep = "_"))
# }))[1:81])
return(ggplot(dat, aes(x = year, y = value, color = value)) + geom_line(size = 2) + facet_grid(row~col) + theme_bw())
}
par_gridplot2(result = res[[1]], graph_par)
# plot end ----------------------------------------------------------------
# devtools::test()
res[[1]]$fc_noncomm[1,,]
parameters[[1]]$fc_y_comm_1985
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
start.time <- Sys.time()
# varying and fitting
number_simulations = 1
time = seq(1986, 2030, 1)
# parameters --------------------------------------------------------------
parameters <- lhs_parameters(number_simulations, set_pars = best_set, Ncat = 9, time = time,
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.08, 0.08),
epsilon_2013 = c(0.08, 0.08),
epsilon_2016 = c(0.08, 0.08),
fraction_FSW_foreign = c(0.9, 0.9),
# epsilon_1985 = c(0.059, 0.059),
# epsilon_1992 = c(0.059, 0.059),
# epsilon_2002 = c(0.059, 0.059),
# epsilon_2013 = c(0.059, 0.059),
# epsilon_2016 = c(0.059, 0.059),
# muF = c(0.05, 0.05),
# muM = c(0.06, 0.06),
muF = c(0.0295, 0.0295),
muM = c(0.0315, 0.0315),
# betaMtoF_noncomm = c(0.00144, 0.00626),
betaMtoF_noncomm = c(0, 0),
frac_women_ProFSW = c(0.0067, 0.0067),
# frac_women_ProFSW = c(0.0024, 0.0067),
# frac_women_LowFSW = c(0.0024, 0.0067),
# frac_women_exFSW = c(0.0024, 0.0067),
frac_men_client = c(0.3, 0.3),
frac_women_virgin = 0.13,
frac_men_virgin = 0.13,
fraction_sexually_active_15_F = c(0.14, 0.14),
fraction_sexually_active_15_M = c(0.21, 0.21),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(6, 12),
c_noncomm_1998_Client = c(1, 3),
c_noncomm_2015_Client = c(2, 6),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0.4347826, 0.4347826),
rate_leave_low_FSW = c(0.4347826, 0.4347826),
rate_leave_client = c(0.5, 0.5),
# rate_enter_sexual_pop = c(0.6571429, 0.6571429),
rate_enter_sexual_pop = c(0.3571429, 0.3571429),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_comm_1998_ProFSW_Client = c(0.872, 0.933), # fake
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.241404781),
fc_y_noncomm_2016_GPM_GPF = c(0.0326087, 0.251404781)
))
# end of parameters --------------------------------------------------------------
outputs = c("prev", "omega", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
f <- function(p, gen, time) {
mod <- gen(user = p)
all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev", "c_comm_balanced", "c_noncomm_balanced", "c_comm", "c_noncomm", "epsilon")]
all_results[outputs]
}
# res = lapply(parameters, f, main_model, time = seq(1986, 2030, 1))
res = lapply(parameters, f, main_model, time = time)
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# prev_points -------------------------------------------------------------
# likelihood calculation -----------------------------------
likelihood_rough <- function(x) {
the_prev = data.frame(time, x$prev_FSW, x$prev_LowFSW, x$prev_client, x$prev_women, x$prev_men)
names(the_prev) = c("time", "Pro FSW", "Low-level FSW", "Clients", "Women", "Men")
likelihood_count <- 0
for(i in 1:length(prev_points[,1]))
{
# likelihood_count <- likelihood_count +
point = subset(the_prev, time == prev_points[i, "time"], select = as.character(prev_points[i, "variable"]))
if(!is.na(point)) {if((point < prev_points[i, "upper"]) && (point > prev_points[i, "lower"]))
{
# print(prev_points[i, c("time", "variable")]);
likelihood_count <- likelihood_count + 1
}}
}
return (likelihood_count)
}
# end of likelihood calculation -----------------------------------
# which(unlist(lapply(res, likelihood_rough)) > 4)
# best runs etc -----------------------------------------------------------
likelihood_list = unlist(lapply(res, likelihood_rough))
sorted_likelihood_list = sort(likelihood_list)
# table(sorted_likelihood_list)
best_runs = which(unlist(lapply(res, likelihood_rough)) == max(sorted_likelihood_list))
out <- res[best_runs]
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
print("number of seconds per simulation:")
as.numeric(time.taken)/ number_simulations
###
# THE DEMOGRAPHIC RESULTS OF BEST RUNS
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(0.67, 0.24,
100*0.195738802*(1-0.515666224), 20,
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.16*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
# demographic graphs ------------------------------------------------------
frac_N_best_runs = 100*do.call(rbind, lapply(res[best_runs], function(x) x$frac_N))
frac_N_best_runs = data.frame(time, frac_N_best_runs, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(frac_N_best_runs) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
frac_N_best_runs_melted = melt(frac_N_best_runs, id.vars = c("time", "replication"))
ggplot() + geom_line(data = frac_N_best_runs_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="Percent in each group (%)") +
facet_wrap(~variable, scales = "free") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
# facet_wrap(~variable, scales = "fixed") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
epsilon_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$epsilon)))
epsilon_best_runs = data.frame(time, epsilon_best_runs)
epsilon_best_runs_melted = melt(epsilon_best_runs, id.vars = "time")
ggplot() + geom_line(data = epsilon_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Growth rate")
Ntot_data_points = data.frame(time = c(1979, 1992, 2002, 2013, 2020, 2030), point = c(191106.1467, 404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65), colour = c("data", "data", "data", "data", "predicted", "predicted"))
Ntot_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$Ntot)))
Ntot_best_runs = data.frame(time, Ntot_best_runs)
Ntot_best_runs_melted = melt(Ntot_best_runs, id.vars = "time")
ggplot() + geom_line(data = Ntot_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Total population size") + geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15)
#output growth rate?????
growth_rate_out = melt(data.frame(time = time[-1], t(do.call(rbind, lapply(lapply(res[best_runs], function(x) x$Ntot), function(y) {
diff(y)/y[-length(y)]
})))), id.vars = "time")
ggplot(growth_rate_out) + geom_line(aes(x = time, y = value, factor = variable)) + theme_bw() +
labs(x="year",y="Output growth rate")
# end of demographic graphs ------------------------------------------------------
# prev graphs ------------------------------------------------------
all_binded = do.call(rbind, lapply(res[best_runs], function(x) {
return(matrix(c(x$prev_FSW, x$prev_LowFSW, x$prev_client, x$prev_women, x$prev_men), ncol = 5))
}))
all_binded[is.na(all_binded)] = 0
out = data.frame(time, all_binded, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(out) = c("time", "Pro FSW", "Low-level FSW", "Clients", "Women", "Men", "replication")
out_melted = melt(out, id.vars = c("time", "replication"))
ggplot() + geom_line(data = out_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
facet_wrap(~variable, scales = "free")
# end of prev graphs ------------------------------------------------------
# who believe etc ---------------------------------------------------------
max(sorted_likelihood_list)
# WHO BELIEVE?
who_believe = unlist(lapply(parameters[which(likelihood_list == max(likelihood_list))], function(x) x$who_believe_comm))
who_believe = ifelse(who_believe == 1, "Clients", "FSWs")
table(who_believe)
c_comm_out = melt(data.frame(years = rep(time, length(best_runs)), do.call(rbind, lapply(res[best_runs], function(x) {
if(x$who_believe_comm[1] == 1)
return(data.frame(c_comm_balanced = x$c_comm_balanced[,1], varies = "FSW"))
else
return(data.frame(c_comm_balanced = x$c_comm_balanced[,5], varies = "Client"))
})), replication = sort(rep(seq(1, length(best_runs), 1), length(time)))), id.vars = c("years", "replication", "varies"))
ggplot(c_comm_out) + geom_line(aes(x = years, y = value, factor = as.factor(replication))) + facet_wrap(~varies, scales = "free") + theme_bw() + labs(y = "commercial partner change rate")
## END OF TESTS
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
# gubbins -----------------------------------------------------------------
#
#
#
# # the parameter sets that are the best fits
#
# # all points except first three
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# prev_points = prev_points[-c(1,2,3),]
# # sorted_likelihood_list = sort(unlist(lapply(res, likelihood_rough)))
# best_runs = which(unlist(lapply(res, likelihood_rough)) == 10)
#
# betas_all_points = lapply(parameters[best_runs], '[', c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm"))
#
# betas_df = do.call(rbind, lapply(betas_all_points, '[', c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm")))
#
# betas_df = data.frame(matrix(unlist(betas_df), nrow = length(best_runs), byrow = F))
#
# names(betas_df) = c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm")
#
# betas_df_melted = melt(betas_df)
#
#
# ggplot(data = betas_df_melted, aes(x = value, fill = variable), alpha = 0.5) + geom_histogram() + theme_bw()
#
# # just client points
#
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# prev_points = prev_points[prev_points$variable == "Clients",]
# best_runs = which(unlist(lapply(res, likelihood_rough)) == 3)
#
# all_binded = do.call(rbind, lapply(res[best_runs], function(x) x$prev))
# all_binded[is.na(all_binded)] = 0
# out = data.frame(time, all_binded, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
# names(out) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
# out_melted = melt(out, id.vars = c("time", "replication"))
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = out_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
#
# betas_just_clients = lapply(parameters[best_runs], '[', c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm"))
#
#
#
#
# # to be altered
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# # single run (prev)
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# # FOI
# FOI <- result["lambda_sum_0"][[1]]
# df = data.frame(time, FOI)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "force of infection on susceptibles (no PrEP)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# # mortality
# alphaItot <- result["alphaItot"][[1]]
# df = data.frame(time, alphaItot)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "Annual AIDS deaths") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
# 1/parameters$mu
#
#
#
# # understanding changes over time
# df = data.frame(time, result$c_comm_balanced)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "c_comm_balanced") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# df = data.frame(time, result$c_noncomm_balanced)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "c_noncomm_balanced") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# df = data.frame(time, result$frac_N)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "frac_N") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
#
# #try to fit to prevalence data
# parameters = lhs_parameters(1, set_pars = best_set,
# forced_pars = list(#betaFtoM_comm = 0.00193, betaFtoM_noncomm = 0.00193, # infect_AIDS = 1,
# c_comm_1993 = c(1229.5, 52, 0, 0, 20, 0, 0, 0, 0),
# c_comm_1995 = c(1280, 52, 0, 0, 10, 0, 0, 0, 0),
# c_comm_1998 = c(881, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2002 = c(598.5, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2005 = c(424, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2008 = c(371.5, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2012 = c(541, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2015 = c(400, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2016 = c(400, 52, 0, 0, 8, 0, 0, 0, 0),
# c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# rate_enter_sexual_pop = 0.4,
# betaMtoF_comm = 0.003,
# betaFtoM_comm = 0.0038*0.44,
# betaMtoF_noncomm = 0.002,
# betaFtoM_noncomm = 0.0028*0.44# ,
# # epsilon_2002 = 0.05 * 1.5,
# # epsilon_2013 = 0.05 * 1.5,
# # epsilon_2016 = 0.05 * 1.5
# ),
# Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = df, aes(x = time, y = value)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
# data.frame(time,result$c_comm_balanced)
# plot(data.frame(year=time, fraction_virgin=result$frac_virgin))
# plot(data.frame(year=time, sum_of_weighted_FOI = rowSums(result$lambda_sum_0 * result$frac_N)))
#
#
# # average life duration
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# 1/(parameters$gamma01+parameters$alpha01+parameters$mu) +
# 1/(parameters$gamma02+parameters$alpha02+parameters$mu) +
# 1/(parameters$gamma03+parameters$alpha03+parameters$mu) +
# 1/(parameters$gamma04+parameters$alpha04+parameters$mu) +
# 1/(parameters$alpha05+parameters$mu)
#
# #on ART
# 1/(parameters$gamma01+parameters$alpha01+parameters$mu) +
# 1/(parameters$gamma32+parameters$alpha32+parameters$mu) +
# 1/(parameters$gamma33+parameters$alpha33+parameters$mu) +
# 1/(parameters$gamma34+parameters$alpha34+parameters$mu) +
# 1/(parameters$alpha35+parameters$mu)
#
#
#
# # fitting betas
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0.00193, betaFtoM = 0.00193, infect_AIDS = 1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
# 1998, 2012, 2015,
# 1998, 2008,
# 1998, 2008,
# 2012, 2015),
# variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),
# value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
# 100*0.084, 100*0.028, 100*0.016,
# 100*0.035, 100*0.04,
# 100*0.033, 100*0.02,
# 100*0.167, 100*0.065),
# upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
# 100*0.11561791, 100*0.051602442, 100*0.035338436,
# 100*0.047726245, 100*0.052817187,
# 100*0.047183668, 100*0.029774338,
# 100*0.268127672, 100*0.130153465),
# lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
# 100*0.05898524, 100*0.012660836, 100*0.006039259,
# 100*0.024181624, 100*0.030073668,
# 100*0.022857312, 100*0.012427931,
# 100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = df, aes(x = time, y = value)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
#
# plot(time, result$c_comm_balanced[,1])
# plot(time, result$fc_comm[,1,5])
#
#
#
# # rho
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["rho"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "ART rate") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
# # N
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["N"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "N") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# # tau
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["tau"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Testing rate") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
# # test c_comm
# parameters = lhs_parameters(1, c_comm_1985 = rep_len(1.1, 9), Ncat = 9)[[1]]
#
#
# # new people
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["new_people_in_group"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# # fc
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["fc_comm"][[1]][,1,5]
# df = data.frame(time, yy)
# plot(df)
# yy <- result["fc_noncomm"][[1]][,1,5]
# df = data.frame(time, yy)
# lines(df)
#
# par_gridplot2(result = result, "fc_comm")
#
# # frac_F
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# frac_F <- result["frac_F"][[1]][,1]
# df = data.frame(time, frac_F)
# plot(df)
#
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# frac_F <- result["frac_F"][[1]][,1]
# df = data.frame(time, frac_F)
# lines(df)
#
#
# # Ntot
# parameters = lhs_parameters(1, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# # result$prev
# # result$Ntot
# # result$new_people
# # result$Ntot_inc_former_FSW_nonCot
# result$epsilon
# plot(result$Ntot_inc_former_FSW_nonCot)
#
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# # result$prev
# # result$Ntot
# # result$new_people
# # result$Ntot_inc_former_FSW_nonCot
# result$epsilon
#
# lines(result$Ntot_inc_former_FSW_nonCot)
#
#
#
# # single run (prev)
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
# # no transmission
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# data.frame(time, result$frac_N)
# result$prev
# result$Ntot
#
#
# # frac virgin
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(rate_enter_sexual_pop = .4))[[1]]
# result = run_model(parameters, main_model, time)
# fraction_virgin <- result["frac_virgin"][[1]]
# df = data.frame(time, fraction_virgin);plot(df)
#
#
# # frac N
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["frac_N"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "frac N") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
#
#
# c_noncomm
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(c_noncomm = c(0.38, 0.38, 0.88, 0.88, 1, 1.065, 0, 0, 0)))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# ### variations of beta
# betaseq = c("point estimates", "lower bounds", "upper bounds")
# betaMtoFseq = c(0.00193, 0.00086, 0.00433)
# betaFtoMseq = c(0.00867, 0.00279, 0.0279)
#
# yy = data.frame()
# for(i in 1:3)
# {
# run = betaseq[i]
# parameters = lhs_parameters(1, set_pars = best_set, forced_pars = list(betaMtoF_comm = betaMtoFseq[i], betaFtoM_comm = betaFtoMseq[i], betaMtoF_noncomm = betaMtoFseq[i], betaFtoM_noncomm = betaFtoMseq[i]
# # , n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
# # 0, 0, 0, 0, 1.935, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0),
# # nrow = 9, ncol = 9, byrow = T)
# ), Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- rbind(yy, data.frame(time = time, result["prev"][[1]], replication = betaseq[i]))
# }
# colnames(yy) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
# yy_melted = melt(yy, id.vars = c("time", "replication"))
#
# ggplot(data = yy_melted, aes(x = time, y = value, color = replication)) + facet_wrap(~variable, scales = "free") + geom_line() + theme_bw() + labs(x="year",y="prevalance (%)")
#
#
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
# 1998, 2012, 2015,
# 1998, 2008,
# 1998, 2008,
# 2012, 2015),
# variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),
# value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
# 100*0.084, 100*0.028, 100*0.016,
# 100*0.035, 100*0.04,
# 100*0.033, 100*0.02,
# 100*0.167, 100*0.065),
# upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
# 100*0.11561791, 100*0.051602442, 100*0.035338436,
# 100*0.047726245, 100*0.052817187,
# 100*0.047183668, 100*0.029774338,
# 100*0.268127672, 100*0.130153465),
# lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
# 100*0.05898524, 100*0.012660836, 100*0.006039259,
# 100*0.024181624, 100*0.030073668,
# 100*0.022857312, 100*0.012427931,
# 100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = yy_melted, aes(x = time, y = value, color = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
#
#
# #c_comm
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(c_comm = c(750, 52, 0, 0, 5, 0, 0, 0, 0)))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")+
# geom_point(data = points, aes(x = time, y = value))+ geom_errorbar(data = points, aes(x = time, ymin = lower, ymax = upper))
#
#
#
#
#
# #beta 0
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(betaMtoF = 0, betaFtoM = 0))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
#
# #more condoms run
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
# best_set_2 = best_set
#
# best_set_2$fc_y_comm_1993 = best_set$fc_y_comm_1993*1.8
# best_set_2$fc_y_comm_1995 = best_set$fc_y_comm_1995*1.8
# best_set_2$fc_y_comm_1998 = best_set$fc_y_comm_1998*1.8
#
# best_set_2$fc_y_noncomm_1998 = best_set$fc_y_noncomm_1998*1.8
# best_set_2$fc_y_noncomm_2008 = best_set$fc_y_noncomm_2008*1.8
# best_set_2$fc_y_noncomm_2015 = best_set$fc_y_noncomm_2015*1.8
#
# parameters = lhs_parameters(1, set_pars = best_set_2, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
# # parameters[!(parameters %in% parameters1)]
#
#
#
#
#
# out=data.frame(time=result$t,output=result$Ntot)
# out
#
# ggplot(out, aes(x = time, y = output)) + geom_line() + theme_bw()
#
#
# # no zetas
# parameters <- lhs_parameters(1,Ncat = 9, set_null = list("zetaa_y", "zetab_y", "zetac_y"))[[1]]
#
#
#
#
#
# # test
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
# time <- seq(1986, 2016, length.out = 31)
#
# parameters <- lhs_parameters(1,Ncat = 9, movement = 0)[[1]]
# result = run_model(parameters, main_model, time)
#
#
#
#
# # prev of all groups
# #### Ncat = 9
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# number_simulations = 25
# parms = lhs_parameters(number_simulations, Ncat = 9)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev")]
# }
# res = lapply(parms, f, main_model, time)
#
# out = data.frame(time, do.call(rbind, lapply(res, function(x) x$prev)), as.character(sort(rep(seq(1,number_simulations), length(time)))))
# names(out) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Former FSW outside Cotonou", "replication")
# out_melted = melt(out, id.vars = c("time", "replication"))
# ggplot(data = out_melted, aes(x = time, y = value, factor = replication, color = variable)) + geom_line() + theme_bw() + facet_wrap(~variable)+ theme(legend.position="none")
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
# result$prev
# result$c_comm_balanced
# result$frac_N
# result$omega
#
# # showing priors are flat and explore space
# result$c_comm
#
# parameters <- lhs_parameters(2000, Ncat = 9)
# parm_prior1 = do.call(rbind, lapply(parameters, function(x) x$mu))
# parm_prior2 = do.call(rbind, lapply(parameters, function(x) x$betaMtoF))
#
# hist(parm_prior1[,1])
# ggplot(data= data.frame(parm_prior1, parm_prior2), aes (x= parm_prior1[,1], y= parm_prior2)) + geom_point() + theme_bw()
#
# # test prep
#
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# time <- seq(1986, 2016, length.out = 31)
# parameters <- lhs_parameters(1,Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
#
# df=melt(data.frame(time, a = result$S1a[,1], b = result$S1b[,1], c = result$S1c[,1], d = result$S1d[,1]), id.vars = "time")
# ggplot(df, aes(x = time, y = value, color = variable)) + geom_line() + theme_bw()
#
#
#
#
#
# # balancing
# parameters <- generate_parameters(Ncat = 9, c_comm=c(1244,52,0,0,24,0,0), c_noncomm=c(0.377,0.96,0.96,0.96,2.03,1.34,0),
# omega = c(1000, 1127, 143728, 500, 27323, 112436, 10)/(1000+1127+143728+500+27323+112436),
# S0_init = c(1000, 1127, 143728, 500, 27323, 112436, 10)*0.99,
# I01_init = c(1000, 1127, 143728, 500, 27323, 112436, 10)*0.01)
# result = run_model(parameters, main_model, time)
# result$N
#
# result$B_check_comm
# result$B_check_noncomm
#
#
#
#
# names(result)
#
# result$Ncat
# result$c_comm
# result$c_comm_balanced
# result$c_noncomm
# result$c_noncomm_balanced
# result$N
#
# result$S0[1,,]
#
# result$sum_in_S0
#
#
# result$B_check_comm
# result$B_check_noncomm
# #
#
# # mixing
#
#
#
#
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# parameters <- lhs_parameters(1,Ncat = 9)[[1]]
# time <- seq(1986, 2016, length.out = 31)
# result = run_model(parameters, main_model, time)
# result$M_comm[2,,]
# result$M_noncomm[2,,]
# result$p_comm[2,,]
# result$p_noncomm[2,,]
#
#
# # need to write general test solutions. done! general test below
# timestep = 3
# all_female_partnerships = 0; all_male_partnerships = 0;
# for(i in 1:4)
# for (j in 1:7)
# all_female_partnerships = all_female_partnerships + result$p_comm[timestep, i, j] * result$c_comm_balanced[timestep,i] * result$N[timestep,i]
#
# for(i in 5:6)
# for (j in 1:7)
# all_male_partnerships = all_male_partnerships + result$p_comm[timestep, i, j] * result$c_comm_balanced[timestep,i] * result$N[timestep,i]
# all_female_partnerships/all_male_partnerships
# #nonnoncomm check
# # need to write general test solutions. done! general test below
# timestep = 3
# all_female_partnerships = 0; all_male_partnerships = 0;
# for(i in 1:4)
# for (j in 1:7)
# all_female_partnerships = all_female_partnerships + result$p_noncomm[timestep, i, j] * result$c_noncomm_balanced[timestep,i] * result$N[timestep,i]
#
# for(i in 5:6)
# for (j in 1:7)
# all_male_partnerships = all_male_partnerships + result$p_noncomm[timestep, i, j] * result$c_noncomm_balanced[timestep,i] * result$N[timestep,i]
# all_female_partnerships/all_male_partnerships
#
#
#
# #below to tset for PrEP
# parameters <- generate_parameters(zetaa = c(0,0),zetab = c(0,0),zetac = c(0,0), psia = c(1, 1), psib = c(1, 1))
# result = run_model(parameters, main_model, time)
#
# result$OnPrEP
# result$t
#
# result$PrEP_0
# result$PrEP_1a
#
# result$S1a
# result$S1b
# result$S1c
#
# result$lambda_0[10,,]
# result$lambda_1a[10,,]
# result$lambda_1b[10,,]
# result$lambda_1c[10,,]
#
# result$lambda_sum_0[2,]
# result$lambda_sum_1a[2,]
# result$lambda_sum_1b[2,]
# result$lambda_sum_1c[2,]
#
#
# # result$N
# # result$c[1,,]
# # result$cstar[1,,]
# # result$B[1,,]
# # result$theta[1,,]
#
# # RUNNING MULTIPLE SIMULATIONS
#
# number_simulations = 2000
#
# parms = lhs_parameters(number_simulations)
#
# time <- seq(1986, 2016, length.out = 31)
#
# # parameter ranges
#
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("mu","fc_comm","betaMtoF","prev", "cumuInftot")]
# }
# res = lapply(parms, f, main_model, time)
# mu_input <- t(sapply(parms, "[[", "mu"))
# fc_y_input <- t(sapply(parms, "[[", "fc_y_comm"))
# prev_client_output <- t(sapply(res, "[[", "prev_client"))
# betaMtoF_input <- t(sapply(parms, "[[", "betaMtoF"))[1,]
# cumuInf_output <- t(sapply(res, "[[", "cumuInftot"))[,31]
#
# ggplot(data = data.frame(betaMtoF_input, cumuInf_output), aes(x = betaMtoF_input, y = cumuInf_output)) + geom_point() + theme_bw()
#
#
#
# # fc over time
# df = melt(data.frame(time, res[[1]]$fc_comm), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
# # prevalence over time
# matplot(time, res[[1]]$prev, type = "l")#, lty = 1, col = "#00000055")
#
#
# # mu vs prev?
# plot(mu_input[, 1], prev_client_output[length(time), ])
#
#
# # PLOTTING MULTIPLE SIMULATIONS
#
#
# number_simulations = 100
# parms = lhs_parameters(number_simulations, Ncat = 2)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev")]
# }
# res = lapply(parms, f, main_model, time)
#
# df=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,1])), group = "group 1")
# df_2=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,2])), group = "group 2")
#
# df_melted = melt(df, id.vars = c("time","group"))
# df_melted_2 = melt(df_2, id.vars = c("time","group"))
# df_all = rbind(df_melted, df_melted_2)
# ggplot(data = df_all, aes(x = time, y = value, factor = variable, color = group)) + geom_line(alpha = 0.5) + theme_bw()
#
#
# #### Ncat = 9
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# number_simulations = 50
# parms = lhs_parameters(number_simulations, Ncat = 9)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev")]
# }
# res = lapply(parms, f, main_model, time)
#
# df=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,1])), group = "group 1")
# df_2=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,2])), group = "group 2")
# df_3=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,3])), group = "group 3")
# df_4=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,4])), group = "group 4")
# df_5=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,5])), group = "group 5")
# df_6=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,6])), group = "group 6")
# df_7=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,7])), group = "group 7")
#
# df_melted = melt(df, id.vars = c("time","group"))
# df_melted_2 = melt(df_2, id.vars = c("time","group"))
# df_melted_3 = melt(df_3, id.vars = c("time","group"))
# df_melted_4 = melt(df_4, id.vars = c("time","group"))
# df_melted_5 = melt(df_5, id.vars = c("time","group"))
# df_melted_6 = melt(df_6, id.vars = c("time","group"))
# df_melted_7 = melt(df_7, id.vars = c("time","group"))
#
# df_all = rbind(df_melted, df_melted_2, df_melted_3, df_melted_4, df_melted_5, df_melted_6, df_melted_7)
# ggplot(data = df_all, aes(x = time, y = value, factor = variable, color = group)) + geom_line(alpha = 0.5) + theme_bw()
#
# df=do.call(cbind,lapply(res, function(x) x$prev[,7]))
# colnames(df) <- seq(1, number_simulations)
# df <- data.frame(time, df)
# df_melted <- melt(df, id.vars = "time")
# ggplot(data = df_melted, aes(x = time, y = value, factor = variable)) + geom_line() + theme_bw() + labs(x="year",y="prevalance (%) former FSW outside Cotonou")
#
#
# # show priors are flat and well explored
# number_simulations = 200
# parms = lhs_parameters(number_simulations, Ncat = 9)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("c_comm", "c_noncomm","mu","gamma01")]
# }
# res = lapply(parms, f, main_model, time)
#
# c_comm_prior = do.call(rbind, lapply(res, function(x) x$c_comm[1,]))
# hist(c_comm_prior[,1])
#
# mu_prior = do.call(rbind, lapply(res, function(x) x$mu[1,]))
# hist(mu_prior[,1])
#
# c_noncomm_prior = do.call(rbind, lapply(res, function(x) x$c_noncomm[1,]))
# hist(c_noncomm_prior[,1])
#
# gamma01_prior = do.call(rbind, lapply(res, function(x) x$gamma01[1,]))
# hist(gamma01_prior[,1])
#
#
#
# # SINGLE RUN WITH PARAMETERS TO CHECK EVERY OUTPUT
#
# # plot fc
# parameters <- lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result[grep("c_comm", names(result))]
# df = melt(data.frame(time, yy$c_comm), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
#
# # number of people on PrEP
# parameters <- lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result[grep("S1[a-z]", names(result))]
# yy_plot <- melt(
# data.frame(time,
# FSW = rowSums(do.call(cbind, lapply(yy, function(x) x <- x[,1]))),
# clients = rowSums(do.call(cbind, lapply(yy, function(x) x <- x[,2])))
# ),id.vars = "time")
#
# ggplot(data = yy_plot, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
#
#
# # plot prevalence
# parameters <- lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result[grep("prev", names(result))]
# df = melt(data.frame(time, FSW = yy$prev_FSW, client = yy$prev_client), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
#
# # cumulative infections
# parameters <-lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# xx <- result[grep("cumu", names(result))]
# N <- rowSums(do.call(cbind, xx))
# df = melt(data.frame(time, N), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
# gubbins -----------------------------------------------------------------
Geidelberg/cotonou documentation built on Aug. 29, 2020, 4:22 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# to debug:
# open terminal in the folder
# R- d valgrind
require(ggplot2)
require(reshape2)
#######################################################################
########################## run this if not going on cluster ###########
#######################################################################
odin::odin_package(".") # looks for any models inside inst/odin
devtools::load_all()
#
devtools::test()
#########################################################################################
#############################################################################################
#############################################################################################
# _ _ _ _ _ _ ____ _ _
# | | / \ | | | | \ | |/ ___| | | |
# | | / _ \| | | | \| | | | |_| |
# | |___ / ___ \ |_| | |\ | |___| _ |
# |_____/_/ \_\___/|_| \_|\____|_| |_|
#
#############################################################################################
#############################################################################################
#############################################################################################
# ____ _ _ _ _ _ ___ ____ _ _
# | _ \| | | | \ | | | | / _ \ / ___| / \ | |
# | |_) | | | | \| | | | | | | | | / _ \ | |
# | _ <| |_| | |\ | | |__| |_| | |___ / ___ \| |___
# |_| \_\\___/|_| \_| |_____\___/ \____/_/ \_\_____|
#
parameters <- lhs_parameters(1, par_seq = par_seq_default, condom_seq = condom_seq_default, groups_seq = groups_seq_default, years_seq = years_seq_default, set_pars = best_set_default, ranges = ranges_default, time = time_default)
result = run_model_for_tests(number_simulations = 1, time = time_default, parameters = parameters)[[1]]
result$rate_leave_pro_FSW
result$rate_leave_pro_FSW_weight_by_PrEP
result$rate_move_out_PrEP
result$rate_move_out
result$new_people_in_group_FSW_only[,c(1)] == result$new_people_in_group_FSW_only_test[,c(1)]
result$frac_N
parameters <- lapply(parameters, function(x) {x$rate_move_out_PrEP[1] = 0; return(x)})
result = run_model_for_tests(number_simulations = 1, time = time_default, parameters = parameters)[[1]]
result$new_people_in_group_FSW_only[,c(1)] == result$new_people_in_group_FSW_only_test[,c(1)]
ART_data_points_lazymcmc = data.frame(time = c(2017, 2017, 2015),
variable = c("Men", "Women","Pro FSW"),
x = c(3908, 9784, 49))#,
# N = c(19988, 207))
parameters = cotonou::lhs_parameters(number_simulations, set_pars = best_set, Ncat = 9, time = time,
ranges = ranges, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq)
res = lapply(parameters, cotonou::return_outputs, cotonou::main_model, time = time, outputs = outputs)
# likelihood_list = lapply(res, cotonou::likelihood_lazymcmc, time = time, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points, PrEP_fitting = PrEP_fitting)
x = res[[1]]
# ART_data_points_with_numbers_reduced$N = c(, , 207)
# 2017 MEN ART COVERAGE
# NUM
# (2369 + 5223)/2 # littoral, L + O + A
#
# # DENOM
# (3500 + 3500 + 1900 + 3100)/2
#
#
# # 2017 WOMEN ART COVERAGE
# # NUM
# (6155 + 13050)/2 # littoral, L + O + A
#
# # DENOM
# (3800 + 3800 + 3000 + 5000)/2
# audit report 2017, by site table:
# 3908 men and 9784 women = 13692 total
# ranges of coverage give 0.57 to 0.80 coverage in 2017
# average is 0.685
# this makes denominator of 13692/0.685 = 19988
# ____ __ ____ _ _ _ _ _
# | _ \ _ _ _ __ / _|_ __ ___ _ __ ___ / ___(_) |_| | | |_ _| |__
# | |_) | | | | '_ \ | |_| '__/ _ \| '_ ` _ \ | | _| | __| |_| | | | | '_ \
# | _ <| |_| | | | | | _| | | (_) | | | | | | | |_| | | |_| _ | |_| | |_) |
# |_| \_\\__,_|_| |_| |_| |_| \___/|_| |_| |_| \____|_|\__|_| |_|\__,_|_.__/
#
# __ _____ _____ _ _ _____ ___ _____
# \ \ / /_ _|_ _| | | | | ___|_ _|_ _|
# \ \ /\ / / | | | | | |_| | | |_ | | | |
# \ V V / | | | | | _ | | _| | | | |
# \_/\_/ |___| |_| |_| |_| |_| |___| |_|
# remove.packages("cotonou")
# rm(list = ls())
require(ggplot2)
require(reshape2)
# devtools::install_github("geidelberg/cotonou")
odin::odin_package(".") # looks for any models inside inst/odin
devtools::load_all()
devtools::test()
tbefore = Sys.time()
number_simulations = 1
batch_size = 1
epi_start = 1986
# epi_end = 2030
epi_end = 2017
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm", "n_y_comm", "n_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
# time <- seq(epi_start, epi_end, length.out = (epi_end - epi_start + 0.5)*2)
# time <- seq(epi_start, epi_end, length.out = (epi_end - epi_start + 1/12)*12)
# ranges etc from cotonou cluster etc
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR = 0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
nu = 0.022,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
# fraction_F = 0.5,
fraction_F = 0.515666224,
epsilon_1985 = 0.08,
epsilon_1992 = 0.08,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = 0.9 * 0.523, # infectiousness RR when on ART (efficacy ART assuimed 90% * % undetectable which is 52.3%)
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
# gamma01 = 0.4166667, #years
# gamma04 = 4.45, #years
#
alpha01 = rep_len(0, 9),
alpha11 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = 0.03,
alpha04 = 0.07,
alpha05 = 2,
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
# alpha23 = rep_len(0.05, 9),
# alpha24 = rep_len(0.08, 9),
# alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
# alpha33 = rep_len(0.05, 9),
# alpha34 = rep_len(0.08, 9),
# alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
# alpha43 = rep_len(0.05, 9),
# alpha44 = rep_len(0.08, 9),
# alpha45 = rep_len(0.27, 9),
test_rate_prep = c(4, 0, 0, 0, 0, 0, 0, 0, 0),
sigma = c(0.82, 0, 0, 0, 0, 0, 0, 0, 0),
prep_intervention_t = c(1985, 2015, 2016, 2017),
prep_intervention_y = matrix(c(rep(0, 9), 1, rep(0, 9-1), 1, rep(0, 9-1), rep(0, 9)), ncol = 9, byrow = T),
PrEPOnOff = 0,
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
# zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
# testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
# 0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
# 0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
# 0.142, 0.142, 0.142, 0.142, 0.142, 0.142, 0, 0, 0, # 2006 0.653/8 slope
# 0.21, 0.21, 0.21, 0.21, 0.21, 0.21, 0, 0, 0, # 2008 3*0.653/8
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0, # 2012 7*0.653/8
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0, # 2013
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0, # 2015
# 0.331, 0.331, 0.331, 0.331, 0.331, 0.331, 0, 0, 0), # 2016
# nrow = 9, ncol = 9, byrow = T),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0.118, 0.118, 0.118, 0.08125, 0.08125, 0, 0, 0, # 2005 0.142*5/6 0.0975*5/6
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
# ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
# 0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
# 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
# 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0, 0, 0),
# nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
# phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
# phi3 = c(0.105360516, rep_len(0.025,8)),
# phi4 = c(0.105360516, rep_len(0.025,8)),
# phi5 = c(0.105360516, rep_len(0.025,8)),
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2002 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2002, 2008, 2011, 2015, 2016),
n_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_comm_2016 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_t_comm = c(1985, 2002, 2015, 2016),
n_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2002 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
n_t_noncomm = c(1985, 1998, 2002, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
dropout_rate_not_FSW = 0.025,
replaceDeaths = 0,
movement = 1,
ART_recruit_rate_rest = 0.25,
ART_recruit_rate_FSW = 0.25,
ART_reinit_rate_FSW = 0.2,
ART_reinit_rate_rest = 0.2
)
# ranges ------------------------------------------------------------------
ranges = rbind(
# rate_move_out_PrEP_FSW = c(1,2),
PrEPOnOff = c(1,1),
testing_prob_men_2006 = c(0.0975, 0.21),
testing_prob_men_2008 = c(0.1, 0.26),
testing_prob_men_2012 = c(0.058, 0.26), # NOTE 0.26 is from MICHEL 2008
testing_prob_women_2006 = c(0.142, 0.4),
testing_prob_women_2008 = c(0.21, 0.54),
testing_prob_women_2012 = c(0.331, 0.513),
ART_init_ratio_MF = c(1, 3),
infected_FSW_incoming = c(1,1),
n_y_noncomm_1998_GPF_GPM = c(34, 44),
n_y_noncomm_2011_GPF_GPM = c(29, 38),
prev_non_ben_fsw_1993 = c(0.027, 0.163),
# prev_non_ben_fsw_1993 = c(0.12, 0.20),
# prev_non_ben_fsw_2015 = c(0.03, 0.157),
prev_non_ben_fsw_2015 = c(0, 0.046),
# prev_non_ben_fsw_2015 = c(0.10, 0.157), # high
# prev_non_ben_fsw_2015 = c(0.03, 0.046),
# MISC
# init_clientN_from_PCR = c(0,0),
who_believe_comm = c(0, 1),
# # growth rates
# epsilon_1985 = c(0.08, 0.08),
# epsilon_1992 = c(0.08, 0.08),
# epsilon_2002 = c(0.06, 0.07),
# epsilon_2013 = c(0.04, 0.06),
# epsilon_2016 = c(0.04, 0.06),
epsilon_1985 = c(0.059, 0.059),
epsilon_1992 = c(0.048, 0.058),
epsilon_2002 = c(0.027, 0.027),
epsilon_2013 = c(0.027, 0.027),
epsilon_2016 = c(0.027, 0.027),
# DEMOGRAPHIC
fraction_F = c(0.512, 0.52), # fraction of population born female
# frac_women_ProFSW = c(0.0024, 0.0036), # fraction of women that are professional FSW
frac_women_ProFSW = c(0.0024, 0.00715), # fraction of women that are professional FSW
frac_women_LowFSW = c(1, 2), # relative abundance of low FSW relative to pro FSW
frac_men_client = c(0.066, 0.3), # fraction of men that are clients
frac_women_virgin = c(0.079, 0.2), # fraction of women that are virgins
frac_men_virgin = c(0.070, 0.17), # fraction of men that are virgins
# prev_init_FSW = c(0.0132, 0.1), # initial prevalence of FSW
prev_init_FSW = c(0.0132, 0.0659), # initial prevalence of FSW
prev_init_rest = c(0.000313, 0.00294), # initial prevalence of the other groups
muF = c(0.0187, 0.02), # female mortality
muM = c(0.0194, 0.022), # male mortality
# rate_leave_pro_FSW = c(0, 0.125),
rate_leave_pro_FSW = c(0, 0.33), # rate of exit of professional sex work
# rate_leave_low_FSW = c(0, 1), # rate of exit of low level sex work
fraction_FSW_foreign = c(0.5, 0.9),
# fraction_FSW_foreign = c(0.1, 0.5),
rate_leave_client = c(0, 0.295), # rate of exit of clients
# rate_leave_client = c(0, 0.2), # rate of exit of clients
rate_enter_sexual_pop_F = c(0.2, 0.5), # rate of entering sexual population women
rate_enter_sexual_pop_M = c(0.2, 0.5), # rate of entering sexual population men
fraction_sexually_active_15_F = c(0.119, 0.17), # fraction of 15 year old women sexually active
fraction_sexually_active_15_M = c(0.18, 0.35), # fraction of 15 year old men sexually active
# BEHAVIOURAL
# commercial partnerships
c_comm_1993_ProFSW = c(192, 1277),
c_comm_1995_ProFSW = c(192, 1277),
c_comm_2005_ProFSW = c(81, 562),
# c_comm_2015_ProFSW = c(71, 501),
c_comm_1993_LowFSW = c(26, 78),
c_comm_1998_Client = c(8.4, 32),
c_comm_2002_Client = c(11.1, 19.8),
# c_comm_2012_Client = c(11.8, 15),
# c_comm_2015_Client = c(14.5, 19.8),
#non commercial partnerships
c_noncomm_1985_ProFSW = c(0.31, 0.86),
c_noncomm_1985_LowFSW = c(0.41, 1.04),
c_noncomm_1985_Client = c(1.6, 3.3),
c_noncomm_1998_GPF = c(0.93, 0.99),
c_noncomm_2008_GPF = c(0.77, 0.82),
c_noncomm_1998_GPM = c(1.25, 1.43),
c_noncomm_2008_GPM = c(0.73, 0.84),
# sex acts per partnership comm
n_y_comm_1985_ProFSW_Client = c(1, 3.3),
# n_y_comm_1985_Client_ProFSW = c(1.45, 11.45),
# n_y_comm_1985_ProFSW_Client = c(1, 4),
# n_y_comm_2002_ProFSW_Client = c(1, 3),
n_y_comm_1985_LowFSW_Client = c(1, 1),
n_y_comm_1985_Client_LowFSW = c(1, 1),
# sex acts per partnership noncomm
n_y_noncomm_2002_ProFSW_Client = c(13, 20),
n_y_noncomm_2015_ProFSW_Client = c(38.2, 60),
# n_y_noncomm_1985_GPF_GPM = c(39, 100),
# n_y_noncomm_1985_GPM_GPF = c(19.4, 46.7),
#BETA
betaMtoF_baseline = c(0.0006, 0.00109), # baseline male to female transmission rate
RR_beta_FtM = c(0.53, 2), # RR for transmission female to male
# RR_beta_HSV2_comm_a = c(1.4, 2.1), # RR for commercial sex acts where the susceptible individual is infected HSV2
# RR_beta_HSV2_noncomm_a = c(2.2, 3.4), # RR for non commercial sex acts where the susceptible individual is infected HSV2
RR_beta_HSV2_a_FSW = c(0.9, 2.3),
RR_beta_HSV2_a_client = c(1.5, 2.2),
RR_beta_HSV2_a_GPF = c(1.8, 3.4),
RR_beta_HSV2_a_GPM = c(2.2, 4.3),
prev_HSV2_FSW = c(0.87, 0.94), # prevalence HSV2 in FSW
prev_HSV2_Client = c(0.18, 0.28), # prevalence HSV2 in clients
prev_HSV2_GPF = c(0.27, 0.32), # prevalence of HSV2 in GPF
prev_HSV2_GPM = c(0.098, 0.14), # prevalence of HSV2 in GPM
RR_beta_circum = c(0.34, 0.72), # RR for transmission if susceptible individual is circumcised
# Progression parameters
infect_acute = c(4.5, 18.8), # RR for transmission rate if infected is acute stage
infect_AIDS = c(4.5, 11.9), # RR for transmission rate if infected is in AIDS stage
ART_eff = c(0.96, 0.99), # infectiousness RR when on ART (efficacy ART assuimed 90% * % undetectable which is 52.3%)
viral_supp_y_1986_rest = c(0.424, 0.85),
viral_supp_y_2015_ProFSW = c(0.75, 0.85),
ec = c(0.58, 0.95), # condom efficacy
# eP1a = c(0.9, 0.9), # prep efficacy perfect adherence
# eP1b = c(0, 0.9), # prep efficacy intermediate adherence
# eP1c = c(0, 0), # prep efficacy poor adherence
SC_to_death = c(8.7, 12.3),
dur_primary_phase = c(0.25, 0.42),
dur_200_349 = c(2.3, 4.4),
dur_below_200 = c(0.58, 3.17),
alpha03 = c(0.01, 0.05),
alpha04 = c(0.03, 0.1),
ART_RR_prog = c(4.82, 10.23),
# intervention_testing_increase = c(1, 2),
# intervention_testing_increase = c(0.5, 2), # keep
intervention_testing_increase = c(0, 0),
RR_test_CD4200 = c(1, 5.4),
# ART_recruit_rate_FSW = c(0.5, 6),
# ART_recruit_rate_FSW = c(0.5, 1.5),
# ART_recruit_rate_FSW = c(0.5, 3),
ART_recruit_rate_FSW = c(0.25, 6),
# ART_recruit_rate_rest = c(0.5, 1.5),
# ART_recruit_rate_rest = c(0.5, 6),
ART_recruit_rate_rest = c(6, 12),
# intervention_ART_increase = c(0, 12),
# intervention_ART_increase = c(0, 24),
# intervention_ART_increase = c(0.5, 5), # keep
intervention_ART_increase = c(0, 0),
dropout_rate_not_FSW = c(0.0233, 0.11),
dropout_rate_FSW = c(0.0233, 0.11),
ART_reinit_rate_FSW = c(0.25, 1.5),
ART_reinit_rate_rest = c(0.25, 1.5),
# condoms
# fc_y_comm_1985_ProFSW_Client = c(0, 0),
# fc_y_comm_1985_ProFSW_Client = c(0.54, 0.69),
# fc_y_comm_1998_ProFSW_Client = c(0.54, 0.99),
fc_y_comm_1985_ProFSW_Client = c(0, 0.18),
fc_y_comm_1993_ProFSW_Client = c(0.18, 0.33),
fc_y_comm_1998_ProFSW_Client = c(0.4, 0.73),
fc_y_comm_2002_ProFSW_Client = c(0.61, 0.99),
fc_y_comm_2008_ProFSW_Client = c(0.86, 0.99),
fc_y_comm_1985_LowFSW_Client = 0,
fc_y_comm_2015_LowFSW_Client = c(0.25, 0.52),
fc_y_noncomm_1985_ProFSW_Client = 0,
fc_y_noncomm_2002_ProFSW_Client = c(0.19, 0.62),
fc_y_noncomm_1985_LowFSW_Client = 0,
fc_y_noncomm_2015_LowFSW_Client = c(0.138, 0.383),
# fc_y_noncomm_1985_GPF_GPM = 0,
fc_y_noncomm_1998_GPF_GPM = c(0.033, 0.05),
fc_y_noncomm_2011_GPF_GPM = c(0.16, 0.26)
)
# outputs -----------------------------------------------------------------
outputs = c("S0", "S1a", "S1b","HIV_positive_On_ART","prep_efficacious", "S1c", "S1d", "prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm", "ART_coverage_FSW", "ART_coverage_men", "ART_coverage_women", "ART_coverage_all", "rho", "n_comm", "n_noncomm", "fc_comm", "fc_noncomm", "N", "cumuHIVDeaths", "lambda_0", "lambda_1a", "lambda_1b", "lambda_1c", "lambda_1d", "HIV_positive")
CEA_outputs = unique(c(
"PrEP_reinit_OnOff_t",
"PrEP_reinit_OnOff_y",
"PrEP_reinit_OnOff",
"zeta_re",
"PrEPinitiations",
"testpar","pfFSW", "prop_FSW_I0_1", "prop_FSW_I0_2", "prop_FSW_I0_3", "prop_FSW_I0_4", "prop_FSW_I0_5","prev_non_ben_fsw_1993",
"prep_efficacious","prev_non_ben_fsw_2015",
"gamma32_without_supp",
"gamma33_without_supp",
"gamma34_without_supp",
"alpha33_without_supp",
"alpha34_without_supp",
"alpha35_without_supp",
"gamma32",
"gamma33",
"gamma34",
"alpha33",
"alpha34",
"alpha35",
"viral_supp", "new_acute_infected","pfFSW", "above_500_by_group", "FSW_eligible", "GP_eligible","eP1a_effective", "eP1b_effective", "eP1c_effective","mu","sigma", "prep_offered","TasPinitiations",
"prep_offered", "TasP_testing","cumu_PrEP_dropouts",
"cost_Initiation_of_ART_study_FSW",
"cost_Initiation_of_ART_government_FSW",
"cost_1_year_of_ART_study_FSW",
"cost_1_year_of_ART_government_FSW",
"cost_Initiation_ART_rest_of_population",
"cost_1_year_of_ART_rest_of_population",
"cost_FSW_initiation_ART_Patient_costs",
"cost_FSW_1_year_ART_Patient_costs",
"cost_Initiation_of_PrEP_study",
"cost_1_year_PrEP_perfect_adherence_study",
"cost_1_year_PrEP_intermediate_adherence_study",
"cost_1_year_PrEP_non_adherence_study",
"cost_Initiation_of_PrEP_government",
"cost_1_year_PrEP_perfect_adherence_government",
"cost_1_year_PrEP_intermediate_adherence_government",
"cost_1_year_PrEP_non_adherence_government",
"cost_PREP_initiation_Patient_costs",
"cost_PREP_1_year_ART_Patient_costs",
"W0", "W1", "W2", "W3", "Number_DALY_W1","Number_DALY_W2", "Number_DALY_W3", "FSW_On_PrEP_all_cats", "PrEPinitiations", "PrEPinitiations1a",
"PrEPinitiations1b", "PrEPinitiations1c", "pc_susceptible_FSW_On_PrEP", "pc_all_FSW_On_PrEP", "Number_Susceptibles",
"HIV_positive_On_ART", "HIV_positive_Diagnosed_Off_ART", "Primary_Off_ART",
"CD4_above_500_Off_ART", "CD4_350_500_Off_ART", "CD4_200_350_Off_ART", "CD4_below_200_Off_ART", "cumuDeaths_On_ART", "HIV_positive", "ec", "cumuARTinitiations","cumuARTREinitiations", "rate_leave_pro_FSW","tau_intervention",
"testing_prob", "tau", "N", "S0", "S1a", "S1b", "S1c", "S1d", "I01", "I11", "I02", "I03", "I04",
"I05", "I22", "I23", "I24", "I25", "I32", "I33", "I34", "I35", "I42", "I43", "I44", "I45", "prev",
"frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client",
"prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm", "ART_coverage_FSW",
"ART_coverage_men", "ART_coverage_women", "ART_coverage_all", "rho", "n_comm", "n_noncomm", "fc_comm",
"fc_noncomm", "N", "cumuHIVDeaths", "lambda_sum_0", "lambda_sum_1a", "lambda_sum_1b", "lambda_sum_1c",
"lambda_sum_1d", "S0", "S1a", "S1b", "S1c", "S1d", "OnPrEP1a", "OnPrEP1b",
"OnPrEP1c", "ART_eligible_CD4_above_500", "ART_eligible_CD4_350_500","ART_eligible_CD4_200_349","ART_eligible_CD4_below_200",
"cumuAllDeaths", "cumuHIVDeaths", "cumuARTinitiations", "cumuARTREinitiations",
"OnPrEP", "ART_sex_ratio", "pc_S1b", "pc_S1a", "pc_S1c", "cumuInf",
"intervention_ART_increase", "testing_prob", "rho_intervention",
"ART_eligible_CD4_above_500", "ART_eligible_CD4_350_500", "ART_eligible_CD4_200_349",
"ART_eligible_CD4_below_200", "new_people_in_group_FSW_only", "rate_move_out", "rate_move_in",
"FSW_out", "FSW_in", "zeta", "tau", "prep_offering_rate", "intervention_testing_increase", "sigma",
"PrEPOnOff", "prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW",
"prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced",
"who_believe_comm", "ART_coverage_FSW", "ART_coverage_men", "ART_coverage_women", "ART_coverage_all",
"rho", "n_comm", "n_noncomm", "fc_comm", "fc_noncomm", "N", "cumuHIVDeaths", "lambda_0", "lambda_1a",
"lambda_1b", "lambda_1c", "lambda_1d"))
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.084, 100*0.043),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
# 100*0.091838441, 100*0.026704897),
100*0.055700329, 100*0.024043597),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.120857355, 100*0.069311506))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
prev_points_extended_low = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.084, 100*0.043),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0, 100*0),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.120857355, 100*0.069311506))
prev_points_FSW_only = data.frame(time = c(1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015
),
variable = c(rep("Pro FSW", 8)
),
value = c(53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7
),
lower = c(48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71
),
upper = c(58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01))
prev_points_FSW_only_even_less_2 = prev_points_FSW_only[c(1, 4, 6, 8),]
prev_points_FSW_Cotonou_centrale_lower_bound = prev_points_FSW_only_even_less_2
prev_points_FSW_Cotonou_centrale_lower_bound[prev_points_FSW_Cotonou_centrale_lower_bound$time == 2015,"lower"] = 13.79
prev_points_FSW_Cotonou_centrale_lower_bound$x = c(195, 74, 122, 116)
prev_points_FSW_Cotonou_centrale_lower_bound$N = c(366, 190, 417, 620)
prev_points_FSW_Cotonou_centrale_lower_bound_mid_year = prev_points_FSW_Cotonou_centrale_lower_bound
prev_points_FSW_Cotonou_centrale_lower_bound_mid_year$time = prev_points_FSW_Cotonou_centrale_lower_bound_mid_year$time + 0.5
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
# frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male", "Low-level FSW"),
# min = c(0.001237599, 0.1509*(1-0.515666224), 0.07896475*0.515666224, 0.07039551*(1-0.515666224), 2*0.001237599),
# max = c(0.007374027, 0.40 * (1-0.515666224), 0.2*0.515666224, 0.17*(1-0.515666224), 5*0.007374027))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"),
min = c(0.001237599, 0.074*(1-0.515666224), 0.07896475*0.515666224, 0.07039551*(1-0.515666224), 0.0048*0.516, 1),
max = c(0.0143*0.515666224/2, 0.3 * (1-0.515666224), 0.2*0.515666224, 0.17*(1-0.515666224), 0.0143*0.516, 5))
frac_N_discard_points_no_FSW_LB = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"),
min = c(0, 0.074*(1-0.515666224), 0.07896475*0.515666224, 0.07039551*(1-0.515666224), 0.0048*0.516, 1),
max = c(0.0143*0.515666224/2, 0.3 * (1-0.515666224), 0.2*0.515666224, 0.17*(1-0.515666224), 0.0143*0.516, 5))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
# ART coverage data points ------------------------------------------------
ART_data_points = data.frame(time = c(2011, 2012, 2013, 2014, 2015, 2016, 2017,
2012, 2014, 2015, 2016, 2017
),
Lower = c(0.33, 0.42, 0.44, 0.39, 0.44, 0.51, 0.57,
0.09, 0.14, 0.2, 0.50, 0.56
),
Upper = c(0.52, 0.66, 0.69, 0.61, 0.69, 0.8, 0.8,
0.13, 0.2, 0.28, 0.7, 0.79
),
variable = c("All", "All", "All", "All", "All", "All", "All",
"Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
ART_data_points_extra = data.frame(time = c(2011, 2012, 2013, 2014, 2015, 2016, 2017,
2012, 2014, 2015, 2016, 2017, 2017.5
),
Lower = c(0.33, 0.42, 0.44, 0.39, 0.44, 0.51, 0.57,
0.08, 0.14, 0.2, 0.50, 0.56, 0.8
),
Upper = c(0.52, 0.66, 0.69, 0.61, 0.69, 0.8, 0.8,
0.11, 0.2, 0.28, 0.7, 0.79, 0.9
),
variable = c("All", "All", "All", "All", "All", "All", "All",
"Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
ART_data_points_FSW = ART_data_points[c(8, 9, 10, 11, 12),]
ART_data_points_FSW_last_2 = ART_data_points[c(11, 12),]
ART_data_points_first_and_last_FSW = ART_data_points[c(8, 12),]
# first and last GP, first FSW and 2016, 2017 FSW
ART_data_points_1611 = ART_data_points[c(1, 7, 8, 11, 12),]
# first and last GP, all fsw before intervention
ART_data_points_1911 = ART_data_points[c(1, 7, 8, 9, 10),]
# NUMBERS OF FSW ON ART
ART_data_points_with_numbers = data.frame(time = c(2011, 2017,
2012, 2014, 2015, 2016, 2017
),
Lower = c(0.33, 0.57,
27, 34, 42, 45, 62
),
Upper = c(0.52, 0.8,
37, 46, 56, 83, 107
),
variable = c("All", "All",
"Numbers FSW", "Numbers FSW", "Numbers FSW", "Numbers FSW", "Numbers FSW"))
# PrEP_fitting ------------------------------------------------
# PrEP_fitting = data.frame(time = c(2016, 2017, 2016, 2017, 2016, 2017),
# group = c("S1a", "S1a", "S1b", "S1b", "S1c", "S1c"),
# lower = c(50, 40, 50, 40, 50, 40),
# point = c(55, 45, 50, 40, 50, 40),
# upper = c(61, 66, 61, 66, 61, 66)
#
#
# )
#
# PrEP_fitting = data.frame(time = c(2016, 2017),
# group = c("S1a", "S1a"),
# lower = c(50, 40),
# point = c(55, 45),
# upper = c(61, 66)
#
#
# )
PrEP_fitting = NULL
#
#
# ART_data_points_FSW = data.frame(time = c(2010, 2013, 2014, 2015, 2016, 2017
# ),
# Lower = c(0.07, 0.13, 0.17, 0.50, 0.56, 0.80
#
# ),
# Upper = c(0.10, 0.18, 0.24, 0.7, 0.79, 0.9
#
# ),
# variable = c("Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
# ART_data_points_FSW_last_3 = data.frame(time = c(2015, 2016, 2017
# ),
# Lower = c(0.50, 0.56, 0.80
#
# ),
# Upper = c(0.7, 0.79, 0.9
#
# ),
# variable = c("Pro FSW", "Pro FSW", "Pro FSW"))
# ART_data_points_first_and_last = data.frame(time = c(2010, 2017
# ),
# Lower = c(0.07, 0.80
#
# ),
# Upper = c(0.10, 0.9
#
# ),
# variable = c("Pro FSW", "Pro FSW"))
# ART_data_points_all = data.frame(time = c(2010, 2011, 2012, 2013, 2014, 2015, 2016,
# 2010, 2011, 2012, 2013, 2014, 2015, 2016,
# 2010, 2011, 2012, 2013, 2014, 2015, 2016,
# 2010, 2013, 2014, 2015, 2016
# ),
# Lower = c(0.32, 0.4, 0.43, 0.38, 0.43, 0.49, 0.552,
# 0.32, 0.4, 0.43, 0.38, 0.43, 0.49, 0.552,
# 0.32, 0.4, 0.43, 0.38, 0.43, 0.49, 0.552,
# 7.5, 12.5, 17.4, 50.0, 56.1
#
# ),
# Upper = c(0.522449, 0.653061, 0.702041, 0.620408, 0.702041, 0.8, 0.8,
# 0.522449, 0.653061, 0.702041, 0.620408, 0.702041, 0.8, 0.8,
# 0.522449, 0.653061, 0.702041, 0.620408, 0.702041, 0.8, 0.8,
# 0.522449, 0.620408, 0.702041, 0.8, 0.8
#
# ),
# variable = c("Women", "Women", "Women", "Women", "Women", "Women", "Women",
# "Men", "Men", "Men", "Men", "Men", "Men", "Men",
# "All", "All", "All", "All", "All", "All", "All",
# "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW", "Pro FSW"))
#####################################################
time_with_mid <- seq(epi_start, epi_end, length.out = (epi_end - epi_start + 0.5)*2)
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points,
# frac_N_discard_points = frac_N_discard_points_no_FSW_LB, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points, PrEP_fitting = PrEP_fitting)
# result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq,
# years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = CEA_outputs)
# result <- cotonou::just_parameters(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs)
#
# result
result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = seq(1986, 2035), ranges = ranges, outputs = CEA_outputs, prev_points = prev_points,
frac_N_discard_points = frac_N_discard_points_no_FSW_LB, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points, PrEP_fitting = PrEP_fitting)
# result[[3]] = result[[2]]
result[[3]][[1]]$zeta_re
result[[3]][[1]]$PrEP_reinit_OnOff
result[[3]][[1]]$PrEP_reinit_OnOff_t
result[[3]][[1]]$PrEP_reinit_OnOff_y
result[[3]][[1]]$PrEPinitiations
# test to explore the effect of incoming FSW prevalence into the model,
# and its interaction with the duration of sex work on the HIV incidence and prevalence of FSWs.
load("best_pars_combined.RData")
pars = result[[1]][[1]]
pars = modifyList(pars, best_pars_combined)
res_best_runs = cotonou::return_outputs(pars, cotonou::main_model, time = time, outputs = outputs, solving_method = "ode45")
res_best_runs = list(res_best_runs)
res_best_runs[[1]]$pfFSW
# ignore these ######################################
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N), function(x) (x[,1]/(x[,1] + x[,2] + x[,3] + x[,4] + x[,7])))), 2, cotonou::quantile_95)))
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N/x$frac_F), function(x) x[,1])), 2, cotonou::quantile_95)))
annual_client_volume_pro_FSW = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$c_comm[,1]}))))
colnames(annual_client_volume_pro_FSW) = c("time", as.character(seq(1, (length(annual_client_volume_pro_FSW[1,])-1))))
annual_client_volume_pro_FSW_melted = reshape2::melt(annual_client_volume_pro_FSW, id.vars = c("time"))
N_Pro_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1)])}))))
colnames(N_Pro_FSW) = c("time", as.character(seq(1, (length(N_Pro_FSW[1,])-1))))
N_Pro_FSW_melted = reshape2::melt(N_Pro_FSW, id.vars = c("time"))
colnames(N_Pro_FSW_melted) = c("time", "run", "value")
N_Low_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(2)])}))))
colnames(N_Low_FSW) = c("time", as.character(seq(1, (length(N_Low_FSW[1,])-1))))
N_Low_FSW_melted = reshape2::melt(N_Low_FSW, id.vars = c("time"))
colnames(N_Low_FSW_melted) = c("time", "run", "value")
N_Client = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5)])}))))
colnames(N_Client) = c("time", as.character(seq(1, (length(N_Client[1,])-1))))
N_Client_melted = reshape2::melt(N_Client, id.vars = c("time"))
colnames(N_Client_melted) = c("time", "run", "value")
Fraction_F = do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)) /
(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5, 6)])}), rowSums)) + do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)))
lambda_sum_0_ProFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,1]))))
lambda_sum_0_LowFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,2]))))
lambda_sum_0_GPF = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,3]))))
lambda_sum_0_FormerFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,4]))))
lambda_sum_0_Client = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,5]))))
lambda_sum_0_GPM = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,6]))))
lambda_sum_0_Virgin_Female = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,7]))))
lambda_sum_0_Virgin_Male = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,8]))))
lambda_sum_0_Former_FSW_Outside = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,9]))))
lambda_sum_0_indiv = rbind(lambda_sum_0_ProFSW, lambda_sum_0_LowFSW, lambda_sum_0_GPF,
lambda_sum_0_FormerFSW, lambda_sum_0_Client, lambda_sum_0_GPM)
lambda_sum_0_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"), each = length(time)), lambda_sum_0_indiv)
colnames(lambda_sum_0_indiv) = c("time", "variable", as.character(seq(1, length(lambda_sum_0_ProFSW[1,]))))
lambda_sum_0_indiv_melted = reshape2::melt(lambda_sum_0_indiv, id.vars = c("time", "variable"))
colnames(lambda_sum_0_indiv_melted) = c("time", "variable", "run", "value")
lambda_sum_0_indiv_melted$variable = factor(lambda_sum_0_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"))
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac_Active_FSW = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {100*(x$frac_N[,1] + x$frac_N[,2])})), 2, cotonou::quantile_95)))
Ratio_Low_Pro = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]})), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside, frac_Active_FSW, Ratio_Low_Pro)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"))
prev_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
prev_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)))
prev_LowFSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)))
prev_client_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)))
prev_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)))
prev_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)))
prev_indiv = rbind(prev_FSW_indiv, prev_LowFSW_indiv, prev_client_indiv, prev_women_indiv, prev_men_indiv)
prev_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)), prev_indiv)
colnames(prev_indiv) = c("time", "variable", as.character(seq(1, length(prev_FSW_indiv[1,]))))
prev_indiv_melted = reshape2::melt(prev_indiv, id.vars = c("time", "variable"))
colnames(prev_indiv_melted) = c("time", "variable", "run", "value")
prev_indiv_melted$variable = factor(prev_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
ART_coverage_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)), 2, cotonou::quantile_95))
ART_coverage_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)), 2, cotonou::quantile_95))
ART_coverage_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)), 2, cotonou::quantile_95))
ART_coverage_all = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)), 2, cotonou::quantile_95))
ART_coverage = rbind(ART_coverage_women, ART_coverage_men, ART_coverage_FSW, ART_coverage_all)
ART_coverage = data.frame(time, ART_coverage, rep(c("Women", "Men", "Pro FSW", "All"), each = length(time)))
colnames(ART_coverage) = c("time", "Lower", "Median", "Upper", "variable")
ART_coverage$variable = factor(ART_coverage$variable, levels = c("Pro FSW", "Women", "Men", "All"))
ART_coverage = ART_coverage[ART_coverage$variable == "All" | ART_coverage$variable == "Pro FSW",]
ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)))
ART_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)))
ART_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)))
ART_all_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)))
ART_indiv = rbind(ART_FSW_indiv, ART_all_indiv)
ART_indiv = data.frame(time, rep(c("Pro FSW", "All"), each = length(time)), ART_indiv)
colnames(ART_indiv) = c("time", "variable", as.character(seq(1, length(ART_FSW_indiv[1,]))))
ART_indiv_melted = reshape2::melt(ART_indiv, id.vars = c("time", "variable"))
colnames(ART_indiv_melted) = c("time", "variable", "run", "value")
ART_indiv_melted$variable = factor(ART_indiv_melted$variable, levels = c("Pro FSW", "All"))
# N of FSW on ART
N_ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$HIV_positive_On_ART[,1])))
N_ART_FSW_indiv = data.frame(time, rep(c("Pro FSW"), each = length(time)), N_ART_FSW_indiv)
colnames(N_ART_FSW_indiv) = c("time", "variable", as.character(seq(1, length(N_ART_FSW_indiv[1,])-2)))
N_ART_FSW_indiv_melted = reshape2::melt(N_ART_FSW_indiv, id.vars = c("time", "variable"))
colnames(N_ART_FSW_indiv_melted) = c("time", "variable", "run", "value")
# N on ART and N off ART diagnosed
Diagnosed_Off_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) x[,1]))))
Diagnosed_On_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) x[,1]))))
Diagnosed_Dropout_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) x[,1]))))
Diagnosed_FSW = data.frame(rbind(Diagnosed_Off_ART_FSW, Diagnosed_On_ART_FSW, Diagnosed_Dropout_ART_FSW),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_FSW) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_FSW[1,])-1))), "variable")
Diagnosed_FSW_melted = reshape2::melt(Diagnosed_FSW, id.vars = c("time", "variable"))
Diagnosed_FSW_melted$group = "FSW"
colnames(Diagnosed_FSW_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_On_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_Dropout_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_All = data.frame(rbind(Diagnosed_Off_ART_All, Diagnosed_On_ART_All, Diagnosed_Dropout_ART_All),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_All) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_All[1,])-1))), "variable")
Diagnosed_All_melted = reshape2::melt(Diagnosed_All, id.vars = c("time", "variable"))
Diagnosed_All_melted$group = "All"
colnames(Diagnosed_All_melted) = c("time", "variable", "run", "value", "group")
Diagnosed = rbind(Diagnosed_FSW_melted, Diagnosed_All_melted)
Diagnosed_Off_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_On_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Dropout_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Men = data.frame(rbind(Diagnosed_Off_ART_Men, Diagnosed_On_ART_Men, Diagnosed_Dropout_ART_Men),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Men) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Men[1,])-1))), "variable")
Diagnosed_Men_melted = reshape2::melt(Diagnosed_Men, id.vars = c("time", "variable"))
Diagnosed_Men_melted$group = "Men"
colnames(Diagnosed_Men_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_On_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Dropout_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Women = data.frame(rbind(Diagnosed_Off_ART_Women, Diagnosed_On_ART_Women, Diagnosed_Dropout_ART_Women),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Women) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Women[1,])-1))), "variable")
Diagnosed_Women_melted = reshape2::melt(Diagnosed_Women, id.vars = c("time", "variable"))
Diagnosed_Women_melted$group = "Women"
colnames(Diagnosed_Women_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Women_Men = rbind(Diagnosed_Women_melted, Diagnosed_Men_melted)
Diagnosed_Women_Men_ratio = data.frame(Diagnosed_Women_melted[,c("time", "variable", "run")],
value = Diagnosed_Women_melted$value/Diagnosed_Men_melted$value)
HIV_deaths = data.frame(time[-1], t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) x$cumuHIVDeaths), rowSums), diff) )))
colnames(HIV_deaths) = c("time", as.character(seq(1, (length(HIV_deaths[1,])-1))))
HIV_deaths_melted = reshape2::melt(HIV_deaths, id.vars = c("time"))
# fraction of groups in their genders -------------------------------------
pc_OfWomen_ProFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))
)))
pc_OfWomen_LowFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_Active_FSW = data.frame(time, t(100*(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) + do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_GPF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_FormerFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_Client = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfMen_GPM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfWomen_VF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_VM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
Ratio_Low_Pro = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]}))))
frac_by_gender = rbind(pc_OfWomen_ProFSW,
pc_OfWomen_LowFSW,
pc_OfWomen_GPF,
pc_OfWomen_FormerFSW,
pc_OfMen_Client,
pc_OfMen_GPM,
pc_OfWomen_VF,
pc_OfMen_VM,
pc_OfWomen_Active_FSW,
Ratio_Low_Pro
)
frac_by_gender = data.frame(frac_by_gender, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac_by_gender) = c("time",as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))), "variable")
frac_by_gender$variable = factor(frac_by_gender$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"))
frac_by_gender_melted = reshape2::melt(frac_by_gender, id.vars = c("time", "variable"))
colnames(frac_by_gender_melted) = c("time", "variable", "run", "value")
colnames(pc_OfWomen_ProFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))))
colnames(pc_OfWomen_LowFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_LowFSW[1,])-1))))
colnames(pc_OfWomen_Active_FSW) = c("time", as.character(seq(1, (length(pc_OfWomen_Active_FSW[1,])-1))))
colnames(pc_OfMen_Client) = c("time", as.character(seq(1, (length(pc_OfMen_Client[1,])-1))))
pc_OfWomen_ProFSW_melted = reshape2::melt(pc_OfWomen_ProFSW, id.vars = c("time"))
pc_OfWomen_LowFSW_melted = reshape2::melt(pc_OfWomen_LowFSW, id.vars = c("time"))
pc_OfWomen_Active_FSW_melted = reshape2::melt(pc_OfWomen_Active_FSW, id.vars = c("time"))
pc_OfMen_Client_melted = reshape2::melt(pc_OfMen_Client, id.vars = c("time"))
# condoms -----------------------------------------------------------------
condom_Pro_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,1,][,5]}))))
condom_Pro_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,1,][,5]}))))
condom_Pro_FSW = data.frame(time, rbind(condom_Pro_FSW_comm, condom_Pro_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Pro_FSW) = c("time", as.character(seq(1, (length(condom_Pro_FSW[1,])-2))), "variable")
condom_Pro_FSW_melted = reshape2::melt(condom_Pro_FSW, id.vars = c("time", "variable"))
colnames(condom_Pro_FSW_melted) = c("time", "variable", "run", "value")
condom_Low_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,2,][,5]}))))
condom_Low_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,2,][,5]}))))
condom_Low_FSW = data.frame(time, rbind(condom_Low_FSW_comm, condom_Low_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Low_FSW) = c("time", as.character(seq(1, (length(condom_Low_FSW[1,])-2))), "variable")
condom_Low_FSW_melted = reshape2::melt(condom_Low_FSW, id.vars = c("time", "variable"))
colnames(condom_Low_FSW_melted) = c("time", "variable", "run", "value")
condom_GPF_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,3,][,6]})))))
colnames(condom_GPF_noncomm) = c("time", as.character(seq(1, (length(condom_GPF_noncomm[1,])-1))))
condom_GPF_noncomm_melted = reshape2::melt(condom_GPF_noncomm, id.vars = c("time"))
condom_GPM_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,6,][,3]})))))
colnames(condom_GPM_noncomm) = c("time", as.character(seq(1, (length(condom_GPM_noncomm[1,])-1))))
condom_GPM_noncomm_melted = reshape2::melt(condom_GPM_noncomm, id.vars = c("time"))
# testing -----------------------------------------------------------------
testing_rate_ratio_F_M = data.frame(time, t((do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(3)])}))/do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(6)])})))))
colnames(testing_rate_ratio_F_M) = c("time", as.character(seq(1, (length(testing_rate_ratio_F_M[1,])-1))))
testing_rate_ratio_F_M_melted = reshape2::melt(testing_rate_ratio_F_M, id.vars = c("time"))
colnames(testing_rate_ratio_F_M_melted) = c("time", "run", "value")
Diagnosed_Women_Men_ratio_On_ART = Diagnosed_Women_Men_ratio[Diagnosed_Women_Men_ratio$variable == "Diagnosed On ART",]
testing_rate_ratio_F_M_Women_Men_ratio_On_ART = data.frame(x=testing_rate_ratio_F_M_melted$value, y=Diagnosed_Women_Men_ratio_On_ART$value)
ggplot() + geom_point(data = testing_rate_ratio_F_M_Women_Men_ratio_On_ART,
aes(x = x, y= y)) + theme_bw() + labs(x = "Probability of being tested in last year and knows the result ratio F:M",
y = "Ratio of F:M on ART")
# OUTCOMES ----------------------------------------------------------------
# next script
###
# res_best_runs
frac_N_discard_points_graph = frac_N_discard_points
frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio", c(2,3)] = frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio",c(2,3)]/100
#####################################################
prev_axes = data.frame(variable = c(rep("Pro FSW", 2),
rep("Clients", 2),
rep("Women", 2),
rep("Men", 2),
rep("Low-level FSW", 2)),
time = c(rep(c(1986, 2025), 5)),
value = c(0, 70, 0, 70, 0, 15, 0, 15, 0, 70)
)
prev_points_80s = prev_points_all[c(1,2,3),]
prev_points[prev_points$time == "2015", "lower"][1] = 13.79
# plot prevalence in each group indiv runs
g1=ggplot() + geom_line(data = prev_indiv_melted, aes(x = time, y = value, factor = variable, factor = run), alpha = 0.3) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
geom_point(data = prev_points_80s, aes(x = time, y = value), colour = "red")+
geom_blank(data = prev_axes, aes(x = time, y = value))+
theme(text = element_text(size=20))
g1
require(ggplot2)
prop_each_inf = lapply(res_best_runs, function(x) {
# list(x$I01[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I02[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I03[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I04[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]),
# x$I05[,1]/(x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1]))
list(
(x$I01[,1] + x$I11[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I02[,1] + x$I22[,1] + x$I32[,1] + x$I42[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I03[,1] + x$I23[,1] + x$I33[,1] + x$I43[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I04[,1] + x$I24[,1] + x$I34[,1] + x$I44[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1]),
(x$I05[,1] + x$I25[,1] + x$I35[,1] + x$I45[,1])/(
x$I01[,1] + x$I02[,1] + x$I03[,1] + x$I04[,1] + x$I05[,1] +
x$I11[,1] +
x$I22[,1] + x$I23[,1] + x$I24[,1] + x$I25[,1] +
x$I32[,1] + x$I33[,1] + x$I34[,1] + x$I35[,1]+
x$I42[,1] + x$I43[,1] + x$I44[,1] + x$I45[,1])
)
}
)
prop_each_inf = data.frame(time, do.call(rbind, lapply(prop_each_inf, function(x) {
t(do.call(rbind, x))
})), rep(1:length(res_best_runs), each = length(res_best_runs[[1]]$S0[,1])))
colnames(prop_each_inf) = c("time", c("Primary", "CD4 > 500", "CD4 350 - 500", "CD4 200 - 349", "CD4 < 200"), "run")
prop_each_inf_melted = reshape2::melt(prop_each_inf, id.vars = c("time", "run"))
ggplot(prop_each_inf_melted) + geom_line(aes(x = time, y = value, colour = variable, factor = as.character(run)), size = I(01.5)) + theme_bw() +
scale_colour_manual(values = c("#e41a1c", "#377eb8", "#4daf4a", "#984ea3", "#ff7f00")) +
geom_hline(yintercept = 0.031904762, col = "#e41a1c")+
geom_hline(yintercept = 0.235238095, col = "#377eb8")+
geom_hline(yintercept = 0.235238095, col = "#4daf4a")+
geom_hline(yintercept = 0.319047619, col = "#984ea3")+
geom_hline(yintercept = 0.178571429, col = "#ff7f00") + labs(y = "proportion in each stage of infection")
# varying!
# pars$pfFSW_y[2,1] <- 0.027
# pars$rate_leave_pro_FSW
# # pars$prev_non_ben_fsw_1993
# # pars$prev_non_ben_fsw_2015
#
# res_best_runs = cotonou::return_outputs(pars, cotonou::main_model, time = time, outputs = CEA_outputs)
#
# res_best_runs = list(res_best_runs)
pars = pars_keep
new_values = rbind(
rate_leave_pro_FSW = c(0.33, 0.33),
prev_non_ben_fsw_1993 = c(0.163, 0.163),
prev_non_ben_fsw_2015= c(0.034, 0.034),
fraction_FSW_foreign = c(0.9, 0.9)
)
x = pars
x = lapply(x[rownames(ranges)], function(y) {
if(length(y) == 9)
y = y[1] else y
})
x = x[-which(names(x) %in% rownames(new_values))]
combined_ranges = cbind(unlist(x[rownames(ranges)]), unlist(x[rownames(ranges)]))
combined_ranges = rbind(combined_ranges, new_values)
res_after_prep = cotonou::run_model(number_simulations = 1, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set,
time = time,
ranges = combined_ranges, outputs = CEA_outputs)[[2]]
median(unlist(lapply(res_after_prep, function(x) x$prev[which(time == 1993),1])))
median(unlist(lapply(res_after_prep, function(x) x$prev[which(time == 2015),1])))
median(unlist(lapply(res_after_prep, function(x) x$lambda_sum_0[which(time == 1993),1])))*100
median(unlist(lapply(res_after_prep, function(x) x$lambda_sum_0[which(time == 2015),1])))*100
res_after_prep[[1]]$pfFSW[which(time == 1993),1]
#
# ignore these ######################################
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N), function(x) (x[,1]/(x[,1] + x[,2] + x[,3] + x[,4] + x[,7])))), 2, cotonou::quantile_95)))
# frac_ProFSW_F = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N/x$frac_F), function(x) x[,1])), 2, cotonou::quantile_95)))
annual_client_volume_pro_FSW = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$c_comm[,1]}))))
colnames(annual_client_volume_pro_FSW) = c("time", as.character(seq(1, (length(annual_client_volume_pro_FSW[1,])-1))))
annual_client_volume_pro_FSW_melted = reshape2::melt(annual_client_volume_pro_FSW, id.vars = c("time"))
N_Pro_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1)])}))))
colnames(N_Pro_FSW) = c("time", as.character(seq(1, (length(N_Pro_FSW[1,])-1))))
N_Pro_FSW_melted = reshape2::melt(N_Pro_FSW, id.vars = c("time"))
colnames(N_Pro_FSW_melted) = c("time", "run", "value")
N_Low_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(2)])}))))
colnames(N_Low_FSW) = c("time", as.character(seq(1, (length(N_Low_FSW[1,])-1))))
N_Low_FSW_melted = reshape2::melt(N_Low_FSW, id.vars = c("time"))
colnames(N_Low_FSW_melted) = c("time", "run", "value")
N_Client = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5)])}))))
colnames(N_Client) = c("time", as.character(seq(1, (length(N_Client[1,])-1))))
N_Client_melted = reshape2::melt(N_Client, id.vars = c("time"))
colnames(N_Client_melted) = c("time", "run", "value")
Fraction_F = do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)) /
(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(5, 6)])}), rowSums)) + do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$N}), function(x) {return(x[,c(1, 2, 3, 4, 7)])}), rowSums)))
lambda_sum_0_ProFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,1]))))
lambda_sum_0_LowFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,2]))))
lambda_sum_0_GPF = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,3]))))
lambda_sum_0_FormerFSW = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,4]))))
lambda_sum_0_Client = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,5]))))
lambda_sum_0_GPM = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,6]))))
lambda_sum_0_Virgin_Female = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,7]))))
lambda_sum_0_Virgin_Male = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,8]))))
lambda_sum_0_Former_FSW_Outside = data.frame(t(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$lambda_sum_0), function(x) x[,9]))))
lambda_sum_0_indiv = rbind(lambda_sum_0_ProFSW, lambda_sum_0_LowFSW, lambda_sum_0_GPF,
lambda_sum_0_FormerFSW, lambda_sum_0_Client, lambda_sum_0_GPM)
lambda_sum_0_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"), each = length(time)), lambda_sum_0_indiv)
colnames(lambda_sum_0_indiv) = c("time", "variable", as.character(seq(1, length(lambda_sum_0_ProFSW[1,]))))
lambda_sum_0_indiv_melted = reshape2::melt(lambda_sum_0_indiv, id.vars = c("time", "variable"))
colnames(lambda_sum_0_indiv_melted) = c("time", "variable", "run", "value")
lambda_sum_0_indiv_melted$variable = factor(lambda_sum_0_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM"))
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac_Active_FSW = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {100*(x$frac_N[,1] + x$frac_N[,2])})), 2, cotonou::quantile_95)))
Ratio_Low_Pro = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]})), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside, frac_Active_FSW, Ratio_Low_Pro)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"))
prev_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
prev_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_FSW)))
prev_LowFSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_LowFSW)))
prev_client_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_client)))
prev_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_women)))
prev_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$prev_men)))
prev_indiv = rbind(prev_FSW_indiv, prev_LowFSW_indiv, prev_client_indiv, prev_women_indiv, prev_men_indiv)
prev_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)), prev_indiv)
colnames(prev_indiv) = c("time", "variable", as.character(seq(1, length(prev_FSW_indiv[1,]))))
prev_indiv_melted = reshape2::melt(prev_indiv, id.vars = c("time", "variable"))
colnames(prev_indiv_melted) = c("time", "variable", "run", "value")
prev_indiv_melted$variable = factor(prev_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
ART_coverage_women = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)), 2, cotonou::quantile_95))
ART_coverage_men = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)), 2, cotonou::quantile_95))
ART_coverage_FSW = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)), 2, cotonou::quantile_95))
ART_coverage_all = t(apply(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)), 2, cotonou::quantile_95))
ART_coverage = rbind(ART_coverage_women, ART_coverage_men, ART_coverage_FSW, ART_coverage_all)
ART_coverage = data.frame(time, ART_coverage, rep(c("Women", "Men", "Pro FSW", "All"), each = length(time)))
colnames(ART_coverage) = c("time", "Lower", "Median", "Upper", "variable")
ART_coverage$variable = factor(ART_coverage$variable, levels = c("Pro FSW", "Women", "Men", "All"))
ART_coverage = ART_coverage[ART_coverage$variable == "All" | ART_coverage$variable == "Pro FSW",]
ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_FSW)))
ART_women_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_women)))
ART_men_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_men)))
ART_all_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$ART_coverage_all)))
ART_indiv = rbind(ART_FSW_indiv, ART_all_indiv)
ART_indiv = data.frame(time, rep(c("Pro FSW", "All"), each = length(time)), ART_indiv)
colnames(ART_indiv) = c("time", "variable", as.character(seq(1, length(ART_FSW_indiv[1,]))))
ART_indiv_melted = reshape2::melt(ART_indiv, id.vars = c("time", "variable"))
colnames(ART_indiv_melted) = c("time", "variable", "run", "value")
ART_indiv_melted$variable = factor(ART_indiv_melted$variable, levels = c("Pro FSW", "All"))
# N of FSW on ART
N_ART_FSW_indiv = t(do.call(rbind, lapply(res_best_runs, function(x) x$HIV_positive_On_ART[,1])))
N_ART_FSW_indiv = data.frame(time, rep(c("Pro FSW"), each = length(time)), N_ART_FSW_indiv)
colnames(N_ART_FSW_indiv) = c("time", "variable", as.character(seq(1, length(N_ART_FSW_indiv[1,])-2)))
N_ART_FSW_indiv_melted = reshape2::melt(N_ART_FSW_indiv, id.vars = c("time", "variable"))
colnames(N_ART_FSW_indiv_melted) = c("time", "variable", "run", "value")
# N on ART and N off ART diagnosed
Diagnosed_Off_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) x[,1]))))
Diagnosed_On_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) x[,1]))))
Diagnosed_Dropout_ART_FSW = data.frame(time, t(do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) x[,1]))))
Diagnosed_FSW = data.frame(rbind(Diagnosed_Off_ART_FSW, Diagnosed_On_ART_FSW, Diagnosed_Dropout_ART_FSW),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_FSW) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_FSW[1,])-1))), "variable")
Diagnosed_FSW_melted = reshape2::melt(Diagnosed_FSW, id.vars = c("time", "variable"))
Diagnosed_FSW_melted$group = "FSW"
colnames(Diagnosed_FSW_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_On_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_Dropout_ART_All = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4, 5, 6, 7, 8)])}), rowSums))))
Diagnosed_All = data.frame(rbind(Diagnosed_Off_ART_All, Diagnosed_On_ART_All, Diagnosed_Dropout_ART_All),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_All) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_All[1,])-1))), "variable")
Diagnosed_All_melted = reshape2::melt(Diagnosed_All, id.vars = c("time", "variable"))
Diagnosed_All_melted$group = "All"
colnames(Diagnosed_All_melted) = c("time", "variable", "run", "value", "group")
Diagnosed = rbind(Diagnosed_FSW_melted, Diagnosed_All_melted)
Diagnosed_Off_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_On_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Dropout_ART_Men = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(5, 6)])}), rowSums))))
Diagnosed_Men = data.frame(rbind(Diagnosed_Off_ART_Men, Diagnosed_On_ART_Men, Diagnosed_Dropout_ART_Men),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Men) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Men[1,])-1))), "variable")
Diagnosed_Men_melted = reshape2::melt(Diagnosed_Men, id.vars = c("time", "variable"))
Diagnosed_Men_melted$group = "Men"
colnames(Diagnosed_Men_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Off_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I22 + x$I23 + x$I24 + x$I25}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_On_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I32 + x$I33 + x$I34 + x$I35}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Dropout_ART_Women = data.frame(time, t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) {x$I42 + x$I43 + x$I44 + x$I45}), function(x) {return(x[,c(1, 2, 3, 4)])}), rowSums))))
Diagnosed_Women = data.frame(rbind(Diagnosed_Off_ART_Women, Diagnosed_On_ART_Women, Diagnosed_Dropout_ART_Women),
rep(c("Diagnosed Off ART", "Diagnosed On ART", "Dropout"), each = length(time)))
colnames(Diagnosed_Women) = c("time", as.character(seq(1, (length(Diagnosed_Off_ART_Women[1,])-1))), "variable")
Diagnosed_Women_melted = reshape2::melt(Diagnosed_Women, id.vars = c("time", "variable"))
Diagnosed_Women_melted$group = "Women"
colnames(Diagnosed_Women_melted) = c("time", "variable", "run", "value", "group")
Diagnosed_Women_Men = rbind(Diagnosed_Women_melted, Diagnosed_Men_melted)
Diagnosed_Women_Men_ratio = data.frame(Diagnosed_Women_melted[,c("time", "variable", "run")],
value = Diagnosed_Women_melted$value/Diagnosed_Men_melted$value)
HIV_deaths = data.frame(time[-1], t(do.call(rbind, lapply(lapply(lapply(res_best_runs, function(x) x$cumuHIVDeaths), rowSums), diff) )))
colnames(HIV_deaths) = c("time", as.character(seq(1, (length(HIV_deaths[1,])-1))))
HIV_deaths_melted = reshape2::melt(HIV_deaths, id.vars = c("time"))
# fraction of groups in their genders -------------------------------------
pc_OfWomen_ProFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))
)))
pc_OfWomen_LowFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_Active_FSW = data.frame(time, t(100*(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) + do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_GPF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfWomen_FormerFSW = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_Client = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfMen_GPM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
pc_OfWomen_VF = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,1])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,2])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,3])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,4]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,7])))))
pc_OfMen_VM = data.frame(time, t(100*do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8]))/
(do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,5])) +
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,6]))+
do.call(rbind, lapply(lapply(res_best_runs, function(x) x$N), function(x) x[,8])))))
Ratio_Low_Pro = data.frame(time, t(do.call(rbind, lapply(res_best_runs, function(x) {x$frac_N[,2]/ x$frac_N[,1]}))))
frac_by_gender = rbind(pc_OfWomen_ProFSW,
pc_OfWomen_LowFSW,
pc_OfWomen_GPF,
pc_OfWomen_FormerFSW,
pc_OfMen_Client,
pc_OfMen_GPM,
pc_OfWomen_VF,
pc_OfMen_VM,
pc_OfWomen_Active_FSW,
Ratio_Low_Pro
)
frac_by_gender = data.frame(frac_by_gender, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac_by_gender) = c("time",as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))), "variable")
frac_by_gender$variable = factor(frac_by_gender$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Active FSW", "Low Pro Ratio"))
frac_by_gender_melted = reshape2::melt(frac_by_gender, id.vars = c("time", "variable"))
colnames(frac_by_gender_melted) = c("time", "variable", "run", "value")
colnames(pc_OfWomen_ProFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_ProFSW[1,])-1))))
colnames(pc_OfWomen_LowFSW) = c("time", as.character(seq(1, (length(pc_OfWomen_LowFSW[1,])-1))))
colnames(pc_OfWomen_Active_FSW) = c("time", as.character(seq(1, (length(pc_OfWomen_Active_FSW[1,])-1))))
colnames(pc_OfMen_Client) = c("time", as.character(seq(1, (length(pc_OfMen_Client[1,])-1))))
pc_OfWomen_ProFSW_melted = reshape2::melt(pc_OfWomen_ProFSW, id.vars = c("time"))
pc_OfWomen_LowFSW_melted = reshape2::melt(pc_OfWomen_LowFSW, id.vars = c("time"))
pc_OfWomen_Active_FSW_melted = reshape2::melt(pc_OfWomen_Active_FSW, id.vars = c("time"))
pc_OfMen_Client_melted = reshape2::melt(pc_OfMen_Client, id.vars = c("time"))
# condoms -----------------------------------------------------------------
condom_Pro_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,1,][,5]}))))
condom_Pro_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,1,][,5]}))))
condom_Pro_FSW = data.frame(time, rbind(condom_Pro_FSW_comm, condom_Pro_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Pro_FSW) = c("time", as.character(seq(1, (length(condom_Pro_FSW[1,])-2))), "variable")
condom_Pro_FSW_melted = reshape2::melt(condom_Pro_FSW, id.vars = c("time", "variable"))
colnames(condom_Pro_FSW_melted) = c("time", "variable", "run", "value")
condom_Low_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,2,][,5]}))))
condom_Low_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,2,][,5]}))))
condom_Low_FSW = data.frame(time, rbind(condom_Low_FSW_comm, condom_Low_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Low_FSW) = c("time", as.character(seq(1, (length(condom_Low_FSW[1,])-2))), "variable")
condom_Low_FSW_melted = reshape2::melt(condom_Low_FSW, id.vars = c("time", "variable"))
colnames(condom_Low_FSW_melted) = c("time", "variable", "run", "value")
condom_GPF_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,3,][,6]})))))
colnames(condom_GPF_noncomm) = c("time", as.character(seq(1, (length(condom_GPF_noncomm[1,])-1))))
condom_GPF_noncomm_melted = reshape2::melt(condom_GPF_noncomm, id.vars = c("time"))
condom_GPM_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,6,][,3]})))))
colnames(condom_GPM_noncomm) = c("time", as.character(seq(1, (length(condom_GPM_noncomm[1,])-1))))
condom_GPM_noncomm_melted = reshape2::melt(condom_GPM_noncomm, id.vars = c("time"))
# testing -----------------------------------------------------------------
testing_rate_ratio_F_M = data.frame(time, t((do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(3)])}))/do.call(rbind, lapply(lapply(res_best_runs, function(x) {x$testing_prob}), function(x) {return(x[,c(6)])})))))
colnames(testing_rate_ratio_F_M) = c("time", as.character(seq(1, (length(testing_rate_ratio_F_M[1,])-1))))
testing_rate_ratio_F_M_melted = reshape2::melt(testing_rate_ratio_F_M, id.vars = c("time"))
colnames(testing_rate_ratio_F_M_melted) = c("time", "run", "value")
Diagnosed_Women_Men_ratio_On_ART = Diagnosed_Women_Men_ratio[Diagnosed_Women_Men_ratio$variable == "Diagnosed On ART",]
testing_rate_ratio_F_M_Women_Men_ratio_On_ART = data.frame(x=testing_rate_ratio_F_M_melted$value, y=Diagnosed_Women_Men_ratio_On_ART$value)
ggplot() + geom_point(data = testing_rate_ratio_F_M_Women_Men_ratio_On_ART,
aes(x = x, y= y)) + theme_bw() + labs(x = "Probability of being tested in last year and knows the result ratio F:M",
y = "Ratio of F:M on ART")
# OUTCOMES ----------------------------------------------------------------
# next script
###
# res_best_runs
frac_N_discard_points_graph = frac_N_discard_points
frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio", c(2,3)] = frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio",c(2,3)]/100
#####################################################
# when is the peak?
lapply(result[[3]], function(x) {
time_with_mid[which(x$prev[,1] == max(x$prev[,1]))]
})
result[[3]][[1]]$new_acute_infected
them <-unlist( lapply(result[[3]], function(x)
{
if(x$prev[which(time == 1993),1] < 59 && x$prev[which(time == 1993),1] > 48 &&
x$prev[which(time == 2008),1] < 34 && x$prev[which(time == 2015),1] > 15.7100000 &&
x$prev[which(time == 2015),1] < 22.010000 &&
x$prev[which(time == 2002),1] < 50 &&
x$prev[which(time == 1998),3] < 4.772625)
x = 1 else x = 0
}))
result[[3]] <- result[[3]][them == 1]
FOI2012 <- median(unlist(lapply(result[[3]], function(x) x$lambda_sum_0[which(time == 2012),1])))
FOI2012
condom_Pro_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,1,][,5]}))))
condom_Pro_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,1,][,5]}))))
condom_Pro_FSW = data.frame(time, rbind(condom_Pro_FSW_comm, condom_Pro_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Pro_FSW) = c("time", as.character(seq(1, (length(condom_Pro_FSW[1,])-2))), "variable")
condom_Pro_FSW_melted = reshape2::melt(condom_Pro_FSW, id.vars = c("time", "variable"))
colnames(condom_Pro_FSW_melted) = c("time", "variable", "run", "value")
condom_Low_FSW_comm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_comm[,2,][,5]}))))
condom_Low_FSW_noncomm = t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,2,][,5]}))))
condom_Low_FSW = data.frame(time, rbind(condom_Low_FSW_comm, condom_Low_FSW_noncomm), rep(c("Commercial", "Non commercial"), each = length(time)))
colnames(condom_Low_FSW) = c("time", as.character(seq(1, (length(condom_Low_FSW[1,])-2))), "variable")
condom_Low_FSW_melted = reshape2::melt(condom_Low_FSW, id.vars = c("time", "variable"))
colnames(condom_Low_FSW_melted) = c("time", "variable", "run", "value")
condom_GPF_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,3,][,6]})))))
colnames(condom_GPF_noncomm) = c("time", as.character(seq(1, (length(condom_GPF_noncomm[1,])-1))))
condom_GPF_noncomm_melted = reshape2::melt(condom_GPF_noncomm, id.vars = c("time"))
condom_GPM_noncomm = data.frame(time, t((do.call(rbind, lapply(res_best_runs, function(x) {x$fc_noncomm[,6,][,3]})))))
colnames(condom_GPM_noncomm) = c("time", as.character(seq(1, (length(condom_GPM_noncomm[1,])-1))))
condom_GPM_noncomm_melted = reshape2::melt(condom_GPM_noncomm, id.vars = c("time"))
ggplot() + geom_line(data = condom_Pro_FSW_melted, aes(x = time, y = value, colour = variable, factor = run), alpha = 1) +
theme_bw() + labs(y = "Condom use of Pro FSW")
ggplot() + geom_line(data = condom_Low_FSW_melted, aes(x = time, y = value, colour = variable, factor = run), alpha = 1) +
theme_bw() + labs(y = "Condom use of Low level FSW")
ggplot() + geom_line(data = condom_GPF_noncomm_melted, aes(x = time, y = value, factor = variable), alpha = 1) +
theme_bw() + labs(y = "Condom use of GPF")
# ggplot() + geom_line(data = condom_GPM_noncomm_melted, aes(x = time, y = value, factor = variable), alpha = 1) +
# theme_bw() + labs(y = "Condom use of GPM")
# lapply(result[[2]], function(x) x$HIV_positive_On_ART[which(time == 2014),1])
#
# result[[3]][[1]]$S1a[32,]
#
# 22.6518633 - 55
# 22.6622749 - 45
# result[[3]] = result[[2]]
#
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = CEA_outputs,
# prev_points = prev_points_FSW_only_even_less_2,
# frac_N_discard_points = frac_N_discard_points_no_FSW_LB, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points_with_numbers, PrEP_fitting = PrEP_fitting)
#
# #
#
#
#
#
#
# result[[5]]
#
# length(result[[3]])
#
# result[[2]]
#
# result[[6]]
#
# (250-(6.628875e+01 + 8.712746e+01))^2
#
#
# result[[3]][[1]]
#
#
#
#
#
#
# data.frame(time, result[[2]][[1]]$OnPrEP1c)
#
#
# data.frame(time, result[[2]][[1]]$ART_eligible_CD4_below_200)
#
#
# result[[2]][[1]]$cumuHIVDeaths
#
#
#
#
#
#
#
#
#
# # test ranges
# frac_N_discard_points_test = data.frame(variable = c("Pro FSW"),
# min = c(0),
# max = c(1))
# ART_data_points_test = data.frame(time = c(2014),
# Lower = c(0),
# Upper = c(1),
# variable = c("Pro FSW"))
# prev_points_test = data.frame(time = c(2015),
# variable = c(rep("Pro FSW", 1)),
# value = c(0),
# lower = c(0),
#
# upper = c(1))
#
# Ntot_data_points_test = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
# point = c(10, 10, 10, 10, 10),
# lower = c(10, 10, 10, 10, 10),
# upper = c(10000000000, 10000000000, 10000000000, 10000000000, 10000000000),
# colour = c("data", "data", "data", "predicted", "predicted"))
#
#
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs,
# prev_points = prev_points_FSW_only_even_less_2, frac_N_discard_points = frac_N_discard_points_no_FSW_LB,
# Ntot_data_points = Ntot_data_points, ART_data_points = NULL, PrEP_fitting = PrEP_fitting)
#
# tafter = Sys.time()
# tafter-tbefore
#
#
# result[[1]]
#
#
# likelihood_list = lapply(res, cotonou::likelihood_rough, time = time, prev_points = prev_points_test, frac_N_discard_points = frac_N_discard_points_test, Ntot_data_points = Ntot_data_points_test, ART_data_points = ART_data_points_test)
#
# likelihood_list
#
#
#
# result = run_model_for_tests(parameters = result[[2]], number_simulations = 1, time = time)
#
#
#
#
# result[[3]] <- result[[2]]
#
#
# lapply(result[[1]], function(x) x$delete)
#
#
# lapply(result[[2]], function(x) x$c_comm_balanced)
# result[[2]][[3]]$frac_N
#
#
# mean(unlist(lapply(result[[2]], function(x) mean(x$c_comm_balanced[,5]))))
#
#
# result[[3]][[1]]$n_comm[4,,]
# result[[3]][[1]]$n_noncomm[12,,]
#
# result[[3]][[1]]$fc_comm[23,,]
# result[[3]][[1]]$fc_noncomm[23,,]
# with fit best runs
# unlist(lapply(result[[2]], function(x) x[[1]]))
#
# # removing those with too high betas
# beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
# result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1])
# unlist(result[[3]])
# ignore these ######################################
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[3]], function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac_Active_FSW = data.frame(time, t(apply(do.call(rbind, lapply(result[[3]], function(x) {100*(x$frac_N[,1] + x$frac_N[,2])})), 2, cotonou::quantile_95)))
Ratio_Low_Pro = data.frame(time, t(apply(do.call(rbind, lapply(result[[3]], function(x) {x$frac_N[,2]/ x$frac_N[,1]})), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside, frac_Active_FSW, Ratio_Low_Pro)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "Active FSW", "Low Pro Ratio"))
prev_FSW = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
prev_FSW_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_FSW)))
prev_LowFSW_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_LowFSW)))
prev_client_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_client)))
prev_women_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_women)))
prev_men_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$prev_men)))
prev_indiv = rbind(prev_FSW_indiv, prev_LowFSW_indiv, prev_client_indiv, prev_women_indiv, prev_men_indiv)
prev_indiv = data.frame(time, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)), prev_indiv)
colnames(prev_indiv) = c("time", "variable", as.character(seq(1, length(prev_FSW_indiv[1,]))))
prev_indiv_melted = reshape2::melt(prev_indiv, id.vars = c("time", "variable"))
colnames(prev_indiv_melted) = c("time", "variable", "run", "value")
prev_indiv_melted$variable = factor(prev_indiv_melted$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(result[[3]], function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
ART_coverage_women = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_women)), 2, cotonou::quantile_95))
ART_coverage_men = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_men)), 2, cotonou::quantile_95))
ART_coverage_FSW = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_FSW)), 2, cotonou::quantile_95))
ART_coverage_all = t(apply(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_all)), 2, cotonou::quantile_95))
ART_coverage = rbind(ART_coverage_women, ART_coverage_men, ART_coverage_FSW, ART_coverage_all)
ART_coverage = data.frame(time, ART_coverage, rep(c("Women", "Men", "Pro FSW", "All"), each = length(time)))
colnames(ART_coverage) = c("time", "Lower", "Median", "Upper", "variable")
ART_coverage$variable = factor(ART_coverage$variable, levels = c("Pro FSW", "Women", "Men", "All"))
ART_coverage = ART_coverage[ART_coverage$variable == "All" | ART_coverage$variable == "Pro FSW",]
ART_FSW_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_FSW)))
ART_women_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_women)))
ART_men_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_men)))
ART_all_indiv = t(do.call(rbind, lapply(result[[3]], function(x) x$ART_coverage_all)))
ART_indiv = rbind(ART_FSW_indiv, ART_all_indiv)
ART_indiv = data.frame(time, rep(c("Pro FSW", "All"), each = length(time)), ART_indiv)
colnames(ART_indiv) = c("time", "variable", as.character(seq(1, length(ART_FSW_indiv[1,]))))
ART_indiv_melted = reshape2::melt(ART_indiv, id.vars = c("time", "variable"))
colnames(ART_indiv_melted) = c("time", "variable", "run", "value")
ART_indiv_melted$variable = factor(ART_indiv_melted$variable, levels = c("Pro FSW", "All"))
frac_N_discard_points_graph = frac_N_discard_points
frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio", c(2,3)] = frac_N_discard_points_graph[frac_N_discard_points_graph$variable == "Low Pro Ratio",c(2,3)]/100
#####################################################
require(ggplot2)
# plot fraction in each group
# ggplot(frac) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
# theme_bw() + labs(y = "Percent in each group (%)") + facet_wrap(~variable, scales = "free") +
# geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15) +
# geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*min), size = I(0.5), color = "red", linetype = 1, alpha = 0.7) +
# geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*max), size = I(0.5), color = "red", linetype = 1, alpha = 0.7)
#
#
#
# # plot prevalence in each group
# ggplot(prev) + geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
# geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))
#
# # plot total population size
# ggplot(Ntot) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
# theme_bw() + labs(y = "Total population size of Grand Cotonou") +
# geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15) + geom_errorbar(data = Ntot_data_points, aes(x = time, ymax = upper, ymin = lower, color = colour), width = 2)
#
# # # plot ART_coverage in each group
# # ggplot(ART_coverage) + geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() +
# # facet_wrap(~variable) + labs(y = "ART coverage ") +
# # geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper), colour = "darkred")
#
# # # plot ART_coverage in all
# ggplot(ART_coverage) +
# geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() +
# facet_wrap(~variable) + labs(y = "ART coverage ") +
# geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper), colour = "darkred")
require(ggplot2)
# plot fraction in each group
ggplot(frac) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Percent in each group (%)") + facet_wrap(~variable, scales = "free") +
geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15) +
geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*min), size = I(0.5), color = "red", linetype = 1, alpha = 0.7) +
geom_hline(data = frac_N_discard_points_graph, aes(yintercept = 100*max), size = I(0.5), color = "red", linetype = 1, alpha = 0.7)
prev_axes = data.frame(variable = c(rep("Pro FSW", 2),
rep("Clients", 2),
rep("Women", 2),
rep("Men", 2),
rep("Low-level FSW", 2)),
time = c(rep(c(1986, 2025), 5)),
value = c(0, 70, 0, 70, 0, 15, 0, 15, 0, 70)
)
prev_points_80s = prev_points_all[c(1,2,3),]
# plot prevalence in each group
ggplot() + geom_line(data = prev, aes(x = time, y = Median))+ geom_ribbon(data = prev, aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper)) +
geom_point(data = prev_points_80s, aes(x = time, y = value), colour = "red")+
geom_blank(data = prev_axes, aes(x = time, y = value))
# plot prevalence in each group indiv runs
ggplot() + geom_line(data = prev_indiv_melted, aes(x = time, y = value, factor = variable, factor = run), alpha = 0.3) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
geom_point(data = prev_points_80s, aes(x = time, y = value), colour = "red")+
geom_blank(data = prev_axes, aes(x = time, y = value))
# plot total population size
ggplot(Ntot) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Total population size of Grand Cotonou") +
geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15) + geom_errorbar(data = Ntot_data_points, aes(x = time, ymax = upper, ymin = lower, color = colour), width = 2)
ggplot(ART_coverage) +
geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() +
facet_wrap(~variable) + labs(y = "ART coverage ") +
geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper), colour = "darkred")
ggplot() + geom_line(data = ART_indiv_melted, aes(x = time, y = value, factor = variable, factor = run), alpha = 0.3) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "ART coverage") +
geom_errorbar(data = ART_data_points, aes(x = time, ymin = Lower, ymax = Upper))
# median_CF = ART_coverage[ART_coverage$variable == "Pro FSW", "Median"]
median_intervention =ART_coverage[ART_coverage$variable == "Pro FSW", "Median"]
median_CF * 100 / median_intervention
################################################################################################################################################################
################################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
parameters <- cotonou::lhs_parameters(number_of_prep_samples, set_pars = best_set, Ncat = 9, time = time,
ranges = combined_ranges, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq)
res = lapply(parameters, return_outputs, main_model, time = time, outputs = outputs)
likelihood_list = lapply(res, likelihood_rough, time = time, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points, Ntot_data_points = Ntot_data_points, ART_data_points = ART_data_points)
sorted_likelihood_list = sort(unlist(lapply(likelihood_list, function(x) x[[1]])))
best_runs = which(unlist(lapply(likelihood_list, function(x) x[[1]])) == max(sorted_likelihood_list))
################################################################################################################################################################
################################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
################################################################################################################################################################
# _____ ___ _____ ____ ___ ____ ____ _____ _ _ _____ ___ ___ _ _ ___ _ _ _____ ___
# | ___|_ _|_ _| _ / ___/ _ \| _ \| _ \| ____| | / \|_ _|_ _/ _ \| \ | | |_ _| \ | | ___/ _ \
# | |_ | | | | _| |_ | | | | | | |_) | |_) | _| | | / _ \ | | | | | | | \| | | || \| | |_ | | | |
# | _| | | | | |_ _| | |__| |_| | _ <| _ <| |___| |___ / ___ \| | | | |_| | |\ | | || |\ | _|| |_| |
# |_| |___| |_| |_| \____\___/|_| \_\_| \_\_____|_____/_/ \_\_| |___\___/|_| \_| |___|_| \_|_| \___/
#
setwd("Q:\\cotonou_cluster")
folder <- "context_after_FSW_post"
options(didehpc.username = "eg1012")
# src <- provisionr::package_sources(github = c("richfitz/odin"))
src <- provisionr::package_sources(github = c("richfitz/odin"))
ctx <- context::context_save(folder, package_sources = src)
config <- didehpc::didehpc_config(cores = 8, template = "GeneralNodes", r_version = "3.3.2")
obj <- didehpc::queue_didehpc(ctx, config = config)
# run first
res_combined_top_fit = 0
res_best_runs_combined = list()
best_pars_combined = list()
task_list = obj$task_status()
task_list = task_list[task_list == "COMPLETE"]
task_list = names(task_list)
# # obj$
# ffff= obj$task_get("c6fdbbc1e0a71f61831efeec8c7a1ab2")$log()
for(i in 1:length(task_list))
{
res = obj$task_get(task_list[i])$result()
res_best_runs = lapply(res[[2]], return_outputs, main_model, time = time, outputs = outputs)
# to combine runs
if(res[[1]] > res_combined_top_fit) {
res_combined_top_fit = res[[1]];
res_best_runs_combined = res_best_runs
best_pars_combined = res[[2]];
} else if(res[[1]] == res_combined_top_fit) {
res_best_runs_combined[(length(res_best_runs_combined)+1):(length(res_best_runs_combined)+length(res_best_runs))] = res_best_runs
best_pars_combined[(length(best_pars_combined)+1):(length(best_pars_combined)+length(res[[2]]))] = res[[2]]
}
res[[1]]
}
res_best_runs = res_best_runs_combined
res_combined_top_fit
length(res_best_runs)
# CORRELATIONS WITH CLIENT PREVALENCE LOOPING THROUGH ALL OF PARAMETERS
year = 2000
cor_test_parm = function(y) {
param_ind = y
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
test = cor.test(x1, x2)
return(test[c("p.value", "estimate")])
}
ranges_with_range = names(ranges[which(ranges[,1] != ranges[,2]),1])
cor_test_results = lapply(as.list(ranges_with_range), cor_test_parm)
cor_test_results_sorted = cor_test_results[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
names(cor_test_results_sorted) = ranges_with_range[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
# parameters with biggest effect on client prevalence
head(do.call(rbind, cor_test_results_sorted), n = 10)
# which points fit? -------------------------------------------------------
# # WHICH POINTS ARE FITS TO FSW PREVALENCE? (POINTS 1 to 8)
# x3 = unlist(lapply(lapply(result_adjusted[[3]], function(x) x[[2]]), function(x) {
# if(!is.null(x))
# {
# return(sum(x < 9))
# } else
# {return (0)}
# }))
# # end of which points fit? -------------------------------------------------------
# WHICH POINTS ARE FITS TO CLIENT PREVALENCE? (POINTS 9 to 14)
x3 = unlist(lapply(lapply(result_adjusted[[3]], function(x) x[[2]]), function(x) {
if(!is.null(x))
{
return(sum(x > 8 & x < 15))
} else
{return (0)}
}))
# end of which points fit? -------------------------------------------------------
# CORRELATIONS WITH CLIENT PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin, who_believe_comm
year = 2000
param_ind = "c_noncomm_1998_Client"
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
correlation_with_fit = data.frame(x1, x2, x3)
cor.test(x1, x2)
ggplot(data = correlation_with_fit)+scale_color_gradient(low="darkgreen", high="red") + geom_point(aes(x = x2, y = x1, colour = x3, size = x3))+ labs(colour=" Number \n of \n CLIENT \n prevalence \n points \n fits", size = "") + theme_bw() + labs(y = param_dep, x = param_ind)
#histogram
ggplot() + aes(x2[x3 > 0])+ geom_histogram(binwidth = (diff(range(x2))/10), colour="black", fill="black") + theme_bw()
# posterior dist
# apply(do.call(rbind, lapply(result_adjusted[[1]][which(x3 > 0)], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))
# prior dist
# apply(do.call(rbind, lapply(result_adjusted[[1]], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))
# the percentage difference between the posterior and prior for all the pars that I vary in LHS, sorted
sort((apply(do.call(rbind, lapply(result_adjusted[[1]][which(x3 > 0)], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))
- apply(do.call(rbind, lapply(result_adjusted[[1]], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x)))) / apply(do.call(rbind, lapply(result_adjusted[[1]], function(x) x[rownames(ranges)])), 2, function(x) mean(unlist(x))))
# _____ ___ _____ ____ ___ ____ ____ _____ _ _ _____ ___ ___ _ _ ___ _ _ _____ ___
# | ___|_ _|_ _| _ / ___/ _ \| _ \| _ \| ____| | / \|_ _|_ _/ _ \| \ | | |_ _| \ | | ___/ _ \
# | |_ | | | | _| |_ | | | | | | |_) | |_) | _| | | / _ \ | | | | | | | \| | | || \| | |_ | | | |
# | _| | | | | |_ _| | |__| |_| | _ <| _ <| |___| |___ / ___ \| | | | |_| | |\ | | || |\ | _|| |_| |
# |_| |___| |_| |_| \____\___/|_| \_\_| \_\_____|_____/_/ \_\_| |___\___/|_| \_| |___|_| \_|_| \___/
#
remove.packages("cotonou")
# rm(list = ls())
require(ggplot2)
require(reshape2)
devtools::install_github("geidelberg/cotonou")
number_simulations = 20
epi_start = 1986
epi_end = 2016
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
#####################################################
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR=0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
c(0, rep_len(0, 8)), ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2008, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1
)
# best_set end ----------------------------------------------------------------
# ranges and outputs ------------------------------------------------------------------
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.08, 0.08),
epsilon_2013 = c(0.08, 0.08),
epsilon_2016 = c(0.08, 0.08),
fraction_FSW_foreign = c(0.9, 0.9),
muF = c(0.01851852, 0.025),
muM = c(0.01851852, 0.025),
betaMtoF_noncomm = c(0.00144, 0.00626),
# betaMtoF_noncomm = c(0, 0),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
frac_women_ProFSW = c(0.0024, 0.0143),
# frac_women_LowFSW = c(0.0024, 0.0067),
frac_women_exFSW = c(0.0024, 0.0143),
frac_men_client = c(0.196, 0.4),
frac_women_virgin = c(0.0972973, 0.18),
frac_men_virgin = c(0.08840413, 0.1255),
fraction_sexually_active_15_F = c(0.1387868, 0.153),
fraction_sexually_active_15_M = c(0.2057087, 0.291),
rate_enter_sexual_pop_F = c(1/(20-15), 1/(17-15)),
rate_enter_sexual_pop_M = c(1/(20-15), 1/(17-15)),
# commercial partnerships
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(12, 17),
#non commercial partnerships
c_non_comm_1985_ProFSW = c(0.273, 0.468),
c_non_comm_2016_ProFSW = c(0.273, 0.468),
c_noncomm_1998_Client = c(1.2, 2.5),
c_noncomm_2015_Client = c(5, 9),
c_noncomm_1998_GPF = c(0.84, 1.05),
c_noncomm_2008_GPF = c(0.5, 1),
c_noncomm_1998_GPM = c(1.14, 1.46),
c_noncomm_2008_GPM = c(0.28, 1.24),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0.2173913, 0.4347826),
rate_leave_low_FSW = c(0.2173913, 0.4347826),
rate_leave_client = c(0.05, 0.2),
# rate_leave_client = 0,
# condoms
fc_y_comm_1985_ProFSW_Client = c(0, 0),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1985_GPM_GPF = 0,
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.05042017),
fc_y_noncomm_2011_GPM_GPF = c(0.161, 0.255)
)
outputs = c("prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male"),
min = c(0.001237599, 0.094735687, 0.050019624, 0.042621372),
max = c(0.007374027, 0.193733511, 0.09281992, 0.060783889))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
#####################################################
result <- cotonou::run_model_with_fit_for_correlations(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# removing those with too high betas
beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1], result[[3]][beta_not_above_1])
# WHICH POINTS ARE FITS TO FSW PREVALENCE? (POINTS 1 to 8)
x3 = unlist(lapply(lapply(result_adjusted[[3]], function(x) x[[2]]), function(x) {
if(!is.null(x))
{
return(sum(x < 9))
} else
{return (0)}
}))
# CORRELATIONS WITH CLIENT PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin, who_believe_comm
year = 2000
param_ind = "fc_y_comm_2002_ProFSW_Client"
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
correlation_with_fit = data.frame(x1, x2, x3)
cor.test(x1, x2)
ggplot(data = correlation_with_fit) + geom_point(aes(x = x2, y = x1, colour = x3)) + theme_bw() + labs(y = param_dep, x = param_ind)
# __ _____ _____ _ _ ___ _ _ _____ _____ ___ _____
# \ \ / /_ _|_ _| | | |/ _ \| | | |_ _| | ___|_ _|_ _|
# \ \ /\ / / | | | | | |_| | | | | | | | | | | |_ | | | |
# \ V V / | | | | | _ | |_| | |_| | | | | _| | | | |
# \_/\_/ |___| |_| |_| |_|\___/ \___/ |_| |_| |___| |_|
#
remove.packages("cotonou")
# rm(list = ls())
require(ggplot2)
require(reshape2)
devtools::install_github("geidelberg/cotonou")
number_simulations = 25
epi_start = 1986
epi_end = 2030
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
#####################################################
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR=0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = c(0, rep_len(0, 8)),
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2008, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1
)
# best_set end ----------------------------------------------------------------
# ranges and outputs ------------------------------------------------------------------
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.08, 0.08),
epsilon_2013 = c(0.08, 0.08),
epsilon_2016 = c(0.08, 0.08),
fraction_FSW_foreign = c(0.9, 0.9),
muF = c(0.01851852, 0.025),
muM = c(0.01851852, 0.025),
betaMtoF_noncomm = c(0.00144, 0.00626),
# betaMtoF_noncomm = c(0, 0),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
frac_women_ProFSW = c(0.0024, 0.0143),
# frac_women_LowFSW = c(0.0024, 0.0067),
frac_women_exFSW = c(0.0024, 0.0143),
frac_men_client = c(0.196, 0.4),
frac_women_virgin = c(0.0972973, 0.18),
frac_men_virgin = c(0.08840413, 0.1255),
fraction_sexually_active_15_F = c(0.1387868, 0.153),
fraction_sexually_active_15_M = c(0.2057087, 0.291),
rate_enter_sexual_pop_F = c(1/(20-15), 1/(17-15)),
rate_enter_sexual_pop_M = c(1/(20-15), 1/(17-15)),
# commercial partnerships
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(12, 17),
#non commercial partnerships
c_non_comm_1985_ProFSW = c(0.273, 0.468),
c_non_comm_2016_ProFSW = c(0.273, 0.468),
c_noncomm_1998_Client = c(1.2, 2.5),
c_noncomm_2015_Client = c(5, 9),
c_noncomm_1998_GPF = c(0.84, 1.05),
c_noncomm_2008_GPF = c(0.5, 1),
c_noncomm_1998_GPM = c(1.14, 1.46),
c_noncomm_2008_GPM = c(0.28, 1.24),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0.2173913, 0.4347826),
rate_leave_low_FSW = c(0.2173913, 0.4347826),
rate_leave_client = c(0.05, 0.2),
# rate_leave_client = 0,
# condoms
fc_y_comm_1985_ProFSW_Client = c(0, 0),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1985_GPM_GPF = 0,
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.05042017),
fc_y_noncomm_2011_GPM_GPF = c(0.161, 0.255)
)
outputs = c("prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male"),
min = c(0.001237599, 0.094735687, 0.050019624, 0.042621372),
max = c(0.007374027, 0.193733511, 0.09281992, 0.060783889))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
#####################################################
# result <- cotonou::run_model_with_fit(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# removing those with too high betas
beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1])
# CORRELATIONS WITH CLIENT PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin, who_believe_comm
year = 2000
param_ind = "fc_y_comm_2002_ProFSW_Client"
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
cor.test(x1, x2)
qplot(x = x2, y = x1) + theme_bw() + labs(y = param_dep, x = param_ind)
# CORRELATIONS WITH CLIENT PREVALENCE / FSW PREVALENCE
# betaMtoF_noncomm, RR_beta_GUD, RR_beta_FtM, frac_men_client, rate_leave_client, frac_men_virgin
year = 2000
param_ind = "frac_men_virgin"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x["prev_FSW"])), function(x) x[which(time == year)])) /
unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x["prev_client"])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
cor.test(x1, x2)
qplot(x = x2, y = x1) + theme_bw() + labs(y = param_dep, x = "FSW prevalence / Client prevalence")
# CORRELATIONS WITH CLIENT PREVALENCE LOOPING THROUGH ALL OF PARAMETERS
year = 2000
cor_test_parm = function(y) {
param_ind = y
param_dep = "prev_client"
x1 = unlist(lapply(lapply(result_adjusted[[2]], function(x) unlist(x[param_dep])), function(x) x[which(time == year)]))
x2 = unlist(lapply(result_adjusted[[1]], function(x) x[param_ind]))
test = cor.test(x1, x2)
return(test[c("p.value", "estimate")])
}
ranges_with_range = names(ranges[which(ranges[,1] != ranges[,2]),1])
cor_test_results = lapply(as.list(ranges_with_range), cor_test_parm)
cor_test_results_sorted = cor_test_results[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
names(cor_test_results_sorted) = ranges_with_range[order(unlist(lapply(cor_test_results, function(x) x$p.value)))]
head(do.call(rbind, cor_test_results_sorted), n =10)
# PLOTS
# ignore these ######################################
frac_ProFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,1])), 2, cotonou::quantile_95)))
frac_LowFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,2])), 2, cotonou::quantile_95)))
frac_GPF = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,3])), 2, cotonou::quantile_95)))
frac_FormerFSW = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,4])), 2, cotonou::quantile_95)))
frac_Client = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,5])), 2, cotonou::quantile_95)))
frac_GPM = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,6])), 2, cotonou::quantile_95)))
frac_Virgin_Female = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,7])), 2, cotonou::quantile_95)))
frac_Virgin_Male = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,8])), 2, cotonou::quantile_95)))
frac_Former_FSW_Outside = data.frame(time, t(apply(do.call(rbind, lapply(lapply(result[[2]], function(x) x$frac_N*100), function(x) x[,9])), 2, cotonou::quantile_95)))
frac = rbind(frac_ProFSW, frac_LowFSW, frac_GPF, frac_FormerFSW, frac_Client, frac_GPM, frac_Virgin_Female, frac_Virgin_Male, frac_Former_FSW_Outside)
frac = data.frame(frac, group = rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"), each = length(time)))
colnames(frac) = c("time", "Lower", "Median", "Upper", "variable")
frac$variable = factor(frac$variable, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"))
prev_FSW = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_FSW)), 2, cotonou::quantile_95))
prev_LowFSW = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_LowFSW)), 2, cotonou::quantile_95))
prev_client = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_client)), 2, cotonou::quantile_95))
prev_women = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_women)), 2, cotonou::quantile_95))
prev_men = t(apply(do.call(rbind, lapply(result[[2]], function(x) x$prev_men)), 2, cotonou::quantile_95))
prev = rbind(prev_FSW, prev_LowFSW, prev_client, prev_women, prev_men)
prev = data.frame(time, prev, rep(c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"), each = length(time)))
colnames(prev) = c("time", "Lower", "Median", "Upper", "variable")
prev$variable = factor(prev$variable, levels = c("Pro FSW", "Low-level FSW", "Clients", "Women", "Men"))
Ntot = data.frame(time, t(apply(do.call(rbind, lapply(result[[2]], function(x) x$Ntot)), 2, cotonou::quantile_95)))
colnames(Ntot) = c("time", "Lower", "Median", "Upper")
#####################################################
# plot fraction in each group
ggplot(frac) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Percent in each group (%)") + facet_wrap(~variable, scales = "free") +
geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15) +
geom_hline(data = frac_N_discard_points, aes(yintercept = 100*min), size = I(0.5), color = "red", linetype = 1, alpha = 0.7) +
geom_hline(data = frac_N_discard_points, aes(yintercept = 100*max), size = I(0.5), color = "red", linetype = 1, alpha = 0.7)
# plot prevalence in each group
ggplot(prev) + geom_line(aes(x = time, y = Median))+ geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) + theme_bw() + facet_wrap(~variable, scales = "free") + labs(y = "prevalence (%)") +
geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))
# plot total population size
ggplot(Ntot) + geom_line(aes(x = time, y = Median)) + geom_ribbon(aes(x = time, ymin = Lower, ymax = Upper), alpha = 0.5) +
theme_bw() + labs(y = "Total population size of Grand Cotonou") +
geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15) + geom_errorbar(data = Ntot_data_points, aes(x = time, ymax = upper, ymin = lower, color = colour), width = 2)
# Below c'est
# ____ _ _ _ _ _
# | _ \ _ _ __ _(_) ___ _ ___ __ _ __ ( |_)_ __ ___ _ __ ___ _ __| |_ ___ __ _ _ _ ___ (_)
# | | | | | | | \ \ / / |/ _ \ | | \ \/ / | '_ \|/| | '_ ` _ \| '_ \ / _ \| '__| __/ _ \ / _` | | | |/ _ \| |
# | |_| | |_| | \ V /| | __/ |_| |> < | | | | | | | | | | | |_) | (_) | | | || __/ | (_| | |_| | (_) | |
# |____/ \__,_| \_/ |_|\___|\__,_/_/\_\ |_| |_| |_|_| |_| |_| .__/ \___/|_| \__\___| \__, |\__,_|\___/|_|
# |_| |_|
#
require(ggplot2)
require(reshape2)
number_simulations = 30
epi_start = 1986
epi_end = 2016
# setup -------------------------------------------------------------------
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(epi_start, epi_end, length.out = epi_end - epi_start + 1)
#####################################################
# this is the best set of parameters (the fixed ones)
# best_set ----------------------------------------------------------------
best_set = list(
init_clientN_from_PCR=0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = c(0, rep_len(0, 8)),
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1993 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2011 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1993, 1998, 2008, 2011, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1,
RR_beta_circum = 0.44,
prev_ratio_FSW_GPF = 1,
prev_ratio_Client_GPM = 1
)
# best_set end ----------------------------------------------------------------
# ranges and outputs ------------------------------------------------------------------
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.06, 0.07),
epsilon_2013 = c(0.04, 0.06),
epsilon_2016 = c(0.04, 0.06),
fraction_FSW_foreign = c(0.9, 0.9),
muF = c(0.01851852, 0.025),
muM = c(0.01851852, 0.025),
# betaMtoF_noncomm = c(0.00144, 0.00626),
betaMtoF_baseline = c(0.0006, 0.001),
# betaMtoF_noncomm = c(0, 0),
RR_beta_FtM = c(0.5, 2),
RR_beta_circum = c(0.34, 0.72),
prev_HSV2_FSW = c(0.8687271, 0.9403027),
prev_HSV2_Client = c(0.1, 0.8687271),
prev_HSV2_GPF = c(0.2666742, 0.3236852),
prev_HSV2_GPM = c(0.09843545, 0.14108970),
RR_beta_HSV2_comm = c(1.4, 2.1),
RR_beta_HSV2_noncomm = c(2.2, 3.4),
frac_women_ProFSW = c(0.0024, 0.0143),
# frac_women_LowFSW = c(0.0024, 0.0067),
frac_women_exFSW = c(0.0024, 0.0143),
frac_men_client = c(0.196, 0.4),
frac_women_virgin = c(0.0972973, 0.18),
frac_men_virgin = c(0.08840413, 0.1255),
fraction_sexually_active_15_F = c(0.1387868, 0.153),
fraction_sexually_active_15_M = c(0.2057087, 0.291),
rate_enter_sexual_pop_F = c(1/(20-15), 1/(17-15)),
rate_enter_sexual_pop_M = c(1/(20-15), 1/(17-15)),
# commercial partnerships
c_comm_1993_ProFSW = c(300, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 17),
c_comm_2015_Client = c(7, 17),
#non commercial partnerships
c_non_comm_1985_ProFSW = c(0.273, 0.468),
c_non_comm_2016_ProFSW = c(0.273, 0.468),
c_noncomm_1998_Client = c(1, 9),
c_noncomm_2015_Client = c(1, 9),
c_noncomm_1998_GPF = c(0.84, 1.05),
c_noncomm_2008_GPF = c(0.5, 1),
c_noncomm_1998_GPM = c(1.14, 1.46),
c_noncomm_2008_GPM = c(0.28, 1.24),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0, 1),
rate_leave_low_FSW = c(0, 1),
rate_leave_client = c(0, 0.2),
# rate_leave_client = 0,
# condoms
fc_y_comm_1985_ProFSW_Client = c(0, 0),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1985_GPM_GPF = 0,
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.05042017),
fc_y_noncomm_2011_GPM_GPF = c(0.161, 0.255)
)
outputs = c("prev", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(1.43*0.515666224, 0.24*0.515666224,
100*0.195738802*(1-0.515666224), 40*(1-0.515666224),
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.18*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
frac_N_discard_points = data.frame(variable = c("Pro FSW", "Clients", "Virgin female", "Virgin male"),
min = c(0.001237599, 0.094735687, 0.050019624, 0.042621372),
max = c(0.007374027, 0.193733511, 0.09281992, 0.060783889))
# Ntot data points ------------------------------------------------------
Ntot_data_points = data.frame(time = c(1992, 2002, 2013, 2020, 2030),
point = c(404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65),
lower = c(343705.15, 579325.15, 776075.5, 959417.95, 1210304.8),
upper = c(465012.85, 783792.85, 1049984.5, 1298036.05, 1637471.2),
colour = c("data", "data", "data", "predicted", "predicted"))
#####################################################
result <- cotonou::run_model_with_fit_for_correlations(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# result <- cotonou::run_model(number_simulations, par_seq = par_seq, condom_seq = condom_seq, groups_seq = groups_seq, years_seq = years_seq, best_set = best_set, time = time, ranges = ranges, outputs = outputs, prev_points = prev_points, frac_N_discard_points = frac_N_discard_points)
# removing those with too high betas
beta_not_above_1 = which(unlist(lapply(result[[1]], function(x) x$beta_above_1)) == 0)
result_adjusted = list(result[[1]][beta_not_above_1], result[[2]][beta_not_above_1], result[[3]][beta_not_above_1])
#
#
# likelihood_list = unlist(lapply(res, likelihood_rough))
# sorted_likelihood_list = sort(likelihood_list)
#
# # table(sorted_likelihood_list)
#
# best_runs = which(unlist(lapply(res, likelihood_rough)) == max(sorted_likelihood_list))
#
# out <- res[best_runs]
###
# THE DEMOGRAPHIC RESULTS OF BEST RUNS
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(0.67, 0.24,
100*0.195738802*(1-0.515666224), 20,
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.16*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
# demographic graphs ------------------------------------------------------
frac_N_best_runs = 100*do.call(rbind, lapply(res[best_runs], function(x) x$frac_N))
frac_N_best_runs = data.frame(time, frac_N_best_runs, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(frac_N_best_runs) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
frac_N_best_runs_melted = melt(frac_N_best_runs, id.vars = c("time", "replication"))
ggplot() + geom_line(data = frac_N_best_runs_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="Percent in each group (%)") +
facet_wrap(~variable, scales = "free") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
# facet_wrap(~variable, scales = "fixed") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
epsilon_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$epsilon)))
epsilon_best_runs = data.frame(time, epsilon_best_runs)
epsilon_best_runs_melted = melt(epsilon_best_runs, id.vars = "time")
ggplot() + geom_line(data = epsilon_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Growth rate")
Ntot_data_points = data.frame(time = c(1979, 1992, 2002, 2013, 2020, 2030), point = c(191106.1467, 404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65), colour = c("data", "data", "data", "data", "predicted", "predicted"))
Ntot_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$Ntot)))
Ntot_best_runs = data.frame(time, Ntot_best_runs)
Ntot_best_runs_melted = melt(Ntot_best_runs, id.vars = "time")
ggplot() + geom_line(data = Ntot_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Total population size") + geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15)
#output growth rate?????
growth_rate_out = melt(data.frame(time = time[-1], t(do.call(rbind, lapply(lapply(res[best_runs], function(x) x$Ntot), function(y) {
diff(y)/y[-length(y)]
})))), id.vars = "time")
ggplot(growth_rate_out) + geom_line(aes(x = time, y = value, factor = variable)) + theme_bw() +
labs(x="year",y="Output growth rate")
# end of demographic graphs ------------------------------------------------------
# prev graphs ------------------------------------------------------
all_binded = do.call(rbind, lapply(res[best_runs], function(x) {
return(matrix(c(x$prev_FSW, x$prev_LowFSW, x$prev_client, x$prev_women, x$prev_men), ncol = 5))
}))
all_binded[is.na(all_binded)] = 0
out = data.frame(time, all_binded, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(out) = c("time", "Pro FSW", "Low-level FSW", "Clients", "Women", "Men", "replication")
out_melted = melt(out, id.vars = c("time", "replication"))
ggplot() + geom_line(data = out_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
facet_wrap(~variable, scales = "free")
# end of prev graphs ------------------------------------------------------
# who believe etc ---------------------------------------------------------
max(sorted_likelihood_list)
# WHO BELIEVE?
who_believe = unlist(lapply(parameters[which(likelihood_list == max(likelihood_list))], function(x) x$who_believe_comm))
who_believe = ifelse(who_believe == 1, "Clients", "FSWs")
table(who_believe)
c_comm_out = melt(data.frame(years = rep(time, length(best_runs)), do.call(rbind, lapply(res[best_runs], function(x) {
if(x$who_believe_comm[1] == 1)
return(data.frame(c_comm_balanced = x$c_comm_balanced[,1], varies = "FSW"))
else
return(data.frame(c_comm_balanced = x$c_comm_balanced[,5], varies = "Client"))
})), replication = sort(rep(seq(1, length(best_runs), 1), length(time)))), id.vars = c("years", "replication", "varies"))
ggplot(c_comm_out) + geom_line(aes(x = years, y = value, factor = as.factor(replication))) + facet_wrap(~varies, scales = "free") + theme_bw() + labs(y = "commercial partner change rate")
## END OF TESTS
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
#############################################################################################
#############################################################################################
#############################################################################################
# ___ _ _ _ __ __
# / _ \| | __| | ___| |_ _ _ / _|/ _|
# | | | | |/ _` | / __| __| | | | |_| |_
# | |_| | | (_| | \__ \ |_| |_| | _| _|
# \___/|_|\__,_| |___/\__|\__,_|_| |_|
#
#############################################################################################
#############################################################################################
#############################################################################################
rm(list = ls())
require(ggplot2)
require(reshape2)
par_seq = c("c_comm", "c_noncomm")
condom_seq = c("fc_y_comm", "fc_y_noncomm")
groups_seq = c("ProFSW", "LowFSW", "GPF", "FormerFSW", "Client", "GPM", "VirginF", "VirginM", "FormerFSWoutside")
years_seq = seq(1985, 2016)
time <- seq(1986, 2016, length.out = 31)
# best_set ----------------------------------------------------------------
best_set = list(
fraction_sexually_active_15_F = 0,
fraction_sexually_active_15_M = 0,
init_clientN_from_PCR = 0,
initial_Ntot = 286114,
frac_women_ProFSW = 0.0024,
frac_women_LowFSW = 0.0027,
frac_women_exFSW = 0.0024,
frac_men_client = 0.2,
frac_women_virgin = 0.1,
frac_men_virgin = 0.1,
prev_init_FSW = 0.0326,
prev_init_rest = 0.0012,
# N_init = c(672, 757, 130895, 672, 27124, 100305, 14544, 11145, 0),
fraction_F = 0.515666224,
epsilon_1985 = 0.059346131 * 1.5,
epsilon_1992 = 0.053594832 * 1.5,
epsilon_2002 = 0.026936907 * 1.5,
epsilon_2013 = 0.026936907 * 1.5,
epsilon_2016 = 0.026936907 * 1.5,
# mu = c(0.02597403, 0.02597403, 0.02597403, 0.02597403, 0.02739726, 0.02739726, 0.02597403, 0.02739726, 0.02597403), # women 1/((27 + 50)/2) # men 1/((25 + 48)/2)
# c_comm = c(750, 52, 0, 0, 13.5, 0, 0, 0, 0),
# c_noncomm = c(0.38, 0.38, 0.88, 0.88, 4, 1.065, 0, 0, 0), # partner change rate lowlevel FSW same as pro, others are approximations from various surveys
#
muF = 0.02597403,
muM = 0.02739726,
# PARTNER CHANGE RATE
c_comm_1985 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1993 = c(1229.5, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1020 + 1439)/2
c_comm_1995 = c(1280, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (1135 + 1425)/2
c_comm_1998 = c(881, 52, 0, 0, 10.15873, 0, 0, 0, 0), # (757 + 1005)/2
c_comm_2002 = c(598.5, 52, 0, 0, 11.08109, 0, 0, 0, 0), # (498 + 699)/2, (13.387-10.15873)/14 * 4 + 10.15873
c_comm_2005 = c(424, 52, 0, 0, 11.77286, 0, 0, 0, 0), # (366 + 482)/2, (13.387-10.15873)/14 * 7 + 10.15873
c_comm_2008 = c(371.5, 52, 0, 0, 12.46464, 0, 0, 0, 0), # (272 + 471)/2, (13.387-10.15873)/14 * 10 + 10.15873
c_comm_2012 = c(541, 52, 0, 0, 13.387, 0, 0, 0, 0), # (459 + 623)/2
c_comm_2015 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_comm_2016 = c(400, 52, 0, 0, 17.15294, 0, 0, 0, 0), # (309 + 491)/2
c_noncomm_1985 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0), # (0.4682779 + 0.3886719 + 0.2729358)/3
c_noncomm_1993 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1995 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_1998 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2002 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2005 = c(0.3766285, 0.3766285, 0.9610526, 0.9610526, 2.028986, 1.337444, 0, 0, 0),
c_noncomm_2008 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 2.028986, 0.7878543, 0, 0, 0),
c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 8.086957, 0.7878543, 0, 0, 0),
c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 6.258258, 0.7878543, 0, 0, 0),
n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
0, 0, 0, 0, 1.935, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
n_noncomm = matrix(c(0, 0, 0, 0, 32.7, 0, 0, 0, 0,
0, 0, 0, 0, 32.7, 0, 0, 0, 0, # could replace lowlevel with bargirls parameters
0, 0, 0, 0, 39, 37.875, 0, 0, 0, #(36.75+39)/2
0, 0, 0, 0, 39, 37.875, 0, 0, 0,
32.7, 32.7, 39, 39, 0, 0, 0, 0, 0,
0, 0, 37.875, 37.875, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0),
nrow = 9, ncol = 9, byrow = T),
#think about transforming to matrix
betaMtoF_comm = 0.00051, # RR circumcision = 0.44
betaFtoM_comm = 0.02442*0.44,
betaMtoF_noncomm = 0.003,
betaFtoM_noncomm = 0.0038*0.44,
infect_acute = 9, # RR for acute phase
infect_AIDS = 2, #7.27, # RR for AIDS phase
infect_ART = c(0, rep_len(0, 8)),
ec = rep_len(0.8, 9), # from kate's paper on nigeria SD couples
eP0 = c(0, rep_len(0, 8)), # assumptions!
eP1a = c(0.9, rep_len(0, 8)),
eP1b = c(0.45, rep_len(0, 8)),
eP1c = c(0, rep_len(0, 8)),
eP1d = c(0, rep_len(0, 8)),
gamma01 = 0.4166667, #years
SC_to_200_349 = 3.4,
gamma04 = 4.45, #years
alpha01 = rep_len(0, 9),
alpha02 = rep_len(0, 9),
alpha03 = rep_len(0.05, 9),
alpha04 = rep_len(0.08, 9),
alpha05 = rep_len(0.27, 9), #1/2.9
alpha11 = rep_len(0, 9),
alpha22 = rep_len(0, 9),
alpha23 = rep_len(0.05, 9),
alpha24 = rep_len(0.08, 9),
alpha25 = rep_len(0.27, 9),
alpha32 = rep_len(0, 9),
alpha33 = rep_len(0.05, 9),
alpha34 = rep_len(0.08, 9),
alpha35 = rep_len(0.27, 9),
alpha42 = rep_len(0, 9),
alpha43 = rep_len(0.05, 9),
alpha44 = rep_len(0.08, 9),
alpha45 = rep_len(0.27, 9),
#PREP
zetaa_t = c(1985, 2013, 2015, 2016),
zetaa_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetab_t = c(1985, 2013, 2015, 2016),
zetab_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
zetac_t = c(1985, 2013, 2015, 2016),
zetac_y = matrix(c(rep(0, 9), 0.0075, rep(0, 9-1), rep(0, 9), rep(0, 9)), ncol = 9, byrow = T),
psia = rep_len(0.1,9),
psib = rep_len(0.1,9),
#TESTING
testing_prob_t = c(1985, 2001, 2005, 2006, 2008, 2012, 2013, 2015, 2016),
testing_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985 columns are the risk groups
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2001
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2005
0.081625, 0.142, 0.142, 0.142, 0.0975, 0.0975, 0, 0, 0, # 2006 0.653/8 slope
0.244875, 0.21, 0.21, 0.21, 0.1, 0.1, 0, 0, 0, # 2008 3*0.653/8
0.571375, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2012 7*0.653/8
0.653, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2013
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0, # 2015
0.68, 0.331, 0.331, 0.331, 0.0582, 0.0582, 0, 0, 0), # 2016
nrow = 9, ncol = 9, byrow = T),
#ART
ART_prob_t = c(1985, 2002, 2005, 2016),
ART_prob_y = matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, # 1985
0, 0, 0, 0, 0, 0, 0, 0, 0, # 2002
0, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0.1448571, 0, 0, 0, # 2005 0.676/14 * 3
0.6739, 0.676, 0.676, 0.676, 0.676, 0.676, 0, 0, 0),
nrow = 4, ncol = 9, byrow = T), # 2016 GP: (0.8+0.552)/2
RR_ART_CD4200 = 5.39,
phi2 = c(0.105360516, rep_len(0.025,8)), # former sex workers drop out rate??!
phi3 = c(0.105360516, rep_len(0.025,8)),
phi4 = c(0.105360516, rep_len(0.025,8)),
phi5 = c(0.105360516, rep_len(0.025,8)),
ART_RR = (1.3+3.45)/2,
#CONDOM
fc_y_comm_1985 = matrix(
c(0, 0, 0, 0, 0.145524, 0, 0, 0, 0, # 0.145524 is using John's FSW condom 1989 as prop of 1993, * our measure of 1993
0, 0, 0, 0, 0.145524, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.145524, 0.145524, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1993 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1995 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_1998 = matrix(
c(0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0.536, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.536, 0.536, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2002 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2005 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2008 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2012 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_comm_2015 = matrix(
c(0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0.8, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0.8, 0.8, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_1985 = matrix(
c(0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 1998
# (0.33 + 0.2705314)/ 2 # average FSW client
# (0.0326087 + 0.2705314)/ 2 # average client GPF
# (0.0326087 + 0.04989035) / 2 # average gpm gpf
fc_y_noncomm_1998 = matrix(
c(0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.3002657, 0, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0, 0, 0, 0, 0.15157, 0.04124952, 0, 0, 0,
0.3002657, 0.3002657, 0.15157, 0.15157, 0, 0, 0, 0, 0,
0, 0, 0.04124952, 0.04124952, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
# 2008
# (0.33 + 0.4)/ 2 # average FSW client (both approx)
# ((0.05042017+0.241404781)/2 + 0.4)/ 2 # average client GPF (gpf averaged from 2 estimtes)
# ((0.05042017+0.241404781)/2 + (0.07103825+0.34838295)/2) / 2 # average gpm gpf
fc_y_noncomm_2008 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2015 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_y_noncomm_2016 = matrix(
c(0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.365, 0, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0, 0, 0, 0, 0.2729562, 0.1778115, 0, 0, 0,
0.365, 0.365, 0.2729562, 0.2729562, 0, 0, 0, 0, 0,
0, 0, 0.1778115, 0.1778115, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 9),
fc_t_comm = c(1985, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015, 2016),
fc_t_noncomm = c(1985, 1998, 2008, 2015, 2016),
rate_leave_pro_FSW = 0.2,
FSW_leave_Cotonou_fraction = 0.1,
rate_leave_low_FSW = 0.1,
rate_leave_client = 0.05,
replaceDeaths = 0,
movement = 1
)
# best_set end ----------------------------------------------------------------
#######################################################################
##########################for local editing
#######################################################################
odin::odin_package(".") # looks for any models inside inst/odin
devtools::load_all()
##############################################################
parameters <- lhs_parameters(1, set_pars = best_set, Ncat = 9, time = time,
ranges = rbind(
fraction_sexually_active_15_F = 0.4,
fraction_sexually_active_15_M = 0.4,
fraction_FSW_foreign = 0.9,
betaMtoF_noncomm = c(0.00144, 0.00626), # c(0.00086, 0.00433),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(6, 12),
c_noncomm_1998_Client = c(1, 3),
c_noncomm_2015_Client = c(2, 6),
who_believe_comm = c(0, 1),
frac_women_ProFSW = c(0.0025, 0.0025),
init_clientN_from_PCR = c(1,1)
))
f <- function(p, gen, time) {
mod <- gen(user = p)
all_results <- mod$transform_variables(mod$run(time))
all_results[c("N", "prev", "c_comm_balanced", "c_noncomm_balanced", "c_comm", "c_noncomm", "prev_men")]
}
res = lapply(parameters, f, cotonou::main_model, time)
pars = parameters[[1]]
pars$frac_women_ProFSW
pars$N_init
sum(pars$N_init)
# library(cotonou)
#test
number_simulations = 1
# test
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
parameters <- lhs_parameters(number_simulations, set_pars = best_set, Ncat = 9, time = time,
ranges = rbind(
# betaMtoF_comm = c(0.00086, 0.0118844), # c(0.00086, 0.00433),
# betaFtoM_comm = c(0.00279 * 0.44, 0.02701 * 0.44),
betaMtoF_noncomm = c(0.00144, 0.00626), # c(0.00086, 0.00433),
# betaFtoM_noncomm = c(0.00279 * 0.44, 0.02701 * 0.44),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(6, 12),
c_noncomm_1998_Client = c(1, 3),
c_noncomm_2015_Client = c(2, 6),
fc_y_comm_1985_ProFSW_Client = c(0.5, 0.5),
fc_y_comm_1993_ProFSW_Client = c(1, 1),
fc_y_comm_1998_ProFSW_Client = c(0.01, 0.01),
fc_y_comm_2016_ProFSW_Client = c(0.3, 0.3),
fc_y_noncomm_1985_GPM_GPF = c(0.0, 0),
fc_y_noncomm_1998_GPM_GPF = c(0.2, 0.2),
fc_y_noncomm_2016_GPM_GPF = c(0, 0),
fc_y_noncomm_1985_ProFSW_Client = c(0.5, 0.5),
fc_y_noncomm_2015_ProFSW_Client = c(0.8, 0.8)
# fc_y_noncomm_2015_Client_GPF = c(1, 1)
))
# lapply(parameters, function(x) x$betaMtoF_noncomm)time <- seq(1986, 2016, length.out = 31)
f <- function(p, gen, time) {
mod <- gen(user = p)
all_results <- mod$transform_variables(mod$run(time))
all_results[c("prev", "c_comm_balanced", "c_noncomm_balanced", "c_comm", "c_noncomm", "fc_comm", "fc_noncomm")]
}
res = lapply(parameters, f, cotonou::main_model, time)
# #checking c_comm
# if(number_simulations == 1)
# ggplot(melt(data.frame(time, do.call(rbind, lapply(res, function(x) x$c_comm))), id.vars = "time"), aes(x = time, y = value)) + geom_line() + facet_wrap(~variable, scales = "free") + theme_bw()
graph_par = "fc_noncomm"
# plot function -----------------------------------------------------------
# checking fc
# DONT TRUST THE PLOTTING!!
par_gridplot2 = function(result, parm) {
require(plyr)
fc_df = aperm(result[parm][[1]], c(2, 3, 1))
fc_df_list = alply(fc_df, 3)
fc_df_list_applied = lapply(fc_df_list, function(x) {colnames(x) = rownames(x) = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
return(x)})
dat = data.frame(row =
rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"), 1, each = 9),
col =
rep(c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"), 9),
value = unlist(lapply(fc_df_list_applied, c)),
year = unlist(sort(rep(time, 81))))
dat$row = factor(dat$row, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"))
dat$col = factor(dat$col, levels = c("Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients",
"GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou"))
# dat$combination = factor(dat$combination, levels =
# unlist(lapply(fc_df_list, function(x) {
# tmp = expand.grid(colnames(x), rownames(x))
# return(paste(tmp[,2], tmp[,1], sep = "_"))
# }))[1:81])
return(ggplot(dat, aes(x = year, y = value, color = value)) + geom_line(size = 2) + facet_grid(row~col) + theme_bw())
}
par_gridplot2(result = res[[1]], graph_par)
# plot end ----------------------------------------------------------------
# devtools::test()
res[[1]]$fc_noncomm[1,,]
parameters[[1]]$fc_y_comm_1985
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
start.time <- Sys.time()
# varying and fitting
number_simulations = 1
time = seq(1986, 2030, 1)
# parameters --------------------------------------------------------------
parameters <- lhs_parameters(number_simulations, set_pars = best_set, Ncat = 9, time = time,
ranges = rbind(
init_clientN_from_PCR = c(0,0),
# NO HIV, CONSTANT POP GROWTH RATE
epsilon_1985 = c(0.08, 0.08),
epsilon_1992 = c(0.08, 0.08),
epsilon_2002 = c(0.08, 0.08),
epsilon_2013 = c(0.08, 0.08),
epsilon_2016 = c(0.08, 0.08),
fraction_FSW_foreign = c(0.9, 0.9),
# epsilon_1985 = c(0.059, 0.059),
# epsilon_1992 = c(0.059, 0.059),
# epsilon_2002 = c(0.059, 0.059),
# epsilon_2013 = c(0.059, 0.059),
# epsilon_2016 = c(0.059, 0.059),
# muF = c(0.05, 0.05),
# muM = c(0.06, 0.06),
muF = c(0.0295, 0.0295),
muM = c(0.0315, 0.0315),
# betaMtoF_noncomm = c(0.00144, 0.00626),
betaMtoF_noncomm = c(0, 0),
frac_women_ProFSW = c(0.0067, 0.0067),
# frac_women_ProFSW = c(0.0024, 0.0067),
# frac_women_LowFSW = c(0.0024, 0.0067),
# frac_women_exFSW = c(0.0024, 0.0067),
frac_men_client = c(0.3, 0.3),
frac_women_virgin = 0.13,
frac_men_virgin = 0.13,
fraction_sexually_active_15_F = c(0.14, 0.14),
fraction_sexually_active_15_M = c(0.21, 0.21),
RR_beta_GUD = c(1.43, 19.58),
RR_beta_FtM = c(0.5, 2),
c_comm_1993_ProFSW = c(1000, 1800),
c_comm_2005_ProFSW = c(250, 600),
c_comm_1998_Client = c(7, 12),
c_comm_2015_Client = c(6, 12),
c_noncomm_1998_Client = c(1, 3),
c_noncomm_2015_Client = c(2, 6),
who_believe_comm = c(0, 1),
rate_leave_pro_FSW = c(0.4347826, 0.4347826),
rate_leave_low_FSW = c(0.4347826, 0.4347826),
rate_leave_client = c(0.5, 0.5),
# rate_enter_sexual_pop = c(0.6571429, 0.6571429),
rate_enter_sexual_pop = c(0.3571429, 0.3571429),
fc_y_comm_1993_ProFSW_Client = c(0.535, 0.687),
fc_y_comm_2002_ProFSW_Client = c(0.872, 0.933),
fc_y_comm_1998_ProFSW_Client = c(0.872, 0.933), # fake
fc_y_noncomm_1985_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_2016_ProFSW_Client = c(0.27, 0.43),
fc_y_noncomm_1998_GPM_GPF = c(0.0326087, 0.241404781),
fc_y_noncomm_2016_GPM_GPF = c(0.0326087, 0.251404781)
))
# end of parameters --------------------------------------------------------------
outputs = c("prev", "omega", "frac_N", "Ntot", "epsilon", "rate_leave_client", "alphaItot", "prev_FSW", "prev_LowFSW", "prev_client", "prev_men", "prev_women", "c_comm_balanced", "c_noncomm_balanced", "who_believe_comm")
f <- function(p, gen, time) {
mod <- gen(user = p)
all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev", "c_comm_balanced", "c_noncomm_balanced", "c_comm", "c_noncomm", "epsilon")]
all_results[outputs]
}
# res = lapply(parameters, f, main_model, time = seq(1986, 2030, 1))
res = lapply(parameters, f, main_model, time = time)
# prev_points -------------------------------------------------------------
prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
1998, 2002, 2005, 2008, 2012, 2015,
1998, 2008, 2011,
1998, 2008, 2011,
2012, 2015),
variable = c(rep("Pro FSW", 11),
rep("Clients", 6),
rep("Women", 3),
rep("Men", 3),
rep("Low-level FSW", 2)),
value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
100*0.084, 9, 6.9, 5.8, 100*0.028, 100*0.016,
100*0.035, 100*0.04, 2.2,
100*0.033, 100*0.02, 1.6,
100*0.167, 100*0.065),
lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
100*0.05898524, 100*0.068218538, 100*0.04293149, 100*0.034772131, 100*0.012660836, 100*0.006039259,
100*0.024181624, 100*0.030073668, 100*0.012980254,
100*0.022857312, 100*0.012427931, 100*0.007517563,
100*0.091838441, 100*0.026704897),
upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
100*0.11561791, 100*0.115608811, 100*0.105215792, 100*0.090216628, 100*0.051602442, 100*0.035338436,
100*0.047726245, 100*0.052817187, 100*0.035296286,
100*0.047183668, 100*0.029774338, 100*0.028546718,
100*0.268127672, 100*0.130153465))
prev_points_all = prev_points
prev_points = prev_points[-c(1,2,3),]
# prev_points -------------------------------------------------------------
# likelihood calculation -----------------------------------
likelihood_rough <- function(x) {
the_prev = data.frame(time, x$prev_FSW, x$prev_LowFSW, x$prev_client, x$prev_women, x$prev_men)
names(the_prev) = c("time", "Pro FSW", "Low-level FSW", "Clients", "Women", "Men")
likelihood_count <- 0
for(i in 1:length(prev_points[,1]))
{
# likelihood_count <- likelihood_count +
point = subset(the_prev, time == prev_points[i, "time"], select = as.character(prev_points[i, "variable"]))
if(!is.na(point)) {if((point < prev_points[i, "upper"]) && (point > prev_points[i, "lower"]))
{
# print(prev_points[i, c("time", "variable")]);
likelihood_count <- likelihood_count + 1
}}
}
return (likelihood_count)
}
# end of likelihood calculation -----------------------------------
# which(unlist(lapply(res, likelihood_rough)) > 4)
# best runs etc -----------------------------------------------------------
likelihood_list = unlist(lapply(res, likelihood_rough))
sorted_likelihood_list = sort(likelihood_list)
# table(sorted_likelihood_list)
best_runs = which(unlist(lapply(res, likelihood_rough)) == max(sorted_likelihood_list))
out <- res[best_runs]
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
print("number of seconds per simulation:")
as.numeric(time.taken)/ number_simulations
###
# THE DEMOGRAPHIC RESULTS OF BEST RUNS
# frac N data points ------------------------------------------------------
frac_N_data_points = data.frame(time = c(1998, 2014,
1998, 1998,
1998, 2008, 2011,
1998, 2008, 2011),
point = c(0.67, 0.24,
100*0.195738802*(1-0.515666224), 20,
100*0.1292392*0.515666224, 100*0.0972973*0.515666224, 100*0.16*0.515666224,
100*0.124632*(1-0.515666224), 100*0.08840413*(1-0.515666224), 100*0.1175*(1-0.515666224)),
variable = c("Pro FSW", "Pro FSW",
"Clients", "Clients",
"Virgin female", "Virgin female", "Virgin female",
"Virgin male", "Virgin male", "Virgin male"))
# demographic graphs ------------------------------------------------------
frac_N_best_runs = 100*do.call(rbind, lapply(res[best_runs], function(x) x$frac_N))
frac_N_best_runs = data.frame(time, frac_N_best_runs, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(frac_N_best_runs) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
frac_N_best_runs_melted = melt(frac_N_best_runs, id.vars = c("time", "replication"))
ggplot() + geom_line(data = frac_N_best_runs_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="Percent in each group (%)") +
facet_wrap(~variable, scales = "free") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
# facet_wrap(~variable, scales = "fixed") + geom_point(data = frac_N_data_points, aes(x = time, y = point), size = I(2), color = "red", shape = 15)
epsilon_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$epsilon)))
epsilon_best_runs = data.frame(time, epsilon_best_runs)
epsilon_best_runs_melted = melt(epsilon_best_runs, id.vars = "time")
ggplot() + geom_line(data = epsilon_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Growth rate")
Ntot_data_points = data.frame(time = c(1979, 1992, 2002, 2013, 2020, 2030), point = c(191106.1467, 404359.0418, 681559.032, 913029.606, 1128727.062, 1423887.65), colour = c("data", "data", "data", "data", "predicted", "predicted"))
Ntot_best_runs = t(do.call(rbind, lapply(res[best_runs], function(x) x$Ntot)))
Ntot_best_runs = data.frame(time, Ntot_best_runs)
Ntot_best_runs_melted = melt(Ntot_best_runs, id.vars = "time")
ggplot() + geom_line(data = Ntot_best_runs_melted, aes(x = time, y = value, factor = variable)) +
theme_bw() + labs(x="year",y="Total population size") + geom_point(data = Ntot_data_points, aes(x = time, y = point, color = colour), size = I(2), shape = 15)
#output growth rate?????
growth_rate_out = melt(data.frame(time = time[-1], t(do.call(rbind, lapply(lapply(res[best_runs], function(x) x$Ntot), function(y) {
diff(y)/y[-length(y)]
})))), id.vars = "time")
ggplot(growth_rate_out) + geom_line(aes(x = time, y = value, factor = variable)) + theme_bw() +
labs(x="year",y="Output growth rate")
# end of demographic graphs ------------------------------------------------------
# prev graphs ------------------------------------------------------
all_binded = do.call(rbind, lapply(res[best_runs], function(x) {
return(matrix(c(x$prev_FSW, x$prev_LowFSW, x$prev_client, x$prev_women, x$prev_men), ncol = 5))
}))
all_binded[is.na(all_binded)] = 0
out = data.frame(time, all_binded, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
names(out) = c("time", "Pro FSW", "Low-level FSW", "Clients", "Women", "Men", "replication")
out_melted = melt(out, id.vars = c("time", "replication"))
ggplot() + geom_line(data = out_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
geom_point(data = prev_points_all, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
facet_wrap(~variable, scales = "free")
# end of prev graphs ------------------------------------------------------
# who believe etc ---------------------------------------------------------
max(sorted_likelihood_list)
# WHO BELIEVE?
who_believe = unlist(lapply(parameters[which(likelihood_list == max(likelihood_list))], function(x) x$who_believe_comm))
who_believe = ifelse(who_believe == 1, "Clients", "FSWs")
table(who_believe)
c_comm_out = melt(data.frame(years = rep(time, length(best_runs)), do.call(rbind, lapply(res[best_runs], function(x) {
if(x$who_believe_comm[1] == 1)
return(data.frame(c_comm_balanced = x$c_comm_balanced[,1], varies = "FSW"))
else
return(data.frame(c_comm_balanced = x$c_comm_balanced[,5], varies = "Client"))
})), replication = sort(rep(seq(1, length(best_runs), 1), length(time)))), id.vars = c("years", "replication", "varies"))
ggplot(c_comm_out) + geom_line(aes(x = years, y = value, factor = as.factor(replication))) + facet_wrap(~varies, scales = "free") + theme_bw() + labs(y = "commercial partner change rate")
## END OF TESTS
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
########################################################################################################
# gubbins -----------------------------------------------------------------
#
#
#
# # the parameter sets that are the best fits
#
# # all points except first three
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# prev_points = prev_points[-c(1,2,3),]
# # sorted_likelihood_list = sort(unlist(lapply(res, likelihood_rough)))
# best_runs = which(unlist(lapply(res, likelihood_rough)) == 10)
#
# betas_all_points = lapply(parameters[best_runs], '[', c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm"))
#
# betas_df = do.call(rbind, lapply(betas_all_points, '[', c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm")))
#
# betas_df = data.frame(matrix(unlist(betas_df), nrow = length(best_runs), byrow = F))
#
# names(betas_df) = c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm")
#
# betas_df_melted = melt(betas_df)
#
#
# ggplot(data = betas_df_melted, aes(x = value, fill = variable), alpha = 0.5) + geom_histogram() + theme_bw()
#
# # just client points
#
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# prev_points = prev_points[prev_points$variable == "Clients",]
# best_runs = which(unlist(lapply(res, likelihood_rough)) == 3)
#
# all_binded = do.call(rbind, lapply(res[best_runs], function(x) x$prev))
# all_binded[is.na(all_binded)] = 0
# out = data.frame(time, all_binded, as.character(sort(rep(seq(1,length(best_runs)), length(time)))))
# names(out) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
# out_melted = melt(out, id.vars = c("time", "replication"))
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = out_melted, aes(x = time, y = value, factor = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
#
# betas_just_clients = lapply(parameters[best_runs], '[', c("betaMtoF_comm", "betaFtoM_comm", "betaMtoF_noncomm", "betaFtoM_noncomm"))
#
#
#
#
# # to be altered
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# # single run (prev)
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# # FOI
# FOI <- result["lambda_sum_0"][[1]]
# df = data.frame(time, FOI)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "force of infection on susceptibles (no PrEP)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# # mortality
# alphaItot <- result["alphaItot"][[1]]
# df = data.frame(time, alphaItot)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "Annual AIDS deaths") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
# 1/parameters$mu
#
#
#
# # understanding changes over time
# df = data.frame(time, result$c_comm_balanced)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "c_comm_balanced") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# df = data.frame(time, result$c_noncomm_balanced)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "c_noncomm_balanced") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
# df = data.frame(time, result$frac_N)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "frac_N") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
#
# #try to fit to prevalence data
# parameters = lhs_parameters(1, set_pars = best_set,
# forced_pars = list(#betaFtoM_comm = 0.00193, betaFtoM_noncomm = 0.00193, # infect_AIDS = 1,
# c_comm_1993 = c(1229.5, 52, 0, 0, 20, 0, 0, 0, 0),
# c_comm_1995 = c(1280, 52, 0, 0, 10, 0, 0, 0, 0),
# c_comm_1998 = c(881, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2002 = c(598.5, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2005 = c(424, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2008 = c(371.5, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2012 = c(541, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2015 = c(400, 52, 0, 0, 8, 0, 0, 0, 0),
# c_comm_2016 = c(400, 52, 0, 0, 8, 0, 0, 0, 0),
# c_noncomm_2012 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2015 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# c_noncomm_2016 = c(0.3766285, 0.3766285, 0.7943578, 0.7943578, 1.258258, 0.7878543, 0, 0, 0),
# rate_enter_sexual_pop = 0.4,
# betaMtoF_comm = 0.003,
# betaFtoM_comm = 0.0038*0.44,
# betaMtoF_noncomm = 0.002,
# betaFtoM_noncomm = 0.0028*0.44# ,
# # epsilon_2002 = 0.05 * 1.5,
# # epsilon_2013 = 0.05 * 1.5,
# # epsilon_2016 = 0.05 * 1.5
# ),
# Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,1998, 2012, 2015,1998, 2008, 1998, 2008,2012, 2015),variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,100*0.084, 100*0.028, 100*0.016,100*0.035, 100*0.04,100*0.033, 100*0.02,100*0.167, 100*0.065),upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,100*0.11561791, 100*0.051602442, 100*0.035338436,100*0.047726245, 100*0.052817187,100*0.047183668, 100*0.029774338,100*0.268127672, 100*0.130153465),lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,100*0.05898524, 100*0.012660836, 100*0.006039259,100*0.024181624, 100*0.030073668,100*0.022857312, 100*0.012427931,100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = df, aes(x = time, y = value)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
# data.frame(time,result$c_comm_balanced)
# plot(data.frame(year=time, fraction_virgin=result$frac_virgin))
# plot(data.frame(year=time, sum_of_weighted_FOI = rowSums(result$lambda_sum_0 * result$frac_N)))
#
#
# # average life duration
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# 1/(parameters$gamma01+parameters$alpha01+parameters$mu) +
# 1/(parameters$gamma02+parameters$alpha02+parameters$mu) +
# 1/(parameters$gamma03+parameters$alpha03+parameters$mu) +
# 1/(parameters$gamma04+parameters$alpha04+parameters$mu) +
# 1/(parameters$alpha05+parameters$mu)
#
# #on ART
# 1/(parameters$gamma01+parameters$alpha01+parameters$mu) +
# 1/(parameters$gamma32+parameters$alpha32+parameters$mu) +
# 1/(parameters$gamma33+parameters$alpha33+parameters$mu) +
# 1/(parameters$gamma34+parameters$alpha34+parameters$mu) +
# 1/(parameters$alpha35+parameters$mu)
#
#
#
# # fitting betas
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0.00193, betaFtoM = 0.00193, infect_AIDS = 1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
# 1998, 2012, 2015,
# 1998, 2008,
# 1998, 2008,
# 2012, 2015),
# variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),
# value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
# 100*0.084, 100*0.028, 100*0.016,
# 100*0.035, 100*0.04,
# 100*0.033, 100*0.02,
# 100*0.167, 100*0.065),
# upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
# 100*0.11561791, 100*0.051602442, 100*0.035338436,
# 100*0.047726245, 100*0.052817187,
# 100*0.047183668, 100*0.029774338,
# 100*0.268127672, 100*0.130153465),
# lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
# 100*0.05898524, 100*0.012660836, 100*0.006039259,
# 100*0.024181624, 100*0.030073668,
# 100*0.022857312, 100*0.012427931,
# 100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = df, aes(x = time, y = value)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
#
# plot(time, result$c_comm_balanced[,1])
# plot(time, result$fc_comm[,1,5])
#
#
#
# # rho
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["rho"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "ART rate") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
# # N
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["N"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "N") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# # tau
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["tau"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Testing rate") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
# # test c_comm
# parameters = lhs_parameters(1, c_comm_1985 = rep_len(1.1, 9), Ncat = 9)[[1]]
#
#
# # new people
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["new_people_in_group"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# # fc
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["fc_comm"][[1]][,1,5]
# df = data.frame(time, yy)
# plot(df)
# yy <- result["fc_noncomm"][[1]][,1,5]
# df = data.frame(time, yy)
# lines(df)
#
# par_gridplot2(result = result, "fc_comm")
#
# # frac_F
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# frac_F <- result["frac_F"][[1]][,1]
# df = data.frame(time, frac_F)
# plot(df)
#
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# frac_F <- result["frac_F"][[1]][,1]
# df = data.frame(time, frac_F)
# lines(df)
#
#
# # Ntot
# parameters = lhs_parameters(1, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# # result$prev
# # result$Ntot
# # result$new_people
# # result$Ntot_inc_former_FSW_nonCot
# result$epsilon
# plot(result$Ntot_inc_former_FSW_nonCot)
#
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# # result$prev
# # result$Ntot
# # result$new_people
# # result$Ntot_inc_former_FSW_nonCot
# result$epsilon
#
# lines(result$Ntot_inc_former_FSW_nonCot)
#
#
#
# # single run (prev)
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
# # no transmission
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, betaMtoF = 0, betaFtoM = 0)[[1]]
# result = run_model(parameters, main_model, time)
# data.frame(time, result$frac_N)
# result$prev
# result$Ntot
#
#
# # frac virgin
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(rate_enter_sexual_pop = .4))[[1]]
# result = run_model(parameters, main_model, time)
# fraction_virgin <- result["frac_virgin"][[1]]
# df = data.frame(time, fraction_virgin);plot(df)
#
#
# # frac N
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["frac_N"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "frac N") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
#
#
# c_noncomm
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(c_noncomm = c(0.38, 0.38, 0.88, 0.88, 1, 1.065, 0, 0, 0)))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
# ### variations of beta
# betaseq = c("point estimates", "lower bounds", "upper bounds")
# betaMtoFseq = c(0.00193, 0.00086, 0.00433)
# betaFtoMseq = c(0.00867, 0.00279, 0.0279)
#
# yy = data.frame()
# for(i in 1:3)
# {
# run = betaseq[i]
# parameters = lhs_parameters(1, set_pars = best_set, forced_pars = list(betaMtoF_comm = betaMtoFseq[i], betaFtoM_comm = betaFtoMseq[i], betaMtoF_noncomm = betaMtoFseq[i], betaFtoM_noncomm = betaFtoMseq[i]
# # , n_comm = matrix(c(0, 0, 0, 0, 1.935, 0, 0, 0, 0, # from client sa per partner
# # 0, 0, 0, 0, 1.935, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 1.935, 1.935, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0,
# # 0, 0, 0, 0, 0, 0, 0, 0, 0),
# # nrow = 9, ncol = 9, byrow = T)
# ), Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- rbind(yy, data.frame(time = time, result["prev"][[1]], replication = betaseq[i]))
# }
# colnames(yy) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou", "replication")
# yy_melted = melt(yy, id.vars = c("time", "replication"))
#
# ggplot(data = yy_melted, aes(x = time, y = value, color = replication)) + facet_wrap(~variable, scales = "free") + geom_line() + theme_bw() + labs(x="year",y="prevalance (%)")
#
#
# prev_points = data.frame(time = c(1986, 1987, 1988, 1993, 1995, 1998, 2002, 2005, 2008, 2012, 2015,
# 1998, 2012, 2015,
# 1998, 2008,
# 1998, 2008,
# 2012, 2015),
# variable = c(rep("Pro FSW", 11), rep("Clients", 3), rep("GPF", 2), rep("GPM", 2), rep("Low-level FSW", 2)),
# value = c(3.3, 8.2, 19.2, 53.3, 48.7, 40.6, 38.9, 34.8, 29.3, 27.4, 18.7,
# 100*0.084, 100*0.028, 100*0.016,
# 100*0.035, 100*0.04,
# 100*0.033, 100*0.02,
# 100*0.167, 100*0.065),
# upper = c(3.3, 8.2, 19.2, 58.48, 54.42, 44.67, 46.27, 39.38, 33.88, 32.23, 22.01,
# 100*0.11561791, 100*0.051602442, 100*0.035338436,
# 100*0.047726245, 100*0.052817187,
# 100*0.047183668, 100*0.029774338,
# 100*0.268127672, 100*0.130153465),
# lower = c(3.3, 8.2, 19.2, 48.02, 43.02, 36.58, 31.97, 30.42, 24.93, 23.01, 15.71,
# 100*0.05898524, 100*0.012660836, 100*0.006039259,
# 100*0.024181624, 100*0.030073668,
# 100*0.022857312, 100*0.012427931,
# 100*0.091838441, 100*0.026704897))
# ggplot() + geom_line(data = yy_melted, aes(x = time, y = value, color = replication)) + theme_bw() + labs(x="year",y="prevalance (%)") +
# geom_point(data = prev_points, aes(x = time, y = value))+ geom_errorbar(data = prev_points, aes(x = time, ymin = lower, ymax = upper))+
# facet_wrap(~variable, scales = "free")
#
#
# #c_comm
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(c_comm = c(750, 52, 0, 0, 5, 0, 0, 0, 0)))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")+
# geom_point(data = points, aes(x = time, y = value))+ geom_errorbar(data = points, aes(x = time, ymin = lower, ymax = upper))
#
#
#
#
#
# #beta 0
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9, forced_pars = list(betaMtoF = 0, betaFtoM = 0))[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
#
#
# #more condoms run
# parameters = lhs_parameters(1, set_pars = best_set, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
# best_set_2 = best_set
#
# best_set_2$fc_y_comm_1993 = best_set$fc_y_comm_1993*1.8
# best_set_2$fc_y_comm_1995 = best_set$fc_y_comm_1995*1.8
# best_set_2$fc_y_comm_1998 = best_set$fc_y_comm_1998*1.8
#
# best_set_2$fc_y_noncomm_1998 = best_set$fc_y_noncomm_1998*1.8
# best_set_2$fc_y_noncomm_2008 = best_set$fc_y_noncomm_2008*1.8
# best_set_2$fc_y_noncomm_2015 = best_set$fc_y_noncomm_2015*1.8
#
# parameters = lhs_parameters(1, set_pars = best_set_2, Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result["prev"][[1]]
# df = data.frame(time, yy)
# names(df) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Virgin female", "Virgin male", "Former FSW outside Cotonou")
# df = melt(df, id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, color = variable)) + labs(y = "Prevalence (%)") + geom_line() + theme_bw() + facet_wrap(~variable, scales = "free")+ theme(legend.position="none")
#
#
# # parameters[!(parameters %in% parameters1)]
#
#
#
#
#
# out=data.frame(time=result$t,output=result$Ntot)
# out
#
# ggplot(out, aes(x = time, y = output)) + geom_line() + theme_bw()
#
#
# # no zetas
# parameters <- lhs_parameters(1,Ncat = 9, set_null = list("zetaa_y", "zetab_y", "zetac_y"))[[1]]
#
#
#
#
#
# # test
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
# time <- seq(1986, 2016, length.out = 31)
#
# parameters <- lhs_parameters(1,Ncat = 9, movement = 0)[[1]]
# result = run_model(parameters, main_model, time)
#
#
#
#
# # prev of all groups
# #### Ncat = 9
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# number_simulations = 25
# parms = lhs_parameters(number_simulations, Ncat = 9)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev")]
# }
# res = lapply(parms, f, main_model, time)
#
# out = data.frame(time, do.call(rbind, lapply(res, function(x) x$prev)), as.character(sort(rep(seq(1,number_simulations), length(time)))))
# names(out) = c("time", "Pro FSW", "Low-level FSW", "GPF", "Former FSW in Cotonou", "Clients", "GPM", "Former FSW outside Cotonou", "replication")
# out_melted = melt(out, id.vars = c("time", "replication"))
# ggplot(data = out_melted, aes(x = time, y = value, factor = replication, color = variable)) + geom_line() + theme_bw() + facet_wrap(~variable)+ theme(legend.position="none")
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
# result$prev
# result$c_comm_balanced
# result$frac_N
# result$omega
#
# # showing priors are flat and explore space
# result$c_comm
#
# parameters <- lhs_parameters(2000, Ncat = 9)
# parm_prior1 = do.call(rbind, lapply(parameters, function(x) x$mu))
# parm_prior2 = do.call(rbind, lapply(parameters, function(x) x$betaMtoF))
#
# hist(parm_prior1[,1])
# ggplot(data= data.frame(parm_prior1, parm_prior2), aes (x= parm_prior1[,1], y= parm_prior2)) + geom_point() + theme_bw()
#
# # test prep
#
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# time <- seq(1986, 2016, length.out = 31)
# parameters <- lhs_parameters(1,Ncat = 9)[[1]]
# result = run_model(parameters, main_model, time)
#
# df=melt(data.frame(time, a = result$S1a[,1], b = result$S1b[,1], c = result$S1c[,1], d = result$S1d[,1]), id.vars = "time")
# ggplot(df, aes(x = time, y = value, color = variable)) + geom_line() + theme_bw()
#
#
#
#
#
# # balancing
# parameters <- generate_parameters(Ncat = 9, c_comm=c(1244,52,0,0,24,0,0), c_noncomm=c(0.377,0.96,0.96,0.96,2.03,1.34,0),
# omega = c(1000, 1127, 143728, 500, 27323, 112436, 10)/(1000+1127+143728+500+27323+112436),
# S0_init = c(1000, 1127, 143728, 500, 27323, 112436, 10)*0.99,
# I01_init = c(1000, 1127, 143728, 500, 27323, 112436, 10)*0.01)
# result = run_model(parameters, main_model, time)
# result$N
#
# result$B_check_comm
# result$B_check_noncomm
#
#
#
#
# names(result)
#
# result$Ncat
# result$c_comm
# result$c_comm_balanced
# result$c_noncomm
# result$c_noncomm_balanced
# result$N
#
# result$S0[1,,]
#
# result$sum_in_S0
#
#
# result$B_check_comm
# result$B_check_noncomm
# #
#
# # mixing
#
#
#
#
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# parameters <- lhs_parameters(1,Ncat = 9)[[1]]
# time <- seq(1986, 2016, length.out = 31)
# result = run_model(parameters, main_model, time)
# result$M_comm[2,,]
# result$M_noncomm[2,,]
# result$p_comm[2,,]
# result$p_noncomm[2,,]
#
#
# # need to write general test solutions. done! general test below
# timestep = 3
# all_female_partnerships = 0; all_male_partnerships = 0;
# for(i in 1:4)
# for (j in 1:7)
# all_female_partnerships = all_female_partnerships + result$p_comm[timestep, i, j] * result$c_comm_balanced[timestep,i] * result$N[timestep,i]
#
# for(i in 5:6)
# for (j in 1:7)
# all_male_partnerships = all_male_partnerships + result$p_comm[timestep, i, j] * result$c_comm_balanced[timestep,i] * result$N[timestep,i]
# all_female_partnerships/all_male_partnerships
# #nonnoncomm check
# # need to write general test solutions. done! general test below
# timestep = 3
# all_female_partnerships = 0; all_male_partnerships = 0;
# for(i in 1:4)
# for (j in 1:7)
# all_female_partnerships = all_female_partnerships + result$p_noncomm[timestep, i, j] * result$c_noncomm_balanced[timestep,i] * result$N[timestep,i]
#
# for(i in 5:6)
# for (j in 1:7)
# all_male_partnerships = all_male_partnerships + result$p_noncomm[timestep, i, j] * result$c_noncomm_balanced[timestep,i] * result$N[timestep,i]
# all_female_partnerships/all_male_partnerships
#
#
#
# #below to tset for PrEP
# parameters <- generate_parameters(zetaa = c(0,0),zetab = c(0,0),zetac = c(0,0), psia = c(1, 1), psib = c(1, 1))
# result = run_model(parameters, main_model, time)
#
# result$OnPrEP
# result$t
#
# result$PrEP_0
# result$PrEP_1a
#
# result$S1a
# result$S1b
# result$S1c
#
# result$lambda_0[10,,]
# result$lambda_1a[10,,]
# result$lambda_1b[10,,]
# result$lambda_1c[10,,]
#
# result$lambda_sum_0[2,]
# result$lambda_sum_1a[2,]
# result$lambda_sum_1b[2,]
# result$lambda_sum_1c[2,]
#
#
# # result$N
# # result$c[1,,]
# # result$cstar[1,,]
# # result$B[1,,]
# # result$theta[1,,]
#
# # RUNNING MULTIPLE SIMULATIONS
#
# number_simulations = 2000
#
# parms = lhs_parameters(number_simulations)
#
# time <- seq(1986, 2016, length.out = 31)
#
# # parameter ranges
#
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("mu","fc_comm","betaMtoF","prev", "cumuInftot")]
# }
# res = lapply(parms, f, main_model, time)
# mu_input <- t(sapply(parms, "[[", "mu"))
# fc_y_input <- t(sapply(parms, "[[", "fc_y_comm"))
# prev_client_output <- t(sapply(res, "[[", "prev_client"))
# betaMtoF_input <- t(sapply(parms, "[[", "betaMtoF"))[1,]
# cumuInf_output <- t(sapply(res, "[[", "cumuInftot"))[,31]
#
# ggplot(data = data.frame(betaMtoF_input, cumuInf_output), aes(x = betaMtoF_input, y = cumuInf_output)) + geom_point() + theme_bw()
#
#
#
# # fc over time
# df = melt(data.frame(time, res[[1]]$fc_comm), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
# # prevalence over time
# matplot(time, res[[1]]$prev, type = "l")#, lty = 1, col = "#00000055")
#
#
# # mu vs prev?
# plot(mu_input[, 1], prev_client_output[length(time), ])
#
#
# # PLOTTING MULTIPLE SIMULATIONS
#
#
# number_simulations = 100
# parms = lhs_parameters(number_simulations, Ncat = 2)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev")]
# }
# res = lapply(parms, f, main_model, time)
#
# df=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,1])), group = "group 1")
# df_2=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,2])), group = "group 2")
#
# df_melted = melt(df, id.vars = c("time","group"))
# df_melted_2 = melt(df_2, id.vars = c("time","group"))
# df_all = rbind(df_melted, df_melted_2)
# ggplot(data = df_all, aes(x = time, y = value, factor = variable, color = group)) + geom_line(alpha = 0.5) + theme_bw()
#
#
# #### Ncat = 9
# odin::odin_package(".") # looks for any models inside inst/odin
# devtools::load_all()
#
# number_simulations = 50
# parms = lhs_parameters(number_simulations, Ncat = 9)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("prev")]
# }
# res = lapply(parms, f, main_model, time)
#
# df=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,1])), group = "group 1")
# df_2=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,2])), group = "group 2")
# df_3=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,3])), group = "group 3")
# df_4=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,4])), group = "group 4")
# df_5=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,5])), group = "group 5")
# df_6=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,6])), group = "group 6")
# df_7=data.frame(time,do.call(cbind, lapply(res, function(x) x <- x$prev[,7])), group = "group 7")
#
# df_melted = melt(df, id.vars = c("time","group"))
# df_melted_2 = melt(df_2, id.vars = c("time","group"))
# df_melted_3 = melt(df_3, id.vars = c("time","group"))
# df_melted_4 = melt(df_4, id.vars = c("time","group"))
# df_melted_5 = melt(df_5, id.vars = c("time","group"))
# df_melted_6 = melt(df_6, id.vars = c("time","group"))
# df_melted_7 = melt(df_7, id.vars = c("time","group"))
#
# df_all = rbind(df_melted, df_melted_2, df_melted_3, df_melted_4, df_melted_5, df_melted_6, df_melted_7)
# ggplot(data = df_all, aes(x = time, y = value, factor = variable, color = group)) + geom_line(alpha = 0.5) + theme_bw()
#
# df=do.call(cbind,lapply(res, function(x) x$prev[,7]))
# colnames(df) <- seq(1, number_simulations)
# df <- data.frame(time, df)
# df_melted <- melt(df, id.vars = "time")
# ggplot(data = df_melted, aes(x = time, y = value, factor = variable)) + geom_line() + theme_bw() + labs(x="year",y="prevalance (%) former FSW outside Cotonou")
#
#
# # show priors are flat and well explored
# number_simulations = 200
# parms = lhs_parameters(number_simulations, Ncat = 9)
# time <- seq(1986, 2016, length.out = 31)
# f <- function(p, gen, time) {
# mod <- gen(user = p)
# all_results <- mod$transform_variables(mod$run(time))
# all_results[c("c_comm", "c_noncomm","mu","gamma01")]
# }
# res = lapply(parms, f, main_model, time)
#
# c_comm_prior = do.call(rbind, lapply(res, function(x) x$c_comm[1,]))
# hist(c_comm_prior[,1])
#
# mu_prior = do.call(rbind, lapply(res, function(x) x$mu[1,]))
# hist(mu_prior[,1])
#
# c_noncomm_prior = do.call(rbind, lapply(res, function(x) x$c_noncomm[1,]))
# hist(c_noncomm_prior[,1])
#
# gamma01_prior = do.call(rbind, lapply(res, function(x) x$gamma01[1,]))
# hist(gamma01_prior[,1])
#
#
#
# # SINGLE RUN WITH PARAMETERS TO CHECK EVERY OUTPUT
#
# # plot fc
# parameters <- lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result[grep("c_comm", names(result))]
# df = melt(data.frame(time, yy$c_comm), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
#
# # number of people on PrEP
# parameters <- lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result[grep("S1[a-z]", names(result))]
# yy_plot <- melt(
# data.frame(time,
# FSW = rowSums(do.call(cbind, lapply(yy, function(x) x <- x[,1]))),
# clients = rowSums(do.call(cbind, lapply(yy, function(x) x <- x[,2])))
# ),id.vars = "time")
#
# ggplot(data = yy_plot, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
#
#
# # plot prevalence
# parameters <- lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# yy <- result[grep("prev", names(result))]
# df = melt(data.frame(time, FSW = yy$prev_FSW, client = yy$prev_client), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
#
#
# # cumulative infections
# parameters <-lhs_parameters(1)[[1]]
# result = run_model(parameters, main_model, time)
# xx <- result[grep("cumu", names(result))]
# N <- rowSums(do.call(cbind, xx))
# df = melt(data.frame(time, N), id.vars = "time")
# ggplot(data = df, aes(x = time, y = value, colour = variable)) + geom_line() + theme_bw()
# gubbins -----------------------------------------------------------------
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.