In OhdsiReportGenerator: Observational Health Data Sciences and Informatics Report Generator

getExternalVal <- function(
  connectionHandler,
  resultSchema,
  myTableAppend,
  databaseTableAppend,
  modelDesignId,
  devDatabase,
  tempEmulationSchema = NULL
){

    sql <- "select per.performance_id, dm.cdm_source_abbreviation as validation_database
      from 
      (select performance_id, validation_database_id from 
      @result_schema.@my_table_appendperformances 
      where model_design_id = @model_design_id 
      and development_database_id != validation_database_id) per
      inner join @result_schema.@my_table_appenddatabase_details d
      on d.database_id = per.validation_database_id
      inner join @result_schema.@database_table_appenddatabase_meta_data dm
      on d.database_meta_data_id = dm.database_id
      where d.database_id = @dev_database

      ;
    "

  res <- connectionHandler$queryDb(
    sql = sql, 
    result_schema = resultSchema,
    my_table_append = myTableAppend,
    database_table_append = databaseTableAppend,
    model_design_id = modelDesignId,
    dev_database = devDatabase
  )

  if(is.null(res$performanceId) || length(res$performanceId)==0){
    return(NULL)
  }

  # get the performances for the performanceId
  result <- list()
  length(result) <- length(res$performanceId)

  for(i in 1:length(result)){
  result[[i]] <- list()
  tableNames <- c(
    'attrition', 
    'prediction_distribution',
    'covariate_summary',
    'threshold_summary',
    'calibration_summary',
    'evaluation_statistics',
    'demographic_summary'
    )
  length(result[[i]]) <- length(tableNames)+1
  names(result[[i]]) <- c('database',tableNames)
  result[[i]][['database']] <- res$validationDatabase[i]

  for(tabName in tableNames){

  sql <- "select * from 
    @result_schema.@my_table_append@table_name 
    where performance_id = @performance_id 
    "

  result[[i]][[tabName]] <- connectionHandler$queryDb(
    sql = sql, 
    result_schema = resultSchema,
    table_name = tabName,
    my_table_append = myTableAppend,
    performance_id = res$performanceId[i]
  )
  }
  }

  return(result)
}

resultList <- getExternalVal(
  connectionHandler = params$connectionHandler,
  resultSchema = params$resultSchema,
  myTableAppend = params$myTableAppend,
  databaseTableAppend = params$databaseTableAppend,
  modelDesignId = params$modelDesignIds[i],
  devDatabase = devDatabase
  )

External Validation

The external validation is the performance of the models when validated using a new database.

if(!is.null(resultList)){
  for (i in 1:length(resultList)) {
    result <- resultList[[i]]
    if(!is.null(result)){
      modelDesign <- knitr::knit_child(
        "plp-results-template.Rmd", 
        quiet = TRUE, 
        envir = environment()
        )
      cat(modelDesign, sep = '\n')
      }
    }
  } else{
    cat('\n No external validation available \n')
  }

OhdsiReportGenerator documentation built on April 12, 2025, 2:09 a.m.