## A simple symbolic differentiator.  The first argument, the
## expression to be differentiated, is assumed to be a "call" object,
## a "name" object or a constant. The second argument can be a name
## object or a string (i.e. a character vector of length 1).  Only
## very little error checking is done.

d <- function(e, v) {
    if (is.expression(e))
        stop("expression objects are not supported; use 'quote'")
    if (is.call(e))
        dCall(e[[1]], as.list(e)[-1], v)
    else if (is.name(e))
        if (e == v) 1 else 0
    else 0 ## everything else is assumed to be a constant
}

## dCall handles differentiation of calls.
dCall <- function(fun, args, v) {
    if (length(args) != 2)
        stop("only binary operations supported for now")
    switch(as.character(fun),
           "+" = dAdd(args, v),
           "-" = dSub(args, v),
           "*" = dMul(args, v),
           stop("function ", sQuote(fun), " is not supported yet"))
}

## The following functions handle differentiation rules for specific
## functions.
dAdd <- function(args, v)
    makeAdd(d(args[[1]], v), d(args[[2]], v))

dSub <- function(args, v)
    makeSub(d(args[[1]], v), d(args[[2]], v))

dMul <- function(args, v)
    makeAdd(makeMul(d(args[[1]], v), args[[2]]),
            makeMul(args[[1]], d(args[[2]], v)))


## Constructors for result expressions have been broken out into
## functions of their own to reduce repetition and make the code more
## readable.
makeAdd <- function(x, y)
    makeCall("+", list(x, y))

makeSub <- function(x, y)
    makeCall("-", list(x, y))

makeMul <- function(x, y)
    makeCall("*", list(x, y))

makeCall <- function(fun, args)
    as.call(c(list(as.name(fun)), args))