Chapter 1 Template

Navigation bar and Tablet Panel

ui <- navbarPage(
  theme = bs_theme(version = 4, 
                   bootswatch = "minty", primary = "#be2bbb", 
                   'navbar-inverse-bg' = "#f7bfc2", 'navbar-bg' = "#f1d4f1",
                   "progress-bar-bg" = "orange"), 
  
  # primary 78c2ad, secondary f3969a
  title = "ShinyMan",
  header = tags$style(HTML("
        .navbar-default .navbar-nav > li > a:hover {color: black;background-color: #f7bfc2; text-decoration:underline;}
                  ")),
  tabPanel(title = "Home",
           fluidPage(
             sidebarLayout(
               sidebarPanel(width = 4,
                            radioButtons(
                              "dist", "Distribution",
                              c("Normal" = "norm", "Uniform" = "unif")
                            )),
               mainPanel(type = "tabs",
                         tabsetPanel(
                           tabPanel(title = "Tab1", class = "p-3 border rounded border-top-0 rounded-bottom"),
                           tabPanel(title = "Tab2", class = "p-3 border rounded border-top-0 rounded-bottom")
                         )),
               position = c("left", "right")
             )
             
           )),
  tabPanel(title = "Feature"),
  navbarMenu(
    "More",
    tabPanel("Summary"),
    "----",
    "Section header",
    tabPanel("Table"),
    tabPanel("Whatever")
  )
)

server <- function(input, output){}

shinyApp(ui, server)

In this example, I use Minty theme. However, the navigation bar cannot apply the specified colors. I specify navbar-bg to change the background color, and tags$style(HTML()) to set active navigator’s background color.

Add And Delete Inputs

require(dplyr)

ui <- basicPage(
  h5("Provide Doses Here: "),
  div(id = "placeholder"),
  fluidRow(
    column(width = 4,
           actionButton("adddose", "Add One Dose", icon("capsules"),
                        style = "background-color: #f7bfc2; color: black"))
  ),
  hr(),
  fluidPage(
    verbatimTextOutput("table1")
  )
)

server <- function(input, output){
  rawdoselist <- reactiveValues(ls = list())
  # store the data set

  doselist <- reactive({
    ls <- rawdoselist$ls
    if(is.null(names(ls)) == 0)
    {
      ID <- ls %>% names()
      toxID <- sapply(1:length(ID), FUN = function(x) paste(ID[x], "tox", sep = "_"))
      effID <- sapply(1:length(ID), FUN = function(x) paste(ID[x], "eff", sep = "_"))
      tox <- sapply(1:length(ID), FUN = function(x) input[[toxID[x]]])
      eff <- sapply(1:length(ID), FUN = function(x) input[[effID[x]]])
      list(ID = ID, tox = tox, eff = eff)
    } else
    {
      list(ID = NA, tox = NA, eff = NA)
    }
  })


  observeEvent(input$adddose, {
    doseID <- as.character(input$adddose)
    toxID <- paste(doseID, "tox", sep = "_")
    effID <- paste(doseID, "eff", sep = "_")
    delID <- paste(doseID, "del", sep = "_")
    if(is.null(rawdoselist$ls[[doseID]]))
    {
      insertUI(
        selector = "#placeholder",
        ui = tags$div(
          id = doseID,
          fluidRow(
            column(width = 2,
                   h6(paste("Dose ID =  ", doseID, sep = ""))),
            column(width = 4,
                   sliderInput(toxID, "Toxicity", value = (as.numeric(doseID)%%10)/10, min = 0, max = 1,
                               step = 0.1)),
            column(width = 4,
                   sliderInput(effID, "Efficacy", value = (as.numeric(doseID)%%10)/10, min = 0, max = 1,
                               step = 0.1)),
            column(width = 2,
                   actionButton(delID, "Delete", icon("trash"), class = "pull-left btn btn-danger"),
                   style = " color: black")
          )
        )
      )

      rawdoselist$ls[[doseID]] <- TRUE

      observeEvent(input[[delID]], {
        removeUI(selector = paste0("#", doseID))
        rawdoselist$ls[[doseID]] <- NULL
      }, ignoreInit = TRUE, once = TRUE)

    }
  })


  output$table1 <- renderPrint({
    doselist()
  })
}

shinyApp(ui, server)

Typography