Data for 2020 is preliminary and for the last 1-3 available weeks may be incomplete. Please refer to the Metadata information for country-specific characteristics.
+The research article provides additional details on the features, the research background and the applied methods: DOI: 10.1371/journal.pone.0246663
+Data for the last available weeks is preliminary and may be incomplete. Please refer to the Metadata information for country-specific characteristics.
Data and metadata information are freely available for download on the project's website in the Human Mortality Database as well as in the sidebar.
For an optimal user experience using an up-to-date browser, e.g. Chrome or Firefox, is recommended.") @@ -699,15 +724,31 @@ server=function(input,output,session){ updateSliderInput(session,"period", min=min(data[CountryCode==input$country]$Year), max=max(data[CountryCode==input$country]$Year), - value=c(min(data[CountryCode==input$country]$Year), - max(data[CountryCode==input$country]$Year)-1) + value=c(max(2010,min(data[CountryCode==input$country]$Year)), + min(2019,max(data[CountryCode==input$country]$Year)-1)) ) updateSliderInput(session,"period2", min=min(data[CountryCode==input$country2]$Year), max=max(data[CountryCode==input$country2]$Year), - value=c(min(data[CountryCode==input$country2]$Year), - max(data[CountryCode==input$country2]$Year)-1) + value=c(max(2010,min(data[CountryCode==input$country2]$Year)), + min(2019,max(data[CountryCode==input$country2]$Year)-1)) + ) + + +# label="Multiperiod", +# choices=unique(data[CountryCode=="AUT"]$Year), +# selected=c((max(data[CountryCode=="AUT"]$Year)-3):(max(data[CountryCode=="AUT"]$Year)-1)), +# multiple=TRUE, +# selectize=TRUE + updateSelectInput(session,"multiperiod", + choices=unique(data[CountryCode==input$country]$Year), + selected=c(max(2010,min(data[CountryCode==input$country]$Year)):(min(2019,max(data[CountryCode==input$country]$Year)-1))) + ) + + updateSelectInput(session,"multiperiod2", + choices=unique(data[CountryCode==input$country]$Year), + selected=c(max(2010,min(data[CountryCode==input$country]$Year)):(min(2019,max(data[CountryCode==input$country]$Year)-1))) ) }) @@ -823,46 +864,53 @@ server=function(input,output,session){ output$myplot=renderPlot({ req(input$targetyear,input$country,input$period,input$area,input$variable) - + if (input$viewlength == "Continuous") { + myper = c(input$period[1]:input$period[2]) + } else if (input$viewlength == "Multi-year") { + myper = as.numeric(sort(input$multiperiod)) + } myvar=input$variable - + # print(myper) #### The baselines #### #### measures cols=colnames(data)[5:16] #### Weekly averages (across years) - meandata=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Week,Sex)] + meandata=data[CountryCode %in% input$country & Year %in% c(myper), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Week,Sex)] + # print(paste("this is multiperiod", input$multiperiod)) + # multimean=data[CountryCode %in% input$country & Year %in% input$multiperiod, lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Week,Sex)] + # print(head(multimean)) dataset$meandata=meandata #### Expected level (average of weekly averages) - expectedlevel=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] + expectedlevel=data[CountryCode %in% input$country & Year %in% c(myper), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] #### summer #### if (input$country %in% c("AUS2","CHL","NZL_NP")){ - expectedlevelsummer=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & !(Week %in% 22:38), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] + expectedlevelsummer=data[CountryCode %in% input$country & Year %in% c(myper) & !(Week %in% 22:38), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] } else { #### Expected level without winter season (from December to March included - week 48 -- week 12) - expectedlevelsummer=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & !(Week %in% c(1:12,48:52)), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] + expectedlevelsummer=data[CountryCode %in% input$country & Year %in% c(myper) & !(Week %in% c(1:12,48:52)), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] } #### lower quartile weekly - q25data=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]), lapply(.SD,quantile,prob=0.25), .SDcols= cols, by = list(CountryCode,Week,Sex)] + q25data=data[CountryCode %in% input$country & Year %in% c(myper), lapply(.SD,quantile,prob=0.25), .SDcols= cols, by = list(CountryCode,Week,Sex)] dataset$q25data=q25data #### lower quartile - q25y=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]), lapply(.SD, quantile, prob=0.25), .SDcols = cols, by = list(CountryCode,Sex)] + q25y=data[CountryCode %in% input$country & Year %in% c(myper), lapply(.SD, quantile, prob=0.25), .SDcols = cols, by = list(CountryCode,Sex)] #### linear trend expectation - smalldata=data[CountryCode==input$country & Year %in% c(input$period[1]:input$period[2]),c("Year",..myvar,"Week","CountryCode","Sex")] + smalldata=data[CountryCode==input$country & Year %in% c(myper),c("Year",..myvar,"Week","CountryCode","Sex")] linex=rbindlist(by(smalldata,smalldata[,c("Week","Sex","CountryCode")],function(x){ eq=lm(x[[myvar]] ~ Year, data=x) @@ -877,30 +925,36 @@ server=function(input,output,session){ if (input$extracountry == TRUE) { - meandata2=data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Week,Sex)] + + if (input$viewlength == "Continuous") { + myper2 = c(input$period2[1]:input$period2[2]) + } else if (input$viewlength2 == "Multi-year") { + myper2 = as.numeric(sort(input$multiperiod2)) + } + meandata2=data[CountryCode %in% input$country2 & Year %in% myper2, lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Week,Sex)] dataset$meandata2=meandata2 #### Expected level (average of weekly averages) - expectedlevel2=data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] + expectedlevel2=data[CountryCode %in% input$country2 & Year %in% myper2, lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] if (input$country2 %in% c("AUS2","CHL","NZL_NP")){ - expectedlevelsummer2=data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & !(Week %in% 22:38), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] + expectedlevelsummer2=data[CountryCode %in% input$country2 & Year %in% myper2 & !(Week %in% 22:38), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] } else { #### Expected level without winter season (from December to March included - week 48 -- week 12) - expectedlevelsummer2=data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & !(Week %in% c(1:12,48:52)), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] + expectedlevelsummer2=data[CountryCode %in% input$country2 & Year %in% myper2 & !(Week %in% c(1:12,48:52)), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)] } #### lower quartile - q25data2=data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]), lapply(.SD,quantile,prob=0.25), .SDcols= cols, by = list(CountryCode,Week,Sex)] + q25data2=data[CountryCode %in% input$country2 & Year %in% myper2, lapply(.SD,quantile,prob=0.25), .SDcols= cols, by = list(CountryCode,Week,Sex)] dataset$q25data2=q25data2 #### lower quartile - q25y2=data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]), lapply(.SD, quantile, prob=0.25), .SDcols = cols, by = list(CountryCode,Sex)] + q25y2=data[CountryCode %in% input$country2 & Year %in% myper2, lapply(.SD, quantile, prob=0.25), .SDcols = cols, by = list(CountryCode,Sex)] - smalldata2=data[CountryCode == input$country2 & Year %in% c(input$period2[1]:input$period2[2]),c("Year",..myvar,"Week","CountryCode","Sex")] + smalldata2=data[CountryCode == input$country2 & Year %in% myper2,c("Year",..myvar,"Week","CountryCode","Sex")] linex2=rbindlist(by(smalldata2,smalldata2[,c("Week","Sex","CountryCode")],function(x){ eq=lm(x[[myvar]] ~ Year, data=x) res=predict.lm(eq,data.frame(Year=as.numeric(input$targetyear2))) @@ -975,10 +1029,10 @@ server=function(input,output,session){ Qb=as.numeric(q25y[CountryCode %in% input$country & Sex == "b", ..myvar]) q25allsel=rbind( - data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "m",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "m",..myvar]