Arman Akbarian
UNIVERSITY OF BRITISH COLUMBIA
PHYSICS & ASTRONOMY DEPT.

#-----------------------------------
# AAK  Mon 10 Aug 2014 00:39:54 PDT
# Functions in R
#-----------------------------------

# Functions returns the last calculation:
myadd <- function(x,y) {
    x+y
}

# Vector as an input:
aboveval <-function(x,threshold){
# Logical subsetting
    use <- x > threshold
        x[use]
}

# Function with default value: (step function, default at 0)
step <-function(x,threshold = 0){
# Logical conversion
    as.integer( x > threshold)
}

# Function with data frame as input and vector as output
RCTM <- function(x, removeNA = TRUE) {
  nc <- ncol(x)
  #initializing an empty vector:
  means <- numeric(nc)
  for(i in 1:nc) {
    means[i] <- mean(x[,i], na.rm = removeNA)
  }
  #returing a vector
  means
}

# ... argument indicates variables that will be passed in to another function:

myplot <- function(x, y, type="l", ...){
  plot(x, y, type=type,...)
}

# Defining a function in a function, and returning it

make.pow <- function(n) {
 pow <- function(x) {
    x^n
  }
 pow
}

# Now you can ``create`` functions using this:

cube <- make.pow(3)
square <- make.pow(2)

cat('cube(3) = ',cube(3), '\n')
cat('square(3) = ', square(3), '\n')

# R uses "Lexical scoping" i.e: It looks up the value of
# the free variables from the enviroument that the function
# is defined, rather than where it is called (Dynamical scoping)
# In the following even if z = 4 will be used when f is invoked 
# even if there is another z defined before the call. 
f <- function(x) {
   g <- function(y) {
      y + z
   }
   z <- 4
   x + g(x)
}

#-----------------------------------------
# Scoping assignment: <<- 
# Assigns value at the parent enviroument
#-----------------------------------------

a <- 3

e <- function(x) {
 #Will not affect a = 3 above
  a <- x
}

e(4)
message("a = ",a)

t <- function(x) {
 # Assigning a value at the parent enviroument
 # Will affect the a=3
 a <<- x
}

# Now calling t function will change the value of the
# a in the parent envirounment
t(4)
message("a now changed to ==> ",a)

# More complicated example:

CreateCache <- function(x=numeric()) {
   cache <- 0
   increment <- function() cache <<- cache + 1
}

AA <- CreateCache()
BB <- CreateCache()

# Now each call of AA function will increment cache in
# its internal enviroument by one
# Note that the cache is in the enviroument of CreateCache (AA)
# not the global enviroument, and creating another copy of
# the function in BB will create another cache


AA() # cache becomes 1
BB() # cache becomes 1 (has nothing to do with AA)
AA() # cache becomes 2 (wont affect BB's cache)
AA() # cache becomes 3
resultcachinAA <- AA() # Cache becomes 4 and returns to result
resultcachinBB <- BB() # Cache becomes 2 and returns to result
message("Now cache in AA is ", resultcachinAA)
message("Now cache in BB is ", resultcachinBB)

# Using this, the following allows caching the
# inverse of the matrix and returning it from
# cached value rather than computing it again

#----------------------------------------------------
# Creates a special matrix type from a given matrix x
# with handle functions get, set, getinv, setinv that
# encapsulates the access to the underlying matrix and
# the cached inverse matrix.
#----------------------------------------------------
makeCacheMatrix <- function(x = matrix()) {
    # When called, empty cache containing inverse:
    invm <- NULL
    # Sets the matrix to the given value and cleans cache:
    set <- function(y) {
        x <<- y
        invm <<- NULL
    }
    # Returns the Matrix:
    get <- function() x
    # Sets the cached invm value to the given value
    setinv <- function(inverse) invm <<- inverse
    # Returns the cached value:
    getinv <- function() invm
    # List of the handle functions:
    list(set = set, get=get, setinv=setinv, getinv=getinv)
}


#------------------------------------------------------------
# Returns the inverse (invm) of a special "matrix" type (x)
# created by makeCacheMatrix either from the cached value 
# or from a computed value if the cach is empty (invm = NULL) 
#-------------------------------------------------------------

cacheSolve <- function(x, ...) {
        # Attempt to get inverse from cached value:
        invm <- x$getinv()
        if (!is.null(invm)) {
            message("getting cached data")
            return(invm)
        }
        # If cached value is empty (NULL) compute the inverse:
        mtrx <- x$get()
        message("Computing inverse, this can take a while...")
        invm <- solve(mtrx,...)
        # Set the cache to the current value
        x$setinv(invm)
        invm
}

# First creating 1000x1000 matrix
X <- replicate(1000,rnorm(1000))

# Creating the matrix function with internal cache:
mymatrix <- makeCacheMatrix()

# Setting the internal value of mymatrix:
mymatrix$set(X)
# First call will use solve routine to find the inverse:
cacheSolve(mymatrix)
# Second and third call will use the cached value:
cacheSolve(mymatrix)
cacheSolve(mymatrix)


last update: Wed Aug 19, 2015