In OhdsiReportGenerator: Observational Health Data Sciences and Informatics Report Generator

getModelDesign <- function(
  connectionHandler,
  resultSchema,
  myTableAppend,
  cohortTableAppend,
  modelDesignId,
  tempEmulationSchema = NULL
){

  ref <- data.frame(
    name = c(
      'populationSettings',
      'covariateSettings', 'featureEngineeringSettings', 'preprocessSettings',
      'modelSettings', 'sampleSettings', 'restrictPlpDataSettings',
      'splitSettings'
      ),
    tableName = c(
      'population_settings', 
      'covariate_settings', 'feature_engineering_settings', 'tidy_covariates_settings',
      'model_settings', 'sample_settings', 'plp_data_settings',
      'split_settings'
      ),
   tableIdRef = c(
      'population_setting_id', 
      'covariate_setting_id', 'feature_engineering_setting_id', 'tidy_covariates_setting_id',
      'model_setting_id', 'sample_setting_id', 'plp_data_setting_id',
      'split_setting_id'
    ),
   modelDesignIdRef = c(
      'population_setting_id', 
      'covariate_setting_id', 'feature_engineering_setting_id', 'tidy_covariates_setting_id',
      'model_setting_id', 'sample_setting_id', 'plp_data_setting_id',
      'split_setting_id'
    ),
   extractName = c('population_settings_json',
  'covariate_settings_json', 'feature_engineering_settings_json',
  'tidy_covariates_settings_json', 
  'model_settings_json',
  'sample_settings_json',
  'plp_data_settings_json',
  'split_settings_json'
  )
  )

  sqlStart <- "select a.@extract_name as value from @result_schema.@my_table_append@table_name a
   inner join @result_schema.@my_table_appendmodel_designs b
  on b.@table_id_ref = a.@model_design_id_ref
  where b.model_design_id = @model_design_id"

  result <- lapply(
    X = 1:nrow(ref), FUN = function(j){

  res <- connectionHandler$queryDb(
    sql = sqlStart, 
    result_schema = resultSchema,
    my_table_append = myTableAppend,
    table_name = ref$tableName[j],
    table_id_ref = ref$tableIdRef[j],
    model_design_id_ref = ref$modelDesignIdRef[j],
    model_design_id = modelDesignId,
    extract_name = ref$extractName[j]
  )

res <- tryCatch(
  {ParallelLogger::convertJsonToSettings(res$value)}, 
  error = function(e){print(e); return(list())}
)
  return(res)

    })

  # do the cohort separately due to required join
  for(tind in 1:2){

    sqlStart <- "select cd.json as value from 
    @result_schema.@my_table_appendcohorts c inner join
    @result_schema.@cohort_table_appendcohort_definition cd
    on c.cohort_definition_id = cd.cohort_definition_id and 
    c.cohort_name = cd.cohort_name
   inner join @result_schema.@my_table_appendmodel_designs b
  on b.@cohort_type = c.cohort_id
  where b.model_design_id = @model_design_id;"

  res <- connectionHandler$queryDb(
    sql = sqlStart, 
    result_schema = resultSchema,
    my_table_append = myTableAppend,
    cohort_table_append = cohortTableAppend,
    model_design_id = modelDesignId,
    cohort_type = c('target_id','outcome_id')[tind]
  )

result[[length(result)+1]] <-
  tryCatch(
  {ParallelLogger::convertJsonToSettings(res$value)}, 
  error = function(e){print(e); return(list())}
)

  }

  names(result) <- c(ref$name, 'targetCohort', 'outcomeCohort')
  return(result)
}


modelDesign <- getModelDesign( # need to create this
  connectionHandler = params$connectionHandler,
  resultSchema = params$resultSchema,
  myTableAppend = params$myTableAppend,
  cohortTableAppend = params$cohortTableAppend,
  modelDesignId = params$modelDesignIds[i]
  )

target <- modelDesign$targetCohort
outcome <- modelDesign$outcomeCohort
populationSettings <- modelDesign$populationSettings
covariateSettings <- modelDesign$covariateSettings
featureEngineeringSettings <-modelDesign$featureEngineeringSettings
preprocessSettings <- modelDesign$preprocessSettings
modelSettings <- modelDesign$modelSettings
sampleSettings <- modelDesign$sampleSettings
restrictPlpDataSettings <- modelDesign$restrictPlpDataSettings
splitSettings <- modelDesign$splitSettings

cat('\n# Model ', params$modelDesignIds[i], '\n')

Model Design

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