R/dp_table.R

In petermeissner/diffrprojectswidget: Visualization for 'diffrprojects'

if(getRversion() >= "2.15.1"){
  utils::globalVariables(
    c(
      "token_i_1", "token_i_2",
      "from", "to", "from_1", "to_1", "ti", "to_2", "from_2",
      "alignment_i",
      "var_name", "var_value", "token_i"
    )
  )
}


#' function for tabulation
#'
#' @param dp an object of type diffrproject
#' @param link which link to produce table for
#' @param width width of widget
#' @param height heigth of widget
#' @param align_var either a character vector of variable names or TRUE for all
#' @param text_var either a character vector of variable names or TRUE for all
#' @param aggregate_function a function able to resolve conflicts if for a
#'    specific variable for a token of text severla values exist, if NULL it
#'    defaults to modus() but could also be e.g. paste or something alike
#' @param ... further arguments passed through to aggregate_function
#'
#' @export
#'
#'
dp_table <- function(
  dp,
  link               = NULL,
  align_var          = FALSE,
  text_var           = FALSE,
  aggregate_function = NULL,
  ...,
  width = "100%",
  height = "400px"
) {

  # pass the data and settings using 'x'
  x <-
    dp_prepare_data_table(
      dp,
      link               = NULL,
      align_var          = align_var,
      text_var           = text_var,
      aggregate_function = NULL
    )

  # create a list that contains the settings
  x$options <- list( )

  # create the widget
  htmlwidgets::createWidget(
    "dp_table",
    x,
    width = width,
    height = height,
    package= "diffrprojectswidget"
  )
}



#' dp_table shiny output function
#'
#' @param outputId I have no idea
#' @param width width
#' @param height height
#'
#' @export
#'
dp_tableOutput <- function(outputId, width = "100%", height = "400px") {
  htmlwidgets::shinyWidgetOutput(outputId, "dp_table", width, height, package = "diffrprojectswidget")
}


#' dp_table shiny render function
#'
#' @param expr expr
#' @param env env
#' @param quoted quoted
#'
#'
#' @export
#'
renderDp_table <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  htmlwidgets::shinyRenderWidget(expr, dp_tableOutput, env, quoted = TRUE)
}