---
title: "ASSURE Full Report"
format: html
self-contained: true
toc: true
toc-depth: 4
toc-title: "Contents"
number-sections: true
prefer-html: true
execute:
  echo: false
  warning: false
params: 
  server: NULL
  password: NULL
  username: NULL
  dbms: "postgresql"
  schema: 'main'
  targetId: 1
  outcomeIds: 3
  indicationIds: ""
  comparatorIds: NULL
  cohortIds: !expr "c(1,3,2)"
  cohortNames: !expr "c('target', 'outcome', 'comp')"
  includeCI: true
  includeCharacterization: true
  includeCohortMethod: true
  includeSccs: true
  includePrediction: true
  numberPredictors: 25
  excludeText: NULL
  timeRestrictionText: NULL
  drugGap: 30
  webAPI: NULL
  authMethod: NULL
  webApiUsername: NULL 
  webApiPassword: NULL
  pathToDriver: !expr "Sys.getenv('DATABASECONNECTOR_JAR_FOLDER')"
---
  
```{r}
#| label: configuration
#| echo: false
#| hide: true

library(dplyr)

targetName <- params$cohortNames[params$cohortIds == params$targetId]
outcomeName <- paste0(params$cohortNames[params$cohortIds %in% params$outcomeIds], collapse = '/')

restrictToIndications <- !('All' %in% params$indicationIds)
indicationIds <- params$indicationIds

#====================================
# first create connection details
#====================================

connectionDetails <- DatabaseConnector::createConnectionDetails(
  dbms = params$dbms,
  user = params$username, 
  password = params$password,
  server = params$server, 
  pathToDriver =  params$pathToDriver
)
#====================================

#====================================
# Figure out what sections to include in report
#====================================

# get prefixes - this only works with standard prefixes
con <- DatabaseConnector::connect(
  connectionDetails = connectionDetails
  )
tableNames <- DatabaseConnector::getTableNames(
  connection = con,
  databaseSchema = params$schema
)
DatabaseConnector::disconnect(con)

prefixes <- unique(unlist(lapply(tableNames, function(x) strsplit(x,'_')[[1]][1])))

includeCI <- 'ci' %in% prefixes & params$includeCI
includeCharacterization <- 'c' %in% prefixes & params$includeCharacterization
includeCohortMethod <- 'cm' %in% prefixes & params$includeCohortMethod 
includeSccs <- 'sccs' %in% prefixes & params$includeSccs 
includePrediction <- 'plp' %in% prefixes & params$includePrediction 
#====================================

#====================================
# create connection handler
#====================================
connectionHandler <- ResultModelManager::ConnectionHandler$new(
  connectionDetails = connectionDetails 
)
#====================================


# ===================================
# Get Cohorts
# ===================================

cohortDefinitions <- OhdsiReportGenerator::getCohortDefinitions(
  connectionHandler = connectionHandler, 
  schema = params$schema 
)

# add the friendly names 
cohortDefinitions <- 
  merge(
    cohortDefinitions,
    data.frame(
      cohortId = params$cohortIds,
      friendlyName = params$cohortNames
    ), 
    by.x = 'subsetParent', 
    by.y = 'cohortId', 
    all.x = TRUE # TODO - change this if we want to ignore all other cohorts? 
  )
cohortDefinitions$friendlyName[is.na(cohortDefinitions$friendlyName)] <- cohortDefinitions$cohortName[is.na(cohortDefinitions$friendlyName)]


# function to get indication subset:
getIndication <- function(json){ 
  if(is.na(json)){
    return("")
  }
  if(is.null(json)){
    return("")
  }
  sub <- ParallelLogger::convertJsonToSettings(as.character(json))
  paste0(unlist(lapply(sub$subsetOperators, function(x){
    
if(x$subsetType == "CohortSubsetOperator"){
    if(!x$negate){
      return(paste0(x$cohortIds, collapse = ','))
    }
}

  })), collapse = ',')}

# function to get get TRUE for indication
getIndication <- function(json){ 
  if(is.na(json)){
    return("" %in% params$indicationIds)
  }
  if(is.null(json)){
    return("" %in% params$indicationIds)
  }

  sub <- ParallelLogger::convertJsonToSettings(as.character(json))
  result <- any(unlist(lapply(sub$subsetOperators, function(x){
    
if(x$subsetType == "CohortSubsetOperator"){
    if(!x$negate){
      return(any(x$cohortIds %in% params$indicationIds))
    }
} 
    return(FALSE)

  })))
  
}

if(restrictToIndications){
cohortDefinitions$indicationOfInt <- unlist(lapply(cohortDefinitions$subsetDefinitionJson, getIndication))
} else{
  # if no restriction (indicationId == 'Any') set all to TRUE
  cohortDefinitions$indicationOfInt <- TRUE
}

# function to convert subset to friendly text
getSubsetString <- function(x){
  if(x$subsetType == "CohortSubsetOperator"){
    txt <- paste0(ifelse(x$negate, 'Not in','In'), ' cohorts ', 
                  paste0(cohortDefinitions$friendlyName[cohortDefinitions$cohortDefinitionId %in% x$cohortIds],
                         collapse = ifelse(x$cohortCombinationOperator == 'all', ' and ', ' or ')
                  ))
    return(paste0(txt, '.'))
  }
  
  if(x$subsetType == "DemographicSubsetOperator"){
    gender <- ''
    if(sum(c(8507,8532) %in% x$gender) == 2){
      gender = ''
    } else if( 8507 %in% x$gender){
      gender = 'Resticted to males.'
    } else if( 8532 %in% x$gender){
      gender = 'Resticted to females.'
    }
    return(paste0('Aged between ', x$ageMin, ' to ', x$ageMax, '.', 
                  gender
    ))
  }
  
  if(x$subsetType == "LimitSubsetOperator"){
    txt <- ''
    joiner <- ' and '
    if(!is.null(x$calendarStartDate)){
      txt <-  paste0(txt,paste0(
        'Restict to exposures occurring after ', x$calendarStartDate, 
        ifelse(!is.null(x$calendarEndDate), paste0(joiner,' before ', x$calendarEndDate), '')
      ))
    } else{
      if(!is.null(x$calendarEndDate)){
        txt <-  paste0(txt,paste0('Restict to exposures occurring before ', x$calendarEndDate))
      }
    }
    
    if(x$priorTime > 0){
      txt <- paste0(txt, ifelse(txt == '', 'Requiring ',paste0(joiner, ' requiring ')) , x$priorTime, ' days observation prior to index')
    }
    
    if(x$followUpTime > 0){
      txt <- paste0(txt, ifelse(txt == '', 'Requiring ',paste0(joiner, ' requiring ')), x$followUpTime, ' days follow up post index')
    }
    
    if(x$limitTo == 'firstEver'){
      txt <- paste0(txt, ifelse(txt == '', 'Limit ', ' and limit '), 'to first exposure')
    }
    
    txt <- paste0(txt, '.')
    return(txt)
  }
  
}

cohortDefinitions$subsetText <- unlist(lapply(1:length(cohortDefinitions$subsetDefinitionJson), function(i){ if(is.null(cohortDefinitions$subsetDefinitionJson[i])){return('')}; if(is.na(cohortDefinitions$subsetDefinitionJson[i])){return('')}
    paste0(unlist(lapply(ParallelLogger::convertJsonToSettings(cohortDefinitions$subsetDefinitionJson[i])$subsetOperators, function(sub) getSubsetString(sub))), collapse = ' ')}
))


# ===================================

# Restrict cohortDefinitions to: 
# 1) targetId with indicationOfInt == TRUE
# 2) comparatorId with indicationOfInt == TRUE
# 3) indicationId
# 4) outcomeId

targetsOfInterest <- cohortDefinitions %>%
  dplyr::filter(
    ((.data$subsetParent %in% params$targetId) & .data$indicationOfInt) |
    ((.data$cohortDefinitionId %in% params$targetId) & ("" %in% indicationIds))
  )
targetIdsOfInterest <- targetsOfInterest$cohortDefinitionId


# if comparators is NULL then include all in results
comparatorIds <- params$comparatorIds
if(is.null(params$comparatorIds)){
  if(params$includeCohortMethod){
    newComps <- OhdsiReportGenerator::getCmDiagnosticsData(
      connectionHandler = connectionHandler,
      schema = params$schema, 
      targetIds = targetIdsOfInterest, 
      outcomeIds = params$outcomeIds
        )
    
    comparatorIds <- unique(cohortDefinitions$subsetParent[cohortDefinitions$cohortDefinitionId %in% unique(newComps$comparatorId)])
    
  }
}
  
comparatorOfInterest <- cohortDefinitions %>%
  dplyr::filter(
    ((.data$subsetParent %in% comparatorIds) & .data$indicationOfInt) |
    ((.data$cohortDefinitionId %in% comparatorIds) & ("" %in% indicationIds))  
  )  
 comparatorIdsOfInterest <-  comparatorOfInterest$cohortDefinitionId
  
 outcomeOfInterest <- cohortDefinitions %>%
  dplyr::filter(
    (.data$cohortDefinitionId %in% params$outcomeIds)
  )
  outcomeIdsOfInterest <- outcomeOfInterest$cohortDefinitionId
  
   indicationOfInterest <- cohortDefinitions %>%
  dplyr::filter(
    (.data$cohortDefinitionId %in% indicationIds)
  )
  indicationIdsOfInterest <- indicationOfInterest$cohortDefinitionId


# for each  comps in CM get the name
comparatorText <- paste0(unique(cohortDefinitions$friendlyName[cohortDefinitions$cohortDefinitionId %in% comparatorIds]), collapse = '/')

# ===================================

# add order column
orderDf <- data.frame(
  subsetParent = c(
    params$targetId,
    params$outcomeIds, 
    params$indicationIds,
    comparatorIds
  ),
  order = 1:length(c(
    params$targetId,
    params$outcomeIds, 
    params$indicationIds,
    comparatorIds
  ))
)

cohortDefinitions <- 
  merge(
    cohortDefinitions,
    orderDf, 
    by.x = 'subsetParent', 
    by.y = 'subsetParent', 
    all.x = TRUE
  )

#nNegativeControls <- 100 # remove?



```

```{r}
#| label: summary
#| echo: false
#| results: 'asis'

result <- knitr::knit_child(text = knitr::knit_expand("summary.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
```

```{r}
#| label: data
#| echo: false
#| results: 'asis'

result <- knitr::knit_child(text = knitr::knit_expand("data.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
```

```{r}
#| label: definitions
#| echo: false
#| results: 'asis'

result <- knitr::knit_child(text = knitr::knit_expand("definitions.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
```


```{r}
#| label: cohort_incidence
#| echo: false
#| results: 'asis'

if(includeCI){
  # ===================================
  # Get CI
  # ===================================
  cohortIncidence <- OhdsiReportGenerator::getIncidenceRates(
    connectionHandler = connectionHandler, 
    schema = params$schema, 
    targetIds = unique(c(targetIdsOfInterest, comparatorIdsOfInterest, indicationIdsOfInterest)), 
    outcomeIds = outcomeIdsOfInterest
  )
  
  cohortIncidenceUnstatified <- cohortIncidence %>%
    dplyr::filter(.data$ageGroupName == 'Any') %>%
    dplyr::filter(.data$genderName == 'Any') %>%
    dplyr::filter(.data$startYear == 'Any')
  
  # only show CI results if there are any
  if(nrow(cohortIncidenceUnstatified) != 0){
    
  ciTargets <- unique(cohortIncidenceUnstatified$targetId)
  ciCohorts <- cohortDefinitions[cohortDefinitions$cohortDefinitionId %in% ciTargets,]
  
  ciParents <- unique(ciCohorts$subsetParent)
  ciSubset <- unique(ciCohorts$subsetDefinitionId) # different for comp vs ind
  
  ciOutcomes <- unique(cohortIncidenceUnstatified$outcomeId)
  
  ciTars <- unique(
    cohortIncidenceUnstatified %>% 
      dplyr::select('tar')
  )

  # ===================================
result <- knitr::knit_child(text = knitr::knit_expand("cohort_incidence.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
  }
 
}
```



```{r}
#| label: characterization
#| echo: false
#| results: 'asis'

if(includeCharacterization){
  # ===================================
result <- knitr::knit_child(text = knitr::knit_expand("characterization.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
}
```


```{r}
#| label: causal_inference
#| echo: false
#| results: 'asis'

if(includeSccs || includeCohortMethod){
if(includeCohortMethod){
  # ===================================
  # Get CohortMethod
  # ===================================
  
  
  # TODO: restrict to comparatorIdsOfInterest?
  cohortMethodDiagnostics <- OhdsiReportGenerator::getCmDiagnosticsData(
    connectionHandler = connectionHandler, 
    schema = params$schema, 
    targetIds = unique(c(targetIdsOfInterest, indicationIdsOfInterest)),
    outcomeIds = outcomeIdsOfInterest
  )
  
  if(nrow(cohortMethodDiagnostics) > 0){
    if(!is.null(params$comparatorIds)){
    cohortMethodDiagnostics <- cohortMethodDiagnostics %>%
      dplyr::filter(.data$comparatorId %in% comparatorOfInterest)
    }
  }
  
  if(nrow(cohortMethodDiagnostics) == 0){
    includeCohortMethod <- FALSE
  } else {
  
  # TODO: restrict to comparatorIdsOfInterest?
  cohortMethodResults <- OhdsiReportGenerator::getCMEstimation(
    connectionHandler = connectionHandler, 
    schema = params$schema, 
    targetIds = unique(c(targetIdsOfInterest, indicationIdsOfInterest)),
    outcomeIds = outcomeIdsOfInterest
  )
  
    if(nrow(cohortMethodResults) > 0){
    if(!is.null(params$comparatorIds)){
    cohortMethodResults <- cohortMethodResults %>%
      dplyr::filter(.data$comparatorId %in% comparatorOfInterest)
    }
  }
  
  # TODO: restrict to comparatorIdsOfInterest?
  # return NULL if the evidence synth tables do not exist
  cohortMethodES <- tryCatch({OhdsiReportGenerator::getCmMetaEstimation(
    connectionHandler = connectionHandler, 
    schema = params$schema, 
    targetIds = unique(c(targetIdsOfInterest, indicationIdsOfInterest)),
    outcomeIds = outcomeIdsOfInterest
  )}, error = function(e){return(invisible(NULL))})
  
  if(!is.null(cohortMethodES)){
    if(nrow(cohortMethodES) > 0){
      if(!is.null(params$comparatorIds)){
      cohortMethodES <- cohortMethodES %>%
       dplyr::filter(.data$comparatorId %in% comparatorOfInterest)
      }
    }
  }
  
  cmTargets <- unique(cohortMethodDiagnostics$targetId)
  cmComparators <- unique(cohortMethodDiagnostics$comparatorId)
  cmOutcomes <- unique(cohortMethodDiagnostics$outcomeId)
  cmDesc <- unique(cohortMethodDiagnostics$description) # can we extract this?
  }
  # ===================================
}

if(includeSccs){
  # ===================================
  # Get Sccs
  # ===================================
  
  sccsDiagnostics <- OhdsiReportGenerator::getSccsDiagnosticsData(
    connectionHandler = connectionHandler, 
    schema = params$schema,
    targetIds = unique(c(params$targetId, comparatorIds)), 
    outcomeIds = outcomeIdsOfInterest
  ) 
  
  # filter to the indications of interest
  if(restrictToIndications){
    sccsDiagnostics <- sccsDiagnostics %>%
      dplyr::filter(ifelse(is.na(.data$indicationId), "", .data$indicationId)  %in% params$indicationId)
  }
  
  if(nrow(sccsDiagnostics)  == 0){
    includeSccs <- FALSE
  } else {
  
  sccsResults <- OhdsiReportGenerator::getSccsEstimation(
    connectionHandler = connectionHandler, 
    schema = params$schema,
    targetIds = unique(c(params$targetId, comparatorIds)), 
    outcomeIds = outcomeIdsOfInterest
  )
  
    # filter to the indications of interest
  if(restrictToIndications){
    sccsResults <- sccsResults %>%
      dplyr::filter(ifelse(is.na(.data$indicationId), "", .data$indicationId)  %in% params$indicationId)
  }
  
  # return NULL if the evidence synth tables do not exist
  sccsES <- tryCatch({OhdsiReportGenerator::getSccsMetaEstimation(
    connectionHandler = connectionHandler, 
    schema = params$schema,
    targetIds = unique(c(params$targetId, comparatorIds)), 
    outcomeIds = outcomeIdsOfInterest
  )}, error = function(e){return(invisible(NULL))})
  
  if(restrictToIndications){
    if(!is.null(sccsES)){
    sccsES <- sccsES %>%
      dplyr::filter(ifelse(is.na(.data$indicationId), "", .data$indicationId)  %in% params$indicationId)
    }
  }
  
  sccsTargets <- unique(sccsDiagnostics$targetId)
  sccsOutcomes <- unique(sccsDiagnostics$outcomeId)
  sccsDesc <- unique(sccsDiagnostics$description)
}
  # ===================================
}
  
result <- knitr::knit_child(text = knitr::knit_expand("causal_inference.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
}
```


```{r}
#| label: prediction
#| echo: false
#| results: 'asis'

if(includePrediction){
  
result <- knitr::knit_child(text = knitr::knit_expand("prediction.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')

}
```


```{r}
#| label: references
#| echo: false
#| results: 'asis'

result <- knitr::knit_child(text = knitr::knit_expand("references.qmd", quiet = TRUE, envir = environment()), quiet = TRUE)
cat(result, sep = '\n')
```

