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","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","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","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","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","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","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)