Execise 1: Control Flow

Part 1.1

Use a for loop to: a. Print all the letters of the Latin alphabet:

for (letter in letters) {
  print(letter)
}
[1] "a"
[1] "b"
[1] "c"
[1] "d"
[1] "e"
[1] "f"
[1] "g"
[1] "h"
[1] "i"
[1] "j"
[1] "k"
[1] "l"
[1] "m"
[1] "n"
[1] "o"
[1] "p"
[1] "q"
[1] "r"
[1] "s"
[1] "t"
[1] "u"
[1] "v"
[1] "w"
[1] "x"
[1] "y"
[1] "z"
  1. Print the numbers 10 to 100 that are divisible by 7
for (i in 10:100) {
  if (i %% 7 == 0) {
    print(i)
  }
}
[1] 14
[1] 21
[1] 28
[1] 35
[1] 42
[1] 49
[1] 56
[1] 63
[1] 70
[1] 77
[1] 84
[1] 91
[1] 98
  1. Print the numbers 1 to 100 that are divisible by 5 but not by 3.
for (i in 1:100) {
  if (i %% 5 == 0 & i %% 3 != 0) {
    print(i)
  }
}
[1] 5
[1] 10
[1] 20
[1] 25
[1] 35
[1] 40
[1] 50
[1] 55
[1] 65
[1] 70
[1] 80
[1] 85
[1] 95
[1] 100

Part 1.2

  1. Find all numbers not greater than 10,000 that are divisible by 5, 7 and 11 and print them.
x <- 1
while (x <= 10000) {
  if(all(x %% 5 == 0, x %% 7 == 0, x %% 11 == 0)) {
    print(x)
  }
  x <- x + 1
}
[1] 385
[1] 770
[1] 1155
[1] 1540
[1] 1925
[1] 2310
[1] 2695
[1] 3080
[1] 3465
[1] 3850
[1] 4235
[1] 4620
[1] 5005
[1] 5390
[1] 5775
[1] 6160
[1] 6545
[1] 6930
[1] 7315
[1] 7700
[1] 8085
[1] 8470
[1] 8855
[1] 9240
[1] 9625
  1. Print for each of the numbers x = 2, . . . 20, all numbers that divide x (all factors) excluding 1 and x. Hence, for 18, it should print 2 3 6 9.
for (x in 2:20) {
  vec <- rep(NA, x-2)
  for (i in 2:(x-1)) {
    if (x == 2) next
    if (x %% i == 0 ) {
      vec[i-1] <- i 
    }
  }
  cat("Factors of", x, "are:", vec[which(!is.na(vec))], "\n")
}
Factors of 2 are:  
Factors of 3 are:  
Factors of 4 are: 2 
Factors of 5 are:  
Factors of 6 are: 2 3 
Factors of 7 are:  
Factors of 8 are: 2 4 
Factors of 9 are: 3 
Factors of 10 are: 2 5 
Factors of 11 are:  
Factors of 12 are: 2 3 4 6 
Factors of 13 are:  
Factors of 14 are: 2 7 
Factors of 15 are: 3 5 
Factors of 16 are: 2 4 8 
Factors of 17 are:  
Factors of 18 are: 2 3 6 9 
Factors of 19 are:  
Factors of 20 are: 2 4 5 10 
# A faster version (inner loop only checks sqrt(x) numbers)
for (x in 2:20) {
  vec <- rep(NA, x-2)
  for (i in 2:ceiling(sqrt(x))) {
    if (x == 2) next
    if (x %% i == 0 ) {
        vec[i - 1] <- i 
        vec[x/i - 1] <- x/i
    }
  }
  cat("Numbers that divide", x, "are:", vec[which(!is.na(vec))], "\n")
}
Numbers that divide 2 are:  
Numbers that divide 3 are:  
Numbers that divide 4 are: 2 
Numbers that divide 5 are:  
Numbers that divide 6 are: 2 3 
Numbers that divide 7 are:  
Numbers that divide 8 are: 2 4 
Numbers that divide 9 are: 3 
Numbers that divide 10 are: 2 5 
Numbers that divide 11 are:  
Numbers that divide 12 are: 2 3 4 6 
Numbers that divide 13 are:  
Numbers that divide 14 are: 2 7 
Numbers that divide 15 are: 3 5 
Numbers that divide 16 are: 2 4 8 
Numbers that divide 17 are:  
Numbers that divide 18 are: 2 3 6 9 
Numbers that divide 19 are:  
Numbers that divide 20 are: 2 4 5 10 

Execise 2: Functions

Part 2.1

a.Create a function what will return the number of times a given integer is contained a given vector of integers. The function should have two arguments one for a vector and the other for a scalar.

# function returns the number of times a given integer, k, 
# occurs in a given vector of integers, vec.
no_of_integers <- function(vec, k) {
  return(sum(vec == k))
}
  1. Then, generate a random vector of 100 integers (in a range 1-20) use the function to count the number of times the number 12 is in that vector.
(vec <- sample(1:20, 100, replace = TRUE))
  [1] 14 11  6 19  6 17  6  6  4  5  7  7  4  1  5 17 11 19 17  1 10  6  7 11  4 16  5  6 20
 [30] 17 12 13  7 13  7 11 14 10  5 16  2  7 15 11  4 11 10 16  4 17 18  1  7  1  5 15  7 11
 [59]  2 12  3 18  1 16  2 11  8  2  7 14 19 10  3 11  4 18  8  7  4 18  4 19  3  3  3 11  7
 [88]  1  7 15  1 12  6  5  3  7  4  3  9  1
cat("Number of times 12 occurs in the vec is:", no_of_integers(vec, 12))
Number of times 12 occurs in the vec is: 3

Part 2.2

Write a function that takes in a data.frame as an input, prints out the column names, and returns its dimensions.

my_function <- function(df) {
  print(colnames(df))
  return(dim(df))
}
x <- my_function(mtcars)
 [1] "mpg"  "cyl"  "disp" "hp"   "drat" "wt"   "qsec" "vs"   "am"   "gear" "carb"
x
[1] 32 11

Execise 3: Apply family functions

Part 1

Below we print six first rows of the built-in dataset, mtcars, from the 1974 Motor Trend US magazine, which comprises information on the fuel consumption and 10 aspects of automobile design and performance for 32 selected car models.

head(mtcars)

Use apply() function to find the standard deviation and the 0.8-quantile
of each of the automobile characteristic.

apply(mtcars, 2, function(x) sd(x))
        mpg         cyl        disp          hp        drat          wt        qsec 
  6.0269481   1.7859216 123.9386938  68.5628685   0.5346787   0.9784574   1.7869432 
         vs          am        gear        carb 
  0.5040161   0.4989909   0.7378041   1.6152000 
apply(mtcars, 2, function(x) { quantile(x, 0.8)})
    mpg     cyl    disp      hp    drat      wt    qsec      vs      am    gear    carb 
 24.080   8.000 350.800 200.000   4.048   3.770  19.332   1.000   1.000   4.000   4.000 

Part 2

Below is a vector of dates in year 2018.

set.seed(1234)
y2018 <- seq(as.Date("2018-01-01", format = "%Y-%m-%d"), 
             as.Date("2018-12-31", format = "%Y-%m-%d"), 
             "days")
length(y2018)
[1] 365
# A random sample of 10 dates from 2018
y2018_sample <- sample(y2018, size = 10)
y2018_sample
 [1] "2018-02-11" "2018-08-15" "2018-08-10" "2018-08-14" "2018-11-07" "2018-08-19"
 [7] "2018-01-04" "2018-03-25" "2018-08-26" "2018-07-03"

Use an apply family function to return the number of weeks left from each day in y2018_sample to the New Year, 2019/01/01.

ny2019 <- as.Date("2019-01-01", format = "%Y-%m-%d")
weeks.to.2019 <- sapply(y2018_sample, function(d) ceiling((ny2019 - d)/7))
names(weeks.to.2019) <- y2018_sample
weeks.to.2019
2018-02-11 2018-08-15 2018-08-10 2018-08-14 2018-11-07 2018-08-19 2018-01-04 2018-03-25 
        47         20         21         20          8         20         52         41 
2018-08-26 2018-07-03 
        19         26 
sessionInfo()
R version 3.5.0 (2018-04-23)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS Sierra 10.12.6

Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] randomForest_4.6-14 ISLR_1.2            forcats_0.3.0       stringr_1.3.1      
 [5] dplyr_0.7.99.9000   purrr_0.2.5         readr_1.1.1         tidyr_0.8.1        
 [9] tibble_1.4.2        ggplot2_3.0.0.9000  tidyverse_1.2.1    

loaded via a namespace (and not attached):
 [1] Rcpp_0.12.19.2   cellranger_1.1.0 pillar_1.3.0     compiler_3.5.0   plyr_1.8.4      
 [6] base64enc_0.1-3  tools_3.5.0      digest_0.6.17    evaluate_0.11    jsonlite_1.5    
[11] lubridate_1.7.4  gtable_0.2.0     nlme_3.1-137     lattice_0.20-35  pkgconfig_2.0.2 
[16] rlang_0.2.2.9002 cli_1.0.0        rstudioapi_0.7   curl_3.2         yaml_2.2.0      
[21] haven_1.1.2      withr_2.1.2      xml2_1.2.0       httr_1.3.1       knitr_1.20      
[26] hms_0.4.2        rprojroot_1.3-2  grid_3.5.0       tidyselect_0.2.4 glue_1.3.0      
[31] R6_2.2.2         readxl_1.1.0     rmarkdown_1.10   modelr_0.1.2     magrittr_1.5    
[36] htmltools_0.3.6  backports_1.1.2  scales_1.0.0     rvest_0.3.2      assertthat_0.2.0
[41] colorspace_1.3-2 labeling_0.3     stringi_1.2.4    lazyeval_0.2.1   munsell_0.5.0   
[46] broom_0.5.0      crayon_1.3.4    
LS0tCnRpdGxlOiAiTGVjdHVyZSAyOiBFeGVyY2lzZSBBbnN3ZXJzIgpkYXRlOiBPY3RvYmVyIDJuZCwgMjAxOApvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6CiAgICB0b2M6IHRydWUKICAgIHRvY19mbG9hdDogdHJ1ZQotLS0KCiMgRXhlY2lzZSAxOiBDb250cm9sIEZsb3cgCgojIyBQYXJ0IDEuMQoKVXNlIGEgZm9yIGxvb3AgdG86CmEuIFByaW50IGFsbCB0aGUgbGV0dGVycyBvZiB0aGUgTGF0aW4gYWxwaGFiZXQ6CgpgYGB7cn0KZm9yIChsZXR0ZXIgaW4gbGV0dGVycykgewogIHByaW50KGxldHRlcikKfQpgYGAKCmIuIFByaW50IHRoZSBudW1iZXJzIDEwIHRvIDEwMCB0aGF0IGFyZSBkaXZpc2libGUgYnkgNwpgYGB7cn0KZm9yIChpIGluIDEwOjEwMCkgewogIGlmIChpICUlIDcgPT0gMCkgewogICAgcHJpbnQoaSkKICB9Cn0KYGBgCgpjLiBQcmludCB0aGUgbnVtYmVycyAxIHRvIDEwMCB0aGF0IGFyZSBkaXZpc2libGUgYnkgNSBidXQgbm90IGJ5IDMuCmBgYHtyfQpmb3IgKGkgaW4gMToxMDApIHsKICBpZiAoaSAlJSA1ID09IDAgJiBpICUlIDMgIT0gMCkgewogICAgcHJpbnQoaSkKICB9Cn0KYGBgCgoKCiMjIFBhcnQgMS4yCgphLiBGaW5kIGFsbCBudW1iZXJzIG5vdCBncmVhdGVyIHRoYW4gMTAsMDAwIHRoYXQgYXJlIGRpdmlzaWJsZSBieSAKNSwgNyBhbmQgMTEgYW5kIHByaW50IHRoZW0uCgpgYGB7cn0KeCA8LSAxCndoaWxlICh4IDw9IDEwMDAwKSB7CiAgaWYoYWxsKHggJSUgNSA9PSAwLCB4ICUlIDcgPT0gMCwgeCAlJSAxMSA9PSAwKSkgewogICAgcHJpbnQoeCkKICB9CiAgeCA8LSB4ICsgMQp9CmBgYAoKCmIuIFByaW50IGZvciBlYWNoIG9mIHRoZSBudW1iZXJzIHggPSAyLCAuIC4gLiAyMCwgYWxsIG51bWJlcnMgdGhhdCBkaXZpZGUgeAooYWxsIGZhY3RvcnMpIGV4Y2x1ZGluZyAxIGFuZCB4LiBIZW5jZSwgZm9yIDE4LCBpdCBzaG91bGQgcHJpbnQgMiAzIDYgOS4KCmBgYHtyfQpmb3IgKHggaW4gMjoyMCkgewogIHZlYyA8LSByZXAoTkEsIHgtMikKICBmb3IgKGkgaW4gMjooeC0xKSkgewogICAgaWYgKHggPT0gMikgbmV4dAogICAgaWYgKHggJSUgaSA9PSAwICkgewogICAgICB2ZWNbaS0xXSA8LSBpIAogICAgfQogIH0KICBjYXQoIkZhY3RvcnMgb2YiLCB4LCAiYXJlOiIsIHZlY1t3aGljaCghaXMubmEodmVjKSldLCAiXG4iKQp9CmBgYAoKYGBge3J9CiMgQSBmYXN0ZXIgdmVyc2lvbiAoaW5uZXIgbG9vcCBvbmx5IGNoZWNrcyBzcXJ0KHgpIG51bWJlcnMpCmZvciAoeCBpbiAyOjIwKSB7CiAgdmVjIDwtIHJlcChOQSwgeC0yKQogIGZvciAoaSBpbiAyOmNlaWxpbmcoc3FydCh4KSkpIHsKICAgIGlmICh4ID09IDIpIG5leHQKICAgIGlmICh4ICUlIGkgPT0gMCApIHsKICAgICAgICB2ZWNbaSAtIDFdIDwtIGkgCiAgICAgICAgdmVjW3gvaSAtIDFdIDwtIHgvaQogICAgfQogIH0KICBjYXQoIk51bWJlcnMgdGhhdCBkaXZpZGUiLCB4LCAiYXJlOiIsIHZlY1t3aGljaCghaXMubmEodmVjKSldLCAiXG4iKQp9CmBgYAoKCiMgRXhlY2lzZSAyOiBGdW5jdGlvbnMKCiMjIFBhcnQgMi4xCgphLkNyZWF0ZSBhIGZ1bmN0aW9uIHdoYXQgd2lsbCByZXR1cm4gdGhlIG51bWJlcgpvZiB0aW1lcyBhIGdpdmVuIGludGVnZXIgaXMgY29udGFpbmVkIGEgZ2l2ZW4gdmVjdG9yIG9mIGludGVnZXJzLgpUaGUgZnVuY3Rpb24gc2hvdWxkIGhhdmUgdHdvIGFyZ3VtZW50cyBvbmUgZm9yIGEgdmVjdG9yCmFuZCB0aGUgb3RoZXIgZm9yIGEgc2NhbGFyLiAKCmBgYHtyfQojIGZ1bmN0aW9uIHJldHVybnMgdGhlIG51bWJlciBvZiB0aW1lcyBhIGdpdmVuIGludGVnZXIsIGssIAojIG9jY3VycyBpbiBhIGdpdmVuIHZlY3RvciBvZiBpbnRlZ2VycywgdmVjLgpub19vZl9pbnRlZ2VycyA8LSBmdW5jdGlvbih2ZWMsIGspIHsKICByZXR1cm4oc3VtKHZlYyA9PSBrKSkKfQpgYGAKCgpiLiBUaGVuLCBnZW5lcmF0ZSBhIHJhbmRvbSB2ZWN0b3Igb2YgMTAwIAppbnRlZ2VycyAoaW4gYSByYW5nZSAxLTIwKSB1c2UgdGhlIGZ1bmN0aW9uIHRvIGNvdW50IHRoZSBudW1iZXIKb2YgdGltZXMgdGhlIG51bWJlciAxMiBpcyBpbiB0aGF0IHZlY3Rvci4gCgpgYGB7cn0KKHZlYyA8LSBzYW1wbGUoMToyMCwgMTAwLCByZXBsYWNlID0gVFJVRSkpCmNhdCgiTnVtYmVyIG9mIHRpbWVzIDEyIG9jY3VycyBpbiB0aGUgdmVjIGlzOiIsIG5vX29mX2ludGVnZXJzKHZlYywgMTIpKQpgYGAKCiMjIFBhcnQgMi4yIAoKV3JpdGUgYSBmdW5jdGlvbiB0aGF0IHRha2VzIGluIGEgZGF0YS5mcmFtZSBhcyBhbiBpbnB1dCwgCnByaW50cyBvdXQgdGhlIGNvbHVtbiBuYW1lcywgYW5kIHJldHVybnMgaXRzIGRpbWVuc2lvbnMuCgpgYGB7cn0KbXlfZnVuY3Rpb24gPC0gZnVuY3Rpb24oZGYpIHsKICBwcmludChjb2xuYW1lcyhkZikpCiAgcmV0dXJuKGRpbShkZikpCn0KYGBgCgpgYGB7cn0KeCA8LSBteV9mdW5jdGlvbihtdGNhcnMpCmBgYApgYGB7cn0KeApgYGAKCiMgRXhlY2lzZSAzOiBBcHBseSBmYW1pbHkgZnVuY3Rpb25zCgojIyBQYXJ0IDEKQmVsb3cgd2UgcHJpbnQgc2l4IGZpcnN0IHJvd3Mgb2YgdGhlIGJ1aWx0LWluIGRhdGFzZXQsIGBtdGNhcnNgLCAKZnJvbSB0aGUgMTk3NCBNb3RvciBUcmVuZCBVUyBtYWdhemluZSwgd2hpY2ggY29tcHJpc2VzIGluZm9ybWF0aW9uCm9uIHRoZSBmdWVsIGNvbnN1bXB0aW9uIGFuZCAxMCBhc3BlY3RzIG9mIGF1dG9tb2JpbGUgZGVzaWduIAphbmQgcGVyZm9ybWFuY2UgZm9yIDMyIHNlbGVjdGVkIGNhciBtb2RlbHMuIAoKYGBge3J9CmhlYWQobXRjYXJzKQpgYGAKClVzZSBgYXBwbHkoKWAgZnVuY3Rpb24gdG8gZmluZCB0aGUgc3RhbmRhcmQgZGV2aWF0aW9uIGFuZCB0aGUgMC44LXF1YW50aWxlICAKb2YgZWFjaCBvZiB0aGUgYXV0b21vYmlsZSBjaGFyYWN0ZXJpc3RpYy4KCmBgYHtyfQphcHBseShtdGNhcnMsIDIsIGZ1bmN0aW9uKHgpIHNkKHgpKQpgYGAKCgpgYGB7cn0KYXBwbHkobXRjYXJzLCAyLCBmdW5jdGlvbih4KSB7IHF1YW50aWxlKHgsIDAuOCl9KQpgYGAKCiMjIFBhcnQgMgoKQmVsb3cgaXMgYSB2ZWN0b3Igb2YgZGF0ZXMgaW4geWVhciAyMDE4LgoKYGBge3J9CnNldC5zZWVkKDEyMzQpCnkyMDE4IDwtIHNlcShhcy5EYXRlKCIyMDE4LTAxLTAxIiwgZm9ybWF0ID0gIiVZLSVtLSVkIiksIAogICAgICAgICAgICAgYXMuRGF0ZSgiMjAxOC0xMi0zMSIsIGZvcm1hdCA9ICIlWS0lbS0lZCIpLCAKICAgICAgICAgICAgICJkYXlzIikKbGVuZ3RoKHkyMDE4KQojIEEgcmFuZG9tIHNhbXBsZSBvZiAxMCBkYXRlcyBmcm9tIDIwMTgKeTIwMThfc2FtcGxlIDwtIHNhbXBsZSh5MjAxOCwgc2l6ZSA9IDEwKQp5MjAxOF9zYW1wbGUKYGBgCgpVc2UgYW4gYGFwcGx5YCBmYW1pbHkgZnVuY3Rpb24gdG8gcmV0dXJuIHRoZSBudW1iZXIgb2Ygd2Vla3MKbGVmdCBmcm9tIGVhY2ggZGF5IGluIGB5MjAxOF9zYW1wbGVgIHRvIHRoZSBOZXcgWWVhciwgMjAxOS8wMS8wMS4KCmBgYHtyfQpueTIwMTkgPC0gYXMuRGF0ZSgiMjAxOS0wMS0wMSIsIGZvcm1hdCA9ICIlWS0lbS0lZCIpCndlZWtzLnRvLjIwMTkgPC0gc2FwcGx5KHkyMDE4X3NhbXBsZSwgZnVuY3Rpb24oZCkgY2VpbGluZygobnkyMDE5IC0gZCkvNykpCm5hbWVzKHdlZWtzLnRvLjIwMTkpIDwtIHkyMDE4X3NhbXBsZQp3ZWVrcy50by4yMDE5CmBgYAoKYGBge3J9CnNlc3Npb25JbmZvKCkKYGBgCgo=