---
title: "BY-COVID - WP5 - Baseline Use Case: SARS-CoV-2 vaccine effectiveness"
subtitle: "Data Quality Assessment (DQA)"
format: 
  html:
    self-contained: true
code-fold: false
echo: false
editor: visual
always_allow_html: yes
title-block-banner: "#27445C"
---

```{r, metadata, results='hide', message=FALSE, warning=FALSE, error=FALSE}

################
### Metadata ###
################

# DATE LAST MODIFIED:
# 19/09/2023

# METADATA: 
if(FALSE) {
  title      <- 'BY-COVID WP5.2 Baseline Use Case: SARS-CoV-2 vaccine effectiveness - analytical pipeline - data quality assessment'
  author     <- list('Marjan Meurisse','Javier González-Galindo','Francisco Estupiñán-Romero','Santiago Royo-Sierra','Nina Van Goethem','Enrique Bernal-Delgado')
  version    <- '1.0.2'
  maintainer <- 'Marjan Meurisse'
  email      <- 'Marjan.Meurisse@sciensano.be'
  input      <- list('cohort_data (database table in BY-COVID-WP5-BaselineUseCase-VE.duckdb)')
  output     <- list('1_DQA.html (report)')
}

```

```{css}

.box {
  padding: 1em;
  color: black;
  background: transparant;
  border: 1px solid lightgrey;
}

```

```{r, general settings, results='hide', message=FALSE, warning=FALSE, error=FALSE}

## Description: load packages
source("./0_global.R")

```

```{r, logging, results='hide', message=FALSE, warning=FALSE, error=FALSE}

## Description: Log of 1_DQA.QMD
    
info(logger, paste0("
========================================================================================
",
"1_DQA.QMD","
",
"========================================================================================
 "))

```

```{r, load data, results='hide', message=FALSE, warning=FALSE, error=FALSE}

## Description: load the data into memory

info(logger_simple, "LOADING THE DATA INTO MEMORY...")

tryCatch(
  {
    con = dbConnect(duckdb::duckdb(), dbdir=auxiliary_database_path, read_only=FALSE)
    df <- dbGetQuery(con,
    "CREATE TEMPORARY TABLE Temp AS SELECT * FROM cohort_data;
    ALTER TABLE Temp DROP COLUMN flag_violating_val;
    ALTER TABLE Temp DROP COLUMN flag_listwise_del;
    SELECT * FROM Temp") 
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  },
  finally={
    dbDisconnect(con, shutdown=TRUE)
  })

```

## Overview {.tabset}

This section provides an overview of the imported dataset. Dataset statistics, variable types, a missing data profile and potential alerts are shown below.

::: panel-tabset
##### Dataset statistics

```{r, introduce, message=FALSE, warning=FALSE, error=FALSE}

## Description: obtain basic information about the cohort_data

info(logger_simple, "OBTAINING BASIC INFORMATION ABOUT THE COHORT_DATA...")

tryCatch(
{
    dt_ind <- as.data.frame(introduce(df))
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```

```{r, dataset statistics, message=FALSE, warning=FALSE, error=FALSE}

## Description: create table with overall dataset statistics (nr columns, nr rows, nr observations, ...)

info(logger_simple, "CREATING TABLE WITH OVERALL DATASET STATISTICS...")

tryCatch(
  {
    dt_stat <- dt_ind
    dt_stat$perc_missing_values <- 
      paste0(round(100*dt_stat$total_missing_values/dt_stat$total_observations,1),"%")
    dt_stat$memory_usage <- utils:::format.object_size(dt_stat$memory_usage,"auto")
    dt_stat$rows <- formatC(dt_stat$rows, format="f", big.mark = " ", digits = 0)
    dt_stat$total_observations <- formatC(dt_stat$total_observations, format="f", big.mark = " ", digits = 0)
    dt_stat$total_missing_values <- formatC(dt_stat$total_missing_values, format="f", big.mark = " ", digits = 0)
    dt_stat <- t(dt_stat[,c("columns", "rows", "total_observations", "total_missing_values","perc_missing_values","memory_usage")])
    DT::datatable(dt_stat,
                  class = 'cell-border stripe',
                  colnames = "",
                  options = list(dom = 't'),
                  caption = htmltools::tags$caption(
                    style = "text-align: left",
                    ''),
                  rownames = c("Number of variables","Number of rows", "Total observation","Total missing cells", "Missing cells (%)", "Memory usage")) 
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })


```

##### Variables

```{r, variables, message=FALSE, warning=FALSE, error=FALSE}

## Description: create table with basic column information (discrete, continuous, all missing columns)

info(logger_simple, "CREATING TABLE WITH BASIC COLUMN INFORMATION...")

tryCatch(
  {
    dt_var <- dt_ind
    dt_var <- t(dt_var[,c("discrete_columns","continuous_columns","all_missing_columns")])
    rownames(dt_var) <- c("Discrete variable","Continuous variable","All missing variable")
    formattable(as.data.frame(dt_var), align = c("l","c"), col.names = NULL)
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```

```{r, classes, message=FALSE, warning=FALSE, error=FALSE}

## Description: create table with information on the variable classes

info(logger_simple, "CREATING TABLE WITH INFORMATION ON VARIABLE CLASSES...")

tryCatch(
  {
    dt_var_class <- as.data.frame(sapply(df, class))
    DT::datatable(dt_var_class,
                  class = 'cell-border stripe',
                  caption = htmltools::tags$caption(
                    style = "text-align: left",''),
                  colnames = c("Variable","Class"))
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```

##### Missing data profile

```{r, missing data profile 1, message=FALSE, warning=FALSE, error=FALSE}

## Description: create table with missing data profile (feature/variable, nr missing, % missing)

info(logger_simple, "CREATING TABLE WITH MISSING DATA PROFILE...")

tryCatch(
  {
    dt_prof <- profile_missing(df)
    DT::datatable(dt_prof,
                  class = 'cell-border stripe',
                  caption = htmltools::tags$caption(
                    style = "text-align: left", NULL),
                  rownames = NULL,
                  colnames=c("Feature","Number missing","Percentage missing")) %>%
      formatPercentage("pct_missing", digits=1) %>%
      formatStyle(
        'pct_missing',
        background = styleColorBar(dt_prof$pct_missing, 'steelblue'),
        backgroundSize = '100% 90%',
        backgroundRepeat = 'no-repeat',
        backgroundPosition = 'center'
      )
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```

<br>

```{r, missing data profile 2, results='hide', fig.show='hide', echo=FALSE, message=FALSE, warning=FALSE, error=FALSE}

## Description: create plot with missing data profile 

info(logger_simple, "CREATING PLOT WITH MISSING DATA PROFILE...")

tryCatch(
  {
    pl <- ggplotly(plot_missing(df) + theme_minimal() +
      theme(axis.title.y=element_blank()))
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```

```{r, missing data profile 3, message=FALSE, warning=FALSE, error=FALSE}

tryCatch(
  {
    pl
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```

##### Alerts

```{r, alerts, message=FALSE, warning=FALSE, error=FALSE}

## Description: create table with alerts when:
# - A variable has a constant value ('Constant')
# - A variable has more than 50% missing values ('Missing')
# - A variable has all unique values ('Unique')

info(logger_simple, "CREATING TABLE WITH ALERTS...")

tryCatch(
  {
    dt_alert <- data.frame(matrix(NA, nrow = 0, ncol = 2))
    
    # Constant values
    for(i in colnames(df)) {
      if((length(unique(df[,i]))==1 && !is.na(unique(df[,i])))) {
        dt_alert <- rbind(dt_alert,c(paste0(i," has constant value ",unique(df[,i])),"Constant"))
      }
    }
    
    # Missing values
    for(k in colnames(df)) {
      n_miss <- length(df[which(is.na(df[,k])),k])
      perc_miss <- n_miss/nrow(df)
      if(perc_miss>0.5) {
        dt_alert <- rbind(dt_alert,c(paste0(k," has ", n_miss, " (", round(100*perc_miss,1), "%) missing values"),"Missing"))
      }
    }
    
    # Unique values
    for(h in colnames(df)) {
      n_unique <- length(unique(df[,h]))
      if(n_unique==nrow(df)) {
        dt_alert <- rbind(dt_alert,c(paste0(h," has all unique values"),"Unique"))
      }
    }
    
    colnames(dt_alert) <- c('V1','V2')
    formattable(dt_alert,
                align = c("l","c"),
                col.names = NULL,
                list(
                    V2 = formatter("V1",
                            style = ~style(
                              display = "block", 
                              padding = "0 4px", 
                              `border-radius` = "4px", 
                              `background-color` = 
                                  case_when(V2 == "Constant" ~ "#F4A460",
                                            V2 == "Missing" ~ "lightblue",
                                            V2 == "Unique" ~ "#66CDAA")))
                ))
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })
    
```

##### Duplicates

```{r, duplicates, message=FALSE, warning=FALSE, error=FALSE}

## Description: create table with information of patients that appear more than once in the data

info(logger_simple, "CREATING TABLE WITH INFORMATION ON DUPLICATES...")

tryCatch(
  {
    dt_duplicates <- data.frame(matrix(NA, nrow = 0, ncol = 3))
    
    if(sum(duplicated(df$person_id))==0) {
      dt_duplicates <- rbind(dt_duplicates,c("The variable 'person_id' has all unique values",paste0("Number of duplicate values: ", sum(duplicated(df$person_id))),"Unique"))
    } else {
      dt_duplicates <- rbind(dt_duplicates,c("The variable 'person_id' does not have all unique values",paste0("Number of duplicate values: ", sum(duplicated(df$person_id))),"Not unique"))
    }
    
    colnames(dt_duplicates) <- c('V1','V2','V3')
    formattable(dt_duplicates,
                align = c("l","c"),
                col.names = NULL,
                list(
                    V3 = formatter("V3",
                            style = ~style(
                              display = "block", 
                              padding = "0 4px", 
                              `border-radius` = "4px", 
                              `background-color` = 
                                  case_when(V3 == "Unique" ~ "#66CDAA",
                                            V3 == "Not Unique" ~ "#FF4747")))
                ))
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```
:::

## Variables

This section provides more detailed information per variable in the imported dataset.

```{r, chunk, message=FALSE, warning=FALSE, error=FALSE, eval=FALSE}
  
htmltools::tagList(datatable(df))

```

```{r, individual variables, results='asis', message=FALSE, warning=FALSE, error=FALSE}

# categorical_integer_variables <- ""

info(logger_simple, "ITERATING OVER INDIVIDUAL VARIABLES...
     ")

## Description: 
# -> iterate over variables
#    -> for every variable different statistics are shown in different panels:
#        - panel 1: Overview
#        - panel 2: Summary
#        - panel 3: Categories
#        - panel 4: Distribution

tryCatch(
  {
    purrr::iwalk(colnames(df), ~ {
      ## create a box for every variable
      cat('::: box \n\n')
      
      ## within the box print the variable name 
      cat('###### ', ., ' {style="color: #7F7F7F"} \n\n')
      
      ## within the box print the variable class
      cat('####### Class of the variable: ', class(df[,.]), ' {style="color: #7F7F7F; font-size: 10pt"} \n')
      
      ## within the box create a tabset panel
      cat('::: panel-tabset\n\n')
      
      ## panel 1 (Overview: nr and % distinct values, nr and % missing values)
      cat('###### Overview \n')
      
      df_sub <- data.frame(matrix(NA, nrow = 4, ncol = 2))
      df_sub[,1] <- c("Distinct","Distinct (%)","Missing","Missing (%)")
      df_sub[1,2] <- length(unique(df[,.]))
      df_sub[2,2] <- round(100*length(unique(df[,.]))/nrow(df),3)
      df_sub[3,2] <- sum(is.na(df[,.]))
      df_sub[4,2] <- round(100*sum(is.na(df[,.]))/nrow(df),3)
      print(htmltools::tagList(DT::datatable(df_sub,
                                             rownames = NULL,
                                             class = 'cell-border stripe',
                                             colnames = NULL,
                                             options = list(dom = 't'),
                                             caption = htmltools::tags$caption(
                                                style = "text-align: left")
                                             )))
      
      ## panel 2 (Summary: summary information of the variable)
      cat('###### Summary \n')
      
      if(class(df[,.])!="Date" & .!="doses_nm") {
        c_sum <- as.data.frame(unclass(summary(df[,.])))
        colnames(c_sum) <- c(.)
        print(htmltools::tagList(DT::datatable(c_sum,
                                               options = list(dom = 't'),
                                               caption = htmltools::tags$caption(
                                                  style = "text-align: left"))))
      } else if(.=="doses_nm") {
        c_sum <- as.data.frame(unclass(summary(as.factor(df[,.]))))
        colnames(c_sum) <- c(.)
        c_sum_tmp <- data.frame(class(df[,.]))
        colnames(c_sum_tmp) <- c(.)
        rownames(c_sum_tmp) <- c("Class")
        c_sum <- rbind(c_sum_tmp, c_sum)
        print(htmltools::tagList(DT::datatable(c_sum,
                                               options = list(dom = 't'),
                                               caption = htmltools::tags$caption(
                                                  style = "text-align: left"))))
      } else {
        c_sum <- data.frame(`Date_range`= paste0(min(df[,.],na.rm=TRUE)," - ", max(df[,.],na.rm=TRUE)))
        rownames(c_sum) <- c(.)
        print(htmltools::tagList(DT::datatable(c_sum,
                                               options = list(dom = 't'),
                                               caption = htmltools::tags$caption(
                                                  style = "text-align: left"),
                                               colnames = c("Date range")
                                               )))
      }
      
      ## panel 3 (Categories: count and frequency of every distinct value of the variable (if less than 100 distinct values))
      cat('###### Categories \n')
    
      if(length(unique(df[,.]))<100) {
        df_values <- as.data.frame(table(df[,.],useNA = 'always'))
        df_values$Freq_perc <- round(100*df_values$Freq/nrow(df),3)
        df_values$Freq_perc <- df_values$Freq/nrow(df)
        print(htmltools::tagList(DT::datatable(df_values,
                                               rownames = NULL,
                                               class = 'cell-border stripe',
                                               colnames = c("Value","Count","Frequency (%)"),
                                               caption = htmltools::tags$caption(
                                                  style = "text-align: left")
                                               ) %>%
                                              formatPercentage("Freq_perc",
                                                           digits=1) %>%
                                              formatStyle(
                                                'Freq_perc',
                                                background = styleColorBar(c(0,1), 'steelblue'),
                                                backgroundSize = '98% 88%%',
                                                backgroundRepeat = 'no-repeat',
                                                backgroundPosition = 'center'
                                              )))
      } else {
        cat('More than 100 distinct values \n\n')
      } 
        
      cat('\n')
    
      ## panel 4 (Distribution: distribution of the variable) 
      cat('###### Distribution \n\n')
      
      if((class(df[,.])=="character") && (length(unique(df[,.]))>=100)) {
        
        cat('More than 100 distinct values \n\n')
        
      } else if(class(df[,.])=="character" || class(df[,.])=="logical") {
        
        pl_dist <- ggplot(df, aes_string(x = .)) +
          geom_bar(fill="steelblue") +
          theme_minimal() +
          theme(axis.title.y=element_blank())
        print(htmltools::tagList(ggplotly(pl_dist)))
        
      } else if(class(df[,.])=="integer" || class(df[,.])=="Date") {
        
        pl_dist <- ggplot(df, aes_string(x = .)) +
                  geom_histogram(fill="steelblue", color="black") +
                  theme_minimal() + 
                  theme(axis.title.y=element_blank())
        print(htmltools::tagList(ggplotly(pl_dist)))
      }
    
      cat('::: \n\n')
      cat('::: \n\n')
      
    })
  },
  error=function(cond) {
    ## Log info
    warn(logger, paste0("MY ERROR:
                        ", cond))
    return(stop(cond))
  })

```
