From 2262a5126670f842c78d312ea7d8026120141e8a Mon Sep 17 00:00:00 2001
From: nemeth <Nemeth@demogr.mpg.de>
Date: Thu, 21 Jan 2021 18:34:43 +0100
Subject: [PATCH] added lower quartile and updated death rate info

---
 app.R | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 79 insertions(+), 11 deletions(-)

diff --git a/app.R b/app.R
index 8c30842..86a41f3 100644
--- a/app.R
+++ b/app.R
@@ -290,7 +290,7 @@ tags$p(style="text-align:center;margin-bottom:0px;",
 
 
                                     fluidRow(align="center",selectInput(inputId="variable",
-                                                label=HTML('Measure','<span id="exclamation">',as.character(icon("exclamation", class="exclamation")),'<span class="tooltiptext"> Death rates are presented as death rates per 100000 person-years.</span> </span>'),
+                                                label=HTML('Measure','<span id="exclamation">',as.character(icon("exclamation", class="exclamation")),'<span class="tooltiptext"> Death rates are displayed on a scale of 100000 person-years.</span> </span>'),
                                                 
                                                 choices=c("Deaths, Total" = "DTotal",
                                                         "Death Rate, Total" = "RTotal",
@@ -333,16 +333,17 @@ tags$p(style="text-align:center;margin-bottom:0px;",
                                                                     <span>Expected value of a linear trend fitted over years in the selected period. </span> 
                                                                     <center><u>Week-specific Lower Quartiles</u></center>
                                                                     <span>The reference level for a given week equals to the lower quartile of the available data for that week in the years of the selected period.</span>
-                                                                    <center><u>Yearly-average-week Trend</u></center>
+                                                                    <center><u>Yearly-average-week</u></center>
                                                                     <span>The arithmetic mean of the week-specific averages over the period.</span> 
-                                                                    <center><u>Summer-average-week Trend</u></center>
+                                                                    <center><u>Summer-average-week</u></center>
                                                                     <span>The arithmetic mean of the week-specific averages over the period excluding calendar weeks between 48 and 12.</span>
                                                                     </span> </span>'),
                                                 choices=c("Week-specific Averages",
                                                         "Week-specific Trends",
                                                         "Week-specific Lower Quartiles",
-                                                        "Yearly-average-week Trend",
-                                                        "Summer-average-week Trend"
+                                                        "Yearly Average-week",
+                                                        "Summer Average-week",
+                                                        "Yearly Lower-quartile-week"
                                                         )
                                     ),
                                     
@@ -848,9 +849,15 @@ server=function(input,output,session){
         }
 
 
-        #### lower quartile
+        #### 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)]
         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)]
+        
+        
         #### linear trend expectation
         
         
@@ -888,7 +895,9 @@ server=function(input,output,session){
         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)]
         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)]
 
             smalldata2=data[CountryCode == input$country2 & Year %in% c(input$period2[1]:input$period2[2]),c("Year",..myvar,"Week","CountryCode","Sex")]
             linex2=rbindlist(by(smalldata2,smalldata2[,c("Week","Sex","CountryCode")],function(x){
@@ -945,21 +954,57 @@ server=function(input,output,session){
                 subdata2$ymaxvalue = subdata2[,..myvar]
                 compareline2 = meandata2[CountryCode == input$country2, c("Sex","Week",..myvar)]
             }
-        } else if (input$area %in% c("Yearly-average-week Trend","Summer-average-week Trend")){
+        } else if (input$area %in% c("Yearly Average-week","Summer Average-week","Yearly Lower-quartile-week")){
             
-            if (input$area == "Yearly-average-week Trend"){
+            if (input$area == "Yearly Average-week"){
                 baseline = expectedlevel[CountryCode==input$country]
                 
                 if (input$extracountry == TRUE){
                     baseline2 = expectedlevel2[CountryCode==input$country2]
                 }
-            } else if (input$area == "Summer-average-week Trend") {
+            } else if (input$area == "Summer Average-week") {
                 baseline = expectedlevelsummer[CountryCode==input$country]
 
                 if (input$extracountry == TRUE){
                     baseline2 = expectedlevelsummer2[CountryCode==input$country2]
                 }
+            } else if (input$area == "Yearly Lower-quartile-week") {
+                Qf=as.numeric(q25y[CountryCode %in% input$country & Sex == "f", ..myvar])
+                Qm=as.numeric(q25y[CountryCode %in% input$country & Sex == "m", ..myvar])
+                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]<Qm)],
+                data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "f",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "f",..myvar]<Qf)],
+                
+                data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "b",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "b",..myvar]<Qb)]
+                )
+
+                colnow=colnames(q25allsel[,5])
+            
+                baseline=q25allsel[, lapply(.SD,mean), .SDcols=colnow, by = list(CountryCode,Sex)]
+
+                
+
+                if (input$extracountry == TRUE){
+                Qf2=as.numeric(q25y2[CountryCode %in% input$country2 & Sex == "f", ..myvar])
+                Qm2=as.numeric(q25y2[CountryCode %in% input$country2 & Sex == "m", ..myvar])
+                Qb2=as.numeric(q25y2[CountryCode %in% input$country2 & Sex == "b", ..myvar])
+
+                q25allsel2=rbind(
+                data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & Sex == "m",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & Sex == "m",..myvar]<Qm2)],
+                data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & Sex == "f",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & Sex == "f",..myvar]<Qf2)],
+                
+                data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & Sex == "b",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country2 & Year %in% c(input$period2[1]:input$period2[2]) & Sex == "b",..myvar]<Qb2)]
+                )
+
+                colnow2=colnames(q25allsel2[,5])
+            
+                baseline2=q25allsel2[, lapply(.SD,mean), .SDcols=colnow2, by = list(CountryCode,Sex)]
+                }
             }
+
+
             ### weeks in target year
             week1=unique(data[CountryCode==input$country & Year==input$targetyear]$Week)
             week2 = 1:52
@@ -1062,7 +1107,30 @@ server=function(input,output,session){
                 subdata2$ymaxvalue = subdata2[,..myvar]
                 compareline2 = q25data2[CountryCode == input$country2, c("Sex","Week",..myvar)]
             }
-        }
+         } #else if (input$area =="Yearly Lower-quartile-week"){
+#             subdata=data[CountryCode==input$country & Year==input$targetyear & Week %in% commonweek]
+            
+
+#             Qf=as.numeric(q25y[CountryCode %in% input$country & Sex == "f", ..myvar])
+#             Qm=as.numeric(q25y[CountryCode %in% input$country & Sex == "m", ..myvar])
+#             Qb=as.numeric(q25y[CountryCode %in% input$country & Sex == "b", ..myvar])
+
+#     # data[CountryCode %in% "AUT" & Sex == "f",c("CountryCode", "Year","Week","Sex","D0_14")][which(data[CountryCode %in% "AUT" & Sex == "f","D0_14"]<Qf)]
+
+#             q25allsel=rbind(
+#                 data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "b",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "b",..myvar]<Qb)],
+#                 data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "f",c("CountryCode", "Year","Week","Sex",..myvar)][which(data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]) & Sex == "f",..myvar]<Qf)],
+#                 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]<Qm)])
+
+# # print(q25allsel)
+# # expectedlevel=data[CountryCode %in% input$country & Year %in% c(input$period[1]:input$period[2]), lapply(.SD,mean), .SDcols= cols, by = list(CountryCode,Sex)]
+#             colnow=colnames(q25allsel[,5])
+#             # =q25allsel[, lapply(.SD,mean), .SDcols=colnow, by = list(CountryCode,Sex)])
+#             baseline=q25allsel[, lapply(.SD,mean), .SDcols=colnow, by = list(CountryCode,Sex)])
+#             # print(data[CountryCode %in% input$country & Sex == "b",][data[CountryCode %in% input$country & Sex == "b", ..myvar]<Qb,])
+
+#             # print(data[CountryCode==input$country & Year %in% c(input$period[1]:input$period[2]) & Sex =="f" & ..myvar<q25y[CountryCode %in% input$country & Sex == "f", ..myvar]])
+#         }