Skip to content

Commit

Permalink
Merge branch 'darwin-eu-dev:master' into master
Browse files Browse the repository at this point in the history
  • Loading branch information
mvankessel-EMC authored Aug 30, 2024
2 parents 5e0b91f + fca9f07 commit 95c37ff
Show file tree
Hide file tree
Showing 26 changed files with 509 additions and 247 deletions.
6 changes: 3 additions & 3 deletions CRAN-SUBMISSION
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
Version: 2.6.6
Date: 2024-04-16 13:53:49 UTC
SHA: 1ba6bac2a46958f957b62aa25c5f50be1f9ef19b
Version: 2.6.8
Date: 2024-08-29 08:55:41 UTC
SHA: 08db56f2c600fd67f4e29706811892f8a61c369a
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: TreatmentPatterns
Type: Package
Title: Analyzes Real-World Treatment Patterns of a Study Population of Interest
Version: 2.6.7
Version: 2.6.8
Authors@R:
c(person("Aniek", "Markus", , role = c("aut"), comment = c(ORCID = "0000-0001-5779-4794")),
person("Maarten", "van Kessel", email = "[email protected]", role = c("cre"), comment = c(ORCID = "0009-0006-8832-6030")))
Expand Down
9 changes: 9 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,12 @@
# TreatmentPatterns 2.6.8
---------
* Updated some tests to work with later versions of omopgenerics.
* Fixed issue with where combinations sometimes got miss-classified.
* Fixed issue when event starts and ends on end-date of target.
* Fixed issue when collapsing events when there is also a combination, when `filterTreatments = "All"`.
* Added check in tests to only run if packages are availible. (noSuggests, M1).
* `createSankeyDiagram()` now supports pathways over 3 levels long.

# TreatmentPatterns 2.6.7
---------
* Updated URLs in description
Expand Down
51 changes: 39 additions & 12 deletions R/constructPathways.R
Original file line number Diff line number Diff line change
Expand Up @@ -203,15 +203,27 @@ createTreatmentHistory <- function(
andromeda$cohortTable <- dplyr::full_join(
x = andromeda$eventCohorts,
y = andromeda$targetCohorts,
by = dplyr::join_by("personId", y$indexDate <= x$startDate, x$startDate < y$endDate)
)
by = dplyr::join_by(
"personId",
y$indexDate <= x$startDate,
x$startDate <= y$endDate,
x$endDate <= y$endDate
))
} else if (includeTreatments == "endDate") {
andromeda$cohortTable <- dplyr::full_join(
x = andromeda$eventCohorts,
y = andromeda$targetCohorts,
by = dplyr::join_by("personId", y$indexDate <= x$endDate, x$endDate < y$endDate)) %>%
by = dplyr::join_by(
"personId",
y$indexDate <= x$endDate,
x$endDate <= y$endDate
)) %>%
dplyr::mutate(
startDate.x = pmax(.data$startDate.y - periodPriorToIndex, .data$startDate.x, na.rm = TRUE)
startDate.x = pmax(
.data$startDate.y - periodPriorToIndex,
.data$startDate.x,
na.rm = TRUE
)
)
}

Expand Down Expand Up @@ -327,7 +339,7 @@ doEraCollapse <- function(andromeda, eraCollapseSize) {
dplyr::select(-"needsMerge", -"rowNumber") %>%
dplyr::mutate(durationEra = .data$eventEndDate - .data$eventStartDate)
} else {
blockEnd <- needsMerge$rowNumber[seq_len(n)] != needsMerge$rowNumber[seq_len(n)] + 1
blockEnd <- as.numeric(needsMerge$rowNumber[seq_len(n)] != needsMerge$rowNumber[seq_len(n)]) + 1
needsMerge$blockId <- cumsum(blockEnd)
needsMerge <- needsMerge %>%
dplyr::group_by(.data$blockId) %>%
Expand All @@ -348,10 +360,21 @@ doEraCollapse <- function(andromeda, eraCollapseSize) {
newEndDates,
by = dplyr::join_by("rowNumber" == "startRowNumber")) %>%
dplyr::mutate(
eventEndDate = if_else(
is.null(.data$newEndDate),
.data$eventEndDate,
.data$newEndDate)) %>%
eventEndDate = dplyr::case_when(
!is.na(.data$newEndDate) ~ .data$newEndDate,
.default = .data$eventEndDate
),
needsMerge = dplyr::case_when(
!is.na(.data$newEndDate) ~ NA,
.default = .data$needsMerge
)
) %>%
dplyr::mutate(durationEra = .data$eventEndDate - .data$eventStartDate) %>%
# dplyr::mutate(
# eventEndDate = if_else(
# is.null(.data$newEndDate),
# .data$eventEndDate,
# .data$newEndDate)) %>%
dplyr::filter(is.na(.data$needsMerge)) %>%
dplyr::select(-"newEndDate", -"needsMerge", -"rowNumber") %>%
dplyr::mutate(durationEra = .data$eventEndDate - .data$eventStartDate)
Expand Down Expand Up @@ -412,18 +435,21 @@ doCombinationWindow <- function(
# treatmentHistory[r, event_end_date] ->
# add column combination first received, first stopped
treatmentHistory <- treatmentHistory %>%
dplyr::group_by(.data$personId) %>%
dplyr::mutate(combinationFRFS = case_when(
.data$selectedRows == 1 &
switch == 0 &
dplyr::lag(eventEndDate, order_by = .data$sortOrder) < eventEndDate ~ 1,
.default = 0
))
)) %>%
dplyr::ungroup()

# For rows selected not in column switch ->
# if treatmentHistory[r - 1, event_end_date] >
# treatmentHistory[r, event_end_date] ->
# add column combination last received, first stopped
andromeda$treatmentHistory <- treatmentHistory %>%
dplyr::group_by(.data$personId) %>%
dplyr::mutate(combinationLRFS = dplyr::case_when(
.data$selectedRows == 1 &
.data$switch == 0 &
Expand All @@ -432,8 +458,9 @@ doCombinationWindow <- function(
dplyr::lead(.data$eventEndDate, order_by = .data$sortOrder) == .data$eventEndDate &
dplyr::lead(.data$eventStartDate, order_by = .data$sortOrder) == .data$eventStartDate)) ~ 1,
.default = 0
))

)) %>%
dplyr::ungroup()

message(sprintf(
"Selected %s \nout of %s rows\nIteration: %s\nSwitches: %s\nFRFS Combinations: %s\nLRFS Combinations: %s\n",
andromeda$treatmentHistory %>%
Expand Down
33 changes: 11 additions & 22 deletions R/createSankeyDiagram.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,28 +16,17 @@ splitPathItems <- function(treatmentPathways) {
}

createLinks <- function(data) {
result1 <- data %>%
mutate(
source = paste0("1.", .data$path1),
target = paste0("2.", .data$path2)
) %>%
select("source", "target", "freq")


if (suppressWarnings(!is.null(data$path3))) {
result2 <- data %>%
mutate(
source = paste0("2.", .data$path2),
target = paste0("3.", .data$path3)
) %>%
select("source", "target", "freq")

links <- dplyr::bind_rows(
result1, result2
)
} else {
links <- result1
}
links <- lapply(seq_len(ncol(data) - 2), function(i) {
df <- data[, c(i, i + 1, ncol(data))]
names(df) <- c("source", "target", "freq")
df <- df %>%
dplyr::mutate(
source = sprintf("%s.%s", i, .data$source),
target = sprintf("%s.%s", i + 1, .data$target)
)
return(df)
}) |>
dplyr::bind_rows()

links <- links %>%
dplyr::mutate(value = round(freq / sum(freq) * 100, 2)) %>%
Expand Down
2 changes: 1 addition & 1 deletion README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ knitr::opts_chunk$set(

<!-- badges: end -->

[_Markus A, Verhamme K, Kors J, Rijnbeek P (2022). “TreatmentPatterns: An R package to facilitate the standardized development and analysis of treatment patterns across disease domains.” Computer Methods and Programs in Biomedicine._](https://www.sciencedirect.com/science/article/pii/S016926072200462X?via%3Dihub)
[_Markus A, Verhamme K, Kors J, Rijnbeek P (2022). “TreatmentPatterns: An R package to facilitate the standardized development and analysis of treatment patterns across disease domains.” Computer Methods and Programs in Biomedicine._](https://doi.org/10.1016/j.cmpb.2022.107081)

This R package contains the resources for performing a treatment pathway analysis of a study population of interest in observational databases. The package partially relies on the Observational Medical Outcomes Partnership Common Data Model (OMOP CDM), but the main parts of the package are also usable with different data formats.

Expand Down
3 changes: 1 addition & 2 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,7 @@
[*Markus A, Verhamme K, Kors J, Rijnbeek P (2022). “TreatmentPatterns:
An R package to facilitate the standardized development and analysis of
treatment patterns across disease domains.” Computer Methods and
Programs in
Biomedicine.*](https://www.sciencedirect.com/science/article/pii/S016926072200462X?via%3Dihub)
Programs in Biomedicine.*](https://doi.org/10.1016/j.cmpb.2022.107081)

This R package contains the resources for performing a treatment pathway
analysis of a study population of interest in observational databases.
Expand Down
Binary file modified extras/TreatmentPatterns.pdf
Binary file not shown.
2 changes: 1 addition & 1 deletion inst/CITATION
Original file line number Diff line number Diff line change
Expand Up @@ -12,5 +12,5 @@ bibentry(
year = 2022,
month = "oct",
doi = "10.1016/j.cmpb.2022.107081",
url = "https://www.sciencedirect.com/science/article/pii/S016926072200462X"
url = "https://doi.org/10.1016/j.cmpb.2022.107081"
)
2 changes: 1 addition & 1 deletion man/CharacterizationPlots.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/InputHandler.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/SankeyDiagram.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/SunburstPlot.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

25 changes: 21 additions & 4 deletions tests/testthat/helper-ableToRun.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,24 @@
ableToRun <- function() {
all(
require("CirceR", character.only = TRUE, quietly = TRUE),
require("Eunomia", character.only = TRUE, quietly = TRUE),
require("CohortGenerator", character.only = TRUE, quietly = TRUE)
list(
CDMC = all(
require("CirceR", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("CDMConnector", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("DBI", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("duckdb", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)
),

CG = all(
require("CirceR", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("CohortGenerator", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("DatabaseConnector", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("SqlRender", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("Eunomia", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)
),

plotting = all(
require("ggplot2", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("webshot2", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE),
require("plotly", character.only = TRUE, quietly = TRUE, warn.conflicts = FALSE)
)
)
}
78 changes: 41 additions & 37 deletions tests/testthat/helper-generateCohortTableCDMC.R
Original file line number Diff line number Diff line change
@@ -1,39 +1,43 @@
generateCohortTableCDMC <- function() {
cohortTableName <- "cohort_table"

con <- DBI::dbConnect(
duckdb::duckdb(),
dbdir = CDMConnector::eunomia_dir()
)

cdm <- CDMConnector::cdmFromCon(
con = con,
cdmSchema = "main",
writeSchema = "main"
)

## Read in cohort set ----
cohortsSet <- CDMConnector::readCohortSet(
path = system.file(package = "TreatmentPatterns", "exampleCohorts")
)

## Generate cohot set ----
cdm <- CDMConnector::generateCohortSet(
cdm = cdm,
cohortSet = cohortsSet,
name = cohortTableName,
computeAttrition = FALSE
)

cohorts <- data.frame(
cohortId = cohortsSet$cohort_definition_id,
cohortName = cohortsSet$cohort_name,
type = c("event", "event", "event", "event", "exit", "event", "event", "target")
)
return(list(
cdm = cdm,
cohorts = cohorts,
cohortTableName = cohortTableName,
con = con
))
if (ableToRun()$CDMC) {
cohortTableName <- "cohort_table"

con <- DBI::dbConnect(
duckdb::duckdb(),
dbdir = CDMConnector::eunomia_dir()
)

cdm <- CDMConnector::cdmFromCon(
con = con,
cdmSchema = "main",
writeSchema = "main"
)

## Read in cohort set ----
cohortsSet <- CDMConnector::readCohortSet(
path = system.file(package = "TreatmentPatterns", "exampleCohorts")
)

## Generate cohot set ----
cdm <- CDMConnector::generateCohortSet(
cdm = cdm,
cohortSet = cohortsSet,
name = cohortTableName,
computeAttrition = FALSE
)

cohorts <- data.frame(
cohortId = cohortsSet$cohort_definition_id,
cohortName = cohortsSet$cohort_name,
type = c("event", "event", "event", "event", "exit", "event", "event", "target")
)
return(list(
cdm = cdm,
cohorts = cohorts,
cohortTableName = cohortTableName,
con = con
))
} else {
return(NULL)
}
}
Loading

0 comments on commit 95c37ff

Please sign in to comment.