villes_s<-list()
for(i in 1:length(villes)) {
villes_s[[i]]<-villes[[i]][villes[[i]]$saison=="summer",]
villes_s[[i]]$temps <- ave(villes_s[[i]]$time,villes_s[[i]]$annee, FUN = seq_along)
}
names(villes_s)<-cities
table of N obs per months to check to have only summer month
for (i in 1:length(villes)){
print(table(villes_s[[i]]$mois))
}
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
##
## 1 2 3 4 5 6 7 8 9 10 11 12
## 0 0 0 0 0 540 558 558 540 0 0 0
trshld95<-c()
for (i in 1:length(villes_s)){
trshld95[i]<-quantile(villes_s[[i]]$tempmax, probs=c(0.975),na.rm=TRUE)
villes_s[[i]]$heat_wave<-0
villes_s[[i]]$heat_wave[which(villes_s[[i]]$tempmax > trshld95[i])]<- 1
}
Â
Number of Heat Wave for each city:
| Heat wave=0 | Heat wave=1 | |
|---|---|---|
| bm | 2143 | 53 |
| bordeaux | 2143 | 53 |
| clermont | 2142 | 54 |
| grenoble | 2141 | 55 |
| lehavre | 2142 | 54 |
| lille | 2143 | 53 |
| lyon | 2142 | 54 |
| marseille | 2142 | 54 |
| montpellier | 2145 | 51 |
| nancy | 2142 | 54 |
| nantes | 2141 | 55 |
| nice | 2142 | 54 |
| paris | 2144 | 52 |
| rennes | 2142 | 54 |
| rouen | 2143 | 53 |
| strasbourg | 2143 | 53 |
| toulouse | 2141 | 55 |
# creation of no2 variable of today and previous day
#function filter {stats}
for (i in 1:length(villes_s)){
villes_s[[i]]<-transform(villes_s[[i]], no2moy = as.vector(filter(no2,sides = 1, filter = rep(1, 2))/2), no2Lag1=Lag(no2,1),no2Lag2=Lag(no2,2))
}
Code:
## create dataframe without missing values
for (i in 1:length(villes_s)){
villes_s[[i]]<-na.omit(villes_s[[i]][, c("respi","o3","Jours","Vacances","hol","heat_wave","no2moy")])
#villes_s[[i]]<-villes_s[[i]][villes_s[[i]]$Dates>="2007-06-01",]
villes_s[[i]]$time<-1:nrow(villes_s[[i]])
}
# start bootstrap
nreps=1000 #number of bootstrap reps
results<-matrix(NA,nrow = 17,ncol=10)
colnames(results)<-c("city","NDE","NDE_2.5","NDE_97.5","NIE","NIE_2.5","NIE_97.5","PMM","PMM_2.5","PMM_97.5")
for (i in (1:length(villes_s))){
boot.nde<- rep(NA,nreps)
boot.nie <- rep(NA,nreps)
boot.pmm <- rep(NA,nreps)
for (rep in 1:nreps)
{
dat_resample <- sample(1:nrow(villes_s[[i]]),nrow(villes_s[[i]]),replace=T)
dat_boot <- villes_s[[i]][dat_resample,]
# outcome model - Poisson Regression: Mortality, HW and O3
m.outcome<-glm(respi~heat_wave+o3+ns(time,df=round(8*length(time)/365.25))+Jours+Vacances+hol,data=dat_boot,family=quasipoisson)
# mediator model - multinomial linear regression
m.mediator<-lm(o3~heat_wave+no2moy+ns(time,df=round(8*length(time)/365.25))+Jours+Vacances+hol,data=dat_boot)
# save coefficients
theta1<-coef(m.outcome)[2]
theta2<-coef(m.outcome)[3]
beta1<-coef(m.mediator)[2]
# estimate CDE and NIE
boot.nde[rep] <- exp(theta1) #NDE
boot.nie[rep] <-exp(theta2*beta1) #NIE
boot.pmm[rep] <-boot.nde[rep]*(boot.nie[rep]-1)/(boot.nde[rep]*boot.nie[rep]-1) #NIE
} #end bootstrap
results[i,1]<-cities[[i]]
results[i,2]<-median(boot.nde, na.rm=T)
results[i,3]<-quantile(boot.nde, 0.025, na.rm=T)
results[i,4]<-quantile(boot.nde, 0.975, na.rm=T)
results[i,5]<-median(boot.nie, na.rm=T)
results[i,6]<-quantile(boot.nie, 0.025, na.rm=T)
results[i,7]<-quantile(boot.nie, 0.975, na.rm=T)
results[i,8]<-median(boot.pmm, na.rm=T)
results[i,9]<-quantile(boot.pmm, 0.025, na.rm=T)
results[i,10]<-quantile(boot.pmm, 0.975, na.rm=T)
}
# output CDE and NIE and confidence intervals
Results:
res<-data.frame(results)
for (i in (2:10)){
res[,i]<-as.numeric(as.character(res[,i]))
}
res[,2:10]<-round(res[,2:10],digits = 4)
kable(res)%>%kable_styling()%>%
column_spec(1, bold = T, border_right = T)%>%
column_spec(4, border_right = T)%>%
column_spec(7, border_right = T)
| city | NDE | NDE_2.5 | NDE_97.5 | NIE | NIE_2.5 | NIE_97.5 | PMM | PMM_2.5 | PMM_97.5 |
|---|---|---|---|---|---|---|---|---|---|
| bm | 0.9919 | 0.7786 | 1.2040 | 1.0599 | 0.9930 | 1.1256 | 0.3931 | -6.8935 | 6.5696 |
| bordeaux | 1.0906 | 0.9907 | 1.2024 | 1.0238 | 0.9822 | 1.0602 | 0.2165 | -0.2060 | 1.0342 |
| clermont | 1.1177 | 0.9140 | 1.3362 | 1.0021 | 0.9515 | 1.0520 | 0.0135 | -1.4060 | 2.1329 |
| grenoble | 1.0960 | 0.9396 | 1.2568 | 1.0234 | 0.9823 | 1.0627 | 0.1944 | -1.4543 | 1.9870 |
| lehavre | 1.0680 | 0.8924 | 1.2634 | 1.0004 | 0.9494 | 1.0493 | -0.0217 | -2.0391 | 2.5687 |
| lille | 1.0553 | 0.9576 | 1.1529 | 1.0097 | 0.9774 | 1.0414 | 0.1258 | -1.8731 | 1.7490 |
| lyon | 0.9873 | 0.8820 | 1.0890 | 0.9878 | 0.9609 | 1.0114 | 0.1023 | -4.0928 | 4.4940 |
| marseille | 0.9732 | 0.8834 | 1.0643 | 1.0045 | 0.9993 | 1.0141 | -0.0529 | -1.9860 | 2.0289 |
| montpellier | 1.0963 | 0.9303 | 1.2674 | 1.0002 | 0.9971 | 1.0046 | 0.0014 | -0.1289 | 0.1017 |
| nancy | 1.0668 | 0.9189 | 1.2303 | 1.0139 | 0.9813 | 1.0515 | 0.1355 | -1.9882 | 2.3868 |
| nantes | 1.0167 | 0.9131 | 1.1334 | 1.0229 | 0.9830 | 1.0649 | 0.2421 | -6.0829 | 6.3498 |
| nice | 1.0778 | 0.9508 | 1.2061 | 0.9980 | 0.9833 | 1.0077 | -0.0174 | -0.4912 | 0.6649 |
| paris | 1.0307 | 0.9666 | 1.0943 | 1.0047 | 0.9875 | 1.0213 | 0.0990 | -1.8650 | 2.3706 |
| rennes | 1.0238 | 0.8086 | 1.2507 | 1.0342 | 0.9795 | 1.1017 | 0.1915 | -4.1711 | 4.8056 |
| rouen | 0.8738 | 0.7602 | 0.9777 | 0.9866 | 0.9401 | 1.0366 | 0.0793 | -0.3002 | 0.6272 |
| strasbourg | 1.1211 | 0.9759 | 1.2735 | 1.0432 | 1.0062 | 1.0832 | 0.2721 | 0.0016 | 1.1900 |
| toulouse | 1.2249 | 1.1089 | 1.3380 | 0.9991 | 0.9740 | 1.0234 | -0.0051 | -0.1707 | 0.1476 |
Natural Direct Effect
Natural Indirect Effect