development/shinyDashboardJR _grid.R

In ratkovic-judgeresearch/shinyPublic: Functions for JudgeResearch Shiny

library(shinyPublic)
library(ggplotify)
library(gridExtra)
library(grid)
# setwd('~/Dropbox/Github/shinyPublic/development')
# devtools::load_all('~/Dropbox/Github/shinyPublic')
loadFile(objName = "reportList", fileName = "practiceGAreport.rds")
lossObj <- reportList[["byGen"]][["loss"]]

# Top matter, HTML CSS etc
MarkHTML <- HTML('
      .main-header .logo {
        font-family: "Mark Pro Bold", Times, "Mark Pro Bold", serif;
        font-weight: bold;
        font-size: 28px;
      }
    ')
colorHTML <- HTML('.logo {
                              background-color: #03123a !important;
                              }
                              .navbar {
                              background-color: #03123aFF !important;
                              }
                              .irs-bar {
                              background-color: #03123aD9 !important;
                              border-color: #03123aD9 !important;
                              }
                              .irs-bar-edge {
                                background-color: #03123aFF !important;
                              }
                              .irs-from {
                                background-color: darkgrey !important;
                                                            }
                              .irs-to {
                                background-color: darkgrey !important;
                              }
                              .irs-slider {
                                background-color: #03123aFF !important;
                              }
                              '
)



## Start app
ui <- dashboardPage(
  dashboardHeader(title = "JudgeResearch"),
  dashboardSidebar(
                 checkboxInput("donum1", "Make #1 plot", value = T,),
                 checkboxInput("donum2", "Make #2 plot", value = F),
                 checkboxInput("donum3", "Make #3 plot", value = F),
                 # sliderInput("wt1","Weight 1",min=1,max=10,value=1),
                 # sliderInput("wt2","Weight 2",min=1,max=10,value=1),
                 # sliderInput("wt3","Weight 3",min=1,max=10,value=1),
                      sliderInput("slider2", label=NULL, min = 0,
                                  max = 1, value = c(0, 1), ticks= FALSE),
    # The dynamically-generated user panel
    uiOutput("userpanel")
  ), 
  # tags$head(tags$style(colorHTML)),
  dashboardBody(    # Boxes need to be put in a row (or column)
    tags$head(tags$style(MarkHTML)),
    tags$head(tags$style(colorHTML)),
    fluidPage(
              column(width=12,plotOutput(outputId="plotgraph"))
    )
  #   fluidRow(
  #     box(plotOutput("plotgraph", height = 300)),
  #     fluidPage(
  #       fluidRow(position = "bottom",
  #                # tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background:  #03123a !important}")),
  #                column(4,
  #                       # Slider
  #                       sliderInput("slider2", label=NULL, min = 0, 
  #                                   max = 1, value = c(0, 1), ticks= FALSE                             )
  #                )
  #       )
  #     )
  #   )
  )
)# Close out UI

server <- function(input, output, session) {

  
  # 
  # output$plot1 <- renderPlot({
  #   plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2])
  # })
 
  pt1 <- reactive({
    if (!input$donum1) return(NULL)
    GAgrob1 <- as.grob(function() plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2]))
    GAgrob1
    # plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2])
    
})
  pt2 <- reactive({
    if (!input$donum2) return(NULL)
    GAgrob2 <- as.grob(function() plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2]))
    GAgrob2
    # plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2])
    })
  pt3 <- reactive({
    if (!input$donum3) return(NULL)
    GAgrob3 <- as.grob(function() plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2]))
    GAgrob3
    # plotGALoss("practiceGAreport.rds", input$slider2[1], input$slider2[2])
    })
  output$plotgraph = renderPlot({
    ptlist <- list(pt1(),pt2(),pt3())
    wtlist <- c(input$wt1,input$wt2,input$wt3)
    # remove the null plots from ptlist and wtlist
    to_delete <- !sapply(ptlist,is.null)
    ptlist <- ptlist[to_delete]
    wtlist <- wtlist[to_delete]
    if (length(ptlist)==0) return(NULL)
    # theme(plot.margin = unit(c(2,2,2,2), "cm")
    hlay <- rbind(c(1,1,NA,2,2,NA, 3,3),
                  c(4,4,NA,5,5,NA,6,6),
                  c(7,7,NA, 8,8,NA, 9,9))
    # hlay <- rbind(c(1,NA,2,NA,3),
    #               c(4,NA,5,NA,6),
    #               c(7,NA,8,NA,9))

    grid.arrange(grobs=ptlist,widths=wtlist,ncol=length(ptlist), layout_matrix= hlay)
  })
  
  
}

shinyApp(ui, server)