Chapter 8 Functions, Control Statements, and Loops
Lander's chapter 8-Writing R Functions
Lander's chapter 9-Control Statement
Lander's chapter 10-Loops
###############################
#Chapter 8 writing R functions#
###############################
say.hello <- function()
{print("Hello, World!")}
say.hello()## [1] "Hello, World!"sprintf("Hello %s", "Jared")## [1] "Hello Jared"hello.person <- function(name)
{print(sprintf("Hello %s", name))}
hello.person("Bob")## [1] "Hello Bob"#goes with the function variables' order when variables are not recalled
hello.person <- function(last, first)
{print(sprintf("Hello %s %s", first, last))}
hello.person("Nick", "Wen")## [1] "Hello Wen Nick"hello.person(first = "Nick", last = "Wen")## [1] "Hello Nick Wen"hello.person(fir="Nick", "Wen")## [1] "Hello Nick Wen"hello.person(last = "Wen", "Nick")## [1] "Hello Nick Wen"#set default
hello.person <- function(first, last="Wen")
{print(sprintf("Hello, %s %s", first, last))}
hello.person("Nick")## [1] "Hello, Nick Wen"#extra arugument
hello.person <- function(first, last="Wen", ...)
{print(sprintf("Hello, %s %s", first, last))}
hello.person("Nick", "Z", "Wen")## [1] "Hello, Nick Z"hello.person("Nick", extra="aaa")## [1] "Hello, Nick Wen"#return value
double.num <- function(x)
{x*2}
double.num(3)## [1] 6double.num <- function(x)
{return(x*2)}
double.num(3)## [1] 6#the function with var. is only executed once
double.num <- function(x)
{7
return(x*2)
return(x*7)}
double.num(3)## [1] 6#specify the name of a function
run.this <- function(x, func=mean)
{do.call(func, args = list(x))}
run.this(1:10)## [1] 5.5run.this(1:10, sd)## [1] 3.02765##############################
#chapter 9 Control Statements#
##############################
toCheck <- 1
if(toCheck==1){print("hello")}## [1] "hello"if(toCheck==0){print("hello")}
#NOTE: if(){}else must be on the same line
check.bool <- function(x){
if(x==1){print("hello")}else
{print("goodbye")}
}
check.bool(1)## [1] "hello"check.bool("k")## [1] "goodbye"check.bool(TRUE)## [1] "hello"x <- 1
ifelse(x==1, "hello", "goodbye")## [1] "hello"#write a function to check a couple of cases
check.bool <- function(x){
if(x==1){print("Hello")}else
if(x==0){
print("goodbye")
}else
{print("confused")}
}
check.bool(1)## [1] "Hello"check.bool(0)## [1] "goodbye"check.bool("a")## [1] "confused"check.bool(4)## [1] "confused"#switch--note: it only check for the same type of elements
use.switch <- function(x){
switch(x,
"a"="first",
"b"="second",
"z"="last",
"c"="third",
"other")
}
use.switch("a")## [1] "first"use.switch(1)## [1] "first"use.switch(12)
use.switch("aaa")## [1] "other"is.null(use.switch(12))## [1] TRUE#ifelse note: the corresponding result from ifelse is NA if there is NA in the vector
toTest <- c(1,NA,0,1,0,1)
ifelse(toTest==1, toTest*3, "zero")## [1] "3" NA "zero" "3" "zero" "3"#compound tests
a <- c(1,1,0,1)
b <- c(2,1,0,1)
#single form checks each element
ifelse(a==1 & b==1, "Yes", "No")## [1] "No" "Yes" "No" "Yes"#double form checks the first element
ifelse(a==1&&b==1, "Yes", "No")## [1] "No"b[1] <- 1
ifelse(a==1&&b==1, "Yes", "No")## [1] "Yes"###############################
#practice for ifelse statement#
###############################
#The if statement
x=rnorm(1)
y=rnorm(1)
x>y## [1] TRUEif(x>y) {z=x^2; w=30*x} else {z=30*x; w=x^2}
if(x>y) {
z=x^2
w=30*x
} else {
z=30*x
w=x^2
}
#Look at z and w closely--they're based only on x[1] vs. y[1]
x=rnorm(5)
y=rnorm(5)
x>y## [1] FALSE FALSE FALSE FALSE TRUEif(x>y) {z=x^2; w=30*x} else {z=30*x; w=x^2}## Warning in if (x > y) {: the condition has length > 1 and only the first element will be usedcbind(x,y,z,w)## x y z w
## [1,] -1.1685677 0.6957427 -35.057030 1.3655504
## [2,] -0.7436970 -0.4897608 -22.310910 0.5530852
## [3,] -2.6339780 -0.1214308 -79.019340 6.9378402
## [4,] 0.3055119 1.2489115 9.165356 0.0933375
## [5,] 1.4581000 -2.3324620 43.743000 2.1260556# use ifelse for elementwise conditional logic:
x=rnorm(5)
y=rnorm(5)
x>y## [1] TRUE TRUE FALSE FALSE TRUEz = ifelse(test = x>y, yes = x^2, no = 30*x) #explicitly including argument names
w = ifelse(x>y, 30*x, x^2)
cbind(x,y,z,w)## x y z w
## [1,] 0.8292795 -1.2259990 0.68770441 24.878384
## [2,] 1.3171671 -1.8215587 1.73492906 39.515012
## [3,] -0.4232399 0.7812279 -12.69719641 0.179132
## [4,] -1.0557369 0.7250605 -31.67210837 1.114580
## [5,] -0.2695323 -2.2515250 0.07264767 -8.085970#application of the ifelse statement
matwithNAs <- matrix(c(3,6,NA,7,1,5,NA,NA,10), nrow=3,ncol=3, byrow=T)
mat.replace <- ifelse(is.na(matwithNAs), 0, matwithNAs)
mmp.truncated <-ifelse(mtcars$mpg>20,20,mtcars$mpg)
###########################################
#Chapter 10 Loops, the Un-R way to iterate#
###########################################
for (i in 1:10) {
print(i)
}## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8
## [1] 9
## [1] 10print(1:10)## [1] 1 2 3 4 5 6 7 8 9 10fruit <- c("apple", "banana", "pomegranate")
fruitLength <- rep(NA, length(fruit))
fruitLength## [1] NA NA NA#it's necessary to give names
names(fruitLength) <- fruit
for (a in fruit) {
fruitLength[a] <- nchar(a)
}
fruitLength## apple banana pomegranate
## 5 6 11fruitLength2 <- nchar(fruit)
names(fruitLength2) <- fruit
fruitLength2## apple banana pomegranate
## 5 6 11identical(fruitLength, fruitLength2)## [1] TRUE#while
x<-1
while (x<=5) {
print(x)
x<-x+1
}## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5#use of next and break
for (i in 1:10) {
if(i==3){
next
}
print(i)
}## [1] 1
## [1] 2
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8
## [1] 9
## [1] 10#alternatives:
for (i in 1:10) {
if(i!=3){
print(i)
}
}## [1] 1
## [1] 2
## [1] 4
## [1] 5
## [1] 6
## [1] 7
## [1] 8
## [1] 9
## [1] 10for (i in 1:10) {
if(i==4){
break
}
print(i)
}## [1] 1
## [1] 2
## [1] 3#############################
#practice for for and while#
#############################
# for and while loops:
mymat <- matrix(1:16, nc=4)
newmat<-matrix(0, nc=4, nr=4)
for (j in 1:ncol(mymat))
{
newmat[,j]<-(j+1)*mymat[,j]
}
newmat## [,1] [,2] [,3] [,4]
## [1,] 2 15 36 65
## [2,] 4 18 40 70
## [3,] 6 21 44 75
## [4,] 8 24 48 80j=1;
while (j <= ncol(mymat))
{
newmat[,j]<-(j+1)*mymat[,j]
j <- j+1
}
newmat## [,1] [,2] [,3] [,4]
## [1,] 2 15 36 65
## [2,] 4 18 40 70
## [3,] 6 21 44 75
## [4,] 8 24 48 80# Iteration
mymat <- matrix(rnorm(49), nc=7)
rowmaxes=NULL # or rowmaxes=c()
rowabsmax=NULL
diffabsmax=NULL
for (j in 1:nrow(mymat)) {
rowmaxes[j]=max(mymat[j,])
rowabsmax[j]=max(abs(mymat[j,]))
diffabsmax[j]=rowabsmax[j]-rowmaxes[j]}
hist(diffabsmax)