smbache

#' Arm a value with a function which fires when evaluated.
#'
#' @param expr an expression
#' @param fun a function of one argument.
#' 
#' @return an expression which when evaluated returns the result of expr,
#'   after evaluating fun(expr).
arm <- function(expr, fun)
{
	substitute({

smbache

#' Placeholder function.
#'
#' @export
as_nonstandard <- function()
{
	stop("This is a placeholder function, and should not be called directly.")
}

#' Declare symbols for nonstandard evalution.
#'

smbache

`%<<%` <- function(con, x)
{
  UseMethod("%<<%", x)
}

`%<<%.function` <- function(con, x)
{
  if (!identical(x, close))
    stop("Unknown function provided to <<", call. = FALSE)

smbache

#' Trigger an action associated with first matched/valid condition.
#' 
#' trigger is a flavour of pattern matching (or an if-else abstraction) in which a 
#' value is matched against a sequence of condition-action sets. When a valid 
#' match/condition is found the action is triggered and the result of the action 
#' is returned. The trigger function is designed to particularly useful in pipelines
#' ala magrittr.
#' 
#' @param value the value to match agaist
#' @param ... a set of formulas containing a condition as LHS and an action as RHS.

smbache

# a few utility funcs, might as well take them from `import`
import::here(symbol_list, symbol_as_character, .from = import)

copy_from <- function(.from, ...)
{
  symbols <- symbol_list(...)
  parent  <- parent.frame()
  from    <- symbol_as_character(substitute(.from))

  for (s in seq_along(symbols)) {

smbache

library(loggr) # should be executed before sourcing the script

log_file("all.log")
log_file("messages.log", DEBUG, INFO, .warning = FALSE, .error = FALSE)
log_file("console", WARN, ERROR, CRITICAL, .message = FALSE)

top_n <- function(data_set, sort_var, n = 3, desc = FALSE)
{
  if (!is.data.frame(data_set))
    log_critical("Invalid data_set provided.")

smbache

# Contents of test.R:
#
#  library(ggplot2)
#
#  my_plot  <- qplot(Sepal.Length, Sepal.Width, data = iris)
#  my_plot2 <- qplot(Petal.Length, Petal.Width, data = iris)
#

```R
> import::from(test.R, my_plot)

smbache

library(shiny)

ol <- function(...) tag("ol", list(...))
li <- function(...) tag("li", list(...))

carousel_events <- function(id) 
{
  js <- sprintf("
    $('#%s').bind('slide.bs.carousel', function (e) { 
      $(e.relatedTarget).find('.shiny-bound-output').each(function(i) {

smbache

# Allow for V(g) %$% color or g %>% V %$% color
# 
# Since %$% uses the generic `with` method, it is possible to tweek this to 
# deal with special cases like this. I know little about igraph, but this 
# may work.
# 
with.igraph.vs <- function(data, expr, ...) {
  eval(substitute(data$c, list(c = substitute(expr))))
}

smbache

#' Recursive If-Then-Else Evaluation.
#' 
#' This function will recursively evaluate conditions, element-by-element, and 
#' apply specified actions for the elements that satisfy the conditions. Each
#' \code{condition~action} pair is specified by a formula, with the condition as
#' left-hand side and action as right-hand side. Each condition is evaluated 
#' sequentially and only to the relevant elements. This means that if an element
#' satisfies an early condition, it will never reach a later condition test.
#' The final argument is a one-sided formula with only an action applied to the
#' elements that do not satisfy any of the conditions (a default).