### send to file
..redirect <- function(object,file,type = c("output", "message", "both"),append){
type <- match.arg( type )
if( is.character(file) ) file <- file( file, open = if(append) "at" else "wt")
if( type %in% c("output", "message") ) sink( file , append = append, type = type)
else{
sink( file, type = "output")
sink( file, type = "message")
}
# borrow the capture function in svMisc instead of all that
# or should I create a text connection, write the expression in, and source it ?
txt <- capture.output(
eval( parse( text = deparse(substitute(object))) )
)
if( type %in% c("output", "both") ) cat( txt, sep = "\n" )
if( type %in% c("output", "message") ) sink(type = type)
else{
sink( type = "output")
sink( type = "message")
}
close(file)
}
..readfromfile <- function(object, file, append = FALSE, objname, envir, verbose = getOption("verbose")){
content <- readLines(file,n=-1)
if(append){ # try to get the content of the object
obj.content <- try( get(objname,envir), silent = !verbose )
if( class(obj.content) == "try-error" ) obj.content <- NULL
content <- c(obj.content,content)
}
assign(objname,content, envir=envir )
invisible(NULL)
}
### send to file
`%file>%` <- function( object, file) ..redirect(object,file,type="output" , append=FALSE)
`%file>>%` <- function( object, file) ..redirect(object,file,type="output" , append=TRUE )
`%2>>%` <- function( object, file) ..redirect(object,file,type="message", append=TRUE )
`%2>%` <- function( object, file) ..redirect(object,file,type="message", append=FALSE)
`%*>>%` <- function( object, file) ..redirect(object,file,type="both", append=TRUE )
`%*>%` <- function( object, file) ..redirect(object,file,type="both", append=FALSE)
### read from file
`%<%` <- function( object, file) ..readfromfile(object,file, append=FALSE, objname=deparse(substitute(object)), envir = parent.frame(1))
`%<<%` <- function( object, file) ..readfromfile(object,file, append=TRUE , objname=deparse(substitute(object)), envir = parent.frame(1))
`%|%` <- function( r, u){
tf <- tempfile()
on.exit( unlink( tf) )
sink(tf)
print( r )
sink()
pi <- pipe( paste( "cat", tf, "|", u ) )
out <- readLines( pi )
close(pi)
structure( out, class= "unixoutput")
}
print.unixoutput <- function( x, ...){
if( length(x) ){
cat( x, sep = "\n", ...)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.