shiny/R/bootstrap.R

#' Create a Twitter Bootstrap page
#' 
#' Create a Shiny UI page that loads the CSS and JavaScript for
#' \href{http://getbootstrap.com}{Twitter Bootstrap}, and has no content in the
#' page body (other than what you provide).
#' 
#' This function is primarily intended for users who are proficient in HTML/CSS,
#' and know how to lay out pages in Bootstrap. Most users should use template
#' functions like \code{\link{pageWithSidebar}}.
#' 
#' @param ... The contents of the document body.
#' @return A UI defintion that can be passed to the \link{shinyUI} function.
#' 
#' @export
bootstrapPage <- function(...) {
  # required head tags for boostrap
  importBootstrap <- function(min = TRUE, responsive = TRUE) {
    
    ext <- function(ext) {
      ifelse(min, paste(".min", ext, sep=""), ext)
    }
    cssExt <- ext(".css")
    jsExt = ext(".js")
    bs <- "shared/bootstrap/"
    
    result <- tags$head(
      tags$link(rel="stylesheet", 
                type="text/css", 
                href=paste(bs, "css/bootstrap", cssExt, sep="")),
      
      tags$script(src=paste(bs, "js/bootstrap", jsExt, sep=""))
    )
    
    if (responsive) {
      result <- tagAppendChild(
        result, 
        tags$meta(name="viewport", 
                  content="width=device-width, initial-scale=1.0"))
      result <- tagAppendChild(
        result,
        tags$link(rel="stylesheet", 
                  type="text/css", 
                  href=paste(bs, "css/bootstrap-responsive", cssExt, sep="")))
    }
    
    result
  }
  
  tagList(
    # inject bootstrap requirements into head
    importBootstrap(),
    list(...)
  )
}

#' Create a page with a sidebar
#' 
#' Create a Shiny UI that contains a header with the application title, a 
#' sidebar for input controls, and a main area for output.
#' 
#' @param headerPanel The \link{headerPanel} with the application title
#' @param sidebarPanel The \link{sidebarPanel} containing input controls
#' @param mainPanel The \link{mainPanel} containing outputs
#' @return A UI defintion that can be passed to the \link{shinyUI} function
#' 
#' @examples
#' # Define UI
#' shinyUI(pageWithSidebar(
#'   
#'   # Application title
#'   headerPanel("Hello Shiny!"),
#'   
#'   # Sidebar with a slider input
#'   sidebarPanel(
#'     sliderInput("obs", 
#'                 "Number of observations:", 
#'                 min = 0, 
#'                 max = 1000, 
#'                 value = 500)
#'   ),
#'   
#'   # Show a plot of the generated distribution
#'   mainPanel(
#'     plotOutput("distPlot")
#'   )
#' ))
#'
#' @export
pageWithSidebar <- function(headerPanel, sidebarPanel, mainPanel) {
  
  bootstrapPage(
    # basic application container divs
    div(
      class="container-fluid", 
      div(class="row-fluid", 
          headerPanel
      ),
      div(class="row-fluid", 
          sidebarPanel, 
          mainPanel
      )
    )
  )
}


#' Create a header panel
#' 
#' Create a header panel containing an application title.
#' 
#' @param title An application title to display
#' @return A headerPanel that can be passed to \link{pageWithSidebar}
#' 
#' @examples
#' headerPanel("Hello Shiny!")
#' @export
headerPanel <- function(title) {    
  tagList(
    tags$head(tags$title(title)),
    div(class="span12", style="padding: 10px 0px;",
      h1(title)
    )
  )
}

#' Create a well panel
#' 
#' Creates a panel with a slightly inset border and grey background. Equivalent
#' to Twitter Bootstrap's \code{well} CSS class.
#' 
#' @param ... UI elements to include inside the panel.
#' @return The newly created panel.
#' 
#' @export
wellPanel <- function(...) {
  div(class="well", ...)
}

#' Create a sidebar panel
#' 
#' Create a sidebar panel containing input controls that can in turn be 
#' passed to \link{pageWithSidebar}.
#' 
#' @param ... UI elements to include on the sidebar
#' @return A sidebar that can be passed to \link{pageWithSidebar}
#' 
#' @examples
#' # Sidebar with controls to select a dataset and specify
#' # the number of observations to view
#' sidebarPanel(
#'   selectInput("dataset", "Choose a dataset:", 
#'               choices = c("rock", "pressure", "cars")),
#'   
#'   numericInput("obs", "Observations:", 10)
#' )
#' @export
sidebarPanel <- function(...) {
  div(class="span4",
    tags$form(class="well", 
      ...
    )
  )
}

#' Create a main panel
#' 
#' Create a main panel containing output elements that can in turn be 
#' passed to \link{pageWithSidebar}.
#' 
#' @param ... Ouput elements to include in the main panel
#' @return A main panel that can be passed to \link{pageWithSidebar}
#' 
#' @examples
#' # Show the caption and plot of the requested variable against mpg
#' mainPanel(
#'    h3(textOutput("caption")),
#'    plotOutput("mpgPlot")
#' )
#' @export
mainPanel <- function(...) {
  div(class="span8",
    ...
  )
}

#' Conditional Panel
#' 
#' Creates a panel that is visible or not, depending on the value of a 
#' JavaScript expression. The JS expression is evaluated once at startup and 
#' whenever Shiny detects a relevant change in input/output.
#' 
#' In the JS expression, you can refer to \code{input} and \code{output} 
#' JavaScript objects that contain the current values of input and output. For
#' example, if you have an input with an id of \code{foo}, then you can use
#' \code{input.foo} to read its value. (Be sure not to modify the input/output
#' objects, as this may cause unpredictable behavior.)
#' 
#' @param condition A JavaScript expression that will be evaluated repeatedly to
#'   determine whether the panel should be displayed.
#' @param ... Elements to include in the panel.
#' 
#' @examples
#' sidebarPanel(
#'    selectInput(
#'       "plotType", "Plot Type",
#'       c(Scatter = "scatter",
#'         Histogram = "hist")),
#' 
#'    # Only show this panel if the plot type is a histogram
#'    conditionalPanel(
#'       condition = "input.plotType == 'hist'",
#'       selectInput(
#'          "breaks", "Breaks",
#'          c("Sturges",
#'            "Scott",
#'            "Freedman-Diaconis",
#'            "[Custom]" = "custom")),
#'               
#'       # Only show this panel if Custom is selected
#'       conditionalPanel(
#'          condition = "input.breaks == 'custom'",
#'          sliderInput("breakCount", "Break Count", min=1, max=1000, value=10)
#'       )
#'    )
#' )
#'   
#' @export
conditionalPanel <- function(condition, ...) {
  div('data-display-if'=condition, ...)
}

#' Create a text input control
#' 
#' Create an input control for entry of unstructured text values
#' 
#' @param inputId Input variable to assign the control's value to
#' @param label Display label for the control
#' @param value Initial value
#' @return A text input control that can be added to a UI definition.
#' 
#' @examples
#' textInput("caption", "Caption:", "Data Summary")
#' @export
textInput <- function(inputId, label, value = "") {
  tagList(
    tags$label(label),
    tags$input(id = inputId, type="text", value=value)
  )
}

#' Create a numeric input control
#' 
#' Create an input control for entry of numeric values
#' 
#' @param inputId Input variable to assign the control's value to
#' @param label Display label for the control
#' @param value Initial value
#' @param min Minimum allowed value
#' @param max Maximum allowed value
#' @param step Interval to use when stepping between min and max
#' @return A numeric input control that can be added to a UI definition.
#' 
#' @examples
#' numericInput("obs", "Observations:", 10, 
#'              min = 1, max = 100)
#' @export
numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA) {
  
  # build input tag
  inputTag <- tags$input(id = inputId, type = "number", value = value)
  if (!is.na(min))
    inputTag$attribs$min = min
  if (!is.na(max))
    inputTag$attribs$max = max
  if (!is.na(step))
    inputTag$attribs$step = step
  
  tagList(
    tags$label(label),
    inputTag
  )
}


#' File Upload Control
#' 
#' Create a file upload control that can be used to upload one or more files. 
#' \bold{Experimental feature. Only works in some browsers (primarily tested on
#' Chrome and Firefox).}
#' 
#' @param inputId Input variable to assign the control's value to.
#' @param label Display label for the control.
#' @param multiple Whether the user should be allowed to select and upload 
#'   multiple files at once.
#' @param accept A character vector of MIME types; gives the browser a hint of 
#'   what kind of files the server is expecting.
#'   
#' @export
fileInput <- function(inputId, label, multiple = FALSE, accept = NULL) {
  inputTag <- tags$input(id = inputId, type = "file")
  if (multiple)
    inputTag$attribs$multiple <- "multiple"
  if (length(accept) > 0)
    inputTag$attribs$accept <- paste(accept, collapse=',')
  
  tagList(
    tags$label(label),
    inputTag
  )
}


#' Checkbox Input Control
#' 
#' Create a checkbox that can be used to specify logical values.
#' 
#' @param inputId Input variable to assign the control's value to.
#' @param label Display label for the control.
#' @param value Initial value (\code{TRUE} or \code{FALSE}).
#' @return A checkbox control that can be added to a UI definition.
#' 
#' @seealso \code{\link{checkboxGroupInput}}
#' 
#' @examples
#' checkboxInput("outliers", "Show outliers", FALSE)
#' @export
checkboxInput <- function(inputId, label, value = FALSE) {
  inputTag <- tags$input(id = inputId, type="checkbox")
  if (!is.null(value) && value)
    inputTag$attribs$checked <- "checked"
  tags$label(class = "checkbox", inputTag, label)
}


#' Checkbox Group Input Control
#' 
#' Create a group of checkboxes that can be used to toggle multiple choices 
#' independently. The server will receive the input as a character vector of the
#' selected values.
#' 
#' @param inputId Input variable to assign the control's value to.
#' @param label Display label for the control.
#' @param choices List of values to show checkboxes for. If elements of the list
#'   are named then that name rather than the value is displayed to the user.
#' @param selected Names of items that should be initially selected, if any.
#' @return A list of HTML elements that can be added to a UI definition.
#'   
#' @seealso \code{\link{checkboxInput}}
#'   
#' @examples
#' checkboxGroupInput("variable", "Variable:",
#'                    c("Cylinders" = "cyl",
#'                      "Transmission" = "am",
#'                      "Gears" = "gear"))
#'                  
#' @export
checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
  # resolve names
  choices <- choicesWithNames(choices)
  
  checkboxes <- list()
  for (choiceName in names(choices)) {
    
    checkbox <- tags$input(name = inputId, type="checkbox",
                           value = choices[[choiceName]])
    
    if (choiceName %in% selected)
      checkbox$attribs$selected <- 'selected'
    
    checkboxes[[length(checkboxes)+1]] <- checkbox
    checkboxes[[length(checkboxes)+1]] <- choiceName
    checkboxes[[length(checkboxes)+1]] <- tags$br()
  } 
  
  # return label and select tag
  tags$div(class='control-group',
           controlLabel(inputId, label),
           checkboxes)
}


#' Create a help text element
#' 
#' Create help text which can be added to an input form to provide additional
#' explanation or context.
#' 
#' @param ... One or more help text strings (or other inline HTML elements)
#' @return A help text element that can be added to a UI definition.
#'   
#' @examples
#' helpText("Note: while the data view will show only",
#'          "the specified number of observations, the",
#'          "summary will be based on the full dataset.")
#' @export
helpText <- function(...) {
  span(class="help-block", ...)
}

controlLabel <- function(controlName, label) {
  tags$label(class = "control-label", `for` = controlName, label)
}

choicesWithNames <- function(choices) {
  # get choice names
  choiceNames <- names(choices)
  if (is.null(choiceNames))
    choiceNames <- character(length(choices))
  
  # default missing names to choice values
  missingNames <- choiceNames == ""
  choiceNames[missingNames] <- paste(choices)[missingNames]
  names(choices) <- choiceNames
  
  # return choices
  return (choices)
}

#' Create a select list input control
#' 
#' Create a select list that can be used to choose a single or
#' multiple items from a list of values.
#' 
#' @param inputId Input variable to assign the control's value to
#' @param label Display label for the control
#' @param choices List of values to select from. If elements of the list are 
#' named then that name rather than the value is displayed to the user.
#' @param selected Name of initially selected item (or multiple names if
#' \code{multiple = TRUE}). If not specified then defaults to the first item
#' for single-select lists and no items for multiple select lists.
#' @param multiple Is selection of multiple items allowed?
#' @return A select list control that can be added to a UI definition.
#' 
#' @examples
#' selectInput("variable", "Variable:",
#'             c("Cylinders" = "cyl",
#'               "Transmission" = "am",
#'               "Gears" = "gear"))
#' @export
selectInput <- function(inputId, 
                        label, 
                        choices, 
                        selected = NULL, 
                        multiple = FALSE) {
  # resolve names
  choices <- choicesWithNames(choices)
  
  # default value if it's not specified
  if (is.null(selected) && !multiple)
    selected <- names(choices)[[1]]
  
  # create select tag and add options
  selectTag <- tags$select(id = inputId)
  if (multiple)
    selectTag$attribs$multiple <- "multiple"
  for (choiceName in names(choices)) {
    optionTag <- tags$option(value = choices[[choiceName]], choiceName)
    if (choiceName %in% selected)
      optionTag$attribs$selected = "selected"
    selectTag <- tagAppendChild(selectTag, optionTag)
  } 
  
  # return label and select tag
  tagList(controlLabel(inputId, label), selectTag)
}

#' Create radio buttons
#' 
#' Create a set of radio buttons used to select an item from a list.
#' 
#' @param inputId Input variable to assign the control's value to
#' @param label Display label for the control
#' @param choices List of values to select from (if elements of the list are 
#' named then that name rather than the value is displayed to the user)
#' @param selected Name of initially selected item (if not specified then
#' defaults to the first item)
#' @return A set of radio buttons that can be added to a UI definition.
#' 
#' @examples
#' radioButtons("dist", "Distribution type:",
#'              c("Normal" = "norm",
#'                "Uniform" = "unif",
#'                "Log-normal" = "lnorm",
#'                "Exponential" = "exp"))
#' @export
radioButtons <- function(inputId, label, choices, selected = NULL) {
  # resolve names
  choices <- choicesWithNames(choices)
  
  # default value if it's not specified
  if (is.null(selected))
    selected <- names(choices)[[1]]
  
  # build list of radio button tags
  inputTags <- list()
  for (i in 1:length(choices)) {
    id <- paste(inputId, i, sep="")
    name <- names(choices)[[i]]
    value <- choices[[i]]
    inputTag <- tags$input(type = "radio", 
                           name = inputId,
                           id = id,
                           value = value)
    if (identical(name, selected))
      inputTag$attribs$checked = "checked"
    
    labelTag <- tags$label(class = "radio")
    labelTag <- tagAppendChild(labelTag, inputTag)
    labelTag <- tagAppendChild(labelTag, name)
    inputTags[[length(inputTags) + 1]] <- labelTag
  }
  
  tagList(tags$label(class = "control-label", label),
          inputTags)
}

#' Create a submit button
#' 
#' Create a submit button for an input form. Forms that include a submit
#' button do not automatically update their outputs when inputs change,
#' rather they wait until the user explicitly clicks the submit button.
#' 
#' @param text Button caption
#' @return A submit button that can be added to a UI definition.
#' 
#' @examples
#' submitButton("Update View")
#' @export
submitButton <- function(text = "Apply Changes") {
  div(
    tags$button(type="submit", class="btn btn-primary", text)
  )
}

#' Slider Input Widget
#' 
#' Constructs a slider widget to select a numeric value from a range.
#' 
#' @param inputId Specifies the \code{input} slot that will be used to access 
#'   the value.
#' @param label A descriptive label to be displayed with the widget.
#' @param min The minimum value (inclusive) that can be selected.
#' @param max The maximum value (inclusive) that can be selected.
#' @param value The initial value of the slider. A warning will be issued if the
#'   value doesn't fit between \code{min} and \code{max}.
#' @param step Specifies the interval between each selectable value on the 
#'   slider (\code{NULL} means no restriction).
#' @param round \code{TRUE} to round all values to the nearest integer; 
#'   \code{FALSE} if no rounding is desired; or an integer to round to that 
#'   number of digits (for example, 1 will round to the nearest 10, and -2 will 
#'   round to the nearest .01). Any rounding will be applied after snapping to 
#'   the nearest step.
#' @param format Customize format values in slider labels. See 
#'   \url{http://archive.plugins.jquery.com/project/numberformatter} for syntax 
#'   details.
#' @param locale The locale to be used when applying \code{format}. See details.
#' @param ticks \code{FALSE} to hide tick marks, \code{TRUE} to show them 
#'   according to some simple heuristics.
#' @param animate \code{TRUE} to show simple animation controls with default 
#'   settings; \code{FALSE} not to; or a custom settings list, such as those 
#'   created using \code{\link{animationOptions}}.
#'   
#' @details
#' 
#' Valid values for \code{locale} are: \tabular{ll}{ Arab Emirates \tab "ae" \cr
#' Australia \tab "au" \cr Austria \tab "at" \cr Brazil \tab "br" \cr Canada 
#' \tab "ca" \cr China \tab "cn" \cr Czech \tab "cz" \cr Denmark \tab "dk" \cr 
#' Egypt \tab "eg" \cr Finland \tab "fi" \cr France  \tab "fr" \cr Germany \tab 
#' "de" \cr Greece \tab "gr" \cr Great Britain \tab "gb" \cr Hong Kong \tab "hk"
#' \cr India \tab "in" \cr Israel \tab "il" \cr Japan \tab "jp" \cr Russia \tab 
#' "ru" \cr South Korea \tab "kr" \cr Spain \tab "es" \cr Sweden \tab "se" \cr 
#' Switzerland \tab "ch" \cr Taiwan \tab "tw" \cr Thailand \tab "th" \cr United 
#' States \tab "us" \cr Vietnam \tab "vn" \cr }
#' 
#' @export
sliderInput <- function(inputId, label, min, max, value, step = NULL,
                        round=FALSE, format='#,##0.#####', locale='us',
                        ticks=TRUE, animate=FALSE) {
 
  # validate label
  labelText <- as.character(label)
  if (!is.character(labelText))
    stop("label not specified")
  
  if (identical(animate, TRUE))
    animate <- animationOptions()
  
  if (!is.null(animate) && !identical(animate, FALSE)) {
    if (is.null(animate$playButton))
      animate$playButton <- tags$i(class='icon-play')
    if (is.null(animate$pauseButton))
      animate$pauseButton <- tags$i(class='icon-pause')
  }
  
  # build slider
  tagList(
    controlLabel(inputId, labelText),  
    slider(inputId, min=min, max=max, value=value, step=step, round=round,
           locale=locale, format=format, ticks=ticks,
           animate=animate)
  )
}


#' Create a tab panel
#' 
#' Create a tab panel that can be included within a \code{\link{tabsetPanel}}.
#' 
#' @param title Display title for tab
#' @param ... UI elements to include within the tab
#' @param value The value that should be sent when \code{tabsetPanel} reports 
#'   that this tab is selected. If omitted and \code{tabsetPanel} has an 
#'   \code{id}, then the title will be used.
#' @return A tab that can be passed to \code{\link{tabsetPanel}}
#'   
#' @examples
#' # Show a tabset that includes a plot, summary, and
#' # table view of the generated distribution
#' mainPanel(
#'   tabsetPanel(
#'     tabPanel("Plot", plotOutput("plot")), 
#'     tabPanel("Summary", verbatimTextOutput("summary")), 
#'     tabPanel("Table", tableOutput("table"))
#'   )
#' )
#' @export
tabPanel <- function(title, ..., value = NULL) {
  div(class="tab-pane", title=title, `data-value`=value, ...)
}

#' Create a tabset panel
#' 
#' Create a tabset that contains \code{\link{tabPanel}} elements. Tabsets are
#' useful for dividing output into multiple independently viewable sections.
#' 
#' @param ... \code{\link{tabPanel}} elements to include in the tabset
#' @param id If provided, you can use \code{input$}\emph{\code{id}} in your server 
#'   logic to determine which of the current tabs is active. The value will 
#'   correspond to the \code{value} argument that is passed to 
#'   \code{\link{tabPanel}}.
#' @return A tabset that can be passed to \code{\link{mainPanel}}
#'   
#' @examples
#' # Show a tabset that includes a plot, summary, and
#' # table view of the generated distribution
#' mainPanel(
#'   tabsetPanel(
#'     tabPanel("Plot", plotOutput("plot")), 
#'     tabPanel("Summary", verbatimTextOutput("summary")), 
#'     tabPanel("Table", tableOutput("table"))
#'   )
#' )
#' @export
tabsetPanel <- function(..., id = NULL) {
  
  # build tab-nav and tab-content divs
  tabs <- list(...)
  tabNavList <- tags$ul(class = "nav nav-tabs", id = id)
  tabContent <- tags$div(class = "tab-content")
  firstTab <- TRUE
  tabsetId <- as.integer(stats::runif(1, 1, 10000))
  tabId <- 1
  for (divTag in tabs) {
    # compute id and assign it to the div
    thisId <- paste("tab", tabsetId, tabId, sep="-")
    divTag$attribs$id <- thisId
    tabId <- tabId + 1
    
    tabValue <- divTag$attribs$`data-value`
    if (!is.null(tabValue) && is.null(id)) {
      stop("tabsetPanel doesn't have an id assigned, but one of its tabPanels ",
           "has a value. The value won't be sent without an id.")
    }

    # create the li tag
    liTag <- tags$li(tags$a(href=paste("#", thisId, sep=""),
                            `data-toggle` = "tab", 
                            `data-value` = tabValue,
                            divTag$attribs$title))
    
    # set the first tab as active
    if (firstTab) {
      liTag$attribs$class <- "active"
      divTag$attribs$class <- "tab-pane active"
      firstTab = FALSE
    }
    
    # append the elements to our lists
    tabNavList <- tagAppendChild(tabNavList, liTag)
    tabContent <- tagAppendChild(tabContent, divTag)
  }
  
  tabDiv <- tags$div(class = "tabbable", tabNavList, tabContent)
}


#' Create a text output element
#' 
#' Render a reactive output variable as text within an application page. The 
#' text will be included within an HTML \code{div} tag. 
#' @param outputId output variable to read the value from
#' @return A text output element that can be included in a panel
#' @details Text is HTML-escaped prior to rendering. This element is often used 
#' to dispaly \link{reactiveText} output variables.
#' @examples
#' h3(textOutput("caption"))
#' @export
textOutput <- function(outputId) {
  div(id = outputId, class = "shiny-text-output")
}

#' Create a verbatim text output element
#' 
#' Render a reactive output variable as verbatim text within an
#' application page. The text will be included within an HTML \code{pre} tag.
#' @param outputId output variable to read the value from
#' @return A verbatim text output element that can be included in a panel
#' @details Text is HTML-escaped prior to rendering. This element is often used
#' with the \link{reactivePrint} function to preserve fixed-width formatting
#' of printed objects.
#' @examples
#' mainPanel(
#'   h4("Summary"),
#'   verbatimTextOutput("summary"),
#'  
#'   h4("Observations"),
#'   tableOutput("view")
#' )
#' @export
verbatimTextOutput <- function(outputId) {
  pre(id = outputId, class =  "shiny-text-output")
}

#' Create a plot output element
#' 
#' Render a \link{reactivePlot} within an application page.
#' @param outputId output variable to read the plot from
#' @param width Plot width
#' @param height Plot height
#' @return A plot output element that can be included in a panel
#' @examples
#' # Show a plot of the generated distribution
#' mainPanel(
#'   plotOutput("distPlot")
#' )
#' @export
plotOutput <- function(outputId, width = "100%", height="400px") {
  style <- paste("width:", width, ";", "height:", height)
  div(id = outputId, class="shiny-plot-output", style = style)
}

#' Create a table output element
#' 
#' Render a \link{reactiveTable} within an application page.
#' @param outputId output variable to read the table from
#' @return A table output element that can be included in a panel
#' @examples
#' mainPanel(
#'   tableOutput("view")
#' )
#' @export
tableOutput <- function(outputId) {
  div(id = outputId, class="shiny-html-output")
}

#' Create an HTML output element
#' 
#' Render a reactive output variable as HTML within an application page. The 
#' text will be included within an HTML \code{div} tag, and is presumed to 
#' contain HTML content which should not be escaped.
#' 
#' \code{uiOutput} is intended to be used with \code{reactiveUI} on the
#' server side. It is currently just an alias for \code{htmlOutput}.
#'   
#' @param outputId output variable to read the value from
#' @return An HTML output element that can be included in a panel
#' @examples
#' htmlOutput("summary")
#' @export
htmlOutput <- function(outputId) {
  div(id = outputId, class="shiny-html-output")
}

#' @rdname htmlOutput
#' @export
uiOutput <- function(outputId) {
  htmlOutput(outputId)
}