In EU-ECDC/EpiSignalDetection: Signal Detection Analysis
##******************************************************************************
## Chunk options
##******************************************************************************
knitr::opts_chunk$set(eval=TRUE, echo=FALSE,
fig.align='center',fig.width=13,fig.height=5,
message=FALSE, warning=FALSE)
knitr::knit_hooks$set(inline = function(x) {
format(x, big.mark=",")
})
##******************************************************************************
## Definition of the main color of graphs and table
##******************************************************************************
maincolor="#69AE23"
##******************************************************************************
## Libraries
##******************************************************************************
library(ggplot2)
library(dplyr)
## ~~~~~~~~~~~~~~~~
## Setting parameters
## ~~~~~~~~~~~~~~~~
if(is.null(params$file)) {
dataset <- EpiSignalDetection::SignalData
} else {
inFile <- params$file
dataset <- EpiSignalDetection::importAtlasExport(inFile$datapath)
dataset <- EpiSignalDetection::cleanAtlasExport(dataset)
}
input <- list(
disease = params$disease,
country = params$country,
indicator = params$indicator,
unit = params$unit,
daterange = params$daterange,
algo = params$algo,
testingperiod = params$testingperiod
)
tempPath <- params$tempPath
#--- Filtering on country, stratification and time unit
dataset <- EpiSignalDetection::filterAtlasExport(dataset, input, stratified = TRUE)
#--- Defining the study period
StudyPeriod <- EpiSignalDetection::studyPeriod(input)
#--- Defining the testing period period
TestingPeriod <- StudyPeriod$Time[length(StudyPeriod$Time):(length(StudyPeriod$Time)
- input$testingperiod + 1)]
#-- Excluding countries with gaps and EU pre-computed values from the TS
excluded <- unique(dataset$RegionName[ is.na(dataset$NumValue) ])
if (input$country == "EU-EEA - complete series") {
included <- unique(dataset$RegionName[!(dataset$RegionName %in% c(excluded, "EU", "EU/EEA"))])
if (length(included) != 0) {
dataset <- dplyr::filter(dataset, dataset$RegionName %in% included )
} else {
warning("All countries present with at least one gmissing value in the time series")
}
} else if (length(excluded) !=0) {
warning("The selected country presents with at least one missing value in the time series")
}
#-- Dataset for the testing period (TP) only
datasetTP <- dplyr::filter(dataset, Time %in% TestingPeriod)
Study period: r StudyPeriod$Time[1] to r StudyPeriod$Time[length(StudyPeriod$Time)]
- Historical data: From
r StudyPeriod$Time[1]
to r StudyPeriod$Time[length(StudyPeriod$Time) - input$testingperiod].
- signal detection period:
The last
r input$testingperiod r tolower(input$unit)(s)
of the study period: from r TestingPeriod[input$testingperiod]
to r TestingPeriod[1].
- Time unit:
r input$unit(s).
- Signal detection algorithm:
r input$algo.
- Gaps in the time series:
r ifelse(input$country == "EU-EEA - complete series", (ifelse(length(excluded) !=0, paste("The following country(ies) presented with at least one missing value in the time series:", paste(excluded, collapse = ", ")), "None" )), (ifelse(length(excluded) !=0, "The selected country presented with at least one missing value in the time series", "None" ))).
Overview cases reported in the signal detection period: r TestingPeriod[input$testingperiod] to r TestingPeriod[1]
- There is(are)
r length(unique(datasetTP$RegionName[datasetTP$NumValue>0]))
country(ies) reporting at least 1 case in the signal detection period.
- There are
r sum(datasetTP$NumValue, na.rm=TRUE) cases reported
in the signal detection period, all strata added up.
if(input$country == "EU-EEA - complete series") {
datasetByCountry <- datasetTP %>%
dplyr::group_by_( c("RegionName") ) %>%
dplyr::summarise( NumValue = sum(NumValue) ) %>%
dplyr::ungroup()
#--- Sort by number cases by countries
datasetByCountry <- datasetByCountry %>%
dplyr::arrange(NumValue) %>%
dplyr::mutate(RegionName = factor(datasetByCountry$RegionName, levels = datasetByCountry$RegionName))
p <- ggplot(datasetByCountry, aes(x = RegionName, y = NumValue)) +
geom_bar(stat = "identity", fill = maincolor) +
scale_y_continuous(expand = c(0,0)) +
coord_flip() +
labs(title = "Graph: Number of cases observed by country in the signal detection period",
x = "Reporting country", y = "Number of cases") +
theme(title = element_text(size = 14),
axis.text = element_text(size = 12),
axis.text.x = element_text(size = 12),
axis.title = element_text(size = 14, face = "bold"),
plot.title = element_text(color = "grey", hjust = 0, vjust = 0),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
p
}
Stratification variable
This report is stratified according to the data entered in the variable 'Population'.
strata <- na.omit(unique(datasetTP$Population[datasetTP$NumValue>0]))
- The selected strata are those with at least one reported case during
the signal detection period.
- There are
r length(strata) strata with at least one case
in the signal detection period: r paste(strata, collapse = ", ").
In decreasing order of number of cases, the most frequent serotypes on
the signal detecion period are:
tab <- tapply(datasetTP$NumValue, datasetTP$Population, sum)
tab <- as.data.frame(tab)
names(tab) <- "Number of cases"
DT::datatable(tab,
options = list(
pageLength = 20,
autoWidth = FALSE,
dom = 't',
order = list(list(1, 'desc')),
columnDefs = list(
list(className = 'dt-left', orderable = TRUE, targets = 1))),
caption = "Table: Number of cases by stratum")
Signal detection: r TestingPeriod[input$testingperiod] to r TestingPeriod[1]
#--- Preparation of the result table that will be append through the following loop
Result <- data.frame( Time = "" ,
Place = "" ,
Stratum = "",
Observed = "" ,
Threshold.ALGO = "",
ALGO = "",
Ranking = NA,
p.value = "",
stringsAsFactors=FALSE)
#-- Creation of a EU/EEA
if(input$country == "EU-EEA - complete series"){
datasetEU <- dataset %>%
dplyr::group_by_("StudyPeriod", "Population" ) %>%
dplyr::summarise( NumValue = sum(NumValue) ) %>%
dplyr::ungroup()
datasetEU <- data.frame(RegionName = "EU-EEA - complete series", datasetEU)
dataset <- dataset[, c("RegionName", "Population", "StudyPeriod", "NumValue")]
dataset <- rbind(datasetEU, dataset)
}
out <- NULL
#-- Creation of stratification levels
countries <- na.omit(unique(dataset$RegionName))
for(i in 1:length(countries)){
country = countries[i]
for(j in 1:length(strata)){
stratum = strata[j]
dataset_1 = dplyr::filter(dataset,
RegionName == country & Population == stratum)
if(nrow(dataset_1) != 0) {
#-------------------------------------------------------
#---- Sts object
#-------------------------------------------------------
dataset.sts <- EpiSignalDetection::stsSD(observedCases = dataset_1$NumValue,
studyPeriod = dataset_1$StudyPeriod,
timeUnit = input$unit,
startYM = c(
as.numeric(format(as.Date(input$daterange[1], "%Y-%m-%d"), "%Y")),
as.numeric(format(as.Date(input$daterange[1], "%Y-%m-%d"), "%m"))
)
)
#-------------------------------------------------------
#---- Detection algorithm
#-------------------------------------------------------
dataset.algo <- EpiSignalDetection::algoSD(dataset.sts,
algo = input$algo,
timeUnit = input$unit,
testingPeriod = input$testingperiod)
#-------------------------------
#--- Incrementation of the Result table
#-------------------------------
if(input$algo == "FarringtonFlexible") {
for(l in 1:(input$testingperiod)){
Result <- rbind(Result,
data.frame(Time = TestingPeriod[input$testingperiod +1 -l],
Place = country,
Stratum = stratum,
Observed = as.character(dataset.algo@observed[l]),
Threshold.ALGO = as.character(round(dataset.algo@upperbound[l],0)),
ALGO = ifelse(dataset.algo@alarm[l],
"<span style=\"color:#DD4814\">Signal</span>",
"no"),
Ranking = round(dataset.algo@control$score[l], 2 ),
p.value = ifelse(dataset.algo@control$pvalue[l] < 0.00001,
"<0.00001",
as.character( round(dataset.algo@control$pvalue[l],5)))
)
)
}
}
if(input$algo == "GLRNB") {
# --- Special treat for GLRNB because:
# --- Exceedance score and pvalue are not available in surveillance 1.16.2
# --- for GLRNB function.
# --- Need to compute expected number of cases and exeedance score:
observed <- dataset.algo@observed
expected <- dataset.algo@control$mu0
threshold <- dataset.algo@upperbound
ranking <- ((observed - expected) / (threshold - expected))
pvalue <- "Not applicable"
# ---
for(l in 1:(input$testingperiod)){
Result <- rbind(Result,
data.frame(Time = TestingPeriod[input$testingperiod +1 -l],
Place = country,
Stratum = stratum,
Observed = as.character(observed[l]),
Threshold.ALGO = as.character(round(threshold[l],0)),
ALGO = ifelse(dataset.algo@alarm[l],
"<span style=\"color:#DD4814\">Signal</span>",
"no"),
Ranking = round(ranking[l], 2 ),
p.value = pvalue
)
)
}
}
}
}
}
Result <- Result[-1,]
r paste(out, collapse='\n')
By geographical level
out=NULL
for(i in countries){
Result_c <- dplyr::filter(Result, Place == i & grepl("Signal", ALGO))
row.names(Result_c) <- NULL
names(Result_c) <- c(paste("Time ( by ", tolower(input$unit), ")", sep = ""),
"Place",
"Stratum",
"Reported cases",
"Threshold value",
"Signal",
"Exceedance score",
"P.value")
out <- c(out,knitr::knit_child('subsection.Rmd'))
}
r paste(out, collapse='\n')
By stratification level
out=NULL
for(i in strata){
Result_c <- dplyr::filter(Result, Stratum == i & grepl("Signal", ALGO))
row.names(Result_c) <- NULL
names(Result_c) <- c(paste("Time ( by ", tolower(input$unit), ")", sep = ""),
"Place",
"Stratum",
"Reported cases",
"Threshold value",
"Signal",
"Exceedance score",
"P.value")
out <- c(out,knitr::knit_child('subsection.Rmd'))
}
r paste(out, collapse='\n')
EU-ECDC/EpiSignalDetection documentation built on May 26, 2019, 2:36 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.
##****************************************************************************** ## Chunk options ##****************************************************************************** knitr::opts_chunk$set(eval=TRUE, echo=FALSE, fig.align='center',fig.width=13,fig.height=5, message=FALSE, warning=FALSE) knitr::knit_hooks$set(inline = function(x) { format(x, big.mark=",") }) ##****************************************************************************** ## Definition of the main color of graphs and table ##****************************************************************************** maincolor="#69AE23" ##****************************************************************************** ## Libraries ##****************************************************************************** library(ggplot2) library(dplyr)
## ~~~~~~~~~~~~~~~~ ## Setting parameters ## ~~~~~~~~~~~~~~~~ if(is.null(params$file)) { dataset <- EpiSignalDetection::SignalData } else { inFile <- params$file dataset <- EpiSignalDetection::importAtlasExport(inFile$datapath) dataset <- EpiSignalDetection::cleanAtlasExport(dataset) } input <- list( disease = params$disease, country = params$country, indicator = params$indicator, unit = params$unit, daterange = params$daterange, algo = params$algo, testingperiod = params$testingperiod ) tempPath <- params$tempPath #--- Filtering on country, stratification and time unit dataset <- EpiSignalDetection::filterAtlasExport(dataset, input, stratified = TRUE)
#--- Defining the study period StudyPeriod <- EpiSignalDetection::studyPeriod(input) #--- Defining the testing period period TestingPeriod <- StudyPeriod$Time[length(StudyPeriod$Time):(length(StudyPeriod$Time) - input$testingperiod + 1)]
#-- Excluding countries with gaps and EU pre-computed values from the TS excluded <- unique(dataset$RegionName[ is.na(dataset$NumValue) ]) if (input$country == "EU-EEA - complete series") { included <- unique(dataset$RegionName[!(dataset$RegionName %in% c(excluded, "EU", "EU/EEA"))]) if (length(included) != 0) { dataset <- dplyr::filter(dataset, dataset$RegionName %in% included ) } else { warning("All countries present with at least one gmissing value in the time series") } } else if (length(excluded) !=0) { warning("The selected country presents with at least one missing value in the time series") } #-- Dataset for the testing period (TP) only datasetTP <- dplyr::filter(dataset, Time %in% TestingPeriod)
Study period: r StudyPeriod$Time[1] to r StudyPeriod$Time[length(StudyPeriod$Time)]
- Historical data: From
r StudyPeriod$Time[1]tor StudyPeriod$Time[length(StudyPeriod$Time) - input$testingperiod]. - signal detection period:
The last
r input$testingperiodr tolower(input$unit)(s) of the study period: fromr TestingPeriod[input$testingperiod]tor TestingPeriod[1]. - Time unit:
r input$unit(s). - Signal detection algorithm:
r input$algo. - Gaps in the time series:
r ifelse(input$country == "EU-EEA - complete series", (ifelse(length(excluded) !=0, paste("The following country(ies) presented with at least one missing value in the time series:", paste(excluded, collapse = ", ")), "None" )), (ifelse(length(excluded) !=0, "The selected country presented with at least one missing value in the time series", "None" ))).
Overview cases reported in the signal detection period: r TestingPeriod[input$testingperiod] to r TestingPeriod[1]
- There is(are)
r length(unique(datasetTP$RegionName[datasetTP$NumValue>0]))country(ies) reporting at least 1 case in the signal detection period. - There are
r sum(datasetTP$NumValue, na.rm=TRUE)cases reported in the signal detection period, all strata added up.
if(input$country == "EU-EEA - complete series") { datasetByCountry <- datasetTP %>% dplyr::group_by_( c("RegionName") ) %>% dplyr::summarise( NumValue = sum(NumValue) ) %>% dplyr::ungroup() #--- Sort by number cases by countries datasetByCountry <- datasetByCountry %>% dplyr::arrange(NumValue) %>% dplyr::mutate(RegionName = factor(datasetByCountry$RegionName, levels = datasetByCountry$RegionName)) p <- ggplot(datasetByCountry, aes(x = RegionName, y = NumValue)) + geom_bar(stat = "identity", fill = maincolor) + scale_y_continuous(expand = c(0,0)) + coord_flip() + labs(title = "Graph: Number of cases observed by country in the signal detection period", x = "Reporting country", y = "Number of cases") + theme(title = element_text(size = 14), axis.text = element_text(size = 12), axis.text.x = element_text(size = 12), axis.title = element_text(size = 14, face = "bold"), plot.title = element_text(color = "grey", hjust = 0, vjust = 0), panel.grid.major = element_blank(), panel.grid.minor = element_blank()) p }
Stratification variable
This report is stratified according to the data entered in the variable 'Population'.
strata <- na.omit(unique(datasetTP$Population[datasetTP$NumValue>0]))
- The selected strata are those with at least one reported case during the signal detection period.
- There are
r length(strata)strata with at least one case in the signal detection period:r paste(strata, collapse = ", ").
In decreasing order of number of cases, the most frequent serotypes on the signal detecion period are:
tab <- tapply(datasetTP$NumValue, datasetTP$Population, sum) tab <- as.data.frame(tab) names(tab) <- "Number of cases" DT::datatable(tab, options = list( pageLength = 20, autoWidth = FALSE, dom = 't', order = list(list(1, 'desc')), columnDefs = list( list(className = 'dt-left', orderable = TRUE, targets = 1))), caption = "Table: Number of cases by stratum")
Signal detection: r TestingPeriod[input$testingperiod] to r TestingPeriod[1]
#--- Preparation of the result table that will be append through the following loop Result <- data.frame( Time = "" , Place = "" , Stratum = "", Observed = "" , Threshold.ALGO = "", ALGO = "", Ranking = NA, p.value = "", stringsAsFactors=FALSE) #-- Creation of a EU/EEA if(input$country == "EU-EEA - complete series"){ datasetEU <- dataset %>% dplyr::group_by_("StudyPeriod", "Population" ) %>% dplyr::summarise( NumValue = sum(NumValue) ) %>% dplyr::ungroup() datasetEU <- data.frame(RegionName = "EU-EEA - complete series", datasetEU) dataset <- dataset[, c("RegionName", "Population", "StudyPeriod", "NumValue")] dataset <- rbind(datasetEU, dataset) } out <- NULL #-- Creation of stratification levels countries <- na.omit(unique(dataset$RegionName)) for(i in 1:length(countries)){ country = countries[i] for(j in 1:length(strata)){ stratum = strata[j] dataset_1 = dplyr::filter(dataset, RegionName == country & Population == stratum) if(nrow(dataset_1) != 0) { #------------------------------------------------------- #---- Sts object #------------------------------------------------------- dataset.sts <- EpiSignalDetection::stsSD(observedCases = dataset_1$NumValue, studyPeriod = dataset_1$StudyPeriod, timeUnit = input$unit, startYM = c( as.numeric(format(as.Date(input$daterange[1], "%Y-%m-%d"), "%Y")), as.numeric(format(as.Date(input$daterange[1], "%Y-%m-%d"), "%m")) ) ) #------------------------------------------------------- #---- Detection algorithm #------------------------------------------------------- dataset.algo <- EpiSignalDetection::algoSD(dataset.sts, algo = input$algo, timeUnit = input$unit, testingPeriod = input$testingperiod) #------------------------------- #--- Incrementation of the Result table #------------------------------- if(input$algo == "FarringtonFlexible") { for(l in 1:(input$testingperiod)){ Result <- rbind(Result, data.frame(Time = TestingPeriod[input$testingperiod +1 -l], Place = country, Stratum = stratum, Observed = as.character(dataset.algo@observed[l]), Threshold.ALGO = as.character(round(dataset.algo@upperbound[l],0)), ALGO = ifelse(dataset.algo@alarm[l], "<span style=\"color:#DD4814\">Signal</span>", "no"), Ranking = round(dataset.algo@control$score[l], 2 ), p.value = ifelse(dataset.algo@control$pvalue[l] < 0.00001, "<0.00001", as.character( round(dataset.algo@control$pvalue[l],5))) ) ) } } if(input$algo == "GLRNB") { # --- Special treat for GLRNB because: # --- Exceedance score and pvalue are not available in surveillance 1.16.2 # --- for GLRNB function. # --- Need to compute expected number of cases and exeedance score: observed <- dataset.algo@observed expected <- dataset.algo@control$mu0 threshold <- dataset.algo@upperbound ranking <- ((observed - expected) / (threshold - expected)) pvalue <- "Not applicable" # --- for(l in 1:(input$testingperiod)){ Result <- rbind(Result, data.frame(Time = TestingPeriod[input$testingperiod +1 -l], Place = country, Stratum = stratum, Observed = as.character(observed[l]), Threshold.ALGO = as.character(round(threshold[l],0)), ALGO = ifelse(dataset.algo@alarm[l], "<span style=\"color:#DD4814\">Signal</span>", "no"), Ranking = round(ranking[l], 2 ), p.value = pvalue ) ) } } } } } Result <- Result[-1,]
r paste(out, collapse='\n')
By geographical level
out=NULL for(i in countries){ Result_c <- dplyr::filter(Result, Place == i & grepl("Signal", ALGO)) row.names(Result_c) <- NULL names(Result_c) <- c(paste("Time ( by ", tolower(input$unit), ")", sep = ""), "Place", "Stratum", "Reported cases", "Threshold value", "Signal", "Exceedance score", "P.value") out <- c(out,knitr::knit_child('subsection.Rmd')) }
r paste(out, collapse='\n')
By stratification level
out=NULL for(i in strata){ Result_c <- dplyr::filter(Result, Stratum == i & grepl("Signal", ALGO)) row.names(Result_c) <- NULL names(Result_c) <- c(paste("Time ( by ", tolower(input$unit), ")", sep = ""), "Place", "Stratum", "Reported cases", "Threshold value", "Signal", "Exceedance score", "P.value") out <- c(out,knitr::knit_child('subsection.Rmd')) }
r paste(out, collapse='\n')
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.