Skip to content

Commit

Permalink
Characterization updates
Browse files Browse the repository at this point in the history 
- updating Characterization for new censoring
- adding counts to risk factor view
  • Loading branch information
@jreps
jreps committed Aug 16, 2024
1 parent 4483c72 commit 025ce0d
Show file tree
Hide file tree
Showing 4 changed files with 371 additions and 264 deletions.
48 changes: 38 additions & 10 deletions R/characterization-caseSeries.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -377,18 +377,26 @@ caseSeriesTable <- function(
# Before Index Cases
beforeData <- data %>%
dplyr::filter(.data$type == 'Before')
Nbefore <- beforeData$sumValue[1]/beforeData$averageValue[1]

Nbefore <- getCountFromFE(
sumValue = beforeData$sumValue,
averageValue = beforeData$averageValue
)

# After Index Cases
afterData <- data %>%
dplyr::filter(.data$type == 'After')
Nafter <- afterData$sumValue[1]/afterData$averageValue[1]
Nafter <- getCountFromFE(
sumValue = afterData$sumValue,
averageValue = afterData$averageValue
)

# During Index Cases
duringData <- data %>%
dplyr::filter(.data$type == 'During')
Nduring <- duringData$sumValue[1]/duringData$averageValue[1]

Nduring <- getCountFromFE(
sumValue = duringData$sumValue,
averageValue = duringData$averageValue
)

beforeData <- beforeData %>%
dplyr::mutate(
Expand Down Expand Up @@ -489,7 +497,7 @@ colDefsBinary <- function(
cell = function(value) {
if(is.null(value)){return('< min threshold')}
if(is.na(value)){return('< min threshold')}
if (value != -1) value else '< min threshold'
if (value >= 0) value else paste0('<', abs(value))
}
),
averageValueBefore = reactable::colDef(
Expand All @@ -506,7 +514,7 @@ colDefsBinary <- function(
cell = function(value) {
if(is.null(value)){return('< min threshold')}
if(is.na(value)){return('< min threshold')}
if (value != -1) value else '< min threshold'
if (value >= 0) value else paste0('<', abs(value))
}
),
averageValueDuring = reactable::colDef(
Expand All @@ -516,14 +524,14 @@ colDefsBinary <- function(
format = reactable::colFormat(digits = 2, percent = T)
),
sumValueAfter = reactable::colDef(
header = withTooltip("# of Cases with Feautre Post-outcome",
header = withTooltip("# of Cases with Feature Post-outcome",
"Number of cases with the covariate after the outcome"),
filterable = T,
format = reactable::colFormat(digits = 2, percent = F),
cell = function(value) {
if(is.null(value)){return('< min threshold')}
if(is.na(value)){return('< min threshold')}
if (value != -1) value else '< min threshold'
if (value >= 0) value else paste0('<', abs(value))
}
),
averageValueAfter = reactable::colDef(
Expand Down Expand Up @@ -653,7 +661,11 @@ colDefsContinuous <- function(
header = withTooltip("# Cases with Feature",
"Number of cases with the covariate"),
filterable = T,
format = reactable::colFormat(digits = 2, percent = F)
format = reactable::colFormat(digits = 2, percent = F),
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
minValue = reactable::colDef(
header = withTooltip("Min Value",
Expand Down Expand Up @@ -713,3 +725,19 @@ colDefsContinuous <- function(
return(result)
}



getCountFromFE <- function(
sumValue,
averageValue
){

Ns <- sumValue/averageValue
if(sum(is.finite(Ns)) > 0 ){
maxN <- max(Ns[is.finite(Ns)])
} else{
message('Issue calculating N')
maxN <- 0
}
return(maxN)
}
57 changes: 47 additions & 10 deletions R/characterization-dechallengeRechallenge.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -136,52 +136,89 @@ characterizationDechallengeRechallengeServer <- function(
numExposureEras = reactable::colDef(
header = withTooltip("# of Exposure Eras",
"Distinct number of exposure events (i.e. drug eras) in a given target cohort"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
numPersonsExposed = reactable::colDef(
header = withTooltip("# of Exposed Persons",
"Distinct nuber of people exposed in target cohort. A person must have at least 1 day exposure to be included"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
numCases = reactable::colDef(
header = withTooltip("# of Cases",
"Distinct number of persons in outcome cohort. A person must have at least 1 day of observation time to be included"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
dechallengeAttempt = reactable::colDef(
header = withTooltip("# of Dechallenge Attempts",
"Distinct count of people with observable time after discontinuation of the exposure era during which the challenge outcome occurred"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
dechallengeFail = reactable::colDef(
header = withTooltip("# of Dechallenge Fails",
"Among people with challenge outcomes, the distinct number of people with outcomes during dechallengeEvaluationWindow"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
dechallengeSuccess = reactable::colDef(
header = withTooltip("# of Dechallenge Successes",
"Among people with challenge outcomes, the distinct number of people without outcomes during the dechallengeEvaluationWindow"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
rechallengeAttempt = reactable::colDef(
header = withTooltip("# of Rechallenge Attempts",
"Number of people with a new exposure era after the occurrence of an outcome during a prior exposure era"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
rechallengeFail = reactable::colDef(
header = withTooltip("# of Rechallenge Fails",
"Number of people with a new exposure era during which an outcome occurred, after the occurrence of an outcome during a prior exposure era"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
rechallengeSuccess = reactable::colDef(
header = withTooltip("# of Rechallenge Successes",
"Number of people with a new exposure era during which an outcome did not occur, after the occurrence of an outcome during a prior exposure era"),
filterable = T
filterable = T,
cell = function(value) {
# Add < if cencored
if (value < 0 ) paste("<", abs(value)) else abs(value)
}
),
pctDechallengeAttempt = reactable::colDef(
header = withTooltip("% of Dechallenge Attempts",
"Percent of people with observable time after discontinuation of the exposure era during which the challenge outcome occurred"),
filterable = T,
#format = reactable::colFormat(digits = 2, percent = T),
format = reactable::colFormat(digits = 2, percent = T)
),
pctDechallengeSuccess = reactable::colDef(
Expand Down Expand Up @@ -211,7 +248,7 @@ characterizationDechallengeRechallengeServer <- function(
pctRechallengeFail = reactable::colDef(
header = withTooltip("% of Rechallenge Fail",
"Percent of people with a new exposure era during which an outcome did not occur, after the occurrence of an outcome during a prior exposure era"),
filterable = T,
filterable = T,
format = reactable::colFormat(digits = 2, percent = T)
)
)
Expand Down
Loading

0 comments on commit 025ce0d

Please sign in to comment.