inst/app/app.R

In kaigu1990/EasyIVD: A statistical analysis tool for IVD trials with R/Shiny

# Global setting ----------------------------------------------------------

rpath <- system.file("R", package = "EasyIVD", mustWork = TRUE)
sapply(list.files(rpath, full.names = T), source)

# Load necessary packages -------------------------------------------------
message("Checking depedencies...")

if (!requireNamespace("pacman")) {
  install.packages("pacman", repos = "http://cran.r-project.org")
}
library(pacman)

pacman::p_load(
  "shiny", "bs4Dash", "fresh", "shinyWidgets"
  # "plotly", "DT", "rmarkdown",
  # "htmltools", "dplyr", "VCA", "EnvStats", "mcr", "BlandAltmanLeh", "data.table"
)

message("Starting...")

# App theme setting -------------------------------------------------------
mytheme <- create_theme(
  # bs4dash_vars(
  #   navbar_light_color = "#bec5cb",
  #   navbar_light_active_color = "#FFF",
  #   navbar_light_hover_color = "#FFF"
  # ),
  # bs4dash_yiq(
  #   contrasted_threshold = 10,
  #   text_dark = "#FFF",
  #   text_light = "#272c30"
  # ),
  # bs4dash_layout(
  #   main_bg = "#353c42"
  # ),
  # bs4dash_sidebar_light(
  #   bg = "#272c30",
  #   color = "#bec5cb",
  #   hover_color = "#FFF",
  #   submenu_bg = "#272c30",
  #   submenu_color = "#FFF",
  #   submenu_hover_color = "#FFF"
  # ),
  bs4dash_status(
    primary = "#5E81AC", danger = "#BF616A", light = "#272c30"
  )
  # bs4dash_color(
  #   gray_900 = "#FFF"
  # )
)

# App main body -----------------------------------------------------------
shiny::shinyApp(
  # The application User-Interface ------------------------------------------
  ui = dashboardPage(
    options = NULL,
    header = bs4DashNavbar(
      # title = dashboardBrand(
      #   title = "Trials Monitoring",
      #   color = "primary",
      #   href = "https://www.google.com/"
      #   # image = "images.png"
      #   # image = "logo.png"
      # ),
      status = "white",
      # leftUi = tagList(),
      actionLink("homelink", "About"),
      HTML("&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"),
      "I can write text in the navbar!"
    ),

    preloader = list(html = tagList(waiter::spin_1(), "Loading ..."), color = "#3c8dbc"),
    fullscreen = TRUE,
    scrollToTop = TRUE,
    help = FALSE,

    sidebar = dashboardSidebar(
      skin = "light",
      elevation = 4,
      width = 200,
      collapsed = TRUE,
      inputId = "sidebarState",

      sidebarUserPanel(
        image = "https://image.flaticon.com/icons/svg/1149/1149168.svg",
        name = "IVD Trials!"
      ),

      sidebarMenu(
        id = "sidebar",
        # compact = TRUE,
        flat = FALSE,

        sidebarHeader("Make and keep our IVD trial earier!"),

        menuItem(
          text = "About",
          tabName = "about",
          selected = TRUE,
          icon = icon("archive")
        ),
        menuItem(
          text = "Home",
          tabName = "home",
          icon = icon("home")
        ),
        menuItem(
          text = "Monitor",
          tabName = "monitor",
          icon = icon("bars"),
          menuSubItem(
            text = "Outlier",
            tabName = "outlier",
            icon = icon("circle-thin")
          ),
          menuSubItem(
            text = "Qualitative",
            tabName = "quali",
            icon = icon("circle-thin")
          ),
          menuSubItem(
            text = "Quantitative",
            tabName = "quant",
            icon = icon("circle-thin")
          ),
          menuSubItem(
            text = "Reader Precision",
            tabName = "rp",
            icon = icon("circle-thin")
          )
        )
      )
    ),

    body = dashboardBody(
      use_theme(mytheme),
      tabItems(
        mod_aboutTab_ui("aboutTab_ui_1"),
        mod_outlierTab_ui("outlierTab_ui_1")
      )
    ),

    footer = dashboardFooter(
      left = a(
        href = "https://github.com/kaigu1990",
        target = "_blank", "Code Respository"
      ),
      right = "2021, by Kai"
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),

  # The application server-side ---------------------------------------------
  server = function(input, output, session) {
    #----------------------------------------------------------------------#
    # Main tools in Server logic module
    mod_aboutTab_server("aboutTab_ui_1")
    mod_outlierTab_server("outlierTab_ui_1")

    observeEvent(input$homelink,
      {
        updatebs4TabItems(session, inputId = "sidebar", selected = "about")
      },
      ignoreInit = TRUE
    )
  }
)