R/ShinyApp.R

In A1exanderAlexeyuk/ODYPACK:

#' @export
#' @importFrom magrittr %>%
runShiny <- function() {


  pathToCsv <- system.file(
    "settings",
    "concept_phenotypes.csv",
    package = "ODYPACK"
  )
  df <- read.csv(pathToCsv)


  ui <- shinydashboard::dashboardPage(
    shinydashboard::dashboardHeader(title = "Phenotype Library"),

    shinydashboard::dashboardSidebar(
      shiny::selectInput("phenotype", "Phenotype Name", choices = df %>%
                      dplyr::select(phenotype) %>%
                      dplyr::distinct() %>%
                      dplyr::arrange(phenotype)
                      )
    ),
    shinydashboard::dashboardBody(
      shiny::fluidRow(shiny::textOutput("ph1")),
    )
  )

  server <- function(input, output) {

    output$ph1 <- shiny::renderText({



      inclusion <- df %>%
        dplyr::filter(
          phenotype == input$phenotype &
            criteria == "inclusion"
        )

      exclusion <- df %>%
        dplyr::filter(phenotype == input$phenotype &
                        criteria == "exclusion"
        )

      stndrdDscdnts <- inclusion %>%
        dplyr::filter(include_descendants == 1) %>%
        dplyr::pull(concept_id) %>%
        paste(collapse = ", ")

      domainsStndrdDscdnts <- inclusion %>%
        dplyr::filter(include_descendants == 1) %>%
        dplyr::select(domain_id) %>% unique()

      stndrdWODscdnts <- inclusion %>%
        dplyr::filter(include_descendants == 0) %>%
        dplyr::pull(concept_id) %>%
        paste(collapse = ", ")

      domainsWOStndrdDscdnts <- inclusion %>%
        dplyr::filter(include_descendants == 0) %>%
        dplyr::select(domain_id) %>% unique()

      srcConceptIds <- inclusion %>%
        dplyr::filter(stringr::str_detect(phenotype, "source_concept")) %>%
        dplyr::pull(concept_id) %>%
        paste(collapse = ", ")
      domainsSrc <- inclusion %>%
        dplyr::filter(stringr::str_detect(phenotype, "source_concept")) %>%
        dplyr::select(domain_id) %>% unique()

      stndrdDscdntsEx <- exclusion %>%
        dplyr::filter(include_descendants == 1) %>%
        dplyr::pull(concept_id) %>%
        paste(collapse = ", ")

      domainsStndrdDscdntsEx <- exclusion %>%
        dplyr::filter(include_descendants == 1) %>%
        dplyr::select(domain_id) %>% unique()

      stndrdWODscdntsEx <- exclusion %>%
        dplyr::filter(include_descendants == 0) %>%
        dplyr::pull(concept_id) %>%
        paste(collapse = ", ")

      domainsWOStndrdDscdntsEx <- exclusion %>%
        dplyr::filter(include_descendants == 0) %>%
        dplyr::select(domain_id) %>% unique()

      srcConceptIdsEx <- exclusion %>%
        dplyr::filter(stringr::str_detect(phenotype, "source_concept")) %>%
        dplyr::pull(concept_id) %>%
        paste(collapse = ", ")
      domainsSrcEx <- exclusion %>%
        dplyr::filter(stringr::str_detect(phenotype, "source_concept")) %>%
        dplyr::select(domain_id) %>% unique()

      paste0(
        "You should include following standard concept_ids and descendants: ", glue::glue({stndrdDscdnts})," and domain_ids ",
        glue::glue({domainsStndrdDscdnts}),
        ", you should include following standard concept_ids without descendants: ", glue::glue({stndrdWODscdnts}),
        " and domain_ids ", glue::glue({domainsWOStndrdDscdnts}), ".",
        " Additionally use following source_concept_ids: ",
        glue::glue({srcConceptIds}), " and domain_ids ",
        glue::glue({domainsSrc}),
        ". You should exclude following standard concept_ids and descendants: ", glue::glue({stndrdDscdntsEx})," and domain_ids ",
        glue::glue({domainsStndrdDscdntsEx}),
        ", you should include following standard concept_ids without descendants: ", glue::glue({stndrdWODscdntsEx}),
        " and domain_ids ", glue::glue({domainsWOStndrdDscdntsEx}), ".",
        " Additionally use following source_concept_ids: ",
        glue::glue({srcConceptIdsEx}), " and domain_ids ",
        glue::glue({domainsSrcEx})
      )


    })


  }

  shiny::shinyApp(ui = ui, server = server)
}