# ccampbell/rainbow

Merge pull request #62 from sjp/r-support

`R support`
2 parents 1a3b4cf + b27f00e commit 4acbe34014e901651d7b2e908cbb547446c2eac9 committed Jun 30, 2012
Showing with 263 additions and 0 deletions.
2. +60 −0 demos/r.html
3. +86 −0 js/language/r.js
4. +1 −0 tests/index.html
5. +114 −0 tests/language/r-test.js
6. +1 −0 util/builder.py
 @@ -66,6 +66,7 @@ Currently supported languages are: - Lua - C# - Smalltalk +- R ## More Info
 @@ -0,0 +1,60 @@ + + + + R Demo + + + +
+## Probability density function for the Generalised Normal Laplace distribution
+dgnl <- function(x, mu = 0, sigma = 1, alpha = 1, beta = 1, rho = 1,
+                 param = c(mu, sigma, alpha, beta, rho)) {
+
+  ## check parameters
+  parResult <- gnlCheckPars(param)
+  case <- parResult\$case
+  errMessage <- parResult\$errMessage
+
+  if (case == "error")
+    stop(errMessage)
+
+  mu <- param[1]
+  sigma <- param[2]
+  alpha <- param[3]
+  beta <- param[4]
+  rho <- param[5]
+
+  ## Shifting by mu
+  x <- x - mu
+
+  ## Initialising result vector
+  pdfValues <- rep(0, length(x))
+
+  ## Because 'integrate' doesn't take vectors as input, we need to iterate over
+  ## x to evaluate densities
+  for (i in 1:length(x)) {
+    ## Modified characteristic function. Includes minor calculation regarding
+    ## complex numbers to ensure the function returns a real number
+    chfn <- function(s) {
+      result <- (alpha * beta * exp(-((sigma^2 * s^2) / 2))) /
+                (complex(real = alpha, imaginary = -s) *
+                 complex(real = beta, imaginary = s))
+      result <- result^rho  ## Scaling result by rho
+      r <- Mod(result)
+      theta <- Arg(result)
+      r * cos(theta - (s * x[i]))
+    }
+
+    ## Integrating modified characteristic function
+    pdfValues[i] <- (1 / pi) * integrate(chfn, 0, Inf)\$value
+  }
+
+  ## Returning vector of densities
+  pdfValues
+}
+
+ + + + +
 @@ -0,0 +1,86 @@ +/** + * R language patterns + * + * @author Simon Potter + * @version 1.0 + */ +Rainbow.extend('r', [ + /** + * Note that a valid variable name is of the form: + * [.a-zA-Z][0-9a-zA-Z._]* + */ + { + 'matches': { + 1: { + 'name': 'keyword.operator', + 'pattern': /\=|<\-|<-/g + }, + 2: { + 'name': 'string', + 'matches': { + 'name': 'constant.character.escape', + 'pattern': /\\('|"){1}/g + } + } + }, + 'pattern': /(\(|\s|\[|\=|:)(('|")([^\\\1]|\\.)*?(\3))/gm + }, + /** + * Most of these are known via the Language Reference. + * The built-in constant symbols are known via ?Constants. + */ + { + 'matches': { + 1: 'constant.language' + }, + 'pattern': /\b(NULL|NA|TRUE|FALSE|T|F|NaN|Inf|NA_integer_|NA_real_|NA_complex_|NA_character_)\b/g + }, + { + 'matches': { + 1: 'constant.symbol' + }, + 'pattern': /[^0-9a-zA-Z\._](LETTERS|letters|month\.(abb|name)|pi)/g + }, + /** + * @todo: The list subsetting operator isn't quite working properly. + * It includes the previous variable when it should only match [[ + */ + { + 'name': 'keyword.operator', + 'pattern': /<-|<-|-|==|<=|<=|>>|>=|<|>|&&|&&|&|&|!=|\|\|?|\*|\+|\^|\/|%%|%\/%|\=|%in%|%\*%|%o%|%x%|\\$|:|~|\[{1,2}|\]{1,2}/g + }, + { + 'matches': { + 1: 'storage', + 3: 'entity.function' + }, + 'pattern': /(\s|^)(.*)(?=\s?=\s?function\s\()/g + }, + { + 'matches': { + 1: 'storage.function' + }, + 'pattern': /[^a-zA-Z0-9._](function)(?=\s*\()/g + }, + { + 'matches': { + 1: 'namespace', + 2: 'keyword.operator', + 3: 'function.call' + }, + 'pattern': /([a-zA-Z][a-zA-Z0-9._]+)([:]{2,3})([.a-zA-Z][a-zA-Z0-9._]*(?=\s*\())\b/g + }, + /* + * Note that we would perhaps match more builtin functions and + * variables, but there are so many that most are ommitted for now. + * See ?builtins for more info. + * + * @todo: Fix the case where we have a function like tmp.logical(). + * This should just be a function call, at the moment it's + * only partly a function all. + */ + { + 'name': 'support.function', + 'pattern': /(^|[^0-9a-zA-Z\._])(array|character|complex|data\.frame|double|integer|list|logical|matrix|numeric|vector)(?=\s*\()/g + } +]);
 @@ -16,6 +16,7 @@ +
 @@ -0,0 +1,114 @@ +/** + * R tests + * + * @author Simon Potter + */ +RainbowTester.startTest('r'); + +RainbowTester.run( + 'comments', + + '# A comment\n' + + 'a <- "b" # Another comment', + + '# A comment\n' + + 'a <- "b" # Another comment' +); + +RainbowTester.run( + 'assignment', + + 'foo.bar <- "foo"\n' + + 'baz1 = 1.62e-4', + + 'foo.bar <- "foo"\n' + + 'baz1 = 1.62e-4' +); + +RainbowTester.run( + 'constants', + + 'baz <- NA\n' + + 'my.pi <- pi\n' + + 'all.letters <- c(LETTERS, letters)\n' + + 'xrange <- c(-Inf, TRUE)', + + 'baz <- NA\n' + + 'my.pi <- pi\n' + + 'all.letters <- c(LETTERS, letters)\n' + + 'xrange <- c(-Inf, TRUE)' +); + +RainbowTester.run( + 'operators', + + 'beta.hat <- solve(t(X) %*% X) %*% t(X) %*% y\n' + + 'bound.rect <- grid::rectGrob()\n' + + 'my_seq <- 1:10\n' + + 'is_in_seq <- c(2, 7, 23) %in% my_seq\n' + + 'plot(y ~ x, type = "l")', + + 'beta.hat <- solve(t(X) %*% X) %*% t(X) %*% y\n' + + 'bound.rect <- grid::rectGrob()\n' + + 'my_seq <- 1:10\n' + + 'is_in_seq <- c(2, 7, 23) %in% my_seq\n' + + 'plot(y ~ x, type = "l")' +); + +/** + * Note that the second function is intentionally not a function call, + * just testing that the regex is matching only 'function' and not .+function + */ +RainbowTester.run( + 'function creation', + + 'square <- function(x) x * x\n' + + 'square2 <- testfunction(x) x * x\n' + + 'area <- function (r) {\n' + + ' pi * r^2\n' + + '}', + + 'square <- function(x) x * x\n' + + 'square2 <- testfunction(x) x * x\n' + + 'area <- function (r) {\n' + + ' pi * r^2\n' + + '}' +); + +RainbowTester.run( + 'variable', + + 'tmp <- 1\n' + + 'another.tmp <- 2\n' + + 'this.is.a.var <- 3', + + 'tmp <- 1\n' + + 'another.tmp <- 2\n' + + 'this.is.a.var <- 3' +); + +RainbowTester.run( + 'subsetting', + + 'tmp[1]\n' + + 'tmp[["test"]]', + + 'tmp[1]\n' + + 'tmp[["test"]]' +); + +RainbowTester.run( + 'support functions', + + 'logical(10)\n' + + 'test.logical(10)\n' + + 'data.frame(a = 1:10, b = 15:24)\n' + + 'complex(real = 1, imaginary = 0.5)', + + 'logical(10)\n' + + 'test.logical(10)\n' + + 'data.frame(a = 1:10, b = 15:24)\n' + + 'complex(real = 1, imaginary = 0.5)' +); + +RainbowTester.endTest('r');
 @@ -22,6 +22,7 @@ def __init__(self, js_path, closure_path, theme_path=None): 'lua': '1.0', 'php': '1.0.5', 'python': '1.0.6', + 'r': '1.0', 'ruby': '1.0.5', 'scheme': '1.0', 'shell': '1.0.3',