R Lesson #6 - Functions and conditionals
This lesson describes the use of conditionals and functions. Conditionals are a way of making choices based on the value of a variable.cond1 <- cond2 <- F
> if (cond1) {
+ # do this if cond1
+ } else if (cond2) {
+ # do this if !cond1 && cond2
+ } else {
+ # do this if !(cond1 || cond2)
+ }
NULL
>
> x <- 2
> if (x >= 0) {
+ print(x)
+ } else {
+ print(-x)
+ }
[1] 2
>
> # note that the condition must be length 1
> # otherwise a warning will be given
> y <- c(5, -5)
> if (y >= 0) {
+ print(y)
+ } else {
+ print(-y)
+ }
[1] 5 -5
Warning message:
In if (y >= 0) { :
the condition has length > 1 and only the first element will be used
> # this is the main use of && and ||, because
> # they only use the first pair of elements
ifelse(y >= 0, y, -y)
[1] 5 5
>
> # Example: several ways to compute GC-content:
> # GC content is the fraction of G's and C's
> # in a DNA sequence (A, C, G, T)
> s <- sample(c("A", "C", "G", "T"),
+ size=1000,
+ replace=TRUE)
> # using ifelse:
> GC <- ifelse(s=="G" | s=="C", 1, 0)
> GCcontent <- sum(GC)/length(s)
> # using which:
> GCcontent <- length(which(s=="G" | s=="C"))/length(s)
> # direct sum:
> GCcontent <- sum(s=="G" | s=="C")/length(s)
> # display the result
> cat(GCcontent*100, "% GC-content", sep="")
50% GC-content
f1 <- function() {} # basic function constructor
> f1() # calling this function does nothing
NULL
> # functions typically have arguments and return something
> f2 <- function(z) {
+ return(z)
+ }
> f2(5L)
[1] 5
> f2 <- function(z) {
+ invisible(z) # do not print the returned value
+ }
> f2(5L)
> make_pos <- function(num) {
+ ifelse(num >= 0,
+ num,
+ -num)
+ } # the last result is returned automatically
> make_pos(y) # this is a "vectorized" function
[1] 5 5
> abs(y) # a built-in way of doing the same thing
[1] 5 5
match_sign <- function(num, sign=1) {
+ if (sign >= 0) {
+ ifelse(num >= 0,
+ num,
+ -num)
+ } else { # sign < 0
+ ifelse(num >= 0,
+ -num,
+ num)
+ }
+ }
> match_sign(y)
[1] 5 5
> match_sign(y, sign=-1)
[1] -5 -5
> match_sign(y, -1)
[1] -5 -5
# what happens in Function, stays in Function
> f3 <- function(x) {
+ x <- 5
+ print(x)
+ }
> print(x)
[1] 2
> f3(y)
[1] 5
> print(x) # x did not change outside the function!
[1] 2
>
> f4 <- function(z) {
+ if (exists("x"))
+ print("overwritting x globally!")
+ x <<- z # global assignment operator
+ return(x)
+ }
> print(x)
[1] 2
> f4(0)
[1] "overwritting x globally!"
[1] 0
> print(x) # now x is changed outside the function
[1] 0
> print(z) # there is no z outside the function
Error: object 'z' not found
> # even though z was initialized inside the function
f5 <- function(x) {
+ if (!is.numeric(x)) {
+ stop("x is not numeric")
+ }
+ if (!is.integer(x)) {
+ warning("coercing x to integer")
+ }
+ return(as.integer(x))
+ }
> f5(5L)
[1] 5
> f5(5)
[1] 5
Warning message:
In f5(5) : coercing x to integer
> f5("5")
Error in f5("5") : x is not numeric
>
> # stopifnot - automatic generic error messages
> f6 <- function(x) {
+ stopifnot(is.logical(x),
+ !is.na(x))
+ return(x)
+ }
> f6(FALSE)
[1] FALSE
> f6("FALSE")
Error: is.logical(x) is not TRUE
> f6(NA)
Error: !is.na(x) is not TRUE
>
> # sometimes it is useful to silently catch the error
> t <- try(f6("FALSE"), silent=TRUE)
> t
[1] "Error : is.logical(x) is not TRUE\n"
attr(,"class")
[1] "try-error"
attr(,"condition")
simpleError: is.logical(x) is not TRUE
> if (class(t)=="try-error")
+ cat("f6 failed silently.")
f6 failed silently.
# takes in three numbers
> # outputs whether can be triangle
> f7 <- function(a, b, c) { # sides of triangle
+ stopifnot(is.numeric(a),
+ is.numeric(b),
+ is.numeric(c))
+ stopifnot(length(a) == 1,
+ length(b) == 1,
+ length(c) == 1)
+
+ if (all((a + b) > c, (b + c) > a, (c + a) > b)) {
+ return(TRUE)
+ } else {
+ return(FALSE)
+ }
+ }
> f7(1, 2, 3)
[1] FALSE
> f7(1.1, 1, 2)
[1] TRUE
>
> # takes a positive integer
> # outputs whether its a perfect square
> f8 <- function(n) {
+ stopifnot(as.integer(n) == n,
+ length(n) == 1,
+ n > 0)
+
+ a <- round(n^0.5)
+ return(a*a == n)
+ }
> f8(9.1)
Error: as.integer(n) == n is not TRUE
> f8(9) # 3^2
[1] TRUE
> f8(8)
[1] FALSE
>
> What2Wear <- function(temp) {
+ # Error checking:
+ stopifnot(length(temp) == 1L)
+ stopifnot(is.numeric(temp))
+ stopifnot(!is.na(temp))
+ stopifnot(temp > -50)
+ stopifnot(temp < 120)
+
+ # The What2Wear algorithm:
+ x <- "Wear a shirt"
+ if (temp >= 70)
+ x <- paste(x, "and shorts")
+ if (temp < 70)
+ x <- paste(x, "and pants")
+ if (temp < 50)
+ x <- paste(x, "and a sweater")
+ if (temp < 30)
+ x <- paste(x, "and a hat")
+ if (temp < 10)
+ x <- paste(x, "and a heavy jacket")
+
+ # Return the result:
+ x <- paste(x, "and shoes.")
+ cat(x)
+ invisible(x)
+ }
>
> What2Wear(90)
Wear a shirt and shorts and shoes.
> What2Wear(-10)
Wear a shirt and pants and a sweater and a hat and a heavy jacket and shoes.
> What2Wear(NA)
Error: is.numeric(temp) is not TRUE