R/viewData.R

Defines functions viewData

Documented in viewData

#' View data
#'
#' A simple widget to view, filter, and sort data. The function \code{viewData()} has a few optional arguments.
#'
#' @param data name of the data object you want to view (e.g., mtcars, iris, etc.)
#' @param showFilter If \code{TRUE}, table filters will be displayed. The default option is \code{FALSE}.
#' @param row.names By default, \code{row.names} are not printed. Use \code{row.names = TRUE} to print row names
#' @param renderURLS If your data contains urls, use \code{renderURLS = TRUE} to make them clickable. These links must be prepared beforehand and wrapped in \code{<a>} html tag.
#' @param launch.browser If \code{TRUE}, the table will be display in your system's default browser.
#'
#'
#' @examples
#' \dontrun{
#' viewData(data= iris)
#'
#' viewData(data = iris, showFilter = TRUE)
#'
#' viewData(data = iris, launch.browser = TRUE)
#'
#' df <- iris
#' df$urls <- paste0('<a href="https://www.google.com.au/search?q=',Species,'">',Species,'</a>')
#'
#' viewData(data = df, showFilter = TRUE, renderURLS = TRUE, launch.browser = TRUE)
#' }
#'
#' @export

viewData <- function(data, showFilter = FALSE, row.names = FALSE, renderURLS = FALSE, launch.browser = FALSE){

  # validate input
  object <- deparse(substitute(data))
  objectExists <- exists(object, parent.frame())
  if(objectExists == FALSE ){
    stop("Object '",object,"' cannot be found.\n Make sure it's been defined or there aren't any typos.")
  }


  # convert data to data.frame
  df <- data.frame(data, stringsAsFactors = FALSE)


  # buid ui
  ui <- miniUI::miniPage(

    # title bar
    miniUI::gadgetTitleBar(title = "Data Viewer"),

    # main content
    miniUI::miniContentPanel(
      # <head>
      shiny::tags$head(

        # set meta
        shiny::tags$meta("charset" ="utf-8"),
        shiny::tags$meta("http-equiv" ="X-UA-Compatible", "content" ="IE=edge"),
        shiny::tags$meta("name" ="viewport", "content"="width=device-width, initial-scale=1"),

        # css
        shiny::tags$style('
                 html,body{
                  width: 100%;
                  margin: 0;
                  padding: 0;
                  background: white;
                 }
                 .table-container{
                    display:block;
                    width: 95%;
                    padding-top: 1em;
                    padding-bottom: 40px;
                    margin: 0 auto;
                 }
                 .table-container table{
                 font-size: 95%;
                 padding: 4px;
                 border-spacing: 0;
                 }
                 .table-container table tbody tr th{
                 border-bottom: 3px solid #252525;
                 }
                 .table-container table thead tr:last-child th{
                 border-bottom: 3px solid #252525;
                 }
                 .table-container table table th,
                 .table-container table table td{
                 padding: 5px;
                 }
                 .table-container table table th:nth-child(1n+2),
                 .table-container table table td:nth-child(1n+2){
                 text-align: center;
                 }
                 .table-container table tbody tr:last-child td{
                 border-bottom: 1px solid #252525;
                 }
                 .table-container table tbody tr:hover td{
                 background-color: #FBD1A2;
                 color: black;
                 cursor: pointer;
                 }
                 ')

      ), # END HEAD

      #'////////////////////////////////////////

      # body - DT table output
      shiny::tags$div(class="table-container",
                      DT::dataTableOutput("tbl",height = ifelse(isTRUE(launch.browser),"100%","500px"))
      ),

      # additional javascript to close window on button click
      shiny::tags$script(type="text/javascript","
                         var quit = document.getElementById('done');
                         quit.addEventListener('click',function(){window.close()});")
    )
  )

  #'////////////////////////////////////////
  # server
  server <- function(input, output, session){

    # output table
    output$tbl <- DT::renderDataTable(
      df,
      escape = ifelse(isTRUE(renderURLS), FALSE, TRUE),
      rownames = ifelse(isTRUE(row.names), TRUE, FALSE),
      filter = ifelse(isTRUE(showFilter), "top", "none"),
      selection = "none",
      class="row-border hover",
      options = list(
        pageLength = 25,
        initComplete = DT::JS(
          "function(settings, json) {",
          "$(this.api().table().header()).css({'font-family': 'Helvetica','font-weight':'bold'});",
          "$(this.api().table().body()).css({'font-family': 'Helvetica', 'font-size':'11pt'});",
          "var tbl = document.querySelector('#tbl input');",
          "tbl.setAttribute('accesskey','t');",
          "}")
      )
    )

    # if done clicked
    observeEvent(input$done, {
      stopApp()
    })

  }

  #'////////////////////////////////////////
  # gadget options
  if(launch.browser){

    view <- shiny::browserViewer()

  } else {

    view <- shiny::paneViewer(minHeight = 500)

  }

  # display
  shiny::runGadget(ui, server, viewer = view)

}
davidruvolo51/viewData documentation built on May 6, 2019, 9:08 a.m.