You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
266 lines
12 KiB
R
266 lines
12 KiB
R
8 months ago
|
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),"101px","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)
|