Skip to content

Commit

Permalink
added lower quartile and updated death rate info
Browse files Browse the repository at this point in the history
  • Loading branch information
@nemeth
nemeth committed Jan 21, 2021
1 parent 79264de commit 2262a51
Showing 1 changed file with 79 additions and 11 deletions.
90 changes: 79 additions & 11 deletions app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down Expand Up @@ -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"
)
),

Expand Down Expand Up @@ -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


Expand Down Expand Up @@ -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){
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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]])
# }



Expand Down

0 comments on commit 2262a51

Please sign in to comment.