6.4 Fizzbuzz

fizzbuzz <- function(x) {
  # these two lines check that x is a valid input
  stopifnot(length(x) == 1)
  stopifnot(is.numeric(x))
  if (!(x %% 3) && !(x %% 5)) {
    "fizzbuzz"
  } else if (!(x %% 3)) {
    "fizz"
  } else if (!(x %% 5)) {
    "buzz"
  } else {
    # ensure that the function returns a character vector
    as.character(x)
  }
}

fizzbuzz(6)
## [1] "fizz"

Check modulo 3 only once

fizzbuzz2 <- function(x) {
  # these two lines check that x is a valid input
  stopifnot(length(x) == 1)
  stopifnot(is.numeric(x))
  if (!(x %% 3)) {
    if (!(x %% 5)) {
      "fizzbuzz"
    } else {
      "fizz"
    }
  } else if (!(x %% 5)) {
    "buzz"
  } else {
    # ensure that the function returns a character vector
    as.character(x)
  }
}

fizzbuzz(6)
## [1] "fizz"

6.4.1 Vectorized conditionals

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

fizzbuzz_vec <- function(x) {
  dplyr::case_when(
    !(x %% 3) & !(x %% 5) ~ "fizzbuzz",
    !(x %% 3) ~ "fizz",
    !(x %% 5) ~ "buzz",
    TRUE ~ as.character(x)
  )
}

fizzbuzz(1:10)
## Error in fizzbuzz(1:10): length(x) == 1 is not TRUE

fizzbuzz_vec(1:10)
##  [1] "1"    "2"    "fizz" "4"    "buzz" "fizz" "7"    "8"    "fizz" "buzz"

6.4.2 Multiple conditions

if (this) {
  # do that
} else if (that) {
  # do something else
} else {
  # 
}

6.4.2.1 switch

calc_op <- function(x, y, op) {
  switch(op,
         plus = x + y,
         minus = x - y,
         times = x * y,
         divide = x / y,
         stop("Unknown op!")
  )
}

calc_op(10, 20, "times")
## [1] 200

calc_op(10, 20, "divide")
## [1] 0.5

6.4.2.2 cut

describe_temp <- function(temp) {
  if (temp <= 0) {
    "freezing"
  } else if (temp <= 10) {
    "cold"
  } else if (temp <= 20) {
    "cool"
  } else if (temp <= 30) { 
    "warm"
  } else {
    "hot"
  }
}

describe_temp(16)
## [1] "cool"

Current function can’t handle vectors

describe_temp(c(16, 61))
## Warning in if (temp <= 0) {: the condition has length > 1 and only the first
## element will be used
## Warning in if (temp <= 10) {: the condition has length > 1 and only the first
## element will be used
## Warning in if (temp <= 20) {: the condition has length > 1 and only the first
## element will be used
## [1] "cool"

How cut works:

values <- -10:10
values
##  [1] -10  -9  -8  -7  -6  -5  -4  -3  -2  -1   0   1   2   3   4   5   6   7   8
## [20]   9  10

cut(values, c(-Inf, -5, -1, 1, 7, Inf))
##  [1] (-Inf,-5] (-Inf,-5] (-Inf,-5] (-Inf,-5] (-Inf,-5] (-Inf,-5] (-5,-1]  
##  [8] (-5,-1]   (-5,-1]   (-5,-1]   (-1,1]    (-1,1]    (1,7]     (1,7]    
## [15] (1,7]     (1,7]     (1,7]     (1,7]     (7, Inf]  (7, Inf]  (7, Inf] 
## Levels: (-Inf,-5] (-5,-1] (-1,1] (1,7] (7, Inf]

cut(values, c(-Inf, -5, -1, 1, 7, Inf), labels = LETTERS[1:5], right = TRUE)
##  [1] A A A A A A B B B B C C D D D D D D E E E
## Levels: A B C D E

cut(values, c(-Inf, -5, -1, 1, 7, Inf), labels = LETTERS[1:5], right = FALSE)
##  [1] A A A A A B B B B C C D D D D D D E E E E
## Levels: A B C D E