This report is automatically generated with the R
package knitr
(version 1.5
)
.
# Chapter 9 Controlling the Logical Flow Making Choices with if Statements priceCalculator <- function(hours, pph = 40) { net.price <- hours * pph round(net.price) } priceCalculator <- function(hours, pph = 40) { net.price <- hours * pph if (hours > 100) { net.price <- net.price * 0.9 } round(net.price) } priceCalculator(hours = 55)
## [1] 2200
priceCalculator(hours = 110)
## [1] 3960
priceCalculator <- function(hours, pph = 40) { net.price <- hours * pph if (hours > 100) net.price <- net.price * 0.9 round(net.price) } `?`("if") `?`("if") `?`(`if`) ## Doing Something Else with an if...else Statement priceCalculator <- function(hours, pph = 40, public = TRUE) { net.price <- hours * pph if (hours > 100) net.price <- net.price * 0.9 if (public) { tot.price <- net.price * 1.06 } else { tot.price <- net.price * 1.12 } round(tot.price) } priceCalculator(25, public = TRUE)
## [1] 1060
priceCalculator(25, public = FALSE)
## [1] 1120
priceCalculator <- function(hours, pph = 40, public = TRUE) { net.price <- hours * pph if (hours > 100) net.price <- net.price * 0.9 if (public) tot.price <- net.price * 1.06 else tot.price <- net.price * 1.12 round(tot.price) } priceCalculator <- function(hours, pph = 40, public = TRUE) { net.price <- hours * pph if (hours > 100) net.price <- net.price * 0.9 tot.price <- net.price * if (public) 1.06 else 1.12 round(tot.price) } # Vectorizing Choices Looking at the problem priceCalculator(c(25, 110))
## Warning: the condition has length > 1 and only the first element will be used
## [1] 1060 4664
priceCalculator(110)
## [1] 4198
c(25, 110) > 100
## [1] FALSE TRUE
## Choosing based on a logical vector Understanding how it works ifelse(c(1, 3) < 2.5, 1:2, 3:4)
## [1] 1 4
### Trying it out my.hours <- c(25, 110) my.hours * 40 * ifelse(my.hours > 100, 0.9, 1)
## [1] 1000 3960
### Adapting the function priceCalculator <- function(hours, pph = 40, public) { net.price <- hours * pph net.price <- net.price * ifelse(hours > 100, 0.9, 1) tot.price <- net.price * ifelse(public, 1.06, 1.12) round(tot.price) } clients <- data.frame(hours = c(25, 110, 125, 40), public = c(TRUE, TRUE, FALSE, FALSE)) with(clients, priceCalculator(hours, public = public))
## [1] 1060 4198 5040 1792
# Making Multiple Choices Chaining if...else statements Code example # NOT run # if(client=='private'){ tot.price <- net.price * 1.12 # 12% VAT } else { # if(client=='public'){ tot.price <- net.price * 1.06 # 6% VAT } else { tot.price <- # net.price * 1 # 0% VAT } } Code example # NOT run if(client=='private'){ tot.price <- # net.price * 1.12 } else if(client=='public'){ tot.price <- net.price * 1.06 } else { # tot.price <- net.price } Code example # NOT run VAT <- ifelse(client=='private', 1.12, # ifelse(client == 'public', 1.06, 1) ) tot.price <- net.price * VAT Switching between # possibilities Making choices with switch Code example # NOT run VAT <- switch(client, # private=1.12, public=1.06, abroad=1) Using default values in switch Code example # NOT # run VAT <- switch(client, private=1.12, public=1.06, 1) client <- "other" switch(client, private = 1.12, public = 1.06, 1)
## [1] 1
# Looping Through Values Constructing a for loop Calculating values in a for loop Using the # values of the vector priceCalculator <- function(hours, pph = 40, client) { net.price <- hours * pph * ifelse(hours > 100, 0.9, 1) VAT <- numeric(0) for (i in client) { VAT <- c(VAT, switch(i, private = 1.12, public = 1.06, 1)) } tot.price <- net.price * VAT round(tot.price) } clients$type <- c("public", "abroad", "private", "abroad") priceCalculator(clients$hours, client = clients$type)
## [1] 1060 3960 5040 1600
### Using loops and indices nclient <- length(client) VAT <- numeric(nclient) for (i in seq_along(client)) { VAT[i] <- switch(client[i], private = 1.12, public = 1.06, 1) } VAT
## [1] 1
# Looping without Loops: Meeting the Apply Family songline <- "Get out of my dreams..." for (songline in 1:5) print("...Get into my car!")
## [1] "...Get into my car!" ## [1] "...Get into my car!" ## [1] "...Get into my car!" ## [1] "...Get into my car!" ## [1] "...Get into my car!"
songline
## [1] 5
## Looking at the family features Meeting three of the members Applying functions on rows ## and columns Counting birds counts <- matrix(c(3, 2, 4, 6, 5, 1, 8, 6, 1), ncol = 3) colnames(counts) <- c("sparrow", "dove", "crow") counts
## sparrow dove crow ## [1,] 3 6 8 ## [2,] 2 5 6 ## [3,] 4 1 1
apply(counts, 2, max)
## sparrow dove crow ## 4 6 8
### Adding extra arguments counts[2, 2] <- NA apply(counts, 2, max)
## sparrow dove crow ## 4 NA 8
apply(counts, 2, max, na.rm = TRUE)
## sparrow dove crow ## 4 6 8
## Applying functions to listlike objects Applying a function to a vector Using switch on ## vectors sapply(c("a", "b"), switch, a = "Hello", b = "Goodbye")
## a b ## "Hello" "Goodbye"
#### Replacing a complete for loop with a single statement priceCalculator <- function(hours, pph = 40, client) { net.price <- hours * pph * ifelse(hours > 100, 0.9, 1) VAT <- sapply(client, switch, private = 1.12, public = 1.06, 1) tot.price <- net.price * VAT round(tot.price) } ### Applying a function to a data frame sapply(clients, class)
## hours public type ## "numeric" "logical" "character"
### Simplifying results (or not) with sapply sapply(clients, unique)
## $hours ## [1] 25 110 125 40 ## ## $public ## [1] TRUE FALSE ## ## $type ## [1] "public" "abroad" "private"
### Getting lists using lapply sapply(clients[c(1, 3), ], unique)
## hours public type ## [1,] "25" "TRUE" "public" ## [2,] "125" "FALSE" "private"
lapply(clients[c(1, 3), ], unique)
## $hours ## [1] 25 125 ## ## $public ## [1] TRUE FALSE ## ## $type ## [1] "public" "private"
The R session information (including the OS info, R version and all packages used):
sessionInfo()
## R version 3.0.2 (2013-09-25) ## Platform: x86_64-w64-mingw32/x64 (64-bit) ## ## locale: ## [1] LC_COLLATE=English_United Kingdom.1252 LC_CTYPE=English_United Kingdom.1252 ## [3] LC_MONETARY=English_United Kingdom.1252 LC_NUMERIC=C ## [5] LC_TIME=English_United Kingdom.1252 ## ## attached base packages: ## [1] stats graphics grDevices utils datasets methods base ## ## other attached packages: ## [1] BiocInstaller_1.12.1 ggplot2_0.9.3.1 reshape2_1.2.2 sos_1.3-8 ## [5] brew_1.0-6 stringr_0.6.2 knitr_1.5 plyr_1.8 ## [9] Revobase_7.1.0 RevoMods_7.1.0 RevoScaleR_7.1.0 lattice_0.20-27 ## [13] rpart_4.1-2 ## ## loaded via a namespace (and not attached): ## [1] codetools_0.2-8 colorspace_1.2-4 dichromat_2.0-0 digest_0.6.4 ## [5] evaluate_0.5.1 foreach_1.4.1 formatR_0.10 fortunes_1.5-2 ## [9] grid_3.0.2 gtable_0.1.2 highr_0.3 iterators_1.0.6 ## [13] labeling_0.2 MASS_7.3-29 munsell_0.4.2 proto_0.3-10 ## [17] RColorBrewer_1.0-5 scales_0.2.3 tools_3.0.2
Sys.time()
## [1] "2014-05-13 15:05:45 BST"