inst/shiny/server.R

In PhenotypeR: Assess Study Cohorts Using a Common Data Model

# Generated by OmopViewer 0.1.0
# Be careful editing this file

server <- function(input, output, session) {

  # Shared variables
  app_initialized_flag <- reactiveVal(FALSE)
  shared_cdm_names     <- reactiveVal(NULL)
  shared_cohort_names  <- reactiveVal(NULL)

  # fill selectise variables ----
  shiny::observe({
    req(!app_initialized_flag())

    for (k in seq_along(choices)) {
      if(!grepl("cdm_name|cohort_name", names(choices)[k])){
        shiny::updateSelectizeInput(
          session,
          inputId = names(choices)[k],
          choices = choices[[k]],
          selected = selected[[k]],
          server = TRUE
        )

        shinyWidgets::updatePickerInput(session,
                                        inputId = names(choices)[k],
                                        choices = choices[[k]],
                                        selected = selected[[k]])
      }else if(grepl("cdm_name", names(choices[k]))){
        updatePickerInput(session, names(choices[k]), selected = shared_cdm_names())
      }else if(grepl("cohort_name", names(choices[k]))){
        updatePickerInput(session, names(choices[k]), selected = shared_cohort_names())
      }
    }

    app_initialized_flag(TRUE)
  })

  # Define shared cdm_names values ----
  shiny::observe({
    cdm_values <- names(choices)[grepl("cdm_name", names(choices)) & names(choices) != "shared_cdm_names"]
    for(inputValue in cdm_values){
      local({
        inputValue_local <- inputValue
        shiny::observeEvent(input[[inputValue_local]], {
          val <- input[[inputValue_local]]
          if (is.null(val) || length(val) == 0 || all(val == "")) { val <- character(0) }
          shared_cdm_names(val)
        }, ignoreNULL = FALSE)
      })
    }
  })

  # Define shared cohort_names values ----
  shiny::observe({
    cohort_values <- names(choices)[grepl("cohort_name", names(choices)) & names(choices) != "shared_cohort_names"]
    for(inputValue in cohort_values){
      local({
        inputValue_local <- inputValue
        shiny::observeEvent(input[[inputValue_local]], {
          val <- input[[inputValue_local]]
          if (is.null(val) || length(val) == 0 || all(val == "")) { val <- character(0) }
          shared_cohort_names(val)
        }, ignoreNULL = FALSE)
      })
    }
  })

  # download raw data -----
  output$download_raw <- shiny::downloadHandler(
    filename = "results.csv",
    content = function(file) {

      # Initialize a progress bar
      shiny::withProgress(value = 0, {

        # Step 1: Importing data
        shiny::incProgress(.25, message = "Importing data", detail = "Preparing summarised result...")
        rawData <- omopgenerics::importSummarisedResult(file.path(getwd(), "data", "raw"))

        # Step 2: Exporting data
        shiny::incProgress(.75, message = "Exporting data", detail = "Preparing file for download...")
        omopgenerics::exportSummarisedResult(rawData, fileName = file)
      })
    }
  )

  # summarise_omop_snapshot -----
  filterOmopSnapshot <- shiny::reactive({
    if (is.null(dataFiltered$summarise_omop_snapshot)) {
      validate("No snapshot in results")
    }

    result <- dataFiltered$summarise_omop_snapshot

    validateFilteredResult(result)

    return(result)
  })
  ## Table summarise_omop_snapshot ----
  createTableOmopSnapshot <- shiny::reactive({
    filterOmopSnapshot() |>
      OmopSketch::tableOmopSnapshot() %>%
      tab_header(
        title = "Database metadata",
        subtitle = "Overview of data source"
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_omop_snapshot_gt <- gt::render_gt({
    createTableOmopSnapshot()
  })
  output$summarise_omop_snapshot_gt_download <- shiny::downloadHandler(
    filename = "summarise_omop_snapshot_gt.docx",
    content = function(file) {
      gt::gtsave(data = createTableOmopSnapshot(), filename = file)
    }
  )

  # summarise_observation_period -----
  filterObservationPeriod <- shiny::reactive({
    if (is.null(dataFiltered$summarise_observation_period)) {
      validate("No observation period summary in results")
    }

    result <- dataFiltered$summarise_observation_period

    validateFilteredResult(result)

    return(result)
  })

  ## Table summarise_observation_period -----
  createTableObservationPeriod <- shiny::reactive({
    filterObservationPeriod() |>
      OmopSketch::tableObservationPeriod() %>%
      tab_header(
        title = "Summary of observation periods",
        subtitle = "Observation periods are used to define time under observation for individuals in the data source."
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_observation_period_gt <- gt::render_gt({
    createTableObservationPeriod()
  })
  output$summarise_observation_period_gt_download <- shiny::downloadHandler(
    filename = "summarise_observation_period_gt.docx",
    content = function(file) {
      obj <- createTableObservationPeriod()
      gt::gtsave(data = obj, filename = file)
    }
  )


  # achilles_code_use -----
  filterAchillesCodeUse <- eventReactive(input$updateAchillesCodeUse, ({

    if (is.null(dataFiltered$achilles_code_use)) {
      validate("No achilles code use in results")
    }

    achillesFiltered <- dataFiltered$achilles_code_use  |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$group_level %in% input$achilles_code_use_codelist_name)

    if(isFALSE(input$achilles_person_count)){
      achillesFiltered <- achillesFiltered  |>
        filter(estimate_name != "person_count")
    }
    if(isFALSE(input$achilles_record_count)){
      achillesFiltered <- achillesFiltered  |>
        filter(estimate_name != "record_count")
    }

    validateFilteredResult(achillesFiltered)

    return(achillesFiltered)
  }))

  ## Table achilles_code_use ----
  createAchillesCodeUseGT <- shiny::reactive({
    tbl <- CodelistGenerator::tableAchillesCodeUse(filterAchillesCodeUse(),
                                                   header = input$achilles_code_use_header,
                                                   groupColumn = input$achilles_code_use_groupColumn,
                                                   hide = input$achilles_code_use_hide) |>
      tab_header(
        title = "Summary of achilles codes",
        subtitle = "Codes from codelist observed in achilles tables."
      ) |>
      tab_options(
        heading.align = "left"
      )

    return(tbl)
  })
  createAchillesCodeUseInteractive <- shiny::reactive({
    tbl <- CodelistGenerator::tableAchillesCodeUse(filterAchillesCodeUse(),
                                                   header = input$achilles_code_use_header,
                                                   groupColumn = input$achilles_code_use_groupColumn,
                                                   hide = input$achilles_code_use_hide,
                                                   type = "tibble")
    names(tbl) <- stringr::str_remove_all(names(tbl),
                                          "\\[header_name\\]Database name\\n\\[header_level\\]")
    names(tbl) <- stringr::str_remove_all(names(tbl),
                                          "Estimate name\n\\[header_level\\]")
    names(tbl) <- stringr::str_replace_all(names(tbl),
                                           "\n\\[header_name\\]",
                                           ": ")
    return(tbl)
  })

  output$achilles_code_use_tbl <- shiny::renderUI({


    if(isFALSE(input$achilles_interactive)){
      tbl <- createAchillesCodeUseGT()
      return(tbl)

    } else {

      tbl <- createAchillesCodeUseInteractive()

      # column ordering by codelist and first column with a count
      order <- list("Codelist name"  = "asc",
                    "count" = "desc")
      names(order)[2] <- names(tbl)[7]

      # suppressed to NA
      tbl <- tbl |>
        purrr::map_df(~ ifelse(grepl("^<", .), NA, .)) |>
        dplyr::mutate(dplyr::across(c(ends_with("count")),
                                    ~ gsub(",", "", .))) |>
        dplyr::mutate(dplyr::across(c(ends_with("count")),
                                    ~ suppressWarnings(as.numeric(.))))

      tbl <- reactable::reactable(tbl,
                                  defaultSorted = order,
                                  columns = getColsForTbl(tbl),
                                  filterable = TRUE,
                                  searchable = TRUE,
                                  defaultPageSize = 25,
                                  highlight = TRUE,
                                  striped = TRUE,
                                  compact = TRUE,
                                  showSortable = TRUE) |>
        reactablefmtr::add_title("Summary of achilles codes",
                                 font_size = 25,
                                 font_weight = "normal") |>
        reactablefmtr::add_subtitle("Codes from codelist observed in achilles tables.",
                                    font_size = 15,
                                    font_weight = "normal")

      return(tbl)
    }
  })

  output$achilles_code_use_download <- shiny::downloadHandler(
    filename = function(){
      if(isFALSE(input$achilles_interactive)){
        "summarise_achilles_code_use_gt.docx"
      }else{
        "summarise_achilles_code_use_tbl.csv"
      }
    },
    content = function(file){
      if(isFALSE(input$achilles_interactive)){
        gt::gtsave(data = createAchillesCodeUseGT(), filename = file)
      }else{
        readr::write_csv(createAchillesCodeUseInteractive(), file = file)
      }
    }
  )


  # orphan_codes -----
  filterOrphanCodes <-  eventReactive(input$updateOrphanCodeUse, ({

    if (is.null(dataFiltered$orphan_code_use)) {
      validate("No orphan codes in results")
    }

    result <- dataFiltered$orphan_code_use |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$group_level %in% input$orphan_code_use_codelist_name)

    if(isFALSE(input$orphan_person_count)){
      result <- result  |>
        filter(estimate_name != "person_count")
    }
    if(isFALSE(input$orphan_record_count)){
      result <- result  |>
        filter(estimate_name != "record_count")
    }

    validateFilteredResult(result)

    return(result)
  }))

  ## Table orphan_codes -----
  createOrphanCodesGT <- shiny::reactive({
    tbl <- CodelistGenerator::tableOrphanCodes(
      filterOrphanCodes(),
      header = input$orphan_codes_gt_header,
      groupColumn = input$orphan_codes_gt_groupColumn,
      hide = input$orphan_codes_gt_hide
    )
    tbl %>%
      tab_header(
        title = "Summary of orphan codes",
        subtitle = "Orphan codes refer to concepts present in the database that are not in a codelist but are related to included codes."
      ) %>%
      tab_options(
        heading.align = "left"
      )

    return(tbl)
  })
  createOrphanCodesInteractive <- shiny::reactive({
    tbl <- CodelistGenerator::tableOrphanCodes(
      filterOrphanCodes(),
      header = input$orphan_codes_gt_header,
      groupColumn = input$orphan_codes_gt_groupColumn,
      hide = input$orphan_codes_gt_hide,
      type = "tibble"
    )
    names(tbl) <-stringr::str_remove_all(names(tbl),
                                         "\\[header_name\\]Database name\\n\\[header_level\\]")
    names(tbl) <- stringr::str_remove_all(names(tbl),
                                          "Estimate name\n\\[header_level\\]")
    names(tbl) <- stringr::str_replace_all(names(tbl),
                                           "\n\\[header_name\\]",
                                           ": ")

    return(tbl)
  })
  output$orphan_codes_tbl <- shiny::renderUI({

    if(isFALSE(input$orphan_interactive)){
      tbl <- createOrphanCodesGT()
      return(tbl)
    } else {
      tbl <- createOrphanCodesInteractive()
      # column ordering by codelist and first column with a count
      order <- list("Codelist name"  = "asc",
                    "count" = "desc")
      names(order)[2] <- names(tbl)[7]

      # suppressed to NA
      tbl <- tbl |>
        purrr::map_df(~ ifelse(grepl("^<", .), NA, .)) |>
        dplyr::mutate(dplyr::across(c(ends_with("count")),
                                    ~ gsub(",", "", .))) |>
        dplyr::mutate(dplyr::across(c(ends_with("count")),
                                    ~ suppressWarnings(as.numeric(.))))

      tbl <- reactable(tbl,
                       columns = getColsForTbl(tbl),
                       defaultSorted = order,
                       filterable = TRUE,
                       searchable = TRUE,
                       defaultPageSize = 25,
                       highlight = TRUE,
                       striped = TRUE,
                       compact = TRUE,
                       showSortable = TRUE) |>
        reactablefmtr::add_title("Summary of orphan codes",
                                 font_size = 25,
                                 font_weight = "normal") |>
        reactablefmtr::add_subtitle("Orphan codes refer to concepts present in the database that are not in a codelist but are related to included codes.",
                                    font_size = 15,
                                    font_weight = "normal")

      return(tbl)
    }
  })

  output$orphan_codes_download <- shiny::downloadHandler(
    filename = function(){
      if(isFALSE(input$orphan_interactive)){
        "summarise_orphan_codes_gt.docx"
      }else{
        "summarise_orphan_codes_tbl.csv"
      }
    },
    content = function(file){
      if(isFALSE(input$orphan_interactive)){
        gt::gtsave(data = createOrphanCodesGT(), filename = file)
      }else{
        readr::write_csv(createOrphanCodesInteractive(), file = file)
      }
    }
  )

  # unmapped codes -----
  # createOutputUnmapped <- shiny::reactive({
  #   if (is.null(dataFiltered$unmapped_codes)) {
  #     validate("No unmapped codes in results")
  #   }
  #
  #   CodelistGenerator::tableUnmappedCodes(
  #     dataFiltered$unmapped_codes |>
  #       dplyr::filter(cdm_name %in% shared_cdm_names(),
  #                     group_level %in% input$unmapped_codelist_name),
  #     header = input$unmapped_header,
  #     groupColumn = input$unmapped_groupColumn,
  #     hide = input$unmapped_hide
  #   ) %>%
  #     tab_header(
  #       title = "Summary of unmapped codes",
  #       subtitle = "These codes are recorded as source concepts that are mapped to 0"
  #     ) %>%
  #     tab_options(
  #       heading.align = "left"
  #     )
  # })
  # output$unmapped_formatted <- gt::render_gt({
  #   createOutputUnmapped()
  # })
  # output$unmapped_formatted_download <- shiny::downloadHandler(
  #   filename = "output_gt_orphan.docx",
  #   content = function(file) {
  #     obj <- createOutputUnmapped()
  #     gt::gtsave(data = obj, filename = file)
  #   }
  # )

  # cohort_code_use -----
  filterCohortCodeUse <- eventReactive(input$updateCohortCodeUse, ({

    if (is.null(dataFiltered$cohort_code_use)) {
      validate("No cohort code use in results")
    }

    result <- dataFiltered$cohort_code_use |>
      visOmopResults::splitGroup(keep = TRUE) |>
      visOmopResults::splitAdditional(keep = TRUE) |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$cohort_name %in% shared_cohort_names(),
                    .data$domain_id %in% input$cohort_code_use_domain_id) |>
      dplyr::select(-visOmopResults::groupColumns(dataFiltered$cohort_code_use)) |>
      dplyr::select(-visOmopResults::additionalColumns(dataFiltered$cohort_code_use))

    if(isFALSE(input$cohort_code_use_person_count)){
      result <- result  |>
        filter(estimate_name != "person_count")
    }
    if(isFALSE(input$cohort_code_use_record_count)){
      result <- result  |>
        filter(estimate_name != "record_count")
    }

    validateFilteredResult(result)

    return(result)
  }))
  ## Table cohort_code_use -----
  createCohortCodeUseGT <- shiny::reactive({
    tbl <- CodelistGenerator::tableCohortCodeUse(
      filterCohortCodeUse(),
      header = input$cohort_code_use_gt_header,
      groupColumn = input$cohort_code_use_gt_groupColumn,
      hide = input$cohort_code_use_gt_hide
    ) %>%
      tab_header(
        title = "Summary of cohort code use",
        subtitle = "Codes from codelist observed on day of cohort entry. Note more than one code could be seen for a person on this day (both of which would have led to inclusion)."
      ) %>%
      tab_options(
        heading.align = "left"
      )

    return(tbl)
  })
  createCohortCodeUseInteractive <- shiny::reactive({
    tbl <-  CodelistGenerator::tableCohortCodeUse(
      filterCohortCodeUse(),
      header = input$cohort_code_use_gt_header,
      groupColumn = input$cohort_code_use_gt_groupColumn,
      hide = input$cohort_code_use_gt_hide,
      type = "tibble"
    )
    names(tbl) <-stringr::str_remove_all(names(tbl),
                                         "\\[header_name\\]Database name\\n\\[header_level\\]")
    names(tbl) <- stringr::str_remove_all(names(tbl),
                                          "Estimate name\n\\[header_level\\]")
    names(tbl) <- stringr::str_replace_all(names(tbl),
                                           "\n\\[header_name\\]",
                                           ": ")
    return(tbl)
  })
  output$cohort_code_use_tbl <- shiny::renderUI({

    if(isFALSE(input$cohort_code_use_interactive)){
      tbl <- createCohortCodeUseGT()
      return(tbl)
    } else {
      tbl <- createCohortCodeUseInteractive() |>
        dplyr::mutate(dplyr::across(c(ends_with("count")),
                                    ~ gsub(",", "", .))) |>
        dplyr::mutate(dplyr::across(c(ends_with("count")),
                                    ~ suppressWarnings(as.numeric(.))))

      # column ordering by codelist and first column with a count
      order <- list("Cohort name"  = "asc",
                    "count" = "desc")
      names(order)[2] <- names(tbl)[9]

      # suppressed to NA
      tbl <- tbl |>
        purrr::map_df(~ ifelse(grepl("^<", .), NA, .))

      tbl <- reactable(tbl,
                       columns = getColsForTbl(tbl,
                                               sortNALast = FALSE,
                                               names = c("Standard concept ID", "Source concept ID")),
                       defaultSorted = order,
                       filterable = TRUE,
                       searchable = TRUE,
                       defaultPageSize = 25,
                       highlight = TRUE,
                       striped = TRUE,
                       compact = TRUE,
                       showSortable = TRUE) |>
        reactablefmtr::add_title("Summary of cohort code use",
                                 font_size = 25,
                                 font_weight = "normal") |>
        reactablefmtr::add_subtitle("Codes from codelist observed on day of cohort entry. Note more than one code could be seen for a person on this day (both of which would have led to inclusion).",
                                    font_size = 15,
                                    font_weight = "normal")

      return(tbl)
    }
  })

  output$cohort_code_use_download <- shiny::downloadHandler(
    filename = function(){
      if(isFALSE(input$cohort_code_use_interactive)){
        file <- "summarise_cohort_code_use_gt.docx"
      }else{
        file <- "summarise_cohort_code_use_tbl.csv"
      }
      return(file)
    },
    content = function(file){
      if(isFALSE(input$cohort_code_use_interactive)){
        gt::gtsave(data = createCohortCodeUseGT(), filename = file)
      }else{
        readr::write_csv(createCohortCodeUseInteractive(), file = file)
      }
    }
  )

  # summarise measurement diagnostics -----
  filterMeasurementTimings <- eventReactive(input$updateMeasurementCodeUse, ({

    if (is.null(dataFiltered$measurement_timings)) {
      validate("No measurement timings in results")
    }

    result <- dataFiltered$measurement_timings |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names()) |>
      visOmopResults::filterGroup(.data$cohort_name %in% shared_cohort_names())

    validateFilteredResult(result)

    return(result)
  }))
  ## Table measurement_timings -----
  createMeasurementTimingsGT <- shiny::reactive({
    tbl <- MeasurementDiagnostics::tableMeasurementTimings(
      filterMeasurementTimings(),
      header = input$measurement_timings_gt_header,
      groupColumn = input$measurement_timings_gt_groupColumn,
      hide = input$measurement_timings_gt_hide
    ) %>%
      tab_header(
        title = "Summary of measurement timings",
        subtitle = "Only codes from measurements are shown. Timing between individuals measurements."
      ) %>%
      tab_options(
        heading.align = "left"
      )

    return(tbl)
  })

  output$measurement_timings_tbl <- shiny::renderUI({
    createMeasurementTimingsGT()
  })

  output$measurement_timings_gt_download <- shiny::downloadHandler(
    filename = "summarise_measurement_timings_gt.docx",
    content = function(file){
        gt::gtsave(data = createMeasurementTimingsGT(), filename = file)
    }
  )
  ## Plot measurement_timings ----
  getPlotMeasurementTimings <- shiny::reactive({
    result <- filterMeasurementTimings()

    MeasurementDiagnostics::plotMeasurementTimings(
      result,
      y = input$measurement_timings_y,
      plotType = input$measurement_timings_plottype,
      timeScale = input$measurement_timings_time_scale,
      facet = input$measurement_timings_facet,
      colour = input$measurement_timings_colour)
  })

  output$plot_measurement_timings <- shiny::renderPlot({
    getPlotMeasurementTimings()
  })

  output$plot_measurement_timings_download <- shiny::downloadHandler(
    filename = "output_ggplot2_measurement_timings.png",
    content = function(file) {
      obj <- getPlotMeasurementTimings()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$plot_measurement_timings_download_width),
        height = as.numeric(input$plot_measurement_timings_download_height),
        units = input$plot_measurement_timings_download_units,
        dpi = as.numeric(input$plot_measurement_timings_download_dpi)
      )
    }
  )

  # summarise measurement value as concept
  filterMeasurementValueAsConcept <- eventReactive(input$updateMeasurementCodeUse, ({

    if (is.null(dataFiltered$measurement_value_as_concept)) {
      validate("No measurement value as concept in results")
    }

    result <- dataFiltered$measurement_value_as_concept |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names()) |>
      visOmopResults::filterGroup(.data$cohort_name %in% shared_cohort_names())

    validateFilteredResult(result)

    return(result)
  }))

  ## Table measurement_value_as_concept -----
  createMeasurementValueAsConceptGT <- shiny::reactive({
    tbl <- MeasurementDiagnostics::tableMeasurementValueAsConcept(
      filterMeasurementValueAsConcept(),
      header = input$measurement_value_as_concept_gt_header,
      groupColumn = input$measurement_value_as_concept_gt_groupColumn,
      hide = input$measurement_value_as_concept_gt_hide
    ) %>%
      tab_header(
        title = "Summary of measurement values (concepts)",
        subtitle = "Only codes from measurements that are concepts are shown."
      ) %>%
      tab_options(
        heading.align = "left"
      )

    return(tbl)
  })

  output$measurement_value_as_concept_tbl <- shiny::renderUI({
    createMeasurementValueAsConceptGT()
  })

  output$measurement_value_as_concept_gt_download <- shiny::downloadHandler(
    filename = "summarise_measurement_value_as_concept_gt.docx",
    content = function(file){
      gt::gtsave(data = createMeasurementValueAsConceptGT(), filename = file)
    }
  )
  ## Plot measurement_value_as_concept ----
  getPlotMeasurementValueAsConcept <- shiny::reactive({
    result <- filterMeasurementValueAsConcept()

    MeasurementDiagnostics::plotMeasurementValueAsConcept(
      result,
      x = input$measurement_value_as_concept_x,
      y = input$measurement_value_as_concept_y,
      facet = input$measurement_value_as_concept_facet,
      colour = input$measurement_value_as_concept_colour
    ) +
      facet_wrap(input$measurement_value_as_concept_facet, scales = "free_y")
  })

  output$plot_measurement_value_as_concept <- shiny::renderPlot({
    getPlotMeasurementValueAsConcept()
  })

  output$plot_measurement_value_as_concept_download <- shiny::downloadHandler(
    filename = "output_ggplot2_measurement_value_as_concept.png",
    content = function(file) {
      obj <- getPlotMeasurementValueAsConcept()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$plot_measurement_value_as_concept_download_width),
        height = as.numeric(input$plot_measurement_value_as_concept_download_height),
        units = input$plot_measurement_value_as_concept_download_units,
        dpi = as.numeric(input$plot_measurement_value_as_concept_download_dpi)
      )
    }
  )

  # summarise measurement value as numeric
  filterMeasurementValueAsNumeric <- eventReactive(input$updateMeasurementCodeUse, ({

    if (is.null(dataFiltered$measurement_value_as_numeric)) {
      validate("No measurement value as numeric in results")
    }

    result <- dataFiltered$measurement_value_as_numeric |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names()) |>
      visOmopResults::filterGroup(.data$cohort_name %in% shared_cohort_names())

    validateFilteredResult(result)

    return(result)
  }))

  ## Table measurement_value_as_numeric -----
  createMeasurementValueAsNumericGT <- shiny::reactive({
    tbl <- MeasurementDiagnostics::tableMeasurementValueAsNumeric(
      filterMeasurementValueAsNumeric(),
      header = input$measurement_value_as_numeric_gt_header,
      groupColumn = input$measurement_value_as_numeric_gt_groupColumn,
      hide = input$measurement_value_as_numeric_gt_hide
    ) %>%
      tab_header(
        title = "Summary of measurement values (numeric)",
        subtitle = "Only codes from measurements that are numeric are shown."
      ) %>%
      tab_options(
        heading.align = "left"
      )

    return(tbl)
  })

  output$measurement_value_as_numeric_tbl <- shiny::renderUI({
    createMeasurementValueAsNumericGT()
  })

  output$measurement_value_as_numeric_gt_download <- shiny::downloadHandler(
    filename = "summarise_measurement_value_as_numeric_gt.docx",
    content = function(file){
      gt::gtsave(data = createMeasurementValueAsNumericGT(), filename = file)
    }
  )
  ## Plot measurement_value_as_numeric ----
  getPlotMeasurementValueAsNumeric <- shiny::reactive({
    result <- filterMeasurementValueAsNumeric()

    MeasurementDiagnostics::plotMeasurementValueAsNumeric(
      result,
      x = input$measurement_value_as_numeric_x,
      plotType = input$measurement_value_as_numeric_plottype,
      facet = input$measurement_value_as_numeric_facet,
      colour = input$measurement_value_as_numeric_colour
    )
  })

  output$plot_measurement_value_as_numeric <- shiny::renderPlot({
    getPlotMeasurementValueAsNumeric()
  })

  output$plot_measurement_value_as_numeric_download <- shiny::downloadHandler(
    filename = "output_ggplot2_measurement_value_as_numeric.png",
    content = function(file) {
      obj <- getPlotMeasurementValueAsNumeric()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$plot_measurement_value_as_numeric_download_width),
        height = as.numeric(input$plot_measurement_value_as_numeric_download_height),
        units = input$plot_measurement_value_as_numeric_download_units,
        dpi = as.numeric(input$plot_measurement_value_as_numeric_download_dpi)
      )
    }
  )


  # summarise_cohort_count -----
  filterCohortCount <- eventReactive(input$updateCohortCount, ({

    if (is.null(dataFiltered$summarise_cohort_count)) {
      validate("No cohort count in results")
    }

    result <- dataFiltered$summarise_cohort_count |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$group_level %in% shared_cohort_names())

    if(isFALSE(input$cohort_count_person_count)){
      result <- result  |>
        dplyr::filter(.data$variable_name != "Number subjects")
    }
    if(isFALSE(input$cohort_count_record_count)){
      result <- result  |>
        dplyr::filter(.data$variable_name != "Number records")
    }

    validateFilteredResult(result)

    return(result)
  }))

  ## Table summarise_cohort_count ----
  createTableCohortCount <- shiny::reactive({

    CohortCharacteristics::tableCohortCount(filterCohortCount()) %>%
      tab_header(
        title = "Cohort count",
        subtitle = "Number of records and subjects in the study cohorts."
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_cohort_count_gt <- gt::render_gt({
    createTableCohortCount()
  })
  output$summarise_cohort_count_gt_download <- shiny::downloadHandler(
    filename = "summarise_cohort_count_gt.docx",
    content = function(file) {
      obj <- createTableCohortCount()
      gt::gtsave(data = obj, filename = file)
    }
  )

  # summarise_cohort_attrition -----
  filterCohortAttrition <- eventReactive(input$updateCohortCount,({

    if (is.null(dataFiltered$summarise_cohort_attrition)) {
      validate("No cohort attrition in results")
    }

    result <- dataFiltered$summarise_cohort_attrition |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$group_level %in% shared_cohort_names())

    if(isFALSE(input$cohort_count_person_count)){
      result <- result  |>
        dplyr::filter(!stringr::str_detect(.data$variable_name, "subjects"))
    }
    if(isFALSE(input$cohort_count_record_count)){
      result <- result  |>
        dplyr::filter(!stringr::str_detect(.data$variable_name, "records"))
    }

    validateFilteredResult(result)

    return(result)
  }))

  ## Table summarise_cohort_attrition ----
  createTableCohortAttrition <- shiny::reactive({
    filterCohortAttrition() |>
      CohortCharacteristics::tableCohortAttrition() |>
      tab_header(
        title = "Cohort attrition",
        subtitle = "Attrition of the study cohorts."
      ) |>
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_cohort_attrition_gt <- gt::render_gt({
    createTableCohortAttrition()
  })
  output$summarise_cohort_attrition_gt_download <- shiny::downloadHandler(
    filename = "summarise_cohort_attrition_gt.docx",
    content = function(file) {
      obj <- createTableCohortAttrition()
      gt::gtsave(data = obj, filename = file)
    }
  )
  ## Diagram summarise_cohort_attrition -----
  createDiagramCohortAttrition <- shiny::reactive({
    result <- filterCohortAttrition()

    n <- result |>
      select(cdm_name, group_level) |>
      distinct() |>
      nrow()

    CohortCharacteristics::plotCohortAttrition(
      result
    )

  })
  output$summarise_cohort_attrition_grViz <- DiagrammeR::renderGrViz({
    createDiagramCohortAttrition()
  })
  output$summarise_cohort_attrition_grViz_download <- shiny::downloadHandler(
    filename = "summarise_cohort_attrition_diagram.png",
    content = function(file) {
      createDiagramCohortAttrition() |>
        DiagrammeRsvg::export_svg() |>
        charToRaw() |>
        rsvg::rsvg_png(file,
                       width = input$summarise_cohort_attrition_grViz_download_width,
                       height = input$summarise_cohort_attrition_grViz_download_height)
    }
  )


  # summarise_characteristics -----
  filterSummariseCharacteristics <- eventReactive(input$updateCohortCharacteristics, ({

    if (is.null(dataFiltered$summarise_characteristics)) {
      validate("No cohort characteristics in results")
    }

    selectedCohorts <- shared_cohort_names()

    if(isTRUE(input$summarise_characteristics_include_matched)){
      selectedCohorts <- as.vector(t(outer(selectedCohorts, c("", "_sampled", "_matched"), paste0)))
    }

    result <- dataFiltered$summarise_characteristics |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$group_level %in% selectedCohorts) |>
      dplyr::mutate(group_level = factor(group_level, levels = selectedCohorts)) |>
      arrange(group_level)

    validateFilteredResult(result)

    return(result)
  }))
  ## Table summarise_characteristics -----
  createTableSummariseCharacteristics <- shiny::reactive({
    filterSummariseCharacteristics() |>
      CohortCharacteristics::tableCharacteristics(
        header = input$summarise_characteristics_gt_header,
        groupColumn = input$summarise_characteristics_gt_groupColumn,
        hide = c(input$summarise_characteristics_gt_hide,
                 "table_name", "value", "window", "table")
      ) %>%
      tab_header(
        title = "Patient characteristics",
        subtitle = "Summary of patient characteristics relative to cohort entry. Please be aware that statistics are calculated by record, not by subject."
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_characteristics_gt <- gt::render_gt({
    createTableSummariseCharacteristics()
  })
  output$summarise_characteristics_gt_download <- shiny::downloadHandler(
    filename = "summarise_characteristics_gt.docx",
    content = function(file) {
      obj <- createTableSummariseCharacteristics()
      gt::gtsave(data = obj, filename = file)
    }
  )

  ## Plot age_pyramid ----
  createAgePyramid <- eventReactive(input$updateCohortCharacteristics, ({
    summarise_characteristics <- filterSummariseCharacteristics()

    summarise_table <- dataFiltered$summarise_table |>
      filter(cdm_name %in% shared_cdm_names())
    selectedCohorts <- shared_cohort_names()
    if(isTRUE(input$summarise_characteristics_include_matched)){
      selectedCohorts <- as.vector(t(outer(selectedCohorts, c("", "_sampled", "_matched"), paste0)))
    }
    summarise_table <- summarise_table |>
      dplyr::filter(.data$group_level %in% selectedCohorts) |>
      dplyr::mutate(group_level = factor(group_level, levels = selectedCohorts)) |>
      arrange(group_level)

    if (nrow(summarise_table) == 0 || nrow(summarise_characteristics) == 0 ) {
      validate("No results found for selected inputs")
    }


    if (nrow(summarise_table) == 0 || nrow(summarise_characteristics) == 0 ) {
      validate("No results found for selected inputs")
    }

    plotAgeDensity(summarise_table, summarise_characteristics, input$summarise_characteristics_add_interquantile_range)

  }))

  output$plot_age_pyramid <- shiny::renderPlot({
    createAgePyramid()
  })

  output$plot_age_pyramid_download <- shiny::downloadHandler(
    filename = "age_pyramid_plot.png",
    content = function(file) {
      obj <- createAgePyramid()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$plot_age_pyramid_download_width),
        height = as.numeric(input$plot_age_pyramid_download_height),
        units = input$plot_age_pyramid_download_units,
        dpi = as.numeric(input$plot_age_pyramid_download_dpi)
      )
    }
  )

  # summarise_large_scale_characteristics -----
  filterLargeScaleCharacteristics <- eventReactive(input$updateLSC, ({

    if (is.null(dataFiltered$summarise_large_scale_characteristics)) {
      validate("No large scale characteristics in results")
    }

    lsc_data <- dataFiltered$summarise_large_scale_characteristics |>
      filter(!is.na(estimate_value)) |>
      filter(estimate_value != "-") |>
      visOmopResults::filterSettings(table_name %in% input$summarise_large_scale_characteristics_table_name,
                                     analysis %in% input$summarise_large_scale_characteristics_analysis) |>
      dplyr::filter(cdm_name %in% shared_cdm_names()) |>
      dplyr::filter(group_level  %in% shared_cohort_names()) |>
      dplyr::filter(variable_level  %in% input$summarise_large_scale_characteristics_variable_level)

    validateFilteredResult(lsc_data)

    return(lsc_data)
  }))
  ## Table summarise_characteristics -----
  tidyLargeScaleCharacteristics <- shiny::reactive({
    tidy_lsc <- filterLargeScaleCharacteristics()

    tidy_lsc <- tidy_lsc |>
      tidy() |>
      mutate(concept = paste0(variable_name, " (",
                              concept_id, ")"))

    if("source_concept_id" %in% colnames(tidy_lsc)){
      tidy_lsc <- tidy_lsc |>
        mutate(source_concept = paste0(source_concept_name, " (",
                                       source_concept_id, ")"))
    }

    tidy_lsc <- tidy_lsc |>
      dplyr::select(dplyr::any_of(c("cdm_name",
                                    "cohort_name",
                                    "concept",
                                    "source_concept",
                                    "time_window" = "variable_level",
                                    "count",
                                    "percentage")))
    return(tidy_lsc)
  })

  ## Table summarise_large_scale_characteristics -----
  output$summarise_large_scale_characteristics_tidy <- shiny::renderUI({
    tbl_data <- tidyLargeScaleCharacteristics()

    if("source_concept" %in% colnames(tbl_data)){
      tbl_data <- tbl_data |>
        rename("CDM name" = "cdm_name",
               "Cohort" = "cohort_name",
               "Time window" = "time_window",
               "Concept name (concept ID)" = "concept",
               "Source concept name (concept ID)" = "source_concept")
      cols <- list("Concept name (concept ID)" = colDef(name = "Concept name (concept ID)",
                                                        cell = function(value){
                                                          value_concept <- gsub(".*\\(|\\)","",value)
                                                          url   <- sprintf("https://athena.ohdsi.org/search-terms/terms/%s", value_concept)
                                                          htmltools::tags$a(href = url, target = "_blank", as.character(value))
                                                        }),
                   "Source concept name (concept ID)" = colDef(name = "Source concept name (concept ID)",
                                                               cell = function(value){
                                                                 value_concept <- gsub(".*\\(|\\)","",value)
                                                                 url   <- sprintf("https://athena.ohdsi.org/search-terms/terms/%s", value_concept)
                                                                 htmltools::tags$a(href = url, target = "_blank", as.character(value))
                                                               }),
                   count = colDef(format = colFormat(separators = TRUE)),
                   percentage = colDef(format = colFormat(percent = TRUE))
      )
    } else {
      tbl_data <- tbl_data |>
        rename("CDM name" = "cdm_name",
               "Cohort" = "cohort_name",
               "Time window" = "time_window",
               "Concept name (concept ID)" = "concept")
      cols <- list("Concept name (concept ID)" = colDef(name = "Concept name (concept ID)",
                                                        cell = function(value){
                                                          value_concept <- gsub(".*\\(|\\)","",value)
                                                          url   <- sprintf("https://athena.ohdsi.org/search-terms/terms/%s", value_concept)
                                                          htmltools::tags$a(href = url, target = "_blank", as.character(value))
                                                        }),
                   count = colDef(format = colFormat(separators = TRUE)),
                   percentage = colDef(format = colFormat(percent = TRUE))
      )

    }

    reactable(tbl_data |>
                mutate(percentage = percentage / 100), # to use colFormat
              defaultSorted = list("percentage"  = "desc"),
              columns = cols,
              filterable = TRUE,
              searchable = TRUE,
              defaultPageSize = 25,
              highlight = TRUE,
              striped = TRUE,
              compact = TRUE,
              showSortable = TRUE) |>
      reactablefmtr::add_title("Large scale characteristics",
                               font_size = 25,
                               font_weight = "normal") |>
      reactablefmtr::add_subtitle("Summary of all records from clinical tables within a time window. The sampled cohort represents individuals from the original cohort, the matched cohort comprises individuals of similar age and sex from the database.",
                                  font_size = 15,
                                  font_weight = "normal")

  })

  output$summarise_large_scale_characteristics_tidy_download <- shiny::downloadHandler(
    filename = "summarise_large_scale_characteristics_tidy.csv",
    content = function(file) {
      tidyLargeScaleCharacteristics() |>
        readr::write_csv(file = file)
    }
  )
  ## Table summarise_large_scale_characteristics -----
  createTableLargeScaleCharacteristics <- shiny::reactive({

    lsc_data <- filterLargeScaleCharacteristics()

    lsc_data |>
      CohortCharacteristics::tableTopLargeScaleCharacteristics(
        topConcepts = input$summarise_large_scale_characteristics_top_concepts) |>
      tab_header(
        title = "Top concepts in large scale characteristics",
        subtitle = "Summary of the most prevalent concepts by percentage across each cohort."
      ) |>
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_large_scale_characteristics_gt <- gt::render_gt({
    createTableLargeScaleCharacteristics()
  })
  output$summarise_large_scale_characteristics_gt_download <- shiny::downloadHandler(
    filename = "summarise_large_scale_characteristics_gt.docx",
    content = function(file) {
      obj <- createTableLargeScaleCharacteristics()
      gt::gtsave(data = obj, filename = file)
    }
  )

  # compare large_scale_characteristics ----
  getComparedCohorts <- eventReactive(input$updateCompareLSC, ({

    cohort <- shared_cohort_names()

    if(length(cohort) > 1){
      validate("Please select only one cohort")
    }

    if(length(cohort) == 0){
      validate("Please select a cohort")
    }

    cohort1 <- switch(input$compare_large_scale_characteristics_cohort_1,
                      "original" = cohort,
                      "sampled" = paste0(cohort,"_sampled"),
                      "matched" = paste0(cohort,"_matched"))

    cohort2 <- switch(input$compare_large_scale_characteristics_cohort_2,
                      "original" = input$compare_large_scale_characteristics_cohort_compare,
                      "sampled" = paste0(input$compare_large_scale_characteristics_cohort_compare,"_sampled"),
                      "matched" = paste0(input$compare_large_scale_characteristics_cohort_compare,"_matched"))

    return(list("cohort1" = cohort1,
                "cohort2" = cohort2))
  }))
  filterCompareLargeScaleCharacteristics <- shiny::reactive({
    shiny::observeEvent(shared_cdm_names(), {
      updatePickerInput(session, "compare_large_scale_characteristics_cdm_name",   selected = shared_cdm_names())
    })

    shiny::observeEvent(shared_cohort_names(), {
      updatePickerInput(session, "compare_large_scale_characteristics_cohort_name",   selected = shared_cohort_names())
    })

    if (is.null(dataFiltered$summarise_large_scale_characteristics)) {
      validate("No large scale characteristics in results")
    }

    cohorts <- getComparedCohorts()
    cohort1 <- cohorts$cohort1
    cohort2 <- cohorts$cohort2

    lsc_filtered <- dataFiltered$summarise_large_scale_characteristics |>
      visOmopResults::filterSettings(.data$table_name %in% input$compare_large_scale_characteristics_table_name,
                                     .data$analysis %in% input$compare_large_scale_characteristics_analysis) |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$group_level %in% c(cohort1, cohort2),
                    .data$variable_level %in% input$compare_large_scale_characteristics_variable_level)

    validateFilteredResult(lsc_filtered)

    return(lsc_filtered)
  })
  ## Tidy compare large_scale_characteristics ----
  createTidyDataCompareLargeScaleCharacteristics <- shiny::reactive({

    lscFiltered <- filterCompareLargeScaleCharacteristics()
    cohorts <- getComparedCohorts()
    target_cohort     <- cohorts$cohort1
    comparator_cohort <- cohorts$cohort2

    if("matchedSample" %in% (lscFiltered |> omopgenerics::settings() |> colnames())){
      msg <- paste0("Matched cohort was created based on a subsample of ", omopgenerics::settings(lscFiltered) |> dplyr::pull("matchedSample") |> unique()," individuals.")
    }else{
      msg <- ""
    }
    lsc <- lscFiltered |>
      dplyr::filter(.data$estimate_name == "percentage") |>
      tidy() |>
      tidyr::pivot_wider(names_from = cohort_name,
                         values_from = percentage)

    if(isTRUE(input$compare_large_scale_characteristics_impute_missings)){
      lsc <- lsc |>
        dplyr::mutate(across(c(target_cohort, comparator_cohort), ~if_else(is.na(.x), 0, .x)))
    }

    lsc <- lsc |>
      dplyr::mutate(across(c(target_cohort, comparator_cohort), ~ as.numeric(.x)/100)) |>
      dplyr::mutate(smd = (!!sym(target_cohort) - !!sym(comparator_cohort))/sqrt((!!sym(target_cohort)*(1-!!sym(target_cohort)) + !!sym(comparator_cohort)*(1-!!sym(comparator_cohort)))/2)) |>
      dplyr::mutate(smd = if_else(is.na(smd), 0, round(smd, 2))) |>
      dplyr::arrange(desc(smd))  |>
      mutate(concept = paste0(variable_name, " (",concept_id, ")"))

    if("source_concept_name" %in% colnames(lsc)){
      lsc <- lsc |>
        mutate(source_concept = paste0(source_concept_name, " (",source_concept_id, ")"))
    }

    lsc <- lsc |>
      select(dplyr::any_of(c(
        "CDM name" = "cdm_name",
        "Concept name (concept ID)" = "concept",
        "Source concept name (concept ID)" = "source_concept",
        "Table" = "table_name",
        "Time window" = "variable_level",
        target_cohort,
        comparator_cohort,
        "Standardised mean difference" = "smd"))) |>
      dplyr::mutate(msg)

    return(lsc)
  })

  output$compare_large_scale_characteristics_tidy <- reactable::renderReactable({
    cohorts <- getComparedCohorts()
    target_cohort <- cohorts$cohort1
    comparator_cohort <- cohorts$cohort2

    tbl <- createTidyDataCompareLargeScaleCharacteristics()
    msg <- tbl$msg |> unique()
    tbl <- tbl |> dplyr::select(-"msg")

    if("Source concept name (concept ID)" %in% colnames(tbl)){
      cols <- list(target_cohort = colDef(name = paste0(target_cohort, " percentage"),
                                          format = colFormat(percent = TRUE),
                                          sortNALast = TRUE),
                   comparator_cohort = colDef(name = paste0(comparator_cohort, " percentage"),
                                              format = colFormat(percent = TRUE),
                                              sortNALast = TRUE),
                   "Concept name (concept ID)" = colDef(name = "Concept name (concept ID)",
                                                        cell = function(value){
                                                          value_concept <- gsub(".*\\(|\\)","",value)
                                                          url   <- sprintf("https://athena.ohdsi.org/search-terms/terms/%s", value_concept)
                                                          htmltools::tags$a(href = url, target = "_blank", as.character(value))
                                                        }),
                   "Source concept name (concept ID)" = colDef(name = "Source  concept name (concept ID)",
                                                               cell = function(value){
                                                                 value_concept <- gsub(".*\\(|\\)","",value)
                                                                 url   <- sprintf("https://athena.ohdsi.org/search-terms/terms/%s", value_concept)
                                                                 htmltools::tags$a(href = url, target = "_blank", as.character(value))
                                                               }),
                   "Standardised mean difference" = colDef(name = "Standardised mean difference",
                                                           sortNALast = TRUE)
      )
    } else {
      cols <- list(target_cohort = colDef(name = paste0(target_cohort, " percentage"),
                                          format = colFormat(percent = TRUE),
                                          sortNALast = TRUE),
                   comparator_cohort = colDef(name = paste0(comparator_cohort, " percentage"),
                                              format = colFormat(percent = TRUE),
                                              sortNALast = TRUE),
                   "Concept name (concept ID)" = colDef(name = "Concept name (concept ID)",
                                                        cell = function(value){
                                                          value_concept <- gsub(".*\\(|\\)","",value)
                                                          url   <- sprintf("https://athena.ohdsi.org/search-terms/terms/%s", value_concept)
                                                          htmltools::tags$a(href = url, target = "_blank", as.character(value))
                                                        }),
                   "Standardised mean difference" = colDef(name = "Standardised mean difference",
                                                           sortNALast = TRUE)
      )
    }


    names(cols)[1] <- target_cohort
    names(cols)[2] <- comparator_cohort

    table <- reactable::reactable(tbl,
                         defaultSorted = list("Standardised mean difference"  = "desc"),
                         columns = cols,
                         filterable = TRUE,
                         searchable = TRUE,
                         defaultPageSize = 25,
                         highlight = TRUE,
                         striped = TRUE,
                         compact = TRUE,
                         showSortable = TRUE)

    return(table)
  })

  output$compare_large_scale_characteristics_tidy_download <- shiny::downloadHandler(
    filename = "compare_large_scale_characteristics_tidy.csv",
    content = function(file) {
      createTidyDataCompareLargeScaleCharacteristics() |>
        readr::write_csv(file = file)
    }
  )

  ## Plot compare large_scale_characteristics ----
  getPlotlyCompareLsc <- shiny::reactive({
    cohorts <- getComparedCohorts()
    plotComparedLsc(lsc = filterCompareLargeScaleCharacteristics(),
                    cohorts = c(cohorts$cohort1, cohorts$cohort2),
                    colour = c(input$compare_large_scale_characteristics_colour_1),
                    facet  = c(input$compare_large_scale_characteristics_facet_1),
                    imputeMissings = input$compare_large_scale_characteristics_impute_missings
    )
  })

  output$plotly_compare_lsc <- renderPlotly({
    ggplotly(getPlotlyCompareLsc(), tooltip = "Details")
  })

  output$plot_compare_large_scale_characteristics_download <- shiny::downloadHandler(
    filename = "output_ggplot2_compare_large_scale_characteristics.png",
    content = function(file) {
      obj <- getPlotlyCompareLsc()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$plot_compare_large_scale_characteristics_download_width),
        height = as.numeric(input$plot_compare_large_scale_characteristics_download_height),
        units = input$plot_compare_large_scale_characteristics_download_units,
        dpi = as.numeric(input$plot_compare_large_scale_characteristics_download_dpi)
      )
    }
  )

  # summarise_cohort_overlap -----
  filterCohortOverlap <- eventReactive(input$updateCompareCohorts, ({

    if (is.null(dataFiltered$summarise_cohort_overlap)) {
      validate("No cohort overlap in results")
    }

    result <- dataFiltered$summarise_cohort_overlap |>
      visOmopResults::splitGroup(keep = TRUE) |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$cohort_name_reference %in% shared_cohort_names(),
                    .data$cohort_name_comparator %in% input$summarise_cohort_overlap_cohort_comparator,
                    .data$variable_name %in% input$summarise_cohort_overlap_variable_name
      ) |>
      dplyr::select(-visOmopResults::groupColumns(dataFiltered$summarise_cohort_overlap))

    validateFilteredResult(result)
    return(result)
  }))
  ## Table cohort_overlap -----
  createTableCohortOverlap <- shiny::reactive({

    result <- filterCohortOverlap()

    CohortCharacteristics::tableCohortOverlap(
      result,
      uniqueCombinations = input$summarise_cohort_overlap_gt_uniqueCombinations,
      header = input$summarise_cohort_overlap_gt_header,
      groupColumn = input$summarise_cohort_overlap_gt_groupColumn,
      hide = input$summarise_cohort_overlap_gt_hide
    ) %>%
      tab_header(
        title = "Cohort overlap",
        subtitle = "Overlap is where the same individual is in both cohorts. Note their cohort entries do not necessarily overlap."
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_cohort_overlap_gt <- gt::render_gt({
    createTableCohortOverlap()
  })
  output$summarise_cohort_overlap_gt_download <- shiny::downloadHandler(
    filename = "summarise_cohort_overlap_gt.docx",
    content = function(file) {
      obj <- createTableCohortOverlap()
      gt::gtsave(data = obj, filename = file)
    }
  )

  ## Plot cohort_overlap -----
  createPlotCohortOverlap <- shiny::reactive({
    result <- filterCohortOverlap()

    CohortCharacteristics::plotCohortOverlap(
      result,
      colour = input$summarise_cohort_overlap_plot_colour,
      facet = input$summarise_cohort_overlap_plot_facet,
      uniqueCombinations = input$summarise_cohort_overlap_plot_uniqueCombinations
    )
  })
  output$summarise_cohort_overlap_plot <- plotly::renderPlotly({
    createPlotCohortOverlap()
  })
  output$summarise_cohort_overlap_plot_download <- shiny::downloadHandler(
    filename = "summarise_cohort_overlap_plot.png",
    content = function(file) {
      obj <- createPlotCohortOverlap()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$summarise_cohort_overlap_plot_download_width),
        height = as.numeric(input$summarise_cohort_overlap_plot_download_height),
        units = input$summarise_cohort_overlap_plot_download_units,
        dpi = as.numeric(input$summarise_cohort_overlap_plot_download_dpi)
      )
    }
  )

  # summarise_cohort_timing ----
  filterCohortTiming <- eventReactive(input$updateCompareCohorts, ({

    if (is.null(dataFiltered$summarise_cohort_timing)) {
      validate("No cohort timing in results")
    }

    result <- dataFiltered$summarise_cohort_timing |>
      visOmopResults::splitGroup(keep = TRUE) |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names(),
                    .data$cohort_name_reference %in% shared_cohort_names(),
                    .data$cohort_name_comparator %in% input$summarise_cohort_overlap_cohort_comparator) |>
      dplyr::select(-visOmopResults::groupColumns(dataFiltered$summarise_cohort_timing))

    validateFilteredResult(result)

    return(result)
  }))

  ## Table cohort_timing -----
  createTableCohortTiming <- shiny::reactive({

    result <- filterCohortTiming()

    CohortCharacteristics::tableCohortTiming(
      result,
      timeScale = input$summarise_cohort_timing_gt_time_scale,
      uniqueCombinations = input$summarise_cohort_timing_gt_uniqueCombinations,
    ) %>%
      tab_header(
        title = "Cohort timing",
        subtitle = "Cohort timing refers to the time between an individual entering one cohort and another cohort."
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$summarise_cohort_timing_gt <- gt::render_gt({
    createTableCohortTiming()
  })
  output$summarise_cohort_timing_gt_download <- shiny::downloadHandler(
    filename = "summarise_cohort_timing_gt.docx",
    content = function(file) {
      obj <- createTableCohortTiming()
      gt::gtsave(data = obj, filename = file)
    }
  )

  ## Plot cohort_timing -----
  createPlotCohortTiming <- shiny::reactive({
    CohortCharacteristics::plotCohortTiming(
      filterCohortTiming(),
      plotType = "densityplot",
      timeScale = input$summarise_cohort_timing_plot_time_scale,
      uniqueCombinations = input$summarise_cohort_timing_plot_uniqueCombinations,
      facet = input$summarise_cohort_timing_plot_facet,
      colour = input$summarise_cohort_timing_plot_colour
    )
  })
  output$summarise_cohort_timing_plot <- plotly::renderPlotly({
    createPlotCohortTiming()
  })
  output$summarise_cohort_timing_plot_download <- shiny::downloadHandler(
    filename = "summarise_cohort_timing_plot.png",
    content = function(file) {
      obj <- createPlotCohortTiming()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$summarise_cohort_timing_plot_download_width),
        height = as.numeric(input$summarise_cohort_timing_plot_download_height),
        units = input$summarise_cohort_timing_plot_download_units,
        dpi = as.numeric(input$summarise_cohort_timing_plot_download_dpi)
      )
    }
  )
  # summarise cohort survival -----
  filterCohortSurvival <- eventReactive(input$updateCohortSurvival, ({

    if (is.null(dataFiltered$survival_probability)) {
      validate("No survival in results")
    }

    if(input$survival_porbability_include_matches){
      cohorts <- c(paste0(shared_cohort_names(),"_sampled"),
                   paste0(shared_cohort_names(),"_matched"))
    }else{
      cohorts <- shared_cohort_names()
    }
    result <- omopgenerics::bind(
      dataFiltered$survival_attrition,
      dataFiltered$survival_events,
      dataFiltered$survival_probability,
      dataFiltered$survival_summary) |>
      dplyr::filter(.data$cdm_name %in% shared_cdm_names()) |>
      visOmopResults::filterGroup(.data$target_cohort %in% cohorts)

    validateFilteredResult(result)
    return(result)
  }))

  getTimeScale <- eventReactive(input$updateCohortSurvival, ({
    timeScale <- input$survival_probability_time_scale
    return(timeScale)
  }))

  ## Table cohort survival -----
  createTableSurvival <- shiny::reactive({
    result <- filterCohortSurvival()
    timeScale <- getTimeScale()

    table <- CohortSurvival::tableSurvival(result,
                                           timeScale = timeScale,
                                           header    = input$survival_table_header,
                                           groupColumn = input$survival_table_groupColumn) |>
      tab_header(
        title = "Single Event Survival Summary",
        subtitle = "Time from cohort entry to death"
      ) |>
      tab_options(
        heading.align = "left"
      )

    return(table)
  })

  output$summarise_cohort_survival_gt <- gt::render_gt({
    createTableSurvival()
  })
  output$summarise_cohort_survival_gt_download <- shiny::downloadHandler(
    filename = "summarise_cohort_survival_gt.docx",
    content = function(file) {
      obj <- createTableSurvival()
      gt::gtsave(data = obj, filename = file)
    }
  )

  ## Plot cohort survival ----
  createPlotSurvival <- shiny::reactive({
    result <- filterCohortSurvival()
    timeScale <- getTimeScale()

    CohortSurvival::plotSurvival(result,
                                 timeScale = timeScale,
                                 ribbon = input$survival_plot_ribbon,
                                 facet = input$survival_plot_facet,
                                 colour = input$survival_plot_colour,
                                 logLog = input$survival_plot_log_log,
                                 cumulativeFailure = input$survival_plot_cf) +
      labs(color = "Color") +
      guides(fill = "none")
  })
  output$summarise_cohort_survival_plot <- shiny::renderUI({
    if(isTRUE(input$survival_plot_interactive)){
      plot <- plotly::ggplotly(createPlotSurvival())
    } else {
      plot <- renderPlot(createPlotSurvival())
    }
    plot
  })
  output$summarise_cohort_survival_plot_download <- shiny::downloadHandler(
    filename = "summarise_cohort_survival_plot.png",
    content = function(file) {
      obj <- createPlotSurvival()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$summarise_cohort_survival_plot_download_width),
        height = as.numeric(input$summarise_cohort_survival_plot_download_height),
        units = input$summarise_cohort_survival_plot_download_units,
        dpi = as.numeric(input$summarise_cohort_survival_plot_download_dpi)
      )
    }
  )

  # incidence -----
  filterIncidence <- eventReactive(input$updateIncidence, ({

    if (is.null(dataFiltered$incidence)) {
      validate("No incidence in results")
    }

    result <- dataFiltered$incidence |>
      filter(cdm_name %in% shared_cdm_names()) |>
      filterGroup(outcome_cohort_name %in% shared_cohort_names()) |>
      filterSettings(denominator_age_group %in%
                       input$incidence_denominator_age_group,
                     denominator_sex %in%
                       input$incidence_denominator_sex,
                     denominator_days_prior_observation %in%
                       input$incidence_denominator_days_prior_observation) |>
      filterAdditional(analysis_interval %in%
                         input$incidence_analysis_interval)

    validateFilteredResult(result)
    return(result)
  }))

  ## Table incidence -----
  createTableIncidence <- shiny::reactive({

    IncidencePrevalence::tableIncidence(
      filterIncidence(),
      groupColumn = c("cdm_name", "outcome_cohort_name"),
      hide = "denominator_cohort_name",
      settingsColumn = c("denominator_age_group",
                         "denominator_sex",
                         "denominator_days_prior_observation",
                         "outcome_cohort_name")
    ) %>%
      tab_header(
        title = "Incidence estimates",
        subtitle = "Incidence rates estimated for outcomes of interest"
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$incidence_gt <- gt::render_gt({
    createTableIncidence()
  })
  output$incidence_gt_download <- shiny::downloadHandler(
    filename = "incidence_gt.docx",
    content = function(file) {
      obj <- createTableIncidence()
      gt::gtsave(data = obj, filename = file)
    }
  )
  ## Plot incidence -----
  createPlotIncidence <- shiny::reactive({
    result <- filterIncidence()

    x <- input$incidence_plot_x
    y <- input$incidence_plot_y
    facet      <- input$incidence_plot_facet
    facet_free <- input$incidence_plot_facet_free
    colour     <- input$incidence_plot_colour

    # Plot incidence estimates
    if(y == "Incidence"){
      plot <- IncidencePrevalence::plotIncidence(
        result,
        x = x,
        ribbon = FALSE,
        facet = facet,
        colour = colour
      )
      plot$data <- plot$data |>
        filter(incidence_100000_pys > 0)

      if(!is.null(facet) && isTRUE(facet_free)){
        plot <- plot +
          facet_wrap(facets = facet, scales = "free")
      }
    }else{
      # Plot incidence population
      y_input <- case_when(
        y == "Denominator count" ~ "denominator_count",
        y == "Denominator person years" ~ "person_years",
        y == "Outcome count" ~ "outcome_count"
      )
      if(!is.null(facet) && isTRUE(facet_free)){
        plot <- plotIncidencePopulation(x = x,
                                        y =  y_input,
                                        result = result,
                                        facet  = NULL,
                                        colour = colour

        ) +
          facet_wrap(facets = facet, scales = "free")
      } else {
        plot <- plotIncidencePopulation(x = x,
                                        y =  y_input,
                                        result = result,
                                        facet  = facet,
                                        colour = colour

        )
      }
    }
    return(plot)
  })

  output$incidence_plot <- shiny::renderUI({
    if(isTRUE(input$incidence_plot_interactive)){
      plot <- plotly::ggplotly(createPlotIncidence())
    } else {
      plot <- renderPlot(createPlotIncidence())
    }
    plot
  })
  output$incidence_plot_download <- shiny::downloadHandler(
    filename = "incidence_plot.png",
    content = function(file) {
      obj <- createPlotIncidence()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$incidence_plot_download_width),
        height = as.numeric(input$incidence_plot_download_height),
        units = input$incidence_plot_download_units,
        dpi = as.numeric(input$incidence_plot_download_dpi)
      )
    }
  )

  # prevalence -----
  filterPrevalence <- eventReactive(input$updatePrevalence, ({

    if (is.null(dataFiltered$prevalence)) {
      validate("No prevalence in results")
    }

    result <- dataFiltered$prevalence |>
      filter(cdm_name %in% shared_cdm_names()) |>
      filterGroup(outcome_cohort_name %in% shared_cohort_names()) |>
      filterSettings(denominator_age_group %in%
                       input$prevalence_denominator_age_group,
                     denominator_sex %in%
                       input$prevalence_denominator_sex,
                     denominator_days_prior_observation %in%
                       input$prevalence_denominator_days_prior_observation) |>
      filterAdditional(analysis_interval %in%
                         input$prevalence_analysis_interval)

    validateFilteredResult(result)

    return(result)
  }))
  ## Table prevalence ----
  createTablePrevalence <- shiny::reactive({
    result <- filterPrevalence()

    IncidencePrevalence::tablePrevalence(
      result,
      groupColumn = c("cdm_name", "outcome_cohort_name"),
      hide = "denominator_cohort_name",
      settingsColumn = c("denominator_age_group",
                         "denominator_sex",
                         "denominator_days_prior_observation",
                         "outcome_cohort_name")
    ) %>%
      tab_header(
        title = "Prevalence estimates",
        subtitle = "Prevalence rates estimated for outcomes of interest"
      ) %>%
      tab_options(
        heading.align = "left"
      )
  })
  output$prevalence_gt <- gt::render_gt({
    createTablePrevalence()
  })
  output$prevalence_gt_download <- shiny::downloadHandler(
    filename = "prevalence_gt.docx",
    content = function(file) {
      obj <- createTablePrevalence()
      gt::gtsave(data = obj, filename = file)
    }
  )
  ## Plot prevalence ----
  createPlotPrevalence <- shiny::reactive({
    result <- filterPrevalence()

    x <- input$prevalence_plot_x
    y <- input$prevalence_plot_y
    facet <- input$prevalence_plot_facet
    facet_free <- input$prevalence_plot_facet_free
    colour <- input$prevalence_plot_colour

    if(y == "Prevalence"){
      plot <- IncidencePrevalence::plotPrevalence(
        result,
        x = x,
        ribbon = FALSE,
        facet = facet,
        colour = colour
      )
      plot$data$prevalence_95CI_lower <- round(plot$data$prevalence_95CI_lower, 6)
      plot$data$prevalence_95CI_upper <- round(plot$data$prevalence_95CI_upper, 6)
      plot$data <- plot$data |>
        dplyr::mutate(prevalence = round((outcome_count/denominator_count),6))

      if(!is.null(facet) && isTRUE(facet_free)){
        plot <- plot +
          facet_wrap(facets = facet, scales = "free")
      }
    }else{
      y_input <- case_when(
        y == "Denominator count" ~ "denominator_count",
        y == "Outcome count" ~ "outcome_count"
      )
      if(!is.null(facet) && isTRUE(input$facet_free)){
        plot <- IncidencePrevalence::plotPrevalencePopulation(
          result = result,
          x = x,
          y = y_input,
          facet = NULL,
          colour = colour) +
          facet_wrap(facets = facet, scales = "free")
      } else {
        plot <- IncidencePrevalence::plotPrevalencePopulation(
          result = result,
          x = x,
          y = y_input,
          facet = facet,
          colour = colour
        )
      }
    }

    return(plot)

  })

  output$prevalence_plot <- shiny::renderUI({
    if(isTRUE(input$prevalence_plot_interactive)){
      plot <- plotly::ggplotly(createPlotPrevalence())
    } else {
      plot <- renderPlot(createPlotPrevalence())
    }
    plot

  })
  output$prevalence_plot_download <- shiny::downloadHandler(
    filename = "prevalence_plot.png",
    content = function(file) {
      obj <- createPlotPrevalence()
      ggplot2::ggsave(
        filename = file,
        plot = obj,
        width = as.numeric(input$prevalence_plot_download_width),
        height = as.numeric(input$prevalence_plot_download_height),
        units = input$prevalence_plot_download_units,
        dpi = as.numeric(input$prevalence_plot_download_dpi)
      )
    }
  )

  # expectations ----
  createExpectationsOutput <- function(trigger_input, output_id) {
    filteredExpectations <- eventReactive(trigger_input(), {
      validateExpectations(expectations)

      section_name <- gsub("_expectations","",output_id)

      result <- expectations |>
        dplyr::filter(.data$cohort_name %in% shared_cohort_names())

      section_name <- gsub("_expectations","",output_id)

      if("diagnostics" %in% colnames(expectations)){
        result <- result |>
          mutate(diagnostics = strsplit(diagnostics, ",\\s*"))  |>
          unnest(diagnostics)

        validateExpectationSections(result)

        result <- result |>
          dplyr::filter(.data$diagnostics %in% section_name)
      }

      if(nrow(result) == 0){
        section_name_nice <- stringr::str_replace_all(section_name, "_", " ")
        validate(glue::glue("No expectations for {section_name_nice} results."))
      }
      result
    })

    output[[output_id]] <- reactable::renderReactable({
      filteredExpectations() |>
        PhenotypeR::tableCohortExpectations()
    })
  }

  createExpectationsOutput(reactive(input$updateCohortCount), "cohort_count_expectations")
  createExpectationsOutput(reactive(input$updateCohortCharacteristics), "cohort_characteristics_expectations")
  createExpectationsOutput(reactive(input$updateLSC), "large_scale_characteristics_expectations")
  createExpectationsOutput(reactive(input$updateCompareLSC), "compare_large_scale_characteristics_expectations")
  createExpectationsOutput(reactive(input$updateCompareCohorts), "compare_cohorts_expectations")
  createExpectationsOutput(reactive(input$updateCohortSurvival), "cohort_survival_expectations")
}