commit a3cf89b5b2cd23c46863bf57b3b3dba8256ed3f6 Author: Eric Schulte Date: Thu Feb 5 15:04:09 2009 -0800 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 000000000..b25c15b81 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/README.markdown b/README.markdown new file mode 100644 index 000000000..e40ab7a5f --- /dev/null +++ b/README.markdown @@ -0,0 +1,9 @@ +rorg --- R and org-mode +====================== + +* for information on R see the [R website](http://www.r-project.org/) +* for information on org see the [Org-Mode website](http://org-mode.org) + +Probably would be good to place the main objectives here, once they +are ironed out. + diff --git a/existing_tools/RweaveOrg/RweaveOrg.R b/existing_tools/RweaveOrg/RweaveOrg.R new file mode 100644 index 000000000..65051921c --- /dev/null +++ b/existing_tools/RweaveOrg/RweaveOrg.R @@ -0,0 +1,358 @@ +require(utils) + +RweaveOrg = function () { + list(setup = RweaveOrgSetup, runcode = RweaveOrgRuncode, + writedoc = RweaveOrgWritedoc, finish = RweaveOrgFinish, + checkopts = RweaveOrgOptions) +} + +RweaveOrgSetup <- + function (file, syntax, output = NULL, quiet = FALSE, debug = FALSE, + echo = TRUE, eval = TRUE, keep.source = FALSE, split = FALSE, + stylepath, pdf = TRUE, eps = TRUE) { + if (is.null(output)) { + prefix.string <- basename(sub(syntax$extension, "", file)) + output <- paste(prefix.string, "org", sep = ".") + } + else prefix.string <- basename(sub("\\.org$", "", output)) + if (!quiet) + cat("Writing to file ", output, "\n", "Processing code chunks ...\n", + sep = "") + output <- file(output, open = "w+") + if (missing(stylepath)) { + p <- as.vector(Sys.getenv("SWEAVE_STYLEPATH_DEFAULT")) + stylepath <- if (length(p) >= 1 && nzchar(p[1])) + identical(p, "TRUE") + else TRUE + } + if (stylepath) { + styfile <- file.path(R.home("share"), "texmf", "Sweave") + if (.Platform$OS.type == "windows") + styfile <- gsub("\\\\", "/", styfile) + if (length(grep(" ", styfile))) + warning(gettextf("path to '%s' contains spaces,\n", + styfile), gettext("this may cause problems when running LaTeX"), + domain = NA) + } + else styfile <- "Sweave" + options <- list(prefix = TRUE, prefix.string = prefix.string, + engine = "R", print = FALSE, eval = eval, fig = FALSE, + pdf = pdf, eps = eps, width = 6, height = 6, term = TRUE, + echo = echo, keep.source = keep.source, results = "verbatim", + split = split, strip.white = "true", include = TRUE, + pdf.version = "1.1", pdf.encoding = "default", concordance = FALSE, + expand = TRUE) + options <- RweaveOrgOptions(options) + list(output = output, styfile = styfile, havesty = FALSE, + haveconcordance = FALSE, debug = debug, quiet = quiet, + syntax = syntax, options = options, chunkout = list(), + srclines = integer(0), srcfile = srcfile(file)) + } + +makeRweaveOrgCodeRunner <- + function (evalFunc = RweaveEvalWithOpt) +{ + RweaveOrgRuncode <- function(object, chunk, options) { + if (!(options$engine %in% c("R", "S"))) { + return(object) + } + if (!object$quiet) { + cat(formatC(options$chunknr, width = 2), ":") + if (options$echo) + cat(" echo") + if (options$keep.source) + cat(" keep.source") + if (options$eval) { + if (options$print) + cat(" print") + if (options$term) + cat(" term") + cat("", options$results) + if (options$fig) { + if (options$eps) + cat(" eps") + if (options$pdf) + cat(" pdf") + } + } + if (!is.null(options$label)) + cat(" (label=", options$label, ")", sep = "") + cat("\n") + } + chunkprefix <- RweaveChunkPrefix(options) + if (options$split) { + chunkout <- object$chunkout[chunkprefix][[1]] + if (is.null(chunkout)) { + chunkout <- file(paste(chunkprefix, "tex", sep = "."), + "w") + if (!is.null(options$label)) + object$chunkout[[chunkprefix]] <- chunkout + } + } + else chunkout <- object$output + saveopts <- options(keep.source = options$keep.source) + on.exit(options(saveopts)) + SweaveHooks(options, run = TRUE) + chunkexps <- try(parse(text = chunk), silent = TRUE) + RweaveTryStop(chunkexps, options) + openSinput <- FALSE + openSchunk <- FALSE + if (length(chunkexps) == 0) + return(object) + srclines <- attr(chunk, "srclines") + linesout <- integer(0) + srcline <- srclines[1] + srcrefs <- attr(chunkexps, "srcref") + if (options$expand) + lastshown <- 0 + else lastshown <- srcline - 1 + thisline <- 0 + for (nce in 1:length(chunkexps)) { + ce <- chunkexps[[nce]] + if (nce <= length(srcrefs) && !is.null(srcref <- srcrefs[[nce]])) { + if (options$expand) { + srcfile <- attr(srcref, "srcfile") + showfrom <- srcref[1] + showto <- srcref[3] + } + else { + srcfile <- object$srcfile + showfrom <- srclines[srcref[1]] + showto <- srclines[srcref[3]] + } + dce <- getSrcLines(srcfile, lastshown + 1, showto) + leading <- showfrom - lastshown + lastshown <- showto + srcline <- srclines[srcref[3]] + while (length(dce) && length(grep("^[[:blank:]]*$", + dce[1]))) { + dce <- dce[-1] + leading <- leading - 1 + } + } + else { + dce <- deparse(ce, width.cutoff = 0.75 * getOption("width")) + leading <- 1 + } + if (object$debug) + cat("\nRnw> ", paste(dce, collapse = "\n+ "), + "\n") + if (options$echo && length(dce)) { + if (!openSinput) { + if (!openSchunk) { + cat("#+BEGIN_LaTeX\n", file = chunkout, append = TRUE) + cat("\\begin{Schunk}\n", file = chunkout, append = TRUE) + linesout[thisline + 1:2] <- srcline + thisline <- thisline + 2 + openSchunk <- TRUE + } + cat("\\begin{Sinput}", file = chunkout, append = TRUE) + openSinput <- TRUE + } + cat("\n", paste(getOption("prompt"), dce[1:leading], + sep = "", collapse = "\n"), file = chunkout, + append = TRUE, sep = "") + if (length(dce) > leading) + cat("\n", paste(getOption("continue"), dce[-(1:leading)], + sep = "", collapse = "\n"), file = chunkout, + append = TRUE, sep = "") + linesout[thisline + 1:length(dce)] <- srcline + thisline <- thisline + length(dce) + } + tmpcon <- file() + sink(file = tmpcon) + err <- NULL + if (options$eval) + err <- evalFunc(ce, options) + cat("\n") + sink() + output <- readLines(tmpcon) + close(tmpcon) + if (length(output) == 1 & output[1] == "") + output <- NULL + RweaveTryStop(err, options) + if (object$debug) + cat(paste(output, collapse = "\n")) + if (length(output) > 0 & (options$results != "hide")) { + if (openSinput) { + cat("\n\\end{Sinput}\n", file = chunkout, append = TRUE) + linesout[thisline + 1:2] <- srcline + thisline <- thisline + 2 + openSinput <- FALSE + } + if (options$results == "verbatim") { + if (!openSchunk) { + cat("#+BEGIN_LaTeX\n", file = chunkout, append = TRUE) + cat("\\begin{Schunk}\n", file = chunkout, + append = TRUE) + linesout[thisline + 1:2] <- srcline + thisline <- thisline + 2 + openSchunk <- TRUE + } + cat("\\begin{Soutput}\n", file = chunkout, + append = TRUE) + linesout[thisline + 1] <- srcline + thisline <- thisline + 1 + } + output <- paste(output, collapse = "\n") + if (options$strip.white %in% c("all", "true")) { + output <- sub("^[[:space:]]*\n", "", output) + output <- sub("\n[[:space:]]*$", "", output) + if (options$strip.white == "all") + output <- sub("\n[[:space:]]*\n", "\n", output) + } + cat(output, file = chunkout, append = TRUE) + count <- sum(strsplit(output, NULL)[[1]] == "\n") + if (count > 0) { + linesout[thisline + 1:count] <- srcline + thisline <- thisline + count + } + remove(output) + if (options$results == "verbatim") { + cat("\n\\end{Soutput}\n", file = chunkout, + append = TRUE) + linesout[thisline + 1:2] <- srcline + thisline <- thisline + 2 + } + } + } + if (openSinput) { + cat("\n\\end{Sinput}\n", file = chunkout, append = TRUE) + linesout[thisline + 1:2] <- srcline + thisline <- thisline + 2 + } + if (openSchunk) { + cat("\\end{Schunk}\n", file = chunkout, append = TRUE) + cat("#+END_LaTeX\n", file = chunkout, append = TRUE) + linesout[thisline + 1:2] <- srcline + thisline <- thisline + 2 + } + if (is.null(options$label) & options$split) + close(chunkout) + if (options$split & options$include) { + cat("#+LaTeX: \\input{", chunkprefix, "}\n", sep = "", file = object$output, + append = TRUE) + linesout[thisline + 1] <- srcline + thisline <- thisline + 1 + } + if (options$fig && options$eval) { + if (options$eps) { + grDevices::postscript(file = paste(chunkprefix, + "eps", sep = "."), width = options$width, height = options$height, + paper = "special", horizontal = FALSE) + err <- try({ + SweaveHooks(options, run = TRUE) + eval(chunkexps, envir = .GlobalEnv) + }) + grDevices::dev.off() + if (inherits(err, "try-error")) + stop(err) + } + if (options$pdf) { + grDevices::pdf(file = paste(chunkprefix, "pdf", + sep = "."), width = options$width, height = options$height, + version = options$pdf.version, encoding = options$pdf.encoding) + err <- try({ + SweaveHooks(options, run = TRUE) + eval(chunkexps, envir = .GlobalEnv) + }) + grDevices::dev.off() + if (inherits(err, "try-error")) + stop(err) + } + if (options$include) { + chunksuffix <- ifelse(options$eps, "eps", "pdf") + cat("[[./", paste(chunkprefix, chunksuffix, sep = "."), "]]\n", + sep = "", file = object$output, append = TRUE) + linesout[thisline + 1] <- srcline + thisline <- thisline + 1 + } + } + object$linesout <- c(object$linesout, linesout) + return(object) + } + RweaveOrgRuncode +} + +RweaveOrgRuncode <- makeRweaveOrgCodeRunner() + +RweaveOrgWritedoc <- + function (object, chunk) { + linesout <- attr(chunk, "srclines") + ## This part of the function adds the appropriate \usepackage + ## directive and begins the document. Skip this for now, but + ## eventually add in detection for #+LATEX_PREAMBLE +### if (length(grep("\\usepackage[^\\}]*Sweave.*\\}", chunk))) +### object$havesty <- TRUE +### if (!object$havesty) { +### begindoc <- "^[[:space:]]*\\\\begin\\{document\\}" +### which <- grep(begindoc, chunk) +### if (length(which)) { +### chunk[which] <- sub(begindoc, paste("\\\\usepackage{", +### object$styfile, "}\n\\\\begin{document}", sep = ""), +### chunk[which]) +### linesout <- linesout[c(1:which, which, seq(from = which + +### 1, length.out = length(linesout) - which))] +### object$havesty <- TRUE +### } +### } + while (length(pos <- grep(object$syntax$docexpr, chunk))) { + cmdloc <- regexpr(object$syntax$docexpr, chunk[pos[1]]) + cmd <- substr(chunk[pos[1]], cmdloc, cmdloc + attr(cmdloc, + "match.length") - 1) + cmd <- sub(object$syntax$docexpr, "\\1", cmd) + if (object$options$eval) { + val <- as.character(eval(parse(text = cmd), envir = .GlobalEnv)) + if (length(val) == 0) + val <- "" + } + else val <- paste("\\\\verb{<<", cmd, ">>{", sep = "") + chunk[pos[1]] <- sub(object$syntax$docexpr, val, chunk[pos[1]]) + } + while (length(pos <- grep(object$syntax$docopt, chunk))) { + opts <- sub(paste(".*", object$syntax$docopt, ".*", sep = ""), + "\\1", chunk[pos[1]]) + object$options <- SweaveParseOptions(opts, object$options, + RweaveOrgOptions) + if (isTRUE(object$options$concordance) && !object$haveconcordance) { + savelabel <- object$options$label + object$options$label <- "concordance" + prefix <- RweaveChunkPrefix(object$options) + object$options$label <- savelabel + object$concordfile <- paste(prefix, "org", sep = ".") + chunk[pos[1]] <- sub(object$syntax$docopt, paste("\\\\input{", + prefix, "}", sep = ""), chunk[pos[1]]) + object$haveconcordance <- TRUE + } + else chunk[pos[1]] <- sub(object$syntax$docopt, "", chunk[pos[1]]) + } + cat(chunk, sep = "\n", file = object$output, append = TRUE) + object$linesout <- c(object$linesout, linesout) + return(object) + } + +RweaveOrgFinish <- + function (object, error = FALSE) { + outputname <- summary(object$output)$description + inputname <- object$srcfile$filename + if (!object$quiet && !error) + cat("\n", gettextf("You can now run org-export-as-latex on '%s'", outputname), + "\n", sep = "") + close(object$output) + if (length(object$chunkout) > 0) + for (con in object$chunkout) close(con) + if (object$haveconcordance) { + linesout <- object$linesout + vals <- rle(diff(linesout)) + vals <- c(linesout[1], as.numeric(rbind(vals$lengths, + vals$values))) + concordance <- paste(strwrap(paste(vals, collapse = " ")), + collapse = " %\n") + special <- paste("\\special{concordance:", outputname, + ":", inputname, ":%\n", concordance, "}\n", sep = "") + cat(special, file = object$concordfile) + } + invisible(outputname) + } + +RweaveOrgOptions <- RweaveLatexOptions diff --git a/existing_tools/RweaveOrg/SweaveSyntaxOrg.R b/existing_tools/RweaveOrg/SweaveSyntaxOrg.R new file mode 100644 index 000000000..df1f10ff8 --- /dev/null +++ b/existing_tools/RweaveOrg/SweaveSyntaxOrg.R @@ -0,0 +1,19 @@ +SweaveSyntaxOrg <- list() +SweaveSyntaxOrg$doc <- "^#\\+END_[SR]" +SweaveSyntaxOrg$code <- "^#\\+BEGIN_[SR]:?[[:space:]]*(.*)$" +SweaveSyntaxOrg$coderef <- "^#\\+[SR]_CODEREF:?[[:space:]]*(.*)$" +SweaveSyntaxOrg$docopt <- "^#\\+[SR]_OPTS:?[[:space:]]*(.*)$" +SweaveSyntaxOrg$docexpr <- "\\\\[SR]\\{([^\\}]*)\\}" +SweaveSyntaxOrg$extension <- "\\.[SRsr]org$" +SweaveSyntaxOrg$syntaxname <- "^#\\+[SR]WEAVE_SYNTAX:?[[:space:]]*(.*)$" +SweaveSyntaxOrg$input <- "^#\\+[SR]_FILE:?[[:space:]]*(.*)$" +SweaveSyntaxOrg$trans <- list() +SweaveSyntaxOrg$trans$doc <- "\\\\end{Scode}" +SweaveSyntaxOrg$trans$code <- "\\\\begin{Scode}{\\1}" +SweaveSyntaxOrg$trans$coderef <- "\\\\Scoderef{\\1}" +SweaveSyntaxOrg$trans$docopt <- "\\\\SweaveOpts{\\1}" +SweaveSyntaxOrg$trans$docexpr <- "\\\\Sexpr{\\1}" +SweaveSyntaxOrg$trans$extension <- ".[SR]org" +SweaveSyntaxOrg$trans$syntaxname <- "\\\\SweaveSyntax{SweaveSyntaxLatex}" +SweaveSyntaxOrg$trans$input <- "\\\\SweaveInput{\\1}" +attr(SweaveSyntaxOrg, "class") <- "SweaveSyntax" diff --git a/existing_tools/RweaveOrg/export_testing.R b/existing_tools/RweaveOrg/export_testing.R new file mode 100644 index 000000000..b8412a620 --- /dev/null +++ b/existing_tools/RweaveOrg/export_testing.R @@ -0,0 +1,5 @@ +source("SweaveSyntaxOrg.R") +source("RweaveOrg.R") + +Sweave("testing.Rorg", driver=RweaveOrg, syntax=SweaveSyntaxOrg) +Stangle("testing.Rorg", driver=Rtangle(), syntax=SweaveSyntaxOrg) diff --git a/existing_tools/RweaveOrg/testing.Rorg b/existing_tools/RweaveOrg/testing.Rorg new file mode 100644 index 000000000..51cf2c643 --- /dev/null +++ b/existing_tools/RweaveOrg/testing.Rorg @@ -0,0 +1,73 @@ +# -*- mode: org -*- +#+OPTIONS: LaTeX:t + +* Sweave and org-mode + If you're reading a PDF version of this document, you should also + look at [[file:testing.Rorg][testing.Rorg]] (the source file) and [[file:testing.org][testing.org]] (the output + of the Sweave process). + + Keep in mind that one of the advantages of a block-based approach is + using \texttt{C-'} to edit code in its native mode. + +** Use the Sweave package for latex formatting + Org allows us to issue commands to be included in \{LaTeX} export. +#+LATEX_HEADER: \usepackage{Sweave} + +** R blocks + The first argument to an R block when using Sweave is the label for + that block. + + Not all R blocks are printed. Sweave options allow the printing of + the evaluated code, the output of the code, both, or neither. + +*** R code that is not printed +#+BEGIN_R: hidden_block, echo=FALSE, results=HIDE + a <- 3 + b <- 6 +#+END_R + +*** R code that is printed +#+BEGIN_R: visible_block + c <- 4 +#+END_R + + We can use block labels to embed blocks by reference (even if they + weren't printed before). +*** R code that references other blocks +#+BEGIN_R: combined_block +#+R_CODEREF: hidden_block +#+R_CODEREF: visible_block + a + b +c +#+END_R + +** Inline references to R data + We can evaluate R code inline. +*** Used in text + The value of =a= is \R{a}. + +*** Used in a table + | a | b | c | TOTAL | + |-------+-------+-------+---------------| + | \R{a} | \R{b} | \R{c} | \R{a + b + c} | + +** Single-line R commands + If we want a line of R code to be evaluated but not printed, + there's a convenient shorthand. This only works for single lines + of R code, but you can have more than one in a row. +#+R: library(lattice) +#+R: data(cars) + +** Graphics + We use values defined elsewhere in the buffer to produce this + graph. The new CAPTION and LABEL arguments work just fine. + +#+CAPTION: speed by distance +#+LABEL: fig:speed_by_distance +#+BEGIN_R fig=TRUE, eps=FALSE, pdf=TRUE +print(xyplot(speed ~ dist, cars, + panel = function (x, y, ...) { + panel.xyplot(x, y, ...) + panel.abline(h=a) + panel.abline(v=b) + })) +#+END_R diff --git a/existing_tools/org-R.el b/existing_tools/org-R.el new file mode 100644 index 000000000..8b84b2cd9 --- /dev/null +++ b/existing_tools/org-R.el @@ -0,0 +1,846 @@ +;;; org-R.el --- Numerical computation and data visualisation for org-mode using R + +;; Copyright (C) 2009 +;; Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: org, R, ESS, tables, graphics +;; Homepage: http://www.stats.ox.ac.uk/~davison/software/org-R +;; Version: 0.05 2009-02-05 +;; +;; This file is not part of GNU Emacs. +;; +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file allows R (http://www.r-project.org) code to be applied to +;; emacs org-mode (http://orgmode.org) tables. When the +;; result of the analysis is a vector or matrix, it is output back +;; into the org-mode buffer as a new org table. Alternatively the R +;; code may be used to plot the data in the org table. It requires R to be +;; running in an inferior-ess-mode buffer (install Emacs Speaks +;; Statistics http://ess.r-project.org and issue M-x R). +;; +;; +;; The user interface is via two different options lines in the org +;; buffer. As is conventional in org-mode, these are lines starting +;; with `#+'. Lines starting with #+R: specify options in the +;; standard org style (option:value) and are used to specify certain +;; off-the-shelf transformations and plots of the table data. The +;; #+R: line is also used to specify the data to be analysed +;; (either an org table or a csv file), and to restrict the analysis +;; to certain columns etc. In lines starting #+RR: you can supply +;; literal R code, giving you full control over what you do with the +;; table. With point in the first #+R line, M-x org-R-apply +;; makes happen whatever has been specified in those lines. + +;; The best documentation is currently the Worg tutorial: +;; +;; http://orgmode.org/worg/org-tutorials/org-R/org-R.php + + +(defconst org-R-skeleton-funcall-1-arg + "%s(x[%s]%s)" + "Skeleton of a call to an R function. +E.g. barplot(x[,3:5], names.arg=rownames(x))") + +(defconst org-R-skeleton-funcall-2-args + "%s(x[,%s], x[,%s]%s)" + "Skeleton of a call to an R function which can take x and y + args.") + +(defconst org-R-write-org-table-def + "write.org.table <- function (x, write.rownames = TRUE) +{ + if(!is.null(dim(x)) && length(dim(x)) > 2) + stop(\"Object must be 1- or 2-dimensional\") ; + if(is.vector(x) || is.table(x) || is.factor(x) || is.array(x)) + x <- as.matrix(x) ; + if(!(is.matrix(x) || inherits(x, c('matrix', 'data.frame')))) { + invisible() ; + print(x) ; + stop(\"Object not recognised as 1- or 2-dimensional\") ; + } ; + if(is.null(colnames(x))) + colnames(x) <- rep('', ncol(x)) ; + if(write.rownames) + x <- cbind(rownames(x), x) ; + cat('|', paste(colnames(x), collapse = ' | '), '|\\n') ; + cat('|', paste(rep('----', ncol(x)), collapse = '+'), '|\\n', sep = '') ; + invisible(apply(x, 1, function(row) cat('|', paste(row, collapse = ' | '), '|\\n'))) ; +}" + "Definition of R function to write org table representation of R objects. +To see a more human-readable version of this, look at the code, +or type dput(write.org.table) RET at the R (inferior-ess-mode +buffer) prompt.") + + +(defun org-R-apply () + "Construct and evaluate an R function call. +Construct an R function corresponding to the #+R: and #+RR: +lines. R must be currently running in an inferior-ess-mode +buffer. The function evaluates any user-supplied R code in the +#+RR: line before the off-the-shelf actions specified in the #+R: +line. The user-supplied R code can operate on a variable called x +that is the org table represented as a data frame in R. Text +output from the R process may be inserted into the org buffer, as +an org table where appropriate." + (interactive) + (require 'ess) + (save-excursion + (beginning-of-line) + (unless (looking-at "#\\+RR?:") (error "Point must be in a #+R or #+RR line")) + (while (looking-at "#\\+RR?:") (forward-line -1)) + (forward-line) + ;; For the rest of the code in this file we are based at the + ;; beginning of the first #+R line + + ;; FIXME: if point is at the beginning of the #+RR? lines when + ;; this function is called, then tabular output gets inserted, + ;; leaving point up at the top of the tabular output. + + (let* ((options (org-R-get-options)) + (code (org-R-construct-code options)) + (infile (plist-get options :infile)) + (ext (if infile (file-name-extension infile))) + csv-file) + + (if (string-equal ext "csv") + (setq csv-file infile) + (setq csv-file + (org-R-export-to-csv + (make-temp-file "org-R-tmp" nil ".csv") options))) + + (org-R-eval code csv-file options) + + (delete-other-windows) ;; FIXME + (if (plist-get options :showcode) (org-R-showcode code))))) + +(defun org-R-apply-to-subtree () + "Call org-R-apply in every org-R block in current subtree." + ;; This currently relies on re-search-forward leaving point after + ;; the #+RR?: If point were at the beginning of the line, then + ;; tabular input would get inserted leaving point above the #+RR?:, + ;; and this would loop infinitely. Same for org-R-apply-to-buffer. + (interactive) + (save-excursion + (org-back-to-heading) + (while (re-search-forward + "^#\\+RR?:" + (save-excursion (org-end-of-subtree)) t) + (org-R-apply) + (forward-line) + (while (looking-at "#\\+RR?") + (forward-line))))) + +(defun org-R-apply-to-buffer () + "Call org-R-apply in every org-R block in the buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^#\\+RR?:" nil t) + (org-R-apply) + (forward-line) + (while (looking-at "#\\+RR?") + (forward-line))))) + +(defun org-R-construct-code (options) + "Construct the R function that implements the requested +behaviour. The body of this function derives from two sources: + +1. Explicit R code which is read from lines starting with +#+RR: by org-R-get-user-code, and + +2. Off-the-shelf code corresponding to options specified in the +#+R: line. This code is constructed by +org-R-off-the-shelf-code." + (let ((user-code (org-R-get-user-code)) + (action (plist-get options :action))) + + (if (or (eq action 'tabulate) (eq action 'transpose)) + (setq options (plist-put options :output-to-buffer t))) + (format "function(x){%sx}" + (concat + (when user-code (concat user-code ";")) + (when action (concat (org-R-off-the-shelf-code options) ";")))))) + +(defun org-R-get-user-code (&optional R) + "Read user-supplied R code from #+RR: lines" + (let ((case-fold-search t)) + (save-excursion + (while (looking-at "^#\\+\\(RR?:\\) *\\(.*\\)") + (if (string= "RR:" (match-string 1)) + (setq R (concat R (when R ";") (match-string 2)))) + (forward-line)))) + R) + +(defun org-R-off-the-shelf-code (options) + "Return R code implementing the actions requested in the +#+R: lines." + + ;; This is a somewhat long function as it deals with several + ;; different cases, corresponding to all the off-the-shelf actions + ;; that have been implemented. + + (let* ((action (plist-get options :action)) + (cols (plist-get options :columns)) + (ncols (org-R-number-of-columns cols)) + (nxcols (nth 0 ncols)) + (nycols (nth 1 ncols)) + (cols-R (org-R-make-index-vectors cols)) + (xcols-R (nth 0 cols-R)) + (ycols-R (nth 1 cols-R)) + seq args largs extra-code title colour matrix-index) + + ;; I want this to affect options outside this function. Will it + ;; necessarily do so? (not if plist-put adds to head of the + ;; plist?) + (setq options (plist-put options :nxcols nxcols)) + + (cond ((eq action 'points) + (setq action 'plot) + (setq options (plist-put options :lines nil))) + ((eq action 'lines) + (setq action 'plot) + (setq options (plist-put options :lines t)))) + + (if (and (setq title (plist-get options :title)) (symbolp title)) + (setq title symbol-name title)) + + (setq args (plist-put args :main (concat "\"" title "\""))) + + (if (setq colour (or (plist-get options :colour) + (plist-get options :color) + (plist-get options :col))) + (setq args + (plist-put args :col + (concat "\"" (if (symbolp colour) (symbol-name colour) colour) "\"")))) + + (setq largs + (if (setq legend (plist-get options :legend)) + (plist-put largs :x + (concat "\"" (if (symbolp legend) (symbol-name legend) legend) "\"")) + (plist-put largs :x "\"topright\""))) + + (cond + ((null ycols-R) + ;; single set of columns; implicit x values + (if (null xcols-R) + (setq xcols-R "" matrix-index "") + (setq matrix-index (concat "," xcols-R))) + (cond + + ;;---------------------------------------------------------------------- + + ((eq action 'barplot) + (if (eq nxcols 1) + (progn + (setq args (plist-put args :names.arg "rownames(x)")) + (setq args (org-R-set-user-supplied-args args (plist-get options :args))) + (format org-R-skeleton-funcall-1-arg + "barplot" xcols-R + (concat ", " (org-R-plist-to-R-args args)))) + + (setq args (plist-put args :names.arg "colnames(x)")) + (setq args (plist-put args :col "seq(nrow(x))")) + (setq args (plist-put args :beside "TRUE")) + + (setq largs (plist-put largs :bty "\"n\"")) + ;; (setq largs (plist-put largs :lwd 10)) + (setq largs (plist-put largs :col "seq(nrow(x))")) + (setq largs (plist-put largs :legend "rownames(x)")) + + (setq args (org-R-set-user-supplied-args args (plist-get options :args))) + + (concat (format org-R-skeleton-funcall-1-arg + "barplot(as.matrix" matrix-index + (concat "), " (org-R-plist-to-R-args args))) + "; legend(" (org-R-plist-to-R-args largs) ")"))) + + ;;---------------------------------------------------------------------- + + ((eq action 'density) + (if (and nxcols (> nxcols 1)) + (error "Multiple columns not implemented for action:%s" action)) + + (setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]"))) + (setq args (org-R-set-user-supplied-args args (plist-get options :args))) + + (format org-R-skeleton-funcall-1-arg + "plot(density" matrix-index + (concat "), " (org-R-plist-to-R-args args)))) + + ;;---------------------------------------------------------------------- + + ((eq action 'hist) + (if (and nxcols (> nxcols 1)) + (error "Multiple columns not implemented for action:%s" action)) + (setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]"))) + (setq args (org-R-set-user-supplied-args args (plist-get options :args))) + (setq args (concat ", " (org-R-plist-to-R-args args))) + (format org-R-skeleton-funcall-1-arg "hist" matrix-index args)) + + ;;---------------------------------------------------------------------- + + ((eq action 'image) + (format org-R-skeleton-funcall-1-arg "image(as.matrix" matrix-index ")")) + + ;;---------------------------------------------------------------------- + + ((eq action 'plot) + (setq seq (concat "seq_along("xcols-R")")) + + (setq args (plist-put args :type (if (plist-get options :lines) "\"l\"" "\"p\""))) + (setq args (plist-put args :ylab (concat "colnames(x)["xcols-R"]"))) + (setq args (concat ", " (org-R-plist-to-R-args args))) + + (concat (format org-R-skeleton-funcall-1-arg + (if (eq nxcols 1) "plot" "matplot") matrix-index args) + extra-code)) + + ;;---------------------------------------------------------------------- + + ((eq action 'tabulate) + (concat + (if (plist-get options :sort) + (format org-R-skeleton-funcall-1-arg + "x <- sort(table" xcols-R "), decreasing=TRUE") + (format org-R-skeleton-funcall-1-arg "x <- table" matrix-index "")) + (if (eq nxcols 1) "; x <- data.frame(value=names(x), count=x[])"))) + + ;;---------------------------------------------------------------------- + + ((eq action 'transpose) + (format org-R-skeleton-funcall-1-arg "x <- t" matrix-index "")) + + ;;---------------------------------------------------------------------- + + ;; Don't recognise action: option, try applying it as the name of an R function. + + (t (format org-R-skeleton-funcall-1-arg + (concat "x <- " (symbol-name action)) matrix-index "")))) + + ;;---------------------------------------------------------------------- + + (ycols-R + ;; x and y columns specified + (cond + + ;;---------------------------------------------------------------------- + + ((eq action 'plot) + (unless (eq nxcols 1) (error "Multiple x-columns not implemented for action:plot")) + + (setq args + (plist-put + args :ylab + (concat "if(length("ycols-R") == 1) colnames(x)["ycols-R"] else ''"))) + (setq args (plist-put args :xlab (concat "colnames(x)["xcols-R"]"))) + + (setq args (plist-put args :type (if (plist-get options :lines) "\"l\"" "\"p\""))) + + (setq args (concat ", " (org-R-plist-to-R-args args))) + (setq seq (concat "seq_along("ycols-R")")) + + (setq largs (plist-put largs :col seq)) + (setq largs (plist-put largs :lty seq)) + (setq largs (plist-put largs :bty "\"n\"")) + (setq largs (plist-put largs :legend (concat "colnames(x)["ycols-R"]"))) + + (setq extra-code + (concat "; " + "if(length("ycols-R") > 1) " + "legend(" (org-R-plist-to-R-args largs) ")")) + + (concat (format org-R-skeleton-funcall-2-args + (if (and (eq nxcols 1) (eq nycols 1)) "plot" "matplot") + xcols-R ycols-R args) + extra-code)) + + ;;---------------------------------------------------------------------- + + (t (error "action:%s requires a single set of columns" (symbol-name action)))))))) + +(defun org-R-set-user-supplied-args (args user-args) + "Set user-supplied values in arguments plist." + (while (setq prop (pop user-args)) + (setq args (plist-put args prop (pop user-args)))) + args) + +(defun org-R-plist-to-R-args (plist) + "Convert a plist into a string of R arguments." + (let (arg-string arg) + (while (setq arg (pop plist)) + (string-match ":\\(\.*\\)" (symbol-name arg)) + (setq arg (match-string 1 (symbol-name arg))) + (setq arg-string + (concat + (if arg-string (concat arg-string ", ")) + (format "%s=%s" arg (pop plist))))) + arg-string)) + +(defun org-R-alist-to-R-args (alist) + "Convert an alist of (argument . val) pairs into a string of R arguments. +The alist is something like + '((arg1 . 1) + (arg2 . a)) +This isn't used, but it seems much nicer than +my plist equivalent. Is there a better way to write the plist +version? +" + (mapconcat + 'identity + (mapcar (lambda(pair) (format "%s = %s" (car pair) (cdr pair))) alist) + ", ")) + +(defun org-R-make-index-vectors (cols) + "COLS is the lisp form given by the `columns:' option. It may +take the following forms: + +1. integer atom - the number of the column +2. symbol/string atom - the name of the column +3. list of length 1 - same as 1 or 2 above +4. list of length > 1 - specification of multiple columns as 1 or 2 above, unless it is +5. list of 2 lists - each list specifies (possibly multiple) columns + +In cases 1-4 this function returns a list of length 1, containing +the R index vector as a string. In case 5 this function returns a +list of two such index vectors. + +In cases 1 - 4, when a bivariate plot is requested such as by +`action:lines', the x values are implicit, i.e +1,2,...,number-of-rows. + +In case 4, an attempt is made to do something sensible with the +multiple columns, e.g. for `action:lines' they will be plotted +together on the same graph against the implicit x values, and for +`action:barplot' the bars corresponding to a single row will be +stacked on top of each other, or placed side by side, depending +on the value of the `beside' option. + +For `action:tabulate', if 2 columns are selected, a +two-dimensional table is created. If more than 2, then the +appropriately dimensioned table is computed and inserted using +the standard text representation of multi-dimensional arrays used +by R (as org does not currently have tables of dimension > 2). + +The straightforward case of case 5 is that both lists are of +length 1. For `action:plot' and `action:lines' these specify the +y and x coordinates of the points to be plotted or joined by +lines. + +The intention is that `org-R-apply' does something +corresponding to what would happen if you did the following in R: + +fun(x=tab[,xcols], y=tab[,ycols]) + +where fun is the R function implementing the desired +action (plotting/computation), tab is the org table, xcols are +the columns specified in cases 1-4 above, and ycols are the +second set of columns which might have been specified under case +5 above. For relevant R documentation see the help page +associated with the function xy.coords, e.g. by typing ?xy.coords +at the R prompt. + +The following won't work with case 5: `tabulate' +" + (defun org-R-make-index-vector (cols) + "Return the R indexing vector (as a string) corresponding to +the lisp form COLS. In this function, COLS is a either a list of +atoms, or an atom, i.e. in the form of cases 1-4" + (when cols + (let (to-stringf) + (unless (listp cols) (setq cols (list cols))) + (setq to-stringf + (cond ((car (mapcar 'symbolp cols)) + (lambda (symbol) (concat "\"" (symbol-name symbol) "\""))) + ((car (mapcar 'integerp cols)) + 'int-to-string) + ((car (mapcar 'stringp cols)) + (lambda (string) (concat "\"" string "\""))) + (t (error "Column selection should be symbol, integer or string: %S" cols)))) + (concat (when (> (length cols) 1) "c(") + (mapconcat to-stringf cols ",") + (when (> (length cols) 1) ")"))))) + + (if (and (listp cols) (listp (car cols))) + (mapcar 'org-R-make-index-vector cols) ;; case 5 + (list (org-R-make-index-vector cols)))) ;; other cases + +(defun org-R-number-of-columns (cols) + (defun f (c) (if (listp c) (length c) 1)) + (if (and (listp cols) (listp (car cols))) + (mapcar 'f cols) + (list (f cols)))) + +(defun org-R-eval (R-function csv-file options) + "Apply an R function to tabular data and receive output as an org table. + +R-FUNCTION is a string; it may be simply the name of an +appropriate R function (e.g. \"summary\", \"plot\"), or a +user-defined anonymous function of the form +\"(function(data.frame) {...})\". It will receive as its first +argument the org table as an R 'data frame' -- a table-like +structure which can have columns containing different types of +data -- numeric, character etc. + +The R function may produce graphical and/or text output. If it +produces text output, and the replace:t is specified, and if +there is a table immediately above the #+R lines, then it is +replaced by the text output. Otherwise the text output is +inserted above the #+R lines. +" + (let ((transit-buffer "org-R-transit") + (infile (plist-get options :infile)) + (output-file (plist-get options :outfile)) + (title (plist-get options :title)) + output-format graphics-output-file width height) + + (unless (not output-file) + ;; We are writing output to file. Determine file format and + ;; location, and open graphics device if necessary. + (if (string-match + "\\(.*\.\\)?\\(org\\|png\\|jpg\\|jpeg\\|pdf\\|ps\\|bmp\\|tiff\\)$" + output-file) + (setq output-format (match-string 2 output-file)) + (error "Did not recognise file name suffix %s as available output format" + (match-string 2 output-file))) + (unless (match-string 1 output-file) + ;; only suffix provided: store in org-attach dir + (require 'org-attach) + (let ((temporary-file-directory (org-attach-dir t))) + (setq output-file + (make-temp-file + "org-R-output-" nil (concat "." output-format))))) + (if (eq output-format "jpg") (setq output-format "jpeg")) + (setq graphics-output-file (not (string-equal output-format "org"))) + (if graphics-output-file ;; open the graphics device + (ess-execute + (concat output-format "(file=\"" output-file "\"" + (if (setq width (plist-get options :width)) + (format ", width=%d" width)) + (if (setq height (plist-get options :height)) + (format ", height=%d" height)) ")")))) + + ;; Apply R code to table (which is now stored as a csv file) + ;; does it matter whether this uses ess-command or ess-execute? + + ;; First evaluate function definition for R -> org table conversion + (ess-execute (replace-regexp-in-string "\n" " " org-R-write-org-table-def) + nil transit-buffer) + + ;; FIXME: why not eval the function def together with the function call + ;; as in the commented out line below (it didn't work for some reason) + (ess-execute + (concat + ;; (replace-regexp-in-string "\n" " " org-R-write-org-table-def) ";" + (org-R-make-expr R-function csv-file options)) nil transit-buffer) + + (save-excursion + (set-buffer (concat "*" transit-buffer "*")) + (unless (or (looking-at "$") + (string-equal (buffer-substring-no-properties 1 2) "|")) + (error "Error in R evaluation:\n%s" (buffer-string)))) + + + (if csv-file + (unless (and infile + (string-equal (file-name-extension infile) "csv")) + (delete-file csv-file))) + + (if graphics-output-file (ess-execute "dev.off()")) ;; Close graphics device + + (unless (or graphics-output-file + (not (plist-get options :output-to-buffer))) + ;; Send tabular output to a org buffer as new org + ;; table. Recall that we are currently at the beginning of the + ;; first #+R line + (if (and output-file graphics-output-file) + (error "output-to-buffer and graphics-output-file both t")) + + (save-excursion + (if output-file + (progn (set-buffer (find-file-noselect output-file)) + (delete-region (point-min) (point-max))) + (if (plist-get options :replace) + (progn ;; kill a table iff in one or one ends on the previous line + (delete-region (org-table-begin) (org-table-end)) + (save-excursion + (forward-line -1) + (if (looking-at "#\\+TBLNAME") + (delete-region (point) (1+ (point-at-eol)))))))) + (if title (insert "#+TBLNAME:" title "\n")) + (insert-buffer-substring (concat "*" transit-buffer "*")) + (org-table-align) + (if output-file (save-buffer)))) + + ;; We might be linking to graphical output, or to org output in + ;; another file. Either way, point is still at the beginning of + ;; the first #+R line. + (unless (not output-file) + (save-excursion + (forward-line -1) + (if (looking-at "\\[\\[file:") + (delete-region (point) (1+ (point-at-eol))))) + (insert (org-make-link-string + (concat "file:" output-file) + (unless (plist-get options :inline) + (or title (concat output-format " output")))) "\n")) + + (kill-buffer (concat "*" transit-buffer "*")))) + + +(defun org-R-export-to-csv (csv-file options) + "Find and export org table to csv. + +If the intable: option has not been supplied, then the table must +end on the line immediately above the #+R lines. Otherwise, +the remote table referenced by the intable: option is found using +org-R-find-table. If options:infile has been set then this is the +org file containing the table. See the docstring of +org-R-find-table for details." + (let ((tbl-name-or-id (plist-get options :intable)) + (org-file (plist-get options :infile)) tbl-marker) + + (if (and org-file + (not (string-equal (file-name-extension org-file) "org"))) + (error "File %s extension is not .csv so should be .org")) + + (save-excursion + (if tbl-name-or-id + ;; a remote table has been specified -- move into it + (progn + (if org-file (set-buffer (find-file-noselect org-file))) + (setq tbl-marker (org-R-find-table tbl-name-or-id 'marker)) + (set-buffer (marker-buffer tbl-marker)) + (goto-char (marker-position tbl-marker))) + (forward-line -1)) ;; move into table above + (if (looking-at "[ \t]*|") + (progn (org-table-export csv-file "orgtbl-to-csv") csv-file) + nil)))) + +(defun org-R-find-table (name-or-id &optional markerp) + "Return location of a table. + +NAME-OR-ID may be the name of a +table in the current file as set by a \"#+TBLNAME:\" directive. +The first table following this line will then be used. +Alternatively, it may be an ID referring to any entry, perhaps in +a different file. In this case, the first table in that entry +will be referenced. The location is returned as a marker pointing +to the beginning of the first line of the table. + +This is taken from the first part of org-table-get-remote-range +in org-table.el. +" + (cond + ((symbolp name-or-id) (setq name-or-id (symbol-name name-or-id))) + ((numberp name-or-id) (setq name-or-id (number-to-string name-or-id)))) + (save-match-data + (let ((id-loc nil) (case-fold-search t) buffer loc) + (save-excursion + (save-restriction + (widen) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + (concat "^#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") + nil t) + ;; OK, we've found a matching table name in this buffer. + (setq buffer (current-buffer) loc (match-beginning 0)) + ;; It's not a table name in this buffer. It must be an entry id. + ;; obtain a marker pointing to it. + (setq id-loc (org-id-find name-or-id 'marker) + buffer (marker-buffer id-loc) + loc (marker-position id-loc)) + (move-marker id-loc nil))) ;; disable the marker + ;; (switch-to-buffer buffer) + (set-buffer buffer) + ;; OK, so now we're in the right buffer, and loc is either + ;; the beginning of the #+TBLNAME line, or the location of the entry + ;; either way we need to search forward to get to the beginning of the table + (save-excursion + (save-restriction + (widen) + (goto-char loc) + (forward-char 1) + ;; The following regexp search finds the beginning of + ;; the next table in this entry. If it gets to the next + ;; entry before the next table, then it signals failure. + (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) + (not (match-beginning 1))) + (error "Cannot find a table at NAME or ID %s" name-or-id)) + (if markerp + (move-marker (make-marker) (point-at-bol) (current-buffer)) + (error "Option to return cons cell not implemented. + It should return (file-name . position) to be + consistent with functions in org-id.el"))))))))) + +(defun org-R-make-expr (R-function csv-file options) + "Construct R code to read data, analyse it and write output." + + (let ((rownames (plist-get options :rownames)) + (colnames (plist-get options :colnames)) + (action (plist-get options :action)) + (replace (plist-get options :replace))) + + (if (and csv-file (symbolp csv-file)) + (setq csv-file (symbol-name csv-file))) + + (format "write.org.table((%s)(%s), write.rownames=%s)" + R-function + (if csv-file + (format + "read.csv(\"%s\", header=%s, row.names=%s)" + csv-file + + ;; Do we treat first row as colnames? Yes by default + ;; FIXME: should really check for hline + (if colnames "TRUE" "FALSE") + + ;; Do we use a column as rownames? Not unless rownames: is specified + (if rownames "1" "NULL")) + "NULL") + + ;; Do we write rownames into org table? + (cond ((eq action 'tabulate) + (if (eq (plist-get options :nxcols) 1) "FALSE" "TRUE")) + ((eq action 'transpose) (if colnames "TRUE" "FALSE")) + (rownames "TRUE") + (t "TRUE"))))) + +(defun org-R-get-options () + "Parse the #+R: lines and return the options and values as a p-list." + (let ((opts '( + (:infile . "infile") + (:intable . "intable") + (:rownames . "rownames") + (:colnames . "colnames") + (:columns . "columns") + + (:action . "action") + (:args . "args") + + (:outfile . "outfile") + (:replace . "replace") + (:title . "title") + (:legend . "legend") + (:colour . "colour") + (:color . "color") + (:col . "col") + (:height . "height") + (:width . "width") + (:lines . "lines") + (:sort . "sort") + (:inline . "inline") + + (:output-to-buffer . "output-to-buffer") + + (:showcode . "showcode"))) + (regexp ":\\(\"[^\"]*\"\\|(([^)]*) *([^)]*))\\|([^)]*)\\|[^ \t\n\r;,.]*\\)") + (case-fold-search t) p) + + ;; FIXME: set default options properly + (setq p (plist-put p :output-to-buffer t)) ;; FIXME: hack: null options plist is bad news + (setq p (plist-put p :replace t)) + (setq p (plist-put p :rownames nil)) + (setq p (plist-put p :colnames t)) + (setq p (plist-put p :inline nil)) + + (save-excursion + (while (looking-at "^#\\+\\(RR?:+\\) *\\(.*\\)") + (if (string= "R:" (match-string 1)) + (setq p (org-R-add-options-to-plist p (match-string 2) opts regexp))) + (forward-line))) + p)) + +(defun org-R-add-options-to-plist (p opt-string op regexp) + "Parse a #+R: line and set values in the property list +p. This function is adapted from similar functions in org-exp.el +and org-plot.el. It might be a good idea to have a single +function serving these three files' needs." + ;; Adapted from org-exp.el and org-plot.el + (let (o) + (when opt-string + (while (setq o (pop op)) + (if (string-match + (concat (regexp-quote (cdr o)) regexp) + opt-string) + (setq p (plist-put p (car o) + (car (read-from-string + (match-string 1 opt-string))))))))) + p) + + +(defun org-R-sanitise-options (options) + (error "not used yet") + (let (should-be-strings '(title legend colour color col csv))) + ) +(defun org-R-showcode (R) + "Display R function constructed by org-R in a new R-mode +buffer" + (split-window-vertically) + (switch-to-buffer "*org-table.R*") + (kill-region (point-min) (point-max)) + (R-mode) + (insert (replace-regexp-in-string + ";" "\n" (replace-regexp-in-string "\\([{}]\\)" "\n\\1\n" R))) + ;; (mark-whole-buffer) + ;; (indent-region) + ;; why doesn't that do what I hoped? + ) + +(defun org-R-get-remote-range (name-or-id form) + "This is a refactoring of Carsten's original version. I have +extracted the first bit of his function and named it +org-R-find-table (which would presumably be called +something like org-table-find-table or org-id-find-table if this +were accepted). + +Get a field value or a list of values in a range from table at ID. + +NAME-OR-ID may be the name of a table in the current file as set by +a \"#+TBLNAME:\" directive. The first table following this line +will then be used. Alternatively, it may be an ID referring to +any entry, possibly in a different file. In this case, the first table +in that entry will be referenced. +FORM is a field or range descriptor like \"@2$3\" or or \"B3\" or +\"@I$2..@II$2\". All the references must be absolute, not relative. + +The return value is either a single string for a single field, or a +list of the fields in the rectangle." + + (let ((tbl-marker (org-R-find-table name-or-id 'marker)) + org-table-column-names org-table-column-name-regexp + org-table-local-parameters org-table-named-field-locations + org-table-current-line-types org-table-current-begin-line + org-table-current-begin-pos org-table-dlines + org-table-hlines org-table-last-alignment + org-table-last-column-widths org-table-last-alignment + org-table-last-column-widths tbeg) + + (save-excursion + (set-buffer (marker-buffer tbl-marker)) + (goto-char (marker-position tbl-marker)) + (org-table-get-specials) + (setq form (org-table-formula-substitute-names form)) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (save-match-data + (org-table-get-range (match-string 0 form) (point) 1)) + form)))) + +(provide 'org-R) diff --git a/existing_tools/org-exp-blocks.el b/existing_tools/org-exp-blocks.el new file mode 100644 index 000000000..b4e72412d --- /dev/null +++ b/existing_tools/org-exp-blocks.el @@ -0,0 +1,380 @@ +;;; org-exp-blocks.el --- pre-process blocks when exporting org files + +;; Copyright (C) 2008 Eric Schulte + +;; Author: Eric Schulte + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; This is a utility for pre-processing blocks in org files before +;; export using the `org-export-preprocess-hook'. It can be used for +;; exporting new types of blocks from org-mode files and also for +;; changing the default export behavior of existing org-mode blocks. +;; The `org-export-blocks' and `org-export-interblocks' alist can be +;; used to control how blocks and the spaces between blocks +;; respectively are processed upon export. +;; +;; The type of a block is defined as the string following =#+begin_=, +;; so for example the following block would be of type ditaa. Note +;; that both upper or lower case are allowed in =#+BEGIN_= and +;; =#+END_=. +;; +;; #+begin_ditaa blue.png -r -S +;; +---------+ +;; | cBLU | +;; | | +;; | +----+ +;; | |cPNK| +;; | | | +;; +----+----+ +;; #+end_ditaa +;; +;;; Currently Implemented Block Types +;; +;; ditaa :: Convert ascii pictures to actual images using ditaa +;; http://ditaa.sourceforge.net/. To use this set +;; `org-ditaa-jar-path' to the path to ditaa.jar on your +;; system (should be set automatically in most cases) . +;; +;; dot :: Convert graphs defined using the dot graphing language to +;; images using the dot utility. For information on dot see +;; http://www.graphviz.org/ +;; +;; comment :: Wrap comments with titles and author information, in +;; their own divs with author-specific ids allowing for css +;; coloring of comments based on the author. +;; +;; R :: Implements Sweave type exporting, evaluates blocks of R code, +;; and also replaces \R{} chunks in the file with their result +;; when passed to R. This require the `R' command which is +;; provided by ESS (Emacs Speaks Statistics). + +(defcustom org-export-blocks + '((comment org-export-blocks-format-comment) + (ditaa org-export-blocks-format-ditaa) + (dot org-export-blocks-format-dot) + (r org-export-blocks-format-R) + (R org-export-blocks-format-R)) + "Use this a-list to associate block types with block exporting +functions. The type of a block is determined by the text +immediately following the '#+BEGIN_' portion of the block header. +Each block export function should accept three argumets..." + :group 'org-export-general + :type 'alist) + +(defcustom org-export-interblocks + '((r org-export-interblocks-format-R) + (R org-export-interblocks-format-R)) + "Use this a-list to associate block types with block exporting +functions. The type of a block is determined by the text +immediately following the '#+BEGIN_' portion of the block header. +Each block export function should accept three argumets..." + :group 'org-export-general + :type 'alist) + +(defcustom org-export-blocks-witheld + '(hidden) + "List of block types (see `org-export-blocks') which should not +be exported." + :group 'org-export-general + :type 'list) + +(defvar org-export-blocks-postblock-hooks nil "") + +(defun org-export-blocks-html-quote (body &optional open close) + "Protext BODY from org html export. The optional OPEN and +CLOSE tags will be inserted around BODY." + (concat + "\n#+BEGIN_HTML\n" + (or open "") + body (if (string-match "\n$" body) "" "\n") + (or close "") + "#+END_HTML\n")) + +(defun org-export-blocks-latex-quote (body &optional open close) + "Protext BODY from org latex export. The optional OPEN and +CLOSE tags will be inserted around BODY." + (concat + "\n#+BEGIN_LaTeX\n" + (or open "") + body (if (string-match "\n$" body) "" "\n") + (or close "") + "#+END_LaTeX\n")) + +(defun org-export-blocks-preprocess () + "Export all blocks acording to the `org-export-blocks' block +exportation alist. Does not export block types specified in +specified in BLOCKS which default to the value of +`org-export-blocks-witheld'." + (interactive) + (save-window-excursion + (let ((count 0) + (blocks org-export-blocks-witheld) + (case-fold-search t) + (types '()) + type func start end) + (flet ((interblock (start end type) + (save-match-data + (when (setf func (cadr (assoc type org-export-interblocks))) + (funcall func start end))))) + (goto-char (point-min)) + (setf start (point)) + (while (re-search-forward + "^#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)#\\+end_\\S-*[\r\n]" nil t) + (save-match-data (setf type (intern (match-string 1)))) + (unless (memq type types) (setf types (cons type types))) + (setf end (save-match-data (match-beginning 0))) + (interblock start end type) + (if (setf func (cadr (assoc type org-export-blocks))) + (replace-match (save-match-data + (if (memq type blocks) + "" + (apply func (match-string 3) (split-string (match-string 2) " ")))) t t)) + (setf start (save-match-data (match-end 0)))) + (mapcar (lambda (type) + (interblock start (point-max) type)) + types))))) + +(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) + +;;================================================================================ +;; type specific functions + +;;-------------------------------------------------------------------------------- +;; ditaa: create images from ASCII art using the ditaa utility +(defvar org-ditaa-jar-path (expand-file-name + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + ".." + (file-name-directory (or load-file-name buffer-file-name))))))) + "Path to the ditaa jar executable") + +(defun org-export-blocks-format-ditaa (body &rest headers) + "Pass block BODY to the ditaa utility creating an image. +Specify the path at which the image should be saved as the first +element of headers, any additional elements of headers will be +passed to the ditaa utility as command line arguments." + (message "ditaa-formatting...") + (let ((out-file (if headers (car headers))) + (args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) + (data-file (make-temp-file "org-ditaa"))) + (unless (file-exists-p org-ditaa-jar-path) + (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) + (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) + body + (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1))) + (org-split-string body "\n") + "\n"))) + (cond + ((or htmlp latexp) + (with-temp-file data-file (insert body)) + (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; dot: create graphs using the dot graphing language +;; (require the dot executable to be in your path) +(defun org-export-blocks-format-dot (body &rest headers) + "Pass block BODY to the dot graphing utility creating an image. +Specify the path at which the image should be saved as the first +element of headers, any additional elements of headers will be +passed to the dot utility as command line arguments. Don't +forget to specify the output type for the dot command, so if you +are exporting to a file with a name like 'image.png' you should +include a '-Tpng' argument, and your block should look like the +following. + +#+begin_dot models.png -Tpng +digraph data_relationships { + \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"] + \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"] + \"data_requirement\" -> \"data_product\" +} +#+end_dot" + (message "dot-formatting...") + (let ((out-file (if headers (car headers))) + (args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) + (data-file (make-temp-file "org-ditaa"))) + (cond + ((or htmlp latexp) + (with-temp-file data-file (insert body)) + (message (concat "dot " data-file " " args " -o " out-file)) + (shell-command (concat "dot " data-file " " args " -o " out-file)) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; comment: export comments in author-specific css-stylable divs +(defun org-export-blocks-format-comment (body &rest headers) + "Format comment BODY by OWNER and return it formatted for export. +Currently, this only does something for HTML export, for all +other backends, it converts the comment into an EXAMPLE segment." + (let ((owner (if headers (car headers))) + (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) + (cond + (htmlp ;; We are exporting to HTML + (concat "#+BEGIN_HTML\n" + "
\n" + (if owner (concat "" owner " ") "") + (if (and title (> (length title) 0)) (concat " -- " title "
\n") "
\n") + "

\n" + "#+END_HTML\n" + body + "#+BEGIN_HTML\n" + "

\n" + "
\n" + "#+END_HTML\n")) + (t ;; This is not HTML, so just make it an example. + (concat "#+BEGIN_EXAMPLE\n" + (if title (concat "Title:" title "\n") "") + (if owner (concat "By:" owner "\n") "") + body + (if (string-match "\n\\'" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; R: Sweave-type functionality +(defvar interblock-R-buffer nil + "Holds the buffer for the current R process") + +(defun org-export-blocks-format-R (body &rest headers) + "Process R blocks and replace \R{} forms outside the blocks +with their values as determined by R." + (interactive) + (message "R processing...") + (let ((image-path (or (and (car headers) + (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers)) + (match-string 1 (car headers))) + (and (> (length (car headers)) 0) + (car headers)) + ;; create the default filename + (format "Rplot-%03d" count))) + (plot (string-match "plot" body)) + R-proc) + (setf count (+ count 1)) + (interblock-initiate-R-buffer) + (setf R-proc (get-buffer-process interblock-R-buffer)) + ;; send strings to the ESS process using `comint-send-string' + (setf body (mapconcat (lambda (line) + (interblock-R-input-command line) (concat "> " line)) + (butlast (split-string body "[\r\n]")) + "\n")) + ;; if there is a plot command, then create the images + (when plot + (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path))) + (concat (cond + (htmlp (org-export-blocks-html-quote body + (format "
\n
\n" count)
+						  "
\n
\n")) + (latexp (org-export-blocks-latex-quote body + "\\begin{Schunk}\n\\begin{Sinput}\n" + "\\end{Sinput}\n\\end{Schunk}\n")) + (t (insert ;; default export + "#+begin_R " (mapconcat 'identity headers " ") "\n" + body (if (string-match "\n$" body) "" "\n") + "#+end_R\n"))) + (if plot + (format "[[file:%s.eps]]\n" image-path) + "")))) + +(defun org-export-interblocks-format-R (start end) + "This is run over parts of the org-file which are between R +blocks. It's main use is to expand the \R{stuff} chunks for +export." + (save-excursion + (goto-char start) + (interblock-initiate-R-buffer) + (let (code replacement) + (while (and (< (point) end) (re-search-forward "\\\\R{\\(.*\\)}" end t)) + (save-match-data (setf code (match-string 1))) + (setf replacement (interblock-R-command-to-string code)) + (setf replacement (cond + (htmlp replacement) + (latexp replacement) + (t replacement))) + (setf end (+ end (- (length replacement) (length code)))) + (replace-match replacement t t))))) + +(defun interblock-initiate-R-buffer () + "If there is not a current R process then create one." + (unless (and (buffer-live-p interblock-R-buffer) (get-buffer interblock-R-buffer)) + (save-excursion + (R) + (setf interblock-R-buffer (current-buffer)) + (interblock-R-wait-for-output) + (interblock-R-input-command "")))) + +(defun interblock-R-command-to-string (command) + "Send a command to R, and return the results as a string." + (interblock-R-input-command command) + (interblock-R-last-output)) + +(defun interblock-R-input-command (command) + "Pass COMMAND to the R process running in `interblock-R-buffer'." + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert command) + (comint-send-input) + (interblock-R-wait-for-output)))) + +(defun interblock-R-wait-for-output () + "Wait until output arrives" + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (while (progn + (goto-char comint-last-input-end) + (not (re-search-forward comint-prompt-regexp nil t))) + (accept-process-output (get-buffer-process (current-buffer))))))) + +(defun interblock-R-last-output () + "Return the last R output as a string" + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (forward-line 0) + (let ((raw (buffer-substring comint-last-input-end (- (point) 1)))) + (if (string-match "\n" raw) + raw + (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw) + (message raw) + (message (match-string 1 raw)) + (match-string 1 raw))))))) + +(provide 'org-exp-blocks) + +;;; org-exp-blocks.el ends here diff --git a/rorg.org b/rorg.org new file mode 100644 index 000000000..b7e726422 --- /dev/null +++ b/rorg.org @@ -0,0 +1,22 @@ +#+TITLE: rorg --- R and org-mode + +Please feel free to change the layout of this file, I'm just putting +this here to get things started. + +* objectives +What are these? + +I'll pre-populate with a quick list from the email to get started + +Just to get this out there, there seem to be four kinds of +functionality we're trying to get here: +1. import data into R from org +2. easy editing of R code using r-mode from an org buffer +3. evaluate R code and make the output available for processing in an + org buffer +4. evaluate R code and format the output for export + + +* tasks + +