if(require(XML))
{
setMethod("formatOutput", "XMLInternalNode",
function(object, formatters = list())
{
new("FormattedOutput", value = saveXML(object), format = "xml")
})
setMethod("formatOutput", "XMLInternalDocument",
function(object, formatters = list())
{
new("FormattedOutput", value = saveXML(object), format = "xml")
})
setMethod("formatOutput", "HTMLInternalDocument",
function(object, formatters = list())
{
new("FormattedOutput", value = saveXML(object), format = "html")
})
}
setMethod("formatOutput", "ANY",
function(object, formatters = list())
{
printed = capture.output(print(object))
new("FormattedOutput", value = paste(printed, collapse="\n") , format = "text")
})
setMethod("formatOutput", "WithVisValue",
function(object, formatters = list())
{
if(object@visible)
formatObject(object@value, formatters=formatters)
else
new("FormattedOutput", value = character(), format = "null")
})
setMethod("formatOutput", "WithVisPlusGraphics",
function(object, formatters = list())
{
if(object@visible)
val = formatObject(object@value, formatters=formatters)
else
val = new("FormattedOutput", value = character(), format = "null")
graphics = lapply(object@graphics, formatObject, formatters = formatters)
if(length(graphics))
val = c(graphics, val)
if(!is(val, "list"))
val = list(val)
as(val, "FormattedOutputList")
})
setMethod("formatOutput", "recordedplot",
function(object, formatters = list())
{
.fimage(object, redrawPlot)
})
setMethod("formatOutput", "trellis",
function(object, formatters = list())
{
.fimage(object)
})
if(require(ggplot2))
{
setMethod("formatOutput", "ggplot",
function(object, formatters = list())
{
.fimage(object)
})
}
setMethod("formatOutput", "PlotList",
function(object, formatters = list())
{
ret = lapply(object, formatObject, formatters = formatters)
as(ret, "FormattedOutputList")
})
setMethod("formatOutput", "OutputList",
function(object, formatters = list())
{
ret = lapply(object, formatObject, formatters = formatters)
as(ret, "FormattedOutputList")
})
#setMethod("formatOutput", "NULL",
# function(object)
# {
# new("FormattedOutput", value = character(), format = "text")
# })
.fimagedata <- function(obj, disp_fun = print, dev = "png")
{
dev_fun = get(dev)
tpng = tempfile(fileext=dev)
dev_fun(tpng)
disp_fun(obj)
dev.off()
stuff = readBin(tpng, raw(), n = file.info(tpng)$size)
stuff
}
.fimage <- function(obj, disp_fun, dev = "png") {
new("FormattedOutput", format="plot", value = obj, info = list(disp_fun = disp_fun, dev = dev))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.