Loops in R

For
While
Repeat

rm(list = ls())

a <- c(1:10)
b <- sample(10, 10)
a

##  [1]  1  2  3  4  5  6  7  8  9 10

##  [1]  4  1 10  9  3  2  7  5  8  6

d <- NULL

# for loop
for (i in c(1:10)) {
  d[i] <- a[i] + b[i]
}
d

##  [1]  5  3 13 13  8  8 14 13 17 16

# while loop
d <- NULL
i <- 1
while ( i < 11) {
  d[i] <- a[i] * b[i]
  i <- i + 1
}
d

##  [1]  4  2 30 36 15 12 49 40 72 60

#  repeat loop
d <- NULL
i <- 1
repeat {
  if ( i > 10) break
  d[i] <- a[i] * b[i]
  i <- i + 1
}
d

##  [1]  4  2 30 36 15 12 49 40 72 60

aa <- 1
while (aa != 0) {
 aa <- as.numeric(readline(prompt="Please, enter your a number: "))
 cat("Square of ", aa, " is equal to ", aa^2)
}

next, break and stop functions

rm(list = ls())

set.seed(1234)
a <- c(1:10)
b <- sample(10, 10)
a
b

# next 
d <- NULL
for (i in c(1:10)) {
  if (1 == (i %% 2)) next
  d[i] <- a[i] + b[i]
}
d

# break 
d <- NULL
for (i in c(1:10)) {
  if (i >= 5) break
  d[i] <- a[i] + b[i]
}
d

# stop
d <- NULL
for (i in c(1:10)) {
  if (i >= 5) stop("i should be less than 5")
  d[i] <- a[i] + b[i]
}
d

d <- NULL
for (i in c(1:10)) {
  if (i >= 5) warning("i should be less than 5")
  d[i] <- a[i] + b[i]
}
d

if, else if, ifelse functions

rm(list = ls())

set.seed(1234)
a <- c(1:10)
b <- sample(10, 10)
a

##  [1]  1  2  3  4  5  6  7  8  9 10

##  [1] 10  6  5  4  1  8  2  7  9  3

d <- NULL
for (i in c(1:10)) {
  if (a[i] >= b[i]) {
    d[i] <- TRUE
  } else {
    d[i] <- FALSE
  }
}
d

##  [1] FALSE FALSE FALSE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE

d <- NULL
for (i in c(1:10)) {
  if (a[i] > b[i]) {
    d[i] <- 1
  } else if (a[i] == b[i]) {
    d[i] <- 0
  } else {
    d[i] <- -1
  }
}
d

##  [1] -1 -1 -1  0  1 -1  1  1  0  1

d <- ifelse(a >= b, T, F)

d <- ifelse(a > b, 1, ifelse(a == b, 0, -1))

If possible, do not use loops

aa <- c(1:1000000)
bb <- c(1000000:1)
sumAB <- 0
sumBA <- 0

system.time(for (i in c(1:length(aa))) {
  sumAB <- sumAB + (aa[i] < bb[i])
  })

##    user  system elapsed 
##   0.072   0.004   0.079

sumAB

## [1] 5e+05

system.time(sumBA <- sum(aa < bb))

##    user  system elapsed 
##   0.001   0.000   0.002

sumBA

## [1] 500000

Algorithms

Define the programming task
- Inputs
- Outputs
Design the structure of the code (the algorithm)
Write the code
- Write it step-by-step
- Test it!

Algorithms

Task: Write program that finds the mean of a vector of values
Input: A numeric vector (V)
Output: The mean value (M)
Algorithm:
- Think backwards - start from the output
  - Output: The mean value (M)
  - Total value (T) and the counter (N, the number of elements)
  - Add values to T and add 1 to the counter
  - Initialize T and N
Algorithm

Given V
Set T = 0
Set N = 1
If V[N] is NA, go to 8
Set T = T + V[N]
Set N = N + 1
Repeat 4 - 6
Set M = T / (N - 1)

V <- c(1:10)

T <- 0
N <- 1
repeat  {
  if (is.na(V[N])) break
  T <- T + V[N]
  N <- N + 1
}
M <- T / (N - 1)
M

Algorithms

If the same code will be used many times, write a function

findMean <- function(V) {
  T <- 0
  N <- 1
  repeat  {
    if (is.na(V[N])) break
    T <- T + V[N]
    N <- N + 1
  }
  M <- T / (N - 1)
  return(M)
}

# Test examples
V <- 1
findMean(V)

V <- c(1:3)
findMean(V)

V <- c(1:10)
findMean(V)

V <- NULL
# findMean(V)

V <- c(1,NA,3)
findMean(V)

findMean2 <- function(V) {
  T <- 0
  N <- 1
  for (i in c(1:length(V)))  {
    if (is.na(V[i])) next
    T <- T + V[i]
    N <- N + 1
  }
  M <- T / (N - 1)
  return(M)
}

V <- c(1, NA, 3)
findMean2(V)

Algorithms

Define the programming task
- Inputs
- Outputs
  - If the task is complex, divide it into sub-tasks
Design the structure of the code (the algorithm)
Write the code
- Write it step-by-step
- Test it!
- Add comments
- Save the script!

Functions

function_name (arg1, arg2, …) expression

function name
arguments
function body

?sample

sample(x, size, replace = FALSE, prob = NULL)

x either a vector of one or more elements from which to choose, or a positive integer
size a non-negative integer giving the number of items to choose
replace should sampling be with replacement?
prob a vector of probability weights for obtaining the elements of the vector being sampled

set.seed(123)
sample(x = c(1:3), size = 5, replace = TRUE)

## [1] 3 3 3 2 3

sample(c(1:3), 5, TRUE)

## [1] 2 2 2 3 1

sample(size = 5, replace = TRUE, x = c(1:3))

## [1] 2 2 1 2 3

sample(c(1:3), 2)

## [1] 1 3

as.logical(5)

## [1] TRUE

sample(c(TRUE, FALSE, TRUE, FALSE), 1, 0)

## [1] TRUE

An example

toplam <- function(x, y = 0) {
  z <- x + y
  return(z)
}

toplam(4)

## [1] 4

toplam(4, 5)

## [1] 9

toplam(c(1:4), c(10, 10, 10, 10))

## [1] 11 12 13 14

toplam(c(1:4), 10)

## [1] 11 12 13 14

toplam(4, TRUE)

## [1] 5

# toplam(y = 2)
# toplam(3, 4, 5)

Creating functions

The “function” function creates a function

mySum <- function(a, b) {
    z <- a + b
    return(z)
}

mySum(3,4)

## [1] 7

# What happens to z?

# No explict return value
mySum <- function(a, b) {
    a + b
}

mySum(5,10)

## [1] 15

# What if we assign the result to a variable?
mySum <- function(a, b) {
    z <- a + b
}

mySum(5,10)


# Setting default values
mySum <- function(a = 0, b = 1) {
    z <- a + b
    return(z)
}

mySum(5, 10)

## [1] 15

mySum(5)

## [1] 6

mySum()

## [1] 1

mySum(b = 3, a = 1)

## [1] 4

# Setting default values for some arguments
mySum <- function(a, b = 1) {
    z <- a + b
    return(z)
}

mySum(5, 10)

## [1] 15

mySum(5)

## [1] 6

mySum()

## Error in mySum(): argument "a" is missing, with no default

mySum(b = 3, a = 1)

## [1] 4

Function components

Body: Code inside the function
Formals: The list of arguments
The environment: Location of a function’s variables

mySum <- function(a = 0, b = 1) {
    z <- a + b
    return(z)
}


body(mySum)

## {
##     z <- a + b
##     return(z)
## }

formals(mySum)

## $a
## [1] 0
## 
## $b
## [1] 1

environment(mySum)

## <environment: R_GlobalEnv>

sumNA <- function(...) {
    return(sum(..., na.rm = TRUE))
}

body(sumNA)

## {
##     return(sum(..., na.rm = TRUE))
## }

formals(sumNA)

## $...

environment(sumNA)

## <environment: R_GlobalEnv>

aa <- c(1, 3, NA, 4)
sum(aa)

## [1] NA

sumNA(aa)

## [1] 8

Primitive functions

Base R functions
Coded in C

sum

## function (..., na.rm = FALSE)  .Primitive("sum")

body(sum)

## NULL

formals(sum)

## NULL

environment(sum)

## NULL

Name masking

a <- 10
b <- 100

f1 <- function() {
  a <- 1
  b <- 2
  return(sum(a + b))
  }

f2 <- function() {
    b <- 2
    return(sum(a + b))
}

f1()

## [1] 3

f2()

## [1] 12

f3 <- function(a = 1) {
    b <<- a * 5
    d <<- 10
    e <- 20
}

a

## [1] 10

## [1] 100

# d
# e
f3()
a

## [1] 10

## [1] 5

## [1] 10

# e

Lazy evaluation

Functions’ arguments are evaluated when they are used

rm(list=ls())

f1 <- function(a = 10, b = d) {
  d <- (a + 1) ^ 2
  return(a + b)
}


f1()

## [1] 131

f1(1)

## [1] 5

f1(1, 5)

## [1] 6

Conditional argument creation

f1 <- function(a = 1, b) {
  if (missing(b)) b = (a + 1) ^ 2
  return(a + b)
}

f1()

## [1] 5

f1(1)

## [1] 5

f1(1, 5)

## [1] 6

if else statements

abss <- function(x) {
  if (x < 0) {
      x <- -1 * x
    }
    else {
      x <- x
    }
  return(x)
}

abss(-5)

## [1] 5

abss(1.5)

## [1] 1.5

# abss(c(-1, 0, 1))

absv <- function(x) {
  x[x < 0] <- -1 * x[x < 0]
  return(x)
}

absv(-5)

## [1] 5

absv(c(-1, 0, 1))

## [1] 1 0 1

Special functions

Infix functions
- Function name comes in between its arguments

`%pow%` <- function(a, b) {a^b}

2 %pow% 3

## [1] 8

Every operation is a function!

# Sum operator
`+`

## function (e1, e2)  .Primitive("+")

`+` <- function(a, b) {a - b}

2 + 2

## [1] 0

rm("+")

2 + 2

## [1] 4

Replacement functions
- They modify their “arguments”
- Special name: “fname <-”

`modify<-` <- function(x, position, value) {
  x[position] <- value
  x
}

x <- c(1:10)
x

##  [1]  1  2  3  4  5  6  7  8  9 10

modify(x, 1) <- 10
x

##  [1] 10  2  3  4  5  6  7  8  9 10

ECON 413
Algorithms, loops, functions

Topics

Loops in R

next, break and stop functions

if, else if, ifelse functions

If possible, do not use loops

Algorithms

Algorithms

Algorithms

Algorithms

Functions

Creating functions

Function components

Primitive functions

Name masking

Lazy evaluation

Special functions

Debugging functions

ECON 413 Algorithms, loops, functions

Topics

Loops in R

next, break and stop functions

if, else if, ifelse functions

If possible, do not use loops

Algorithms

Algorithms

Algorithms

Algorithms

Functions

Creating functions

Function components

Primitive functions

Name masking

Lazy evaluation

Special functions

Debugging functions

ECON 413
Algorithms, loops, functions