Chapter 13 (The complex number above is the same as in Euler's identity.)

exp(complex(i = pi, 1, 0)) 
## [1] -1+0i

13.1 Task 24

A frequently used function is seq().

  1. Read the help page about seq()
  2. Use seq() to generate a sequence of integers from -5 to 3. Pass arguments in default order, don't use argument names.
  3. Use seq() to generate a sequence of numbers from -2 to 2 in intervals of 1/3. This time, use argument names.
  4. Use seq() to generate a sequence of 30 numbers between 1 and 100. Pass the arguments in the following order: length.out, to, from.

13.2 On missing parameters

If a parameter is missing several things can happen. Let's illustrate wih a little function that returns the golden-ratio pair to a number, either the smaller, or the larger one.

goldenRatio <- function(x, smaller) {
  phi <- (1 + sqrt(5)) / 2
  if (smaller == TRUE) {
    return(x / phi)
  } else {
    return(x * phi)
  }
}

If there's no way to recover, executing the function will throw an error:

goldenRatio(1)

Error in goldenRatio(1) : argument "smaller" is missing, with no default

If the function has a default parameter defined, it is used :

goldenRatio <- function(x, smaller = TRUE) {
  phi <- (1 + sqrt(5)) / 2
  if (smaller == TRUE) {
    return(x / phi)
  } else {
    return(x * phi)
  }
}
goldenRatio(1)
## [1] 0.618034

Alternatively, the function body can check whether a parameter is missing with the missing() function, and then react accordingly:

goldenRatio <- function(x, smaller) {
  if (missing(smaller)) {
    smaller <- TRUE
  }
  phi <- (1 + sqrt(5)) / 2
  if (smaller == TRUE) {
    return(x / phi)
  } else {
    return(x * phi)
  }
}
goldenRatio(1)
## [1] 0.618034
goldenRatio(1, smaller = FALSE)
## [1] 1.618034

Why is this useful, if you could just define a default? Because the parameter can then be the result of a (complex) computation, based on other parameters.

13.3 Reading functions

13.3.1 Basic R

If the function is a normal R function, like the ones we have defined above, you can read the function code when type its name without parantheses:

goldenRatio
## function(x, smaller) {
##   if (missing(smaller)) {
##     smaller <- TRUE
##   }
##   phi <- (1 + sqrt(5)) / 2
##   if (smaller == TRUE) {
##     return(x / phi)
##   } else {
##     return(x * phi)
##   }
## }
## <bytecode: 0x7fea37115aa0>

But that strictly only works for functions which have been written in basic R code.

13.3.2 S3 methods

You might also get a line saying UseMethod(). Then you are looking at a "method" from R's S3 object oriented system - such a function is also called a "generic", because it dispatches to more specific code, depending on the type of the parameter it is being given. Use methods() to see which specific methods are defined, and then use getAnywhere(<function.class>) to get the code.

seq
## function (...) 
## UseMethod("seq")
## <bytecode: 0x7fea2bea0e88>
## <environment: namespace:base>
methods(seq)
## [1] seq.Date    seq.default seq.POSIXt 
## see '?methods' for accessing help and source code
getAnywhere(seq.default)
## A single object matching 'seq.default' was found
## It was found in the following places
##   package:base
##   registered S3 method for seq from namespace base
##   namespace:base
## with value
## 
## function (from = 1, to = 1, by = ((to - from)/(length.out - 1)), 
##     length.out = NULL, along.with = NULL, ...) 
## {
##     is.logint <- function(.) (is.integer(.) || is.logical(.)) && 
##         !is.object(.)
##     if ((One <- nargs() == 1L) && !missing(from)) {
##         lf <- length(from)
##         return(if (mode(from) == "numeric" && lf == 1L) {
##             if (!is.finite(from)) stop("'from' must be a finite number")
##             1L:from
##         } else if (lf) 1L:lf else integer())
##     }
##     if (!missing(along.with)) {
##         length.out <- length(along.with)
##         if (One) 
##             return(if (length.out) seq_len(length.out) else integer())
##         intn1 <- is.integer(length.out)
##     }
##     else if (!missing(length.out)) {
##         len <- length(length.out)
##         if (!len) 
##             stop("argument 'length.out' must be of length 1")
##         if (len > 1L) {
##             warning("first element used of 'length.out' argument")
##             length.out <- length.out[1L]
##         }
##         if (!(intn1 <- is.logint(length.out))) 
##             length.out <- as.numeric(ceiling(length.out))
##     }
##     chkDots(...)
##     if (!missing(from) && length(from) != 1L) 
##         stop("'from' must be of length 1")
##     if (!missing(to) && length(to) != 1L) 
##         stop("'to' must be of length 1")
##     if (!missing(from) && !is.finite(if (is.character(from)) from <- as.numeric(from) else from)) 
##         stop("'from' must be a finite number")
##     if (!missing(to) && !is.finite(if (is.character(to)) to <- as.numeric(to) else to)) 
##         stop("'to' must be a finite number")
##     if (is.null(length.out)) 
##         if (missing(by)) 
##             from:to
##         else {
##             int <- is.logint(from) && is.logint(to)
##             del <- to - if (int) 
##                 as.double(from)
##             else from
##             if (del == 0 && to == 0) 
##                 return(to)
##             if (length(by) != 1L) 
##                 stop("'by' must be of length 1")
##             if (!is.logint(by)) 
##                 int <- FALSE
##             else if (!int) 
##                 storage.mode(by) <- "double"
##             n <- del/by
##             if (!is.finite(n)) {
##                 if (!is.na(by) && by == 0 && del == 0) 
##                   return(from)
##                 stop("invalid '(to - from)/by'")
##             }
##             if (n < 0L) 
##                 stop("wrong sign in 'by' argument")
##             if (n > .Machine$integer.max) 
##                 stop("'by' argument is much too small")
##             dd <- abs(del)/max(abs(to), abs(from))
##             if (dd < 100 * .Machine$double.eps) 
##                 return(from)
##             if (int) {
##                 n <- as.integer(n)
##                 if (n >= 2L) 
##                   cumsum(rep.int(c(from, by), c(1L, n)))
##                 else from + (0L:n) * by
##             }
##             else {
##                 n <- as.integer(n + 1e-10)
##                 x <- from + (0L:n) * by
##                 if (by > 0) 
##                   pmin(x, to)
##                 else pmax(x, to)
##             }
##         }
##     else if (!is.finite(length.out) || length.out < 0L) 
##         stop("'length.out' must be a non-negative number")
##     else if (length.out == 0L) 
##         integer()
##     else if (One) 
##         seq_len(length.out)
##     else if (missing(by)) {
##         if (missing(to)) {
##             to <- from + (length.out - 1)
##             intdel <- intn1 && is.logint(from) && to <= .Machine$integer.max
##             if (intdel) 
##                 storage.mode(to) <- "integer"
##         }
##         else intdel <- is.logint(to)
##         if (missing(from)) {
##             from <- to - (length.out - 1)
##             if (intdel) {
##                 intdel <- intn1 && from >= -.Machine$integer.max
##                 if (intdel) 
##                   storage.mode(from) <- "integer"
##             }
##         }
##         else if (intdel) 
##             intdel <- is.logint(from)
##         if (length.out > 2L) 
##             if (from == to) 
##                 rep.int(from, length.out)
##             else {
##                 n1 <- length.out - 1L
##                 if (intdel && intn1 && from%%n1 == to%%n1) {
##                   by <- to%/%n1 - from%/%n1
##                   cumsum(rep.int(c(from, by), c(1L, n1)))
##                 }
##                 else {
##                   if (intdel) 
##                     storage.mode(from) <- "double"
##                   by <- (to - from)/n1
##                   as.vector(c(from, from + seq_len(length.out - 
##                     2L) * by, to))
##                 }
##             }
##         else as.vector(c(from, to))[seq_len(length.out)]
##     }
##     else if (missing(to)) {
##         int <- (intby <- is.logint(by)) && is.logint(from) && 
##             (!(nby <- length(by)) || (naby <- is.na(by)) || ((to <- from + 
##                 (length.out - 1) * by) <= .Machine$integer.max && 
##                 to >= -.Machine$integer.max))
##         if (int && length.out > 2L && nby == 1L && !naby) 
##             cumsum(rep.int(c(from, by), c(1L, length.out - 1L)))
##         else {
##             if (intby && !(int || is.object(from))) 
##                 storage.mode(by) <- "double"
##             from + (0L:(length.out - 1L)) * by
##         }
##     }
##     else if (missing(from)) {
##         int <- (intby <- is.logint(by)) && is.logint(to) && (!(nby <- length(by)) || 
##             (naby <- is.na(by)) || ((from <- to - (length.out - 
##             1) * by) >= -.Machine$integer.max && from <= .Machine$integer.max))
##         if (int && length.out > 2L && nby == 1L && !naby) 
##             cumsum(rep.int(c(as.integer(from), by), c(1L, length.out - 
##                 1L)))
##         else {
##             if (intby && !(int || is.object(to))) 
##                 storage.mode(by) <- "double"
##             to - ((length.out - 1L):0L) * by
##         }
##     }
##     else stop("too many arguments")
## }
## <bytecode: 0x7fea2be9ffe0>
## <environment: namespace:base>

13.4 Primitives

You might also get a line saying .Call(C_ ). Then you are looking at a primitive - a function that has been compiled in the C programming language, for efficiency.

runif
## function (n, min = 0, max = 1) 
## .Call(C_runif, n, min, max)
## <bytecode: 0x7fea3009e590>
## <environment: namespace:stats>

To read the C source code, just do a Google search for the function name in the repository where the R sources are kept:

This search finds runif.c (have a look).site:https://svn.r-project.org/R/trunk/src runif

13.5 Writing your own functions

R is a "functional programming language" and working with R will involve writing your own functions. This is easy and gives you access to flexible, powerful and reusable solutions. You have to understand the "anatomy" of an R function however.

Functions are assigned to function names. They are treated like any other R object and you can have vectors of functions, and functions that return functions etc. Data gets into the function via the function's parameters.

Data is returned from a function via the return() statement[Actually the return() statement is optional, if missing, the result of the last expression is returned. You will find this frequently in other people's code, somthing to be aware of. However, you'll surely understand that it is really poor practice to omit return(), it makes the code harder to read and can give rise to misunderstandings. Never use implicit behaviour where you can be explicit instead]. One and only one object is returned. However the object can be a list, and thus contain values of arbitrary complexity. This is called the "value" of the function. Well-written functions have no side-effects like changing global variables.

# the function definition pattern:
 
<myName> <- function(<myArguments>) {
  # <documentation!>
    result <- <do something with the parameters>
    return(result)
}

In this pattern, the function is assigned to the name - any valid name in R. Once it is assigned, it the function can be invoked with myName(). The parameter list (the values we write into the parentheses following the function name) can be empty, or hold a list of variable names. If variable names are present, you need to enter the corresponding parameters when you execute the function. These assigned variables are available inside the function, and can be used for computations. This is called "passing variables into the function".

13.6 Task 25

This exercise is similar to the while loop exercise. The only difference is to put the code into a function. Write a function countDown() so that you can start the countdown call from any number. For example calling countDown(5) should give:

[1] "5" "4" "3" "2" "1" "0" "Lift Off!"

Answer18

The scope of functions is local: this means all variables within a function are lost upon return, and global variables are not overwritten by a definition within a function. However variables that are defined outside the function are also available inside.

We can use loops and control structures inside functions. For example the following creates a vector containing n Fibonacci numbers.

fibSeq <- function(n) {
   if (n < 1) { return( 0 ) }
   else if (n == 1) { return( 1 ) }
   else if (n == 2) { return( c(1, 1) ) }
   else {
      v <- numeric(n)
      v[1] <- 1
      v[2] <- 1
      for ( i in 3:n ) {
         v[n] <- v[n-2] + v[n-1]
      }
      return( v )
   }
}

Here is another example to play with: a function that calculates how old you are. In days. This is neat - you can celebrate your 10,000 birthday - or so.

13.7 Task 26

Copy, explore and run the below code

Define the function ...

# A lifedays calculator function
 
myLifeDays <- function(birthday) {
  if (missing(birthday)) {
    print ("Enter your birthday as a string in \"YYYY-MM-DD\" format.")
    return()
  }
  bd <- strptime(birthday, "%Y-%m-%d") # convert string to time
  now <- format(Sys.time(), "%Y-%m-%d") # convert "now" to time
  diff <- round(as.numeric(difftime(now, bd, unit="days")))
  print(sprintf("This date was %d days ago.", diff))
}

Use the function (example)

   myLifeDays("1932-09-25")  # Glenn Gould's birthday
## [1] "This date was 32238 days ago."

Here is a good opportunity to practice programming: modify this function to accept a second argument. When a second argument is present (e.g. 10000) the function should print the calendar date on which the input date will be the required number of days ago. Then you could use it to know when to celebrate your 10,000th life-day, or your 777th anniversary or whatever.

13.8 Self-evaluation

  1. countDown <- function(n) {
    start <- n
    countdown <- start
    txt <- as.character(start)

    while (countdown > 0) {
    countdown <- countdown - 1
    txt <- c(txt, countdown)
    }
    txt <- c(txt,"Lift Off!")
    return(txt)
    }

    countDown(7)
    ↩