diff --git a/R/characterization-caseSeries.R b/R/characterization-caseSeries.R index c343e861..c7237ae4 100644 --- a/R/characterization-caseSeries.R +++ b/R/characterization-caseSeries.R @@ -190,7 +190,7 @@ characterizationGetCaseSeriesOptions <- function( and s.database_id = cd.database_id and cd.target_cohort_id = @target_id and cd.outcome_cohort_id = @outcome_id - and cd.cohort_type = 'TnO' + and cd.cohort_type = 'Cases' inner join @schema.@cg_table_prefixcohort_definition ct1 @@ -256,9 +256,9 @@ characterizationGetCaseSeriesData <- function( sql <- "SELECT case - when cov.cohort_type = 'TnO' then 'Before' - when cov.cohort_type = 'TnObetween' then 'During' - when cov.cohort_type = 'OnT' then 'After' + when cov.cohort_type = 'CasesBefore' then 'Before' + when cov.cohort_type = 'CasesBetween' then 'During' + when cov.cohort_type = 'CaseAfter' then 'After' end as type, cr.covariate_name, s.min_prior_observation, s.outcome_washout_days, @@ -277,7 +277,7 @@ characterizationGetCaseSeriesData <- function( where cov.target_cohort_id = @target_id and cov.outcome_cohort_id = @outcome_id - and cov.cohort_type in ('TnObetween','OnT','TnO') + and cov.cohort_type in ('CasesBetween','CasesAfter','CasesBefore') --and cov.setting_id = @setting_id and s.risk_window_start = @risk_window_start and s.risk_window_end = @risk_window_end @@ -309,9 +309,9 @@ characterizationGetCaseSeriesData <- function( sql <- "SELECT case - when cov.cohort_type = 'TnO' then 'Before' - when cov.cohort_type = 'TnObetween' then 'During' - when cov.cohort_type = 'OnT' then 'After' + when cov.cohort_type = 'CasesBefore' then 'Before' + when cov.cohort_type = 'CasesBetween' then 'During' + when cov.cohort_type = 'CasesAfter' then 'After' end as type, cr.covariate_name, s.min_prior_observation, s.outcome_washout_days, @@ -333,7 +333,7 @@ characterizationGetCaseSeriesData <- function( where cov.target_cohort_id = @target_id and cov.outcome_cohort_id = @outcome_id - and cov.cohort_type in ('TnObetween','OnT','TnO') + and cov.cohort_type in ('CasesBetween','CasesAfter','CasesBefore') and s.risk_window_start = @risk_window_start and s.risk_window_end = @risk_window_end and s.start_anchor = '@start_anchor' diff --git a/R/characterization-cohorts.R b/R/characterization-cohorts.R index e7e79394..20ab24c6 100644 --- a/R/characterization-cohorts.R +++ b/R/characterization-cohorts.R @@ -968,7 +968,7 @@ characterizatonGetCohortComparisonDataContinuous <- function( res <- res %>% dplyr::select(-"cohortDefinitionId", -"databaseId", -"type", -"settingId", -"targetCohortId", -"outcomeCohortId", -"cohortType") %>% - dplyr::relocate(.data$databaseName, .after = .data$covariateName) + dplyr::relocate("databaseName", .after = "covariateName") } shiny::incProgress(4/4, detail = paste("Done")) diff --git a/R/characterization-incidence.R b/R/characterization-incidence.R index 40c445f9..62360bb7 100644 --- a/R/characterization-incidence.R +++ b/R/characterization-incidence.R @@ -1215,9 +1215,9 @@ characterizationIncidenceServer <- function( outcomeLabel = paste(.data$outcomeIdShort, " = ", .data$outcomeName), ageGroupName = factor(.data$ageGroupName, levels = custom_age_sort(.data$ageGroupName), ordered = TRUE) ) %>% - dplyr::rename("Target" = "targetIdShort", - "Outcome" = "outcomeIdShort", - "Age" = "ageGroupName") + dplyr::rename(Target = "targetIdShort", + Outcome = "outcomeIdShort", + Age = "ageGroupName") # Get unique target and outcome labels unique_target_labels <- strwrap(unique(plotData$targetLabel), width = 300) @@ -1362,9 +1362,9 @@ renderIrPlotStandardAgeSex <- shiny::reactive( outcomeLabel = paste(outcomeIdShort, " = ", outcomeName), ageGroupName = factor(ageGroupName, levels = custom_age_sort(ageGroupName), ordered = TRUE) ) %>% - dplyr::rename("Target" = targetIdShort, - "Outcome" = outcomeIdShort, - "Age" = ageGroupName) + dplyr::rename(Target = "targetIdShort", + Outcome = "outcomeIdShort", + Age = "ageGroupName") # plotHeightStandardAgeSex <- shiny::reactive({ # paste(sum(length(unique(plotData$targetLabel)), length(unique(plotData$Age)), -3)*100, "px", sep="") @@ -1512,9 +1512,9 @@ renderIrPlotStandardYear <- shiny::reactive( outcomeLabel = paste(outcomeIdShort, " = ", outcomeName), ageGroupName = factor(ageGroupName, levels = custom_age_sort(ageGroupName), ordered = TRUE) ) %>% - dplyr::rename("Target" = targetIdShort, - "Outcome" = outcomeIdShort, - "Age" = ageGroupName) + dplyr::rename(Target = "targetIdShort", + Outcome = "outcomeIdShort", + Age = "ageGroupName") #get unique shorthand cohort name unique_target <- unique(plotData$Target) @@ -1668,9 +1668,9 @@ renderIrPlotStandardAggregate <- shiny::reactive( dplyr::mutate(targetLabel = paste(targetIdShort, " = ", targetName), outcomeLabel = paste(outcomeIdShort, " = ", outcomeName) ) %>% - dplyr::rename("Target" = targetIdShort, - "Outcome" = outcomeIdShort, - "Age" = ageGroupName) + dplyr::rename(Target = "targetIdShort", + Outcome = "outcomeIdShort", + Age = "ageGroupName") # Get unique target and outcome labels unique_target_labels <- strwrap(unique(plotData$targetLabel), width = 300) diff --git a/R/characterization-main.R b/R/characterization-main.R index 1d5e4f7d..c9238219 100644 --- a/R/characterization-main.R +++ b/R/characterization-main.R @@ -639,7 +639,7 @@ select distinct target_cohort_id, outcome_cohort_id from @schema.@c_table_prefixcohort_details -where cohort_type = 'TnO' +where cohort_type = 'Cases' {@include_incidence} ? { union diff --git a/R/characterization-riskFactors.R b/R/characterization-riskFactors.R index 5817058a..b7314dfb 100644 --- a/R/characterization-riskFactors.R +++ b/R/characterization-riskFactors.R @@ -222,7 +222,7 @@ characterizationGetRiskFactorData <- function( where cov.target_cohort_id = @target_id and cov.outcome_cohort_id in (0,@outcome_id) - and cov.cohort_type in ('Target','TnO', 'TnOprior') + and cov.cohort_type in ('Target','Cases', 'Exclude') and cov.database_id = '@database_id' and cov.setting_id in (@setting_ids) and cr.analysis_id not in (109, 110, 217, 218, 305, 417, 418, 505, 605, 713, 805, 926, 927) @@ -264,7 +264,7 @@ characterizationGetRiskFactorData <- function( where cov.target_cohort_id = @target_id and cov.outcome_cohort_id in (0,@outcome_id) - and cov.cohort_type in ('Target','TnO', 'TnOprior') + and cov.cohort_type in ('Target','Cases', 'Exclude') and cov.database_id = '@database_id' and cov.setting_id in (@setting_ids) and cr.analysis_id not in (109, 110, 217, 218, 305, 417, 418, 505, 605, 713, 805, 926, 927) @@ -354,7 +354,7 @@ riskFactorTable <- function( caseData <- data %>% dplyr::filter( - .data$cohortType == 'TnO' & + .data$cohortType == 'Cases' & .data$outcomeWashoutDays == !!outcomeWashoutDay ) %>% dplyr::select(-"cohortType") @@ -367,7 +367,7 @@ riskFactorTable <- function( excludeData <- data %>% dplyr::filter( - .data$cohortType == 'TnOprior' & + .data$cohortType == 'Exclude' & .data$outcomeWashoutDays == !!outcomeWashoutDay ) %>% dplyr::select(-"cohortType") @@ -417,6 +417,13 @@ riskFactorTable <- function( }) } + } else{ + # if no excludes we need to add N for the target + allData <- allData %>% + dplyr::inner_join( # add N per washout/min obs + allcounts, + by = c('minPriorObservation') + ) } if(nrow(caseData) > 0){ @@ -487,8 +494,8 @@ riskFactorTable <- function( dplyr::mutate( outcomeWashoutDays = !!outcomeWashoutDay ) %>% - dplyr::relocate(.data$outcomeWashoutDays, - .after = .data$minPriorObservation) + dplyr::relocate("outcomeWashoutDays", + .after = "minPriorObservation") completeData <- rbind(allData, completeData) @@ -522,7 +529,7 @@ riskFactorContinuousTable <- function( data <- unique(data) caseData <- data %>% - dplyr::filter(.data$cohortType == 'TnO') %>% + dplyr::filter(.data$cohortType == 'Cases') %>% dplyr::select(-"cohortType") allData <- data %>% diff --git a/R/cohort-diagnostics-characterization.R b/R/cohort-diagnostics-characterization.R index 02a88887..88335ff5 100644 --- a/R/cohort-diagnostics-characterization.R +++ b/R/cohort-diagnostics-characterization.R @@ -419,7 +419,7 @@ prepareTable1 <- function(covariates, "characteristic", "valueCount" ) %>% - dplyr::rename("count" = "valueCount") %>% + dplyr::rename(count = "valueCount") %>% dplyr::inner_join(cohort %>% dplyr::select( "cohortId", @@ -739,7 +739,7 @@ cohortDiagCharacterizationModule <- function( "covariateName", "mean" ) %>% - dplyr::rename("sumValue" = "mean") + dplyr::rename(sumValue = "mean") table <- data %>% diff --git a/R/estimation-cohort-method-covariateBalance.R b/R/estimation-cohort-method-covariateBalance.R index 8806a3af..e2ceb331 100644 --- a/R/estimation-cohort-method-covariateBalance.R +++ b/R/estimation-cohort-method-covariateBalance.R @@ -497,8 +497,8 @@ plotCohortMethodCovariateBalanceSummary <- function(balanceSummary, upper = .data$upper, ymax = .data$ymax, group = .data$databaseId)) + - ggplot2::geom_errorbar(ggplot2::aes(ymin = .data$ymin, ymax = .data$ymin), size = 1) + - ggplot2::geom_errorbar(ggplot2::aes(ymin = .data$ymax, ymax = .data$ymax), size = 1) + + ggplot2::geom_errorbar(ggplot2::aes(ymin = .data$ymin, ymax = .data$ymin), linewidth = 1) + + ggplot2::geom_errorbar(ggplot2::aes(ymin = .data$ymax, ymax = .data$ymax), linewidth = 1) + ggplot2::geom_boxplot(stat = "identity", fill = grDevices::rgb(0, 0, 0.8, alpha = 0.25), size = 1) + ggplot2::geom_hline(yintercept = 0) + ggplot2::scale_x_continuous(limits = c(0.5, max(vizData$x) + 1.75)) + diff --git a/R/estimation-cohort-method-diagnostics.R b/R/estimation-cohort-method-diagnostics.R index fae2f233..56430cf2 100644 --- a/R/estimation-cohort-method-diagnostics.R +++ b/R/estimation-cohort-method-diagnostics.R @@ -127,7 +127,7 @@ estimationGetCmDiagnostics <- function( # add summaryValue after outcome result <- result %>% - dplyr::relocate(.data$summaryValue, .after = .data$outcome) + dplyr::relocate("summaryValue", .after = "outcome") return( result diff --git a/R/estimation-cohort-method-full-result.R b/R/estimation-cohort-method-full-result.R index 76987d5c..7f4631cd 100644 --- a/R/estimation-cohort-method-full-result.R +++ b/R/estimation-cohort-method-full-result.R @@ -76,11 +76,11 @@ estimationCmFullResultServer <- function( "cdmSourceAbbreviation" ) %>% dplyr::rename( - 'Target' = .data$target, - 'Comparator' = .data$comparator, - 'Outcome' = .data$outcome, - 'Analysis' = .data$description, - 'Database' = .data$cdmSourceAbbreviation + Target = "target", + Comparator = "comparator", + Outcome = "outcome", + Analysis = "description", + Database = "cdmSourceAbbreviation" ) }) diff --git a/R/estimation-sccs-results-full.R b/R/estimation-sccs-results-full.R index 492be46a..f7977f29 100644 --- a/R/estimation-sccs-results-full.R +++ b/R/estimation-sccs-results-full.R @@ -145,10 +145,10 @@ estimationSccsFullResultServer <- function( "databaseName" ) %>% dplyr::rename( - 'Indication' = .data$indication, - 'Outcome' = .data$outcome, - 'Analysis' = .data$description, - 'Database' = .data$databaseName + Indication = "indication", + Outcome = "outcome", + Analysis = "description", + Database = "databaseName" ) }) diff --git a/R/helpers-sccsPlots.R b/R/helpers-sccsPlots.R index f7700ec5..947557f5 100644 --- a/R/helpers-sccsPlots.R +++ b/R/helpers-sccsPlots.R @@ -175,24 +175,21 @@ plotTimeToEventSccs <- function(timeToEvent) { drawAttritionDiagram <- function(attrition) { - formatNumber <- function(x) { - return(formatC(x, big.mark = ",")) - } - + addStep <- function(data, attrition, row) { data$leftBoxText[length(data$leftBoxText) + 1] <- paste(attrition$description[row], "\n", "Cases: ", - formatNumber(attrition$outcomeSubjects[row]), + format(attrition$outcomeSubjects[row], scientific = FALSE), "\n", "Outcomes: ", - formatNumber(attrition$outcomeEvents[row]), + format(attrition$outcomeEvents[row], scientific = FALSE), sep = "") data$rightBoxText[length(data$rightBoxText) + 1] <- paste("Cases: ", - formatNumber(data$currentCases - attrition$outcomeSubjects[row]), + format(data$currentCases - attrition$outcomeSubjects[row], scientific = FALSE), "\n", "Outcomes: ", - formatNumber(data$currentOutcomes - attrition$outcomeEvents[row]), + format(data$currentOutcomes - attrition$outcomeEvents[row], scientific = FALSE), sep = "") data$currentCases <- attrition$outcomeSubjects[row] data$currentOutcomes <- attrition$outcomeEvents[row] @@ -201,10 +198,10 @@ drawAttritionDiagram <- function(attrition) { data <- list(leftBoxText = c(paste("All outcomes occurrences:\n", "Cases: ", - formatNumber(attrition$outcomeSubjects[1]), + format(attrition$outcomeSubjects[1], scientific = FALSE), "\n", "Outcomes: ", - formatNumber(attrition$outcomeEvents[1]), + format(attrition$outcomeEvents[1], scientific = FALSE), sep = "")), rightBoxText = c(""), currentCases = attrition$outcomeSubjects[1], diff --git a/R/report-main.R b/R/report-main.R index 9bba523d..d30e1659 100644 --- a/R/report-main.R +++ b/R/report-main.R @@ -932,7 +932,7 @@ getTandOs <- function( by.y = 'cohortDefinitionId' ) %>% dplyr::rename( - targetName = 'cohortName' + targetName = "cohortName" ) res <- merge( @@ -942,7 +942,7 @@ getTandOs <- function( by.y = 'cohortDefinitionId' ) %>% dplyr::rename( - outcomeName = 'cohortName' + outcomeName = "cohortName" ) %>% dplyr::arrange( .data$targetName, @@ -1021,7 +1021,7 @@ getTandOs <- function( by.x = 'comparatorId', by.y = 'cohortDefinitionId' ) %>% - dplyr::rename(comparatorName = 'cohortName') + dplyr::rename(comparatorName = "cohortName") cs <- lapply(unique(comps$targetId), function(tid){ data.frame( diff --git a/extras/codeToCreateCharacterizationDatabase.R b/extras/codeToCreateCharacterizationDatabase.R index 76373a25..e7f3a61d 100644 --- a/extras/codeToCreateCharacterizationDatabase.R +++ b/extras/codeToCreateCharacterizationDatabase.R @@ -44,29 +44,44 @@ Characterization::runCharacterizationAnalyses( outcomeDatabaseSchema = "main", outcomeTable = "cohort", cdmDatabaseSchema = "main", - characterizationSettings = charSet, - saveDirectory = file.path(testDir,'charDatabase'), + characterizationSettings = charSet, incremental = F, + executionPath = file.path(testDir,'charDatabase','execution'), + outputDirectory = file.path(testDir,'charDatabase', 'results'), databaseId = 'eunomia', - tablePrefix = 'c_' + csvFilePrefix = 'c_' ) +#serverDesc <- file.path(getwd(), +# 'inst/extdata/results.sqlite') serverDesc <- "tests/resources/charDatabase/databaseFile.sqlite" connectionDetailsDesc <- DatabaseConnector::createConnectionDetails( dbms = 'sqlite', server = serverDesc ) +if(F){ +for(table in c('c_time_to_event', 'c_dechallenge_rechallenge', + 'c_analysis_ref', 'c_covariate_ref', 'c_covariates', + 'c_covariates_continuous', 'c_settings', + 'c_cohort_details', 'c_cohort_counts')){ + sql <- "UPDATE main.@tbl SET database_id = '85642205.0';" + sql <- SqlRender::render(sql, tbl = table) + DatabaseConnector::executeSql(con, sql) +} +} + Characterization::createCharacterizationTables( connectionDetails = connectionDetailsDesc, resultSchema = 'main', - createTables = T + createTables = T, + deleteExistingTables = T ) Characterization::insertResultsToDatabase( connectionDetails = connectionDetailsDesc, schema = 'main', resultsFolder = file.path(testDir,'charDatabase', 'results'), - tablePrefix = 'c_' + csvTablePrefix = 'c_' ) if(F){ diff --git a/extras/examples/app.R b/extras/examples/app.R index e6b74054..c56651b3 100644 --- a/extras/examples/app.R +++ b/extras/examples/app.R @@ -25,16 +25,6 @@ schema <- "main" #Sys.unsetenv('RESULTS_PASSWORD') #Sys.setenv(RESULTS_DBMS = "sqlite") -est <- ShinyAppBuilder::createModuleConfig( - moduleId = 'estimation', - tabName = 'Estimation', - shinyModulePackage = 'OhdsiShinyModules', - moduleUiFunction = 'estimationViewer', - moduleServerFunction = 'estimationServer', - moduleInfoBoxFile = 'esimationHelperFile()', - moduleIcon = 'list' - ) - # Specify the config - create a new one and then add # each shiny module you want to include config <- initializeModuleConfig() %>% @@ -78,4 +68,3 @@ ShinyAppBuilder::createShinyApp( title = 'Testing OhdsiShinyModules with ShinyAppBuilder', protocolLink = 'http://ohdsi.org' ) - diff --git a/inst/cohort-method-www/cohort-method.html b/inst/cohort-method-www/cohort-method.html deleted file mode 100644 index 0fd54ddb..00000000 --- a/inst/cohort-method-www/cohort-method.html +++ /dev/null @@ -1,13 +0,0 @@ -

Description

-

CohortMethod is an R package for performing new-user cohort studies in an observational database in the OMOP Common Data Model. This module: - -

- -

For more information, please visit https://github.com/OHDSI/CohortMethod

- \ No newline at end of file diff --git a/inst/estimation-www/estimation.html b/inst/estimation-www/estimation.html index e69de29b..819bfae2 100644 --- a/inst/estimation-www/estimation.html +++ b/inst/estimation-www/estimation.html @@ -0,0 +1,28 @@ +

Description

+

CohortMethod is an R package for performing new-user cohort studies in an observational database in the OMOP Common Data Model. This module: + +

+ +

For more information, please visit https://github.com/OHDSI/CohortMethod

+ + +

Self Controlled Case Series

+

SelfControlledCaseSeries is an R package for performing Self-Controlled Case Series (SCCS) analyses in an observational database in the OMOP Common Data Model. This module:

+ + + +

For more information, please visit https://github.com/OHDSI/SelfControlledCaseSeries

\ No newline at end of file diff --git a/inst/extdata/results.sqlite b/inst/extdata/results.sqlite index 22bcf4a4..62cb4733 100755 Binary files a/inst/extdata/results.sqlite and b/inst/extdata/results.sqlite differ diff --git a/inst/sccs-www/sccs.html b/inst/sccs-www/sccs.html deleted file mode 100644 index 64e0fa03..00000000 --- a/inst/sccs-www/sccs.html +++ /dev/null @@ -1,14 +0,0 @@ -

Self Controlled Case Series

-

SelfControlledCaseSeries is an R package for performing Self-Controlled Case Series (SCCS) analyses in an observational database in the OMOP Common Data Model. This module:

- - - -

For more information, please visit https://github.com/OHDSI/SelfControlledCaseSeries

\ No newline at end of file diff --git a/tests/resources/cDatabase/databaseFile.sqlite b/tests/resources/cDatabase/databaseFile.sqlite index 796a5d3a..fe336c21 100644 Binary files a/tests/resources/cDatabase/databaseFile.sqlite and b/tests/resources/cDatabase/databaseFile.sqlite differ