findFileInDirs = function(file,dirs) {
pot = c(file, if (length(dirs)>0) paste(dirs,file,sep="/") else NULL)
sel = sapply(pot,file.exists)
sel = which(sel)
if (length(sel) < 1)
stop("file not found:",file," in include directories:",paste(dirs,collapse=","))
pot[sel[1]]
}
RT.standards = c(
"printf = function(...) {",
" cat(sprintf(...))",
"}",
"quiet.source = function(..., comment=\"# \") {",
" f=textConnection(\"quiet.source.text\",\"w\");",
" sink(f); ret=source(...); sink();",
" close(f);",
" cat(paste(comment,quiet.source.text,\"\n\",sep=\"\"),sep=\"\")",
" ret",
"}",
"if (!exists(\"include.dir\")) include.dir=NULL;",
"findFileInDirs =",
deparse(findFileInDirs),
"source = function(file,...) {",
" newfile=findFileInDirs(file, include.dir)",
" base::source(file=newfile,...)",
"}",
"add.include.dir = function(dir) {",
" if (substr(dir,1,1) != \"/\") dir = paste(getwd(),dir,sep=\"/\");",
" include.dir <<- c(include.dir,dir)",
"}",
"linemark=function(...) {invisible(NULL)}"
)
python.standards = c(
"require(rjson,quietly=TRUE,warn.conflicts=FALSE)",
"require(reticulate,quietly=TRUE,warn.conflicts=FALSE)",
"python.run = function(str) py_run_string(paste(str,collapse=\"\\n\"))",
"python.export.all = function() {",
"python.myassign = function (var.name, value)",
"{",
"value <- try(rjson::toJSON(value),silent=TRUE)",
"if (\"try-error\" %in% class(value)) return(invisible(NULL))",
"var.name = gsub(\"[.]\",\"_\",var.name)",
"python.command <- c(paste(var.name, \"='\", value, \"'\", sep = \" \"), ",
"paste(var.name, \"= json.loads(\", var.name, \")\", sep = \"\"))",
"python.command <- paste(python.command, collapse = \"\\n\")",
"python.run(python.command)",
"invisible(NULL)",
"}",
"for (i__ in ls(parent.frame())) python.myassign(i__,get(i__));",
"}",
"python.run(c(",
"\"from io import StringIO\",",
"\"import sys\",",
"\"import json\"))"
)
combine.repeated.opt = function(obj, args, sep = "|") {
opts <- obj@options
opts <- opts[sapply(opts, function(x) x@type == "character")]
for (opt in opts) {
n <- length(args)
values <- character(0)
to.remove <- integer(0)
x <- opt@short_flag
if (!is.na(x)) {
pattern <- paste0("^",x,"$")
i <- grep(pattern, args)
i <- i[i+1 <= n]
values <- c(values, args[i+1])
to.remove <- c(to.remove, c(i,i+1))
}
x <- opt@long_flag
pattern <- paste0("^",x,"$")
i <- grep(pattern, args)
i <- i[i+1 <= n]
values <- c(values, args[i+1])
to.remove <- c(to.remove, c(i,i+1))
pattern <- paste0("^",x,"=")
i <- grep(pattern, args)
values <- c(values,sub(pattern,"",args[i]))
to.remove <- c(to.remove, c(i))
if (length(values) > 1) {
i = min(to.remove)-1
args = args[-to.remove]
n = length(args)
newargs = c(opt@long_flag, paste0(values, collapse=sep))
args = c(
args[seq_len(i)],
newargs,
args[seq_len(n-i)+i]
)
}
}
args
}
#' Main sript for usage of RTemplate as a command-line tool
#'
#' You just call it, and it takes arguments from command-line and does stuff.
#' an example shell script would look like this
#'
#' "#!/bin/bash"
#' "R -e "rtemplate:RTscript()" --args $@@"
#'
#' @export
#' @import optparse
RTscript = function(args = commandArgs(trailingOnly = TRUE)) {
options <- list(
make_option(c("-f","--file"), "store", default="", help="Input file", type="character"),
make_option(c("-o","--out"), "store", default="", help="Output file", type="character"),
make_option(c("-x","--kill"), "store_true", default=FALSE, help="Put the output in a file without \".Rt\" (make a \"dead\" file)"),
make_option(c("-c","--code"), "store_true", default=FALSE, help="Generate R code"),
make_option(c("-s","--shell"), "store_true", default=FALSE,help="Discart first '#!...' line"),
make_option(c("-i","--include"), "store", default="", help="Include a .R file", type="character"),
make_option(c("-I","--includedir"), "store", default="", help="Include directory", type="character"),
make_option(c("-w","--workdir"), "store", default="", help="Set working directory", type="character"),
make_option(c("-q","--quiet"), "store_true", default=FALSE,help="Quiet (print only errors)"),
make_option(c("-t","--csv"), "store", default="", help="Read csv. use: \"-t example.csv:3\" the 3 record of example.csv", type="character"),
make_option(c("-b","--code-fallback"), "store_true", default=FALSE, help="Fallback to code on error"),
make_option(c("-k","--keep-code"), "store_true", default=FALSE, help="Keep the generated .R file"),
make_option(c("-l","--mark-lines"), "store_true", default=FALSE, help="Map lines of input to output (usefull for error marking in C)"),
make_option(c("-p","--profile"), "store_true", default=FALSE, help="Run profiling"),
make_option(c("--relative-to"), "store", default="", help="The path (in marklines) should be relative to this (default: out)", type="character")
)
parser = OptionParser(usage="Usage: RT [-x] -f inputfile [-o outputfile]", options)
args = combine.repeated.opt(parser,args)
opt <- parse_args(parser, args=args, positional_arguments=TRUE)
args = opt$args
opt = opt$options
if (opt$file == "") stop("Input file not specified\nUsage: RT -f file\n");
if (opt$out == "") opt$out = NULL
if (opt$kill) {
if (is.null(opt$out))
{ re = "[.]R[tT][^.]*$";
if (!grepl(re, opt$file))
{
cat("Warning: file not ending with .Rt* while killing - generating .dead file\n")
opt$out = paste(opt$file,"dead",sep=".");
} else {
opt$out = sub(re,"",opt$file);
}
if (opt$code) {
opt$out = paste(opt$out,".R",sep="");
opt$codeout = opt$out;
}
} else {
cat("Warning: output file name provided while killing\n");
}
}
if (is.null(opt$out)) {
if (opt$'keep-code' || opt$"code-fallback") {
cat("Warning: output file name not provided but code requested\n");
opt$'keep-code' = FALSE
opt$"code-fallback" = FALSE
}
} else {
if (opt$code) {
opt$codeout = opt$out;
} else {
opt$codeout = paste0(opt$out,".code.R");
}
}
if (opt$profile) {
if (is.null(opt$out)) {
opt$profile.file = opt$file
} else {
opt$profile.file = opt$out
}
}
if (opt$profile) {
Rprof(paste0(opt$profile.file,".RT.Rprof"))
}
if (opt$'relative-to' == "") opt$'relative-to' = opt$out
if (!is.null(opt$'relative-to')) {
opt$relative = relativePath(opt$file, opt$'relative-to')
} else {
opt$relative = opt$file
}
if (!is.null(opt$out) && !(opt$quiet))
cat("Parsing RT:",opt$file, "->", opt$out," (rel:",opt$relative,")\n");
addcode = NULL
if(opt$csv != "")
{
# cat("Getting params from",opt$csv,"\n");
csvs = strsplit(opt$csv,"[,|]")[[1]]
csvs = strsplit(csvs,":")
for (csv in csvs) {
ind = "";
if (length(csv) == 2) {ind = as.integer(csv[2]); csv = csv[1]; }
if (length(csv) > 2) stop("Wrong format -t argument: file:record");
addcode = c(addcode,
paste0("csvfile = \"", encodeString(csv), "\";"),
"tab = read.csv(csvfile);",
"tab[] = lapply(tab, function(x) if (all(x %in% c('True','TRUE','False','FALSE'))) as.logical(x) else x);",
paste0("tab = tab[", ind, ",,drop=FALSE]"),
"for (n in names(tab)) assign(n,tab[,n]);"
)
}
}
if (length(args) > 0) {
# cat("Evaluating commandline arguments\n");
# argp = parse(text=args)
# eval(argp,e)
addcode = c(addcode,
args
)
}
opt$includedir = strsplit(opt$includedir,"[,|]")[[1]]
if (length(opt$includedir) > 0) {
addcode = c(addcode, paste("add.include.dir(\"",opt$includedir,"\")",sep=""))
}
if (opt$workdir != "") {
addcode = c(addcode, paste("setwd(\"",opt$workdir,"\")",sep=""))
}
opt$include = strsplit(opt$include,"[,|]")[[1]]
if (length(opt$include) > 0) {
addcode = c(addcode, paste("source(\"", opt$include, "\")",sep=""))
}
code = RTfile(opt$file, add=addcode, shell=opt$shell, mark.lines=opt$"mark-lines",filename=opt$relative, includedirs=opt$includedir)
if (opt$profile) {
Rprof(NULL)
}
if (opt$code) {
if (is.null(opt$out)) {
writeLines(code);
} else {
writeLines(code, con=opt$out);
}
} else {
if (opt$'keep-code') {
writeLines(code, con=opt$codeout);
}
if (opt$profile) {
Rprof(paste0(opt$profile.file,".parse.Rprof"))
}
code.p = try(parse(text=code))
if (inherits(code.p,"try-error")) {
if (opt$"code-fallback") {
writeLines(code, con=opt$codeout);
stop("Failed to parse: writen code to ", opt$codeout)
} else {
stop("Failed to parse R code")
}
}
if (opt$profile) {
Rprof(NULL)
Rprof(paste0(opt$profile.file,".run.Rprof"))
}
old.wd = getwd()
if (! is.null(opt$out)) sink(opt$out);
eval.res = try(eval(code.p, globalenv()))
if (! is.null(opt$out)) sink()
setwd(old.wd)
if (inherits(eval.res,"try-error")) {
if (opt$"code-fallback") {
writeLines(code, con=opt$codeout);
stop("Failed to execude R code: writen code to ", opt$codeout)
} else {
stop("Failed to execude R code")
}
}
if (opt$profile) {
Rprof(NULL)
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.