Nothing
#' Render a data_diff to html
#'
#' Converts a diff_data object to HTML code, and opens the resulting HTML code
#' in a browser window if \code{view==TRUE} and R is running interactively.
#'
#' @example ./examples/render-diff.R
#' @param diff \code{diff_data object} generated with \code{\link{diff_data}}
#' @param file \code{character} target file (optional)
#' @param view \code{logical} Open the generated HTML in a browser
#' if R is being used interactively
#' @param fragment \code{logical} If \code{TRUE} generate (just) an
#' HTML table, otherwise
#' generate a valid HTML document.
#' @param pretty \code{logical} Use HTML arrow characters instead of '-->'.
#' @param title \code{character} title text. Defaults to the quoted
#' names of the data objects compared,
#' separated by 'vs.'
#' @param summary \code{logical} Should a summary of changes be shown above
#' the HTML table?
#' @param use.DataTables \code{logical} Include jQuery DataTables plugin and enable:
#' - pagination (10,25,50,100,All)
#' - searching
#' - filtering
#' - column visibility (individually enable/disable)
#' - copy/csv/excel/pdf export buttons
#' - column reorder (drag and drop)
#' - row reorder (drag and drop)
#' - row/multirow select
#'
#' @return generated html
#'
#' @seealso data_diff
#'
#' @export
render_diff <- function( diff
, file=tempfile(fileext = ".html")
, view=interactive()
, fragment=FALSE
, pretty=TRUE
, title
, summary=!fragment
, use.DataTables=!fragment
)
{
# get summary information
s <- summary(diff)
# construct the title string
if(missing(title))
{
data_names <- attr(diff, "data_names")
title <- paste(sQuote(s$source_name), "vs.", sQuote(s$target_name))
}
# render to HTML
ctx <- diff$ctx
html <- ctx$call("render_diff", JS(diff$var_name), fragment, pretty)
# add id to main table so we can target it in JavaScript/CSS
html <- gsub("<table>",
"<table id='daff-main' class='dataTable daff-dataTable'>",
html
)
if(pretty)
{
# Replace \u2192 Unicode arrows with html arrows, since it doesn't display
# correctly (or at all) in some browsers, notably Chrome version 50-55 on
# some platforms.
#
# **These changes should be propagated back into the underlying daff source code.**\
# BONUS: At the start of the line, use double right arrow, allowing searches
# to distinguish between "line contains changes" (double right) and
# "this cell has changed" (single right)
modified.line.pattern <- '<tr class="modify">(<td class="index">[0-9:]+</td>)?<td class="modify">\u2192</td>'
modified.line.replace <- '<tr class="modify">\\1<td class=\"modify\">⇒</td>'
html <- gsub(modified.line.pattern,
modified.line.replace,
html,
perl=TRUE)
# Anywhere else, replace with single right arrow bounded by spaces. The spaces
# makes the arrow easier to distinguies visually as wells as allowing browsers
# to split cells containing long strings before/and/or after the arrow.
modified.cell.pattern <- '\u2192'
modified.cell.replace <- ' → '
html <- gsub(modified.cell.pattern,
modified.cell.replace,
html,
fixed=TRUE)
}
# Add title in header and body, as well as date and time
if(!fragment)
html <- gsub("</head>\\s*<body>",
paste0("<title>", title ,"</title>", "\n",
"</head>", "\n",
"<body>", "\n",
"<h1 style='text-align: center;'>", title, "</h1>", "\n",
"<h3 style='text-align: center;'>", Sys.time(), "</h3>", "\n"
),
html
)
if(summary)
{
row_count_change_text <- s$row_count_change_text
col_count_change_text <- s$col_count_change_text
if(pretty)
{
row_count_change_text <- gsub("-->", "→", row_count_change_text)
col_count_change_text <- gsub("-->", "→", col_count_change_text)
}
summary_html <- paste("",
"<div class='highlighter' style='align:center;'>",
"<table style='margin: 0px auto; margin-bottom: 2em; text-align: right'>",
" <thead>",
" <tr class='header' style='text-align: center'>",
" <th></th>",
" <th>#</th>",
" <th class='modify'>Modified</th>",
" <th >Reordered</th>",
" <th class='remove'>Deleted</th>",
" <th class='add'>Added</th>",
" </thead>",
" <tbody>",
" <tr>",
" <td style='font-weight:bold;'>Rows</td>",
" <td>", row_count_change_text, "</td>",
" <td class='modify'>", s$row_updates, "</td>",
" <td >", s$row_reorders, "</td>",
" <td class='remove'>", s$row_deletes, "</td>",
" <td class='add'>" , s$row_inserts, "</td>",
" </tr>",
" <tr>",
" <td style='font-weight:bold;'>Columns</td>",
" <td>", col_count_change_text, "</td>",
" <td class='modify'>", s$col_updates, "</td>",
" <td >", s$col_reorders, "</td>",
" <td class='remove'>", s$col_deletes, "</td>",
" <td class='add'>" , s$col_inserts, "</td>",
" </tr>",
" </tbody>",
"</table>",
"</div>",
"<div class='highlighter'>",
sep="\n"
)
if(fragment)
html <- paste0(summary_html, html, "</div>", sep="\n")
else
html <- gsub("<div class='highlighter'>",
summary_html,
html
)
}
if(use.DataTables)
{
templateFile <- system.file("html_templates", "render_diff.html", package="daff", mustWork=TRUE)
template <- readLines(templateFile)
template <- paste(template, sep="\n", collapse="\n")
html <- gsub("</style>",
template,
html
)
}
# Write to the specified file
cat(html, file = file)
# Display in a browser window
if (view && file != "" && interactive()){
viewer <- getOption("viewer")
if (!is.null(viewer) && is.function(viewer)){
viewer(file)
}else{
utils::browseURL(file)
}
}
# return the rendered HTML code
invisible(html)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.