Advanced_R_Assignment/factorial_code.R at master · dvsdimas/Advanced_R_Assignment · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
if(!require(purrr)) {
    stop("the 'purrr' package needs to be installed first")
}

if(!require(microbenchmark)) {
    stop("the 'microbenchmark' package needs to be installed first")
}


# data for tests

numbers <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20)
factorials <- c(1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800, 479001600, 6227020800, 87178291200,
                1307674368000, 20922789888000, 355687428096000, 6402373705728000, 121645100408832000, 2432902008176640000)

# test function

test_function <- function(f) {
    stopifnot(all(map2_lgl(numbers, factorials, function(x, y) { identical(f(x), y) } )))
}


# Factorial_loop: a version that computes the factorial of an integer using looping (such as a for loop)

Factorial_loop <- function(n) {

    stopifnot(n >= 0)

    ret <- 1

    if( n > 1) {
        for(i in 2:n) {
            ret <- ret * i
        }
    }

    ret
}

test_function(Factorial_loop)


# Factorial_reduce: a version that computes the factorial using the reduce() function in the purrr package

Factorial_reduce <- function(n) {

    stopifnot(n >= 0)

    if( (n == 0) || (n == 1) ) {
        return(1)
    }

    reduce(as.numeric(2:n), `*`)
}

test_function(Factorial_reduce)


# Factorial_func: a version that uses recursion to compute the factorial

Factorial_func <- function(n) {

    stopifnot(n >= 0)

    if( (n == 0) || (n == 1) ) {
        return(1)
    }

    n * Factorial_func(n - 1)
}

test_function(Factorial_func)


# Factorial_mem: a version that uses memoization to compute the factorial

factorial_cache <- c(rep(NA, 100))

Factorial_mem <- function(n) {

    stopifnot(n >= 0)

    if( (n == 0) || (n == 1) ) {
        return(1)
    }

    if(is.na(factorial_cache[n])){
        factorial_cache[n] <<- n * Factorial_mem(n - 1)
    }

    factorial_cache[n]
}

test_function(Factorial_mem)


### Function's performance tests

count <- 100000


n_small <- 5

microbenchmark(Factorial_loop(n_small), times = count)
microbenchmark(Factorial_reduce(n_small), times = count)
microbenchmark(Factorial_func(n_small), times = count)
microbenchmark(Factorial_mem(n_small), times = count)


n_big <- 20

microbenchmark(Factorial_loop(n_big), times = count)
microbenchmark(Factorial_reduce(n_big), times = count)
microbenchmark(Factorial_func(n_big), times = count)
microbenchmark(Factorial_mem(n_big), times = count)