Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Develop #368

Merged
merged 14 commits into from
Oct 22, 2024
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: OhdsiShinyModules
Type: Package
Title: Repository of Shiny Modules for OHDSI Result Viewers
Version: 3.1.0
Version: 3.1.1
Authors@R: c(
person("Jenna", "Reps", email = "jreps@its.jnj.com", role = c("aut", "cre")),
person("Nathan", "Hall", role = c("aut")),
Expand Down
5 changes: 5 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
OhdsiShinyModules v3.1.1
========================
- bug fixes
- updated helper documents

OhdsiShinyModules v3.1.0
========================
- Removed percentage calculation from records field in CohortDiagnostics
Expand Down
52 changes: 45 additions & 7 deletions R/characterization-incidence.R
Original file line number Diff line number Diff line change
Expand Up @@ -353,6 +353,23 @@ characterizationIncidenceServer <- function(
)
),

shinyWidgets::pickerInput(
inputId = session$ns('cleanWindows'),
label = 'Select Clean Window',
choices = ciOptions$cleanWindows,
selected = ciOptions$cleanWindows,
multiple = F,
options = shinyWidgets::pickerOptions(
actionsBox = TRUE,
liveSearch = TRUE,
size = 10,
dropupAuto = TRUE,
liveSearchStyle = "contains",
liveSearchPlaceholder = "Type here to search",
virtualScroll = 50
)
),

shinyWidgets::pickerInput(
inputId = session$ns('tars'),
label = 'Select Time at risk (TAR)',
Expand All @@ -370,6 +387,7 @@ characterizationIncidenceServer <- function(
)
),


shiny::actionButton(
inputId = session$ns('generate'),
label = 'Generate',
Expand All @@ -384,12 +402,14 @@ characterizationIncidenceServer <- function(
incidenceRateAgeFilter <- shiny::reactiveVal(NULL)
incidenceRateGenderFilter <- shiny::reactiveVal(NULL)
incidenceRateDbFilter <- shiny::reactiveVal(NULL)
incidenceRateCleanWindowsFilter <- shiny::reactiveVal(NULL)
shiny::observeEvent(input$generate,{
incidenceRateTarFilter(names(ciOptions$tar)[(ciOptions$tar == input$tars)]) # filter needs actual value
incidenceRateCalendarFilter(input$startYears)
incidenceRateAgeFilter(input$ageIds)
incidenceRateGenderFilter(input$sexIds)
incidenceRateDbFilter(input$databaseSelector)
incidenceRateCleanWindowsFilter(input$cleanWindows)
outcomeIds(input$outcomeIds)
})

Expand Down Expand Up @@ -594,11 +614,13 @@ characterizationIncidenceServer <- function(
shiny::validate("Please wait...")
}

else if(targetIds()[1] == outcomeIds()[1] &&
length(targetIds())==1 && length(outcomeIds())==1
){
shiny::validate("Target and outcome cohorts must differ from each other. Make a different selection.")
}
#causing an issue when we want the same target & outcome for recurrent events

# else if(targetIds()[1] == outcomeIds()[1] &&
# length(targetIds())==1 && length(outcomeIds())==1
# ){
# shiny::validate("Target and outcome cohorts must differ from each other. Make a different selection.")
# }

else {
result <- getIncidenceData(targetIds = targetIds(),
Expand All @@ -625,7 +647,8 @@ characterizationIncidenceServer <- function(
.data$genderId %in% !! incidenceRateGenderFilter() &
.data$startYear %in% !! incidenceRateCalendarFilter() &
.data$tar %in% incidenceRateTarFilter() &
.data$cdmSourceAbbreviation %in% !! incidenceRateDbFilter()
.data$cdmSourceAbbreviation %in% !! incidenceRateDbFilter() &
.data$cleanWindow %in% !! incidenceRateCleanWindowsFilter()
) %>%
dplyr::relocate("targetName", .after = "cdmSourceAbbreviation") %>%
dplyr::relocate("outcomeName", .after = "targetName") %>%
Expand Down Expand Up @@ -654,7 +677,7 @@ characterizationIncidenceServer <- function(
id = "incidenceRateTable",
df = filteredData,
selectedCols = c("cdmSourceAbbreviation", "targetName", "targetNameShort", "outcomeName", "outcomeNameShort",
"ageGroupName", "genderName", "startYear", "tar", "outcomes",
"ageGroupName", "genderName", "startYear", "cleanWindow", "tar", "outcomes",
"incidenceProportionP100p", "incidenceRateP100py"),
sortedCols = c("ageGroupName", "genderName", "startYear", "incidenceRateP100py"),
elementId = "incidence-select",
Expand Down Expand Up @@ -1809,6 +1832,20 @@ from @result_schema.@incidence_table_prefixOUTCOME_DEF
outcomes <- outcomeDf$outcomeId
names(outcomes) <- outcomeDf$outcomeName

#getting clean window options
sql <- '
select clean_window
from @result_schema.@incidence_table_prefixOUTCOME_DEF
'
cleanWindowDf <- connectionHandler$queryDb(
sql = sql,
result_schema = resultDatabaseSettings$schema,
incidence_table_prefix = resultDatabaseSettings$incidenceTablePrefix
)
cleanWindows <- cleanWindowDf$cleanWindow
names(cleanWindows) <- cleanWindowDf$cleanWindow


irPlotCategoricalChoices <- list(
"cdmSourceAbbreviation",
"ageGroupName",
Expand Down Expand Up @@ -1867,6 +1904,7 @@ from @result_schema.@incidence_table_prefixOUTCOME_DEF
startYear = startYear,
tar = tar,
outcomes = outcomes,
cleanWindows = cleanWindows,
irPlotNumericChoices = irPlotNumericChoices,
irPlotCategoricalChoices = irPlotCategoricalChoices
)
Expand Down
20 changes: 10 additions & 10 deletions docs/404.html

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

29 changes: 16 additions & 13 deletions docs/articles/AddingShinyModules.html

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

Loading
Loading