simul_these/RProject/shinyapps/results-dashboard/app.R

library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyWidgets)

conditionalPanel2 <- function(condition, ..., ns = NS(NULL), inline = FALSE, container = if (inline) span else div) {
  container(`data-display-if` = condition, `data-ns-prefix` = ns(""), ...)
}
conditionalMenuItem <- function(label,tabName,iconName,condition) {
  t <- menuItem(
    label,
    tabName = tabName,
    icon = icon(iconName)
  )
  t$attribs <- list('data-display-if'=condition,'data-ns-prefix'='')
  t
}

# Define UI for application that draws a histogram
ui <- 
  dashboardPage(
    dashboardHeader(title = "ResCenter",
                    dropdownMenu(type = "notifications",
                                 notificationItem(
                                   text = "Return to services list",
                                   icon = icon("right-from-bracket"),
                                   href = 'https://service.corentinchoisy.xyz',
                                   status = 'danger'),
                                 badgeStatus = NULL,
                                 icon = icon('right-from-bracket'),
                                 headerText = ''
                    ),
                    dropdownMenu(type='messages',
                                 messageItem(from = 'View source on Gitea',
                                             message = 'Browse and download',
                                             icon = icon('git'),
                                             href = 'https://gitlab.com/corentinchoisy/kids'),
                                 badgeStatus = NULL,
                                 icon = icon('circle-info'),
                                 headerText = "App info")
    ),
    
    dashboardSidebar(
      collapsed=TRUE,
      sidebarMenu(
        menuItem("Tables", tabName = "tables", icon = icon("table"))
        #,conditionalMenuItem(condition='input.predictions == 1',label = "Autres métriques", tabName = "metriques", iconName = "square-poll-vertical")
      )
    ),
    
    dashboardBody(
      tabItems(tabItem('tables',
                       fluidRow(
                         box(title = "Input",status="success",width=12,
                         pickerInput(
                               inputId = "typeres",
                               label = "DIF recovery",
                               options=list(style='btn'),
                               choices = c("None", "Perfect", "ROSALI", "Residuals")),
                         conditionalPanel2(condition='input.typeres == "ROSALI" | input.typeres == "Residuals"',checkboxInput(inputId = "weak",label = "Show only weak detection scenarios (p.moreflexible<0.15)")
                                           ,conditionalPanel2(condition="!input.dif",checkboxInput(inputId = "causal",label = "Hide DIF detection data")),
                                           conditionalPanel2(condition='!input.causal',checkboxInput(inputId = "dif",label = "Hide causal inference data"))
                                           )
                         )
                       ),
                       fluidRow(
                         box(title = "Compiled results",status="primary",width = 12,solidHeader = T,DT::dataTableOutput("res"))
                       )
          )
      )
      
      
      
      
      ,tags$head(tags$style(HTML('
                              .content-wrapper { overflow: auto; }
                              
                              #options .box-header{ display: none}
                              
                              button.btn.dropdown-toggle.btn-default {
                                background-color: #d32927;
                                border-color: #d32927;
                                border-radius: 0px;
                              }

                              .box.box-danger{                                 
                                background:#f5eceb
                              }
                              
                              .box.box-warning{                                 
                                background:#f7f4ed
                              }
                              
                              .box.box-danger .form-control{                                 
                                background-color:#f5eceb !important
                              }
                              
                              .box.box-success{                                 
                                background:#e1fff1
                              }
                              
                              .box.box-success .form-control{                                 
                                background-color:#e1fff1 !important
                              }
                              
                              .box.box-primary{                                 
                                background:#ebf4f9
                              }
                            
                              
                              .box.box-solid{                                 
                                background:#ffffff
                              }
                              
                              .navbar-nav > .messages-menu > .dropdown-menu > li .menu, .navbar-nav > .notifications-menu > .dropdown-menu > li .menu, .navbar-nav > .tasks-menu > .dropdown-menu > li .menu {
                                max-height: 500px; overflow-y: hidden;
                              }
                              
                              .content {
                                height: auto; overflow-y: auto;
                              }
                    
                              /* navbar (rest of the header) */
                               .skin-blue .main-header .navbar {
                              background-color: #d32927;
                              }
                                            
                              /* navbar (rest of the header) */
                               .skin-blue .main-header .logo {
                              background-color: #d32927;
                              }              
                                            
                              /* logo when hovered */
                              .skin-blue .main-header .logo:hover {
                              background-color: #931c1b;
                              }              
                              /* toggle button when hovered  */                    
                              .skin-blue .main-header .navbar .sidebar-toggle:hover{
                              background-color: #931c1b;
                              }
                              
                              /* main sidebar */
                              .skin-blue .main-sidebar {
                              background-color: #4e4c4c;
                              }
                                            
                              /* active selected tab in the sidebarmenu */
                              .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
                              background-color: #282828;
                              border-left: 3px solid #d32927;
                              }
                         
                              /* other links in the sidebarmenu when hovered */
                              .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
                              background-color: #282828;
                              border-left: 3px solid #d32927;
                              }
              '))))
  )
    
    
    
    
    
    
    
    
    
    
    
    
    

# Define server logic required to draw a histogram
server <- function(input, output) {
  res.dat <- read.csv("res_dat.csv")
  res.dat.dif <- read.csv("res_dat_dif.csv")
  res.dat.dif.resali <- read.csv("res_dat_dif_resali.csv")
  res.dat.dif.rosali <- read.csv("res_dat_dif_rosali.csv")
  
  df_res <- reactive({
    if(input$typeres=="None") {
      dd <- res.dat
    }
    if(input$typeres=="Perfect") {
      dd <- res.dat.dif
    }
    if(input$typeres=="ROSALI") {
      dd <- res.dat.dif.rosali
    }
    if(input$typeres=="Residuals") {
      dd <- res.dat.dif.resali
    }
    dd
  })
  

  
  df_res_r <- reactive({
    rs <- df_res()
    if(input$typeres=="None") {
      rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","theoretical.power","m.beta","se.empirical.beta","se.analytical.beta",
                  "m.low.ci.beta","m.high.ci.beta","true.value.in.ci.p","h0.rejected.p","beta.same.sign.truebeta.p",
                  "beta.same.sign.truebeta.signif.p","bias")]
      rs <- dplyr::mutate_if(rs,is.numeric,round,3)
      rs <- dplyr::mutate_all(rs,as.character)
    }
    if(input$typeres=="Perfect") {
      rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","theoretical.power","m.beta","se.empirical.beta","se.analytical.beta",
                  "m.low.ci.beta","m.high.ci.beta","true.value.in.ci.p","h0.rejected.p","beta.same.sign.truebeta.p",
                  "beta.same.sign.truebeta.signif.p","bias")]
      rs <- dplyr::mutate_if(rs,is.numeric,round,3)
      rs <- dplyr::mutate_all(rs,as.character)
    }
    if(input$typeres=="ROSALI") {
      rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","theoretical.power","m.beta","se.empirical.beta","se.analytical.beta",
                  "m.low.ci.beta","m.high.ci.beta","true.value.in.ci.p","h0.rejected.p","beta.same.sign.truebeta.p",
                  "beta.same.sign.truebeta.signif.p","bias","dif.detected","prop.perfect","flexible.detect","moreflexible.detect","any.detect")]
      if (input$causal) {
        rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","theoretical.power","m.beta","se.empirical.beta","se.analytical.beta",
                    "m.low.ci.beta","m.high.ci.beta","true.value.in.ci.p","h0.rejected.p","beta.same.sign.truebeta.p",
                    "beta.same.sign.truebeta.signif.p","bias")]
      }
      if (input$dif) {
        rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","dif.detected","prop.perfect","flexible.detect","moreflexible.detect","any.detect")]
      }
      if (input$weak) {
        rs <- rs[rs$moreflexible.detect<0.15 & !is.na(rs$moreflexible.detect),]
      }

      rs <- dplyr::mutate_if(rs,is.numeric,round,3)
      rs <- dplyr::mutate_all(rs,as.character)
    }
    if(input$typeres=="Residuals") {
      rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","theoretical.power","m.beta","se.empirical.beta","se.analytical.beta",
                  "m.low.ci.beta","m.high.ci.beta","true.value.in.ci.p","h0.rejected.p","beta.same.sign.truebeta.p",
                  "beta.same.sign.truebeta.signif.p","bias","dif.detected","prop.perfect","flexible.detect","moreflexible.detect","any.detect")]
      if (input$causal) {
        rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","theoretical.power","m.beta","se.empirical.beta","se.analytical.beta",
                    "m.low.ci.beta","m.high.ci.beta","true.value.in.ci.p","h0.rejected.p","beta.same.sign.truebeta.p",
                    "beta.same.sign.truebeta.signif.p","bias")]
      }
      if (input$dif) {
        rs <- rs[,c('scenario','N','J','M','eff.size',"nb.dif","dif.size","dif.detected","prop.perfect","flexible.detect","moreflexible.detect","any.detect")]
      }
      if (input$weak) {
        rs <- rs[rs$moreflexible.detect<0.15 & !is.na(rs$moreflexible.detect),]
      }
      rs <- dplyr::mutate_if(rs,is.numeric,round,3)
      rs <- dplyr::mutate_all(rs,as.character)
    }
    rs
  })

  
  output$res <- DT::renderDataTable(df_res_r(),
                                        options = list(columnDefs = list(list(className = 'dt-center',width=ifelse(input$dif & !is.na(input$dif),"119px","50px"), targets = "_all")),
                                          pageLength=100,autoWidth=T,scrollY=400,scrollX = T,server=F,buttons=c("csv","excel")),
                                        rownames = FALSE,
                                    selection="single",
                                    filter=list(plain=F,clear=F,position="top"))
}

# Run the application 
shinyApp(ui = ui, server = server)