mda14jx_week1.ipynb

Kernel: R

help(library)

Exercise 1

The code help(library) displays the Loading/Attaching and Listing of Packages. How to use the function.

library

function (package, help, pos = 2, lib.loc = NULL, character.only = FALSE, 
    logical.return = FALSE, warn.conflicts = TRUE, quietly = FALSE, 
    verbose = getOption("verbose")) 
{
    testRversion <- function(pkgInfo, pkgname, pkgpath) {
        if (is.null(built <- pkgInfo$Built)) 
            stop(gettextf("package %s has not been installed properly\n", 
                sQuote(pkgname)), call. = FALSE, domain = NA)
        R_version_built_under <- as.numeric_version(built$R)
        if (R_version_built_under < "3.0.0") 
            stop(gettextf("package %s was built before R 3.0.0: please re-install it", 
                sQuote(pkgname)), call. = FALSE, domain = NA)
        current <- getRversion()
        if (length(Rdeps <- pkgInfo$Rdepends2)) {
            for (dep in Rdeps) if (length(dep) > 1L) {
                target <- dep$version
                res <- if (is.character(target)) {
                  do.call(dep$op, list(as.numeric(R.version[["svn rev"]]), 
                    as.numeric(sub("^r", "", dep$version))))
                }
                else {
                  do.call(dep$op, list(current, as.numeric_version(target)))
                }
                if (!res) 
                  stop(gettextf("This is R %s, package %s needs %s %s", 
                    current, sQuote(pkgname), dep$op, target), 
                    call. = FALSE, domain = NA)
            }
        }
        if (R_version_built_under > current) 
            warning(gettextf("package %s was built under R version %s", 
                sQuote(pkgname), as.character(built$R)), call. = FALSE, 
                domain = NA)
        platform <- built$Platform
        r_arch <- .Platform$r_arch
        if (.Platform$OS.type == "unix") {
            if (!nzchar(r_arch) && length(grep("\\w", platform)) && 
                !testPlatformEquivalence(platform, R.version$platform)) 
                stop(gettextf("package %s was built for %s", 
                  sQuote(pkgname), platform), call. = FALSE, 
                  domain = NA)
        }
        else {
            if (nzchar(platform) && !grepl("mingw", platform)) 
                stop(gettextf("package %s was built for %s", 
                  sQuote(pkgname), platform), call. = FALSE, 
                  domain = NA)
        }
        if (nzchar(r_arch) && file.exists(file.path(pkgpath, 
            "libs")) && !file.exists(file.path(pkgpath, "libs", 
            r_arch))) 
            stop(gettextf("package %s is not installed for 'arch = %s'", 
                sQuote(pkgname), r_arch), call. = FALSE, domain = NA)
    }
    checkLicense <- function(pkg, pkgInfo, pkgPath) {
        L <- tools:::analyze_license(pkgInfo$DESCRIPTION["License"])
        if (!L$is_empty && !L$is_verified) {
            site_file <- path.expand(file.path(R.home("etc"), 
                "licensed.site"))
            if (file.exists(site_file) && pkg %in% readLines(site_file)) 
                return()
            personal_file <- path.expand("~/.R/licensed")
            if (file.exists(personal_file)) {
                agreed <- readLines(personal_file)
                if (pkg %in% agreed) 
                  return()
            }
            else agreed <- character()
            if (!interactive()) 
                stop(gettextf("package %s has a license that you need to accept in an interactive session", 
                  sQuote(pkg)), domain = NA)
            lfiles <- file.path(pkgpath, c("LICENSE", "LICENCE"))
            lfiles <- lfiles[file.exists(lfiles)]
            if (length(lfiles)) {
                message(gettextf("package %s has a license that you need to accept after viewing", 
                  sQuote(pkg)), domain = NA)
                readline("press RETURN to view license")
                encoding <- pkgInfo$DESCRIPTION["Encoding"]
                if (is.na(encoding)) 
                  encoding <- ""
                if (encoding == "latin1") 
                  encoding <- "cp1252"
                file.show(lfiles[1L], encoding = encoding)
            }
            else {
                message(gettextf("package %s has a license that you need to accept:\naccording to the DESCRIPTION file it is", 
                  sQuote(pkg)), domain = NA)
                message(pkgInfo$DESCRIPTION["License"], domain = NA)
            }
            choice <- menu(c("accept", "decline"), title = paste("License for", 
                sQuote(pkg)))
            if (choice != 1) 
                stop(gettextf("license for package %s not accepted", 
                  sQuote(package)), domain = NA, call. = FALSE)
            dir.create(dirname(personal_file), showWarnings = FALSE)
            writeLines(c(agreed, pkg), personal_file)
        }
    }
    checkNoGenerics <- function(env, pkg) {
        nenv <- env
        ns <- .getNamespace(as.name(pkg))
        if (!is.null(ns)) 
            nenv <- asNamespace(ns)
        if (exists(".noGenerics", envir = nenv, inherits = FALSE)) 
            TRUE
        else {
            length(objects(env, pattern = "^\\.__T", all.names = TRUE)) == 
                0L
        }
    }
    checkConflicts <- function(package, pkgname, pkgpath, nogenerics, 
        env) {
        dont.mind <- c("last.dump", "last.warning", ".Last.value", 
            ".Random.seed", ".Last.lib", ".onDetach", ".packageName", 
            ".noGenerics", ".required", ".no_S3_generics", ".Depends", 
            ".requireCachedGenerics")
        sp <- search()
        lib.pos <- match(pkgname, sp)
        ob <- objects(lib.pos, all.names = TRUE)
        if (!nogenerics) {
            these <- ob[substr(ob, 1L, 6L) == ".__T__"]
            gen <- gsub(".__T__(.*):([^:]+)", "\\1", these)
            from <- gsub(".__T__(.*):([^:]+)", "\\2", these)
            gen <- gen[from != package]
            ob <- ob[!(ob %in% gen)]
        }
        fst <- TRUE
        ipos <- seq_along(sp)[-c(lib.pos, match(c("Autoloads", 
            "CheckExEnv"), sp, 0L))]
        for (i in ipos) {
            obj.same <- match(objects(i, all.names = TRUE), ob, 
                nomatch = 0L)
            if (any(obj.same > 0)) {
                same <- ob[obj.same]
                same <- same[!(same %in% dont.mind)]
                Classobjs <- grep("^\\.__", same)
                if (length(Classobjs)) 
                  same <- same[-Classobjs]
                same.isFn <- function(where) vapply(same, exists, 
                  NA, where = where, mode = "function", inherits = FALSE)
                same <- same[same.isFn(i) == same.isFn(lib.pos)]
                not.Ident <- function(ch, TRAFO = identity, ...) vapply(ch, 
                  function(.) !identical(TRAFO(get(., i)), TRAFO(get(., 
                    lib.pos)), ...), NA)
                if (length(same)) 
                  same <- same[not.Ident(same)]
                if (length(same) && identical(sp[i], "package:base")) 
                  same <- same[not.Ident(same, ignore.environment = TRUE)]
                if (length(same)) {
                  if (fst) {
                    fst <- FALSE
                    packageStartupMessage(gettextf("\nAttaching package: %s\n", 
                      sQuote(package)), domain = NA)
                  }
                  msg <- .maskedMsg(same, pkg = sQuote(sp[i]), 
                    by = i < lib.pos)
                  packageStartupMessage(msg, domain = NA)
                }
            }
        }
    }
    if (verbose && quietly) 
        message("'verbose' and 'quietly' are both true; being verbose then ..")
    if (!missing(package)) {
        if (is.null(lib.loc)) 
            lib.loc <- .libPaths()
        lib.loc <- lib.loc[dir.exists(lib.loc)]
        if (!character.only) 
            package <- as.character(substitute(package))
        if (length(package) != 1L) 
            stop("'package' must be of length 1")
        if (is.na(package) || (package == "")) 
            stop("invalid package name")
        pkgname <- paste("package", package, sep = ":")
        newpackage <- is.na(match(pkgname, search()))
        if (newpackage) {
            pkgpath <- find.package(package, lib.loc, quiet = TRUE, 
                verbose = verbose)
            if (length(pkgpath) == 0L) {
                txt <- if (length(lib.loc)) 
                  gettextf("there is no package called %s", sQuote(package))
                else gettext("no library trees found in 'lib.loc'")
                if (logical.return) {
                  warning(txt, domain = NA)
                  return(FALSE)
                }
                else stop(txt, domain = NA)
            }
            which.lib.loc <- normalizePath(dirname(pkgpath), 
                "/", TRUE)
            pfile <- system.file("Meta", "package.rds", package = package, 
                lib.loc = which.lib.loc)
            if (!nzchar(pfile)) 
                stop(gettextf("%s is not a valid installed package", 
                  sQuote(package)), domain = NA)
            pkgInfo <- readRDS(pfile)
            testRversion(pkgInfo, package, pkgpath)
            if (!package %in% c("datasets", "grDevices", "graphics", 
                "methods", "splines", "stats", "stats4", "tcltk", 
                "tools", "utils") && isTRUE(getOption("checkPackageLicense", 
                FALSE))) 
                checkLicense(package, pkgInfo, pkgpath)
            if (is.character(pos)) {
                npos <- match(pos, search())
                if (is.na(npos)) {
                  warning(gettextf("%s not found on search path, using pos = 2", 
                    sQuote(pos)), domain = NA)
                  pos <- 2
                }
                else pos <- npos
            }
            .getRequiredPackages2(pkgInfo, quietly = quietly)
            deps <- unique(names(pkgInfo$Depends))
            if (packageHasNamespace(package, which.lib.loc)) {
                if (isNamespaceLoaded(package)) {
                  newversion <- as.numeric_version(pkgInfo$DESCRIPTION["Version"])
                  oldversion <- as.numeric_version(getNamespaceVersion(package))
                  if (newversion != oldversion) {
                    res <- try(unloadNamespace(package))
                    if (inherits(res, "try-error")) 
                      stop(gettextf("Package %s version %s cannot be unloaded", 
                        sQuote(package), oldversion, domain = "R-base"))
                  }
                }
                tt <- try({
                  ns <- loadNamespace(package, c(which.lib.loc, 
                    lib.loc))
                  env <- attachNamespace(ns, pos = pos, deps)
                })
                if (inherits(tt, "try-error")) 
                  if (logical.return) 
                    return(FALSE)
                  else stop(gettextf("package or namespace load failed for %s", 
                    sQuote(package)), call. = FALSE, domain = NA)
                else {
                  on.exit(detach(pos = pos))
                  nogenerics <- !.isMethodsDispatchOn() || checkNoGenerics(env, 
                    package)
                  if (warn.conflicts && !exists(".conflicts.OK", 
                    envir = env, inherits = FALSE)) 
                    checkConflicts(package, pkgname, pkgpath, 
                      nogenerics, ns)
                  on.exit()
                  if (logical.return) 
                    return(TRUE)
                  else return(invisible(.packages()))
                }
            }
            else stop(gettextf("package %s does not have a namespace and should be re-installed", 
                sQuote(package)), domain = NA)
        }
        if (verbose && !newpackage) 
            warning(gettextf("package %s already present in search()", 
                sQuote(package)), domain = NA)
    }
    else if (!missing(help)) {
        if (!character.only) 
            help <- as.character(substitute(help))
        pkgName <- help[1L]
        pkgPath <- find.package(pkgName, lib.loc, verbose = verbose)
        docFiles <- c(file.path(pkgPath, "Meta", "package.rds"), 
            file.path(pkgPath, "INDEX"))
        if (file.exists(vignetteIndexRDS <- file.path(pkgPath, 
            "Meta", "vignette.rds"))) 
            docFiles <- c(docFiles, vignetteIndexRDS)
        pkgInfo <- vector("list", 3L)
        readDocFile <- function(f) {
            if (basename(f) %in% "package.rds") {
                txt <- readRDS(f)$DESCRIPTION
                if ("Encoding" %in% names(txt)) {
                  to <- if (Sys.getlocale("LC_CTYPE") == "C") 
                    "ASCII//TRANSLIT"
                  else ""
                  tmp <- try(iconv(txt, from = txt["Encoding"], 
                    to = to))
                  if (!inherits(tmp, "try-error")) 
                    txt <- tmp
                  else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
                    call. = FALSE)
                }
                nm <- paste0(names(txt), ":")
                formatDL(nm, txt, indent = max(nchar(nm, "w")) + 
                  3)
            }
            else if (basename(f) %in% "vignette.rds") {
                txt <- readRDS(f)
                if (is.data.frame(txt) && nrow(txt)) 
                  cbind(basename(gsub("\\.[[:alpha:]]+$", "", 
                    txt$File)), paste(txt$Title, paste0(rep.int("(source", 
                    NROW(txt)), ifelse(nzchar(txt$PDF), ", pdf", 
                    ""), ")")))
                else NULL
            }
            else readLines(f)
        }
        for (i in which(file.exists(docFiles))) pkgInfo[[i]] <- readDocFile(docFiles[i])
        y <- list(name = pkgName, path = pkgPath, info = pkgInfo)
        class(y) <- "packageInfo"
        return(y)
    }
    else {
        if (is.null(lib.loc)) 
            lib.loc <- .libPaths()
        db <- matrix(character(), nrow = 0L, ncol = 3L)
        nopkgs <- character()
        for (lib in lib.loc) {
            a <- .packages(all.available = TRUE, lib.loc = lib)
            for (i in sort(a)) {
                file <- system.file("Meta", "package.rds", package = i, 
                  lib.loc = lib)
                title <- if (nzchar(file)) {
                  txt <- readRDS(file)
                  if (is.list(txt)) 
                    txt <- txt$DESCRIPTION
                  if ("Encoding" %in% names(txt)) {
                    to <- if (Sys.getlocale("LC_CTYPE") == "C") 
                      "ASCII//TRANSLIT"
                    else ""
                    tmp <- try(iconv(txt, txt["Encoding"], to, 
                      "?"))
                    if (!inherits(tmp, "try-error")) 
                      txt <- tmp
                    else warning("'DESCRIPTION' has an 'Encoding' field and re-encoding is not possible", 
                      call. = FALSE)
                  }
                  txt["Title"]
                }
                else NA
                if (is.na(title)) 
                  title <- " ** No title available ** "
                db <- rbind(db, cbind(i, lib, title))
            }
            if (length(a) == 0L) 
                nopkgs <- c(nopkgs, lib)
        }
        dimnames(db) <- list(NULL, c("Package", "LibPath", "Title"))
        if (length(nopkgs) && !missing(lib.loc)) {
            pkglist <- paste(sQuote(nopkgs), collapse = ", ")
            msg <- sprintf(ngettext(length(nopkgs), "library %s contains no packages", 
                "libraries %s contain no packages"), pkglist)
            warning(msg, domain = NA)
        }
        y <- list(header = NULL, results = db, footer = NULL)
        class(y) <- "libraryIQR"
        return(y)
    }
    if (logical.return) 
        TRUE
    else invisible(.packages())
}
<bytecode: 0x1bdd868>
<environment: namespace:base>

The library command code executes the command. The library( ) executes an empty command.

Exercise 2

getwd()

[1] "/projects/ddda6a8e-2bca-47f5-b1d6-79b2c48d0e30/Autumn2016/Week1"

setwd("~/Autumn2016/Week1")

Marked in red as it's a string/ path, which has no value.

Exercise 3

x<-3
y<-10
z<-15

x+y+z

[1] 28

(y-x)/z

[1] 0.4666667

x*y*z

[1] 450

(x+y+z)^2

[1] 784

v<-c(x,y,z)

sum(v)

[1] 28

The question states calculate the sum of the vector raised to the power of 4, which can be interperated in two ways. The first method calculates the (sum of the vector) raised to the power of 4, and the second method calculates the sum of (vector raised to the power of 4)

(sum(v))^4

[1] 614656

sum(v^4)

[1] 60706

sqrt(z-x)

[1] 3.464102

Exercise 4

myname <-"Jingyi"
email <-"[email protected]"
module <-"BMS353"
message <- paste(myname,email,module,sep="")
print (message)

[1] "[email protected]"

Exercise5

seq(1,30,by=2)

 [1]  1  3  5  7  9 11 13 15 17 19 21 23 25 27 29

seq(2,30,by=2)

 [1]  2  4  6  8 10 12 14 16 18 20 22 24 26 28 30

a<-seq(1,30,by=2)

b<-seq(2,30,by=2)

length(seq(1,30,by=2))

[1] 15

length(seq(2,30,by=2))

[1] 15

sum(a)

[1] 225

sum(b)

[1] 240

sum(seq(1,30))

[1] 465

The conclusion is that the sum of the entire sequence of numbers ranging from 1-30 is equal to the total sum of the odd numbers from 1-30 and even numbers from 2-30.

sample(1:100,12,replace=TRUE)

 [1] 100  63   7  69  93  90  15  63  26  65  84  44

Exercise 6

dept<- "BMS"
code<- 353
BMSmodule<- c(dept,as.character(code))
print(BMSmodule)

[1] "BMS" "353"

dept<- "APS"
code<- 227
APSmodule<- c(dept,as.character(code))
print(APSmodule)

[1] "APS" "227"

dept<- "MBB"
code<- 253
MBBmodule<- c(dept,as.character(code))
print(MBBmodule)

[1] "MBB" "253"

mergevector<- c(BMSmodule,APSmodule,MBBmodule)
print(mergevector)

[1] "BMS" "353" "APS" "227" "MBB" "253"

stringsvector<- c("BMS","APS","MBB")
print(stringsvector)

[1] "BMS" "APS" "MBB"

x<-c("BMS","APS","MSS")
y<-c(353,227,253)
z<-c(x,as.character(y))
print(z)

[1] "BMS" "APS" "MSS" "353" "227" "253"

x<-c("BMS","APS","MSS")
y<-c(353,227,253)
z<- paste(x,y,sep="")
print(z)

[1] "BMS353" "APS227" "MSS253"

Exercise 7

Mat1<- matrix(1:20,nrow=4,ncol=5,byrow=TRUE)
M

  1st 2nd 3rd 4th 5th
A  1   2   3   4   5 
B  6   7   8   9  10 
C 11  12  13  14  15 
D 16  17  18  19  20 

In R, matrices are created by column by defult, therefore byrow=TRUE will create the matrix by row.

rownames(M)<-c("A","B","C","D")
colnames(M)<-c("1st", "2nd", "3rd","4th","5th")
M

  1st 2nd 3rd 4th 5th
A  1   2   3   4   5 
B  6   7   8   9  10 
C 11  12  13  14  15 
D 16  17  18  19  20 

M=matrix(1:20,nrow=4,ncol=5,byrow=TRUE)
M

     [,1] [,2] [,3] [,4] [,5]
[1,]  1    2    3    4    5  
[2,]  6    7    8    9   10  
[3,] 11   12   13   14   15  
[4,] 16   17   18   19   20  

M[c(1,2),c(1,2)]

     [,1] [,2]
[1,] 1    2   
[2,] 6    7   

M[c(1,2),c(1,2,4,5)]

     [,1] [,2] [,3] [,4]
[1,] 1    2    4     5  
[2,] 6    7    9    10  

M[2,]

[1]  6  7  8  9 10

Exercise 8

Mat2=matrix(c(32,42,18,20,33,38,25,28,26),nrow=3,ncol=3,byrow=TRUE)
Mat2

     [,1] [,2] [,3]
[1,] 32   42   18  
[2,] 20   33   38  
[3,] 25   28   26  

rownames(Mat2)<- c("BMS353","APS227","MBB253")
colnames(Mat2)<- c("2013-14","2014-15","2015-16")
Mat2

       2013-14 2014-15 2015-16
BMS353 32      42      18     
APS227 20      33      38     
MBB253 25      28      26     

Mat2["BMS353",]

2013-14 2014-15 2015-16 
     32      42      18 

Exercise 9

Mat3=matrix(sample(1:100,12,replace=TRUE),nrow=3,ncol=4)
Mat3

     [,1] [,2] [,3] [,4]
[1,]  3   98   46   58  
[2,] 41   50   84   96  
[3,] 77   15    1   40  

Mat4=matrix(sample(1:100,12,replace=TRUE),nrow=3,ncol=4)
Mat4

     [,1] [,2] [,3] [,4]
[1,] 32   64   24   90  
[2,] 90   67    2   73  
[3,] 28   48   92   51  

Mat3+Mat4

     [,1] [,2] [,3] [,4]
[1,]  35  162  70   148 
[2,] 131  117  86   169 
[3,] 105   63  93    91 

Mat4-Mat3

     [,1] [,2] [,3] [,4]
[1,]  29  -34  -22   32 
[2,]  49   17  -82  -23 
[3,] -49   33   91   11 

Mat3-Mat4

     [,1] [,2] [,3] [,4]
[1,] -29   34   22  -32 
[2,] -49  -17   82   23 
[3,]  49  -33  -91  -11 

Mat3 %*% t(Mat4)
t(Mat3)%*%Mat4

     [,1]  [,2]  [,3] 
[1,] 12692 11162 11978
[2,] 15168 14216 16172
[3,]  7048 10857  5008

     [,1]  [,2]  [,3] [,4] 
[1,]  5942  6635 7238  7190
[2,]  8056 10342 3832 13235
[3,]  9060  8620 1364 10323
[4,] 11616 12064 5264 14268

sqrt(Mat3)
sqrt(Mat4)

     [,1]     [,2]     [,3]     [,4]    
[1,] 1.732051 9.899495 6.782330 7.615773
[2,] 6.403124 7.071068 9.165151 9.797959
[3,] 8.774964 3.872983 1.000000 6.324555

     [,1]     [,2]     [,3]     [,4]    
[1,] 5.656854 8.000000 4.898979 9.486833
[2,] 9.486833 8.185353 1.414214 8.544004
[3,] 5.291503 6.928203 9.591663 7.141428

Exercise 10

myFunction <- function(x) {
  ux <- x^3-1
  return(ux)
}

test<-myFunction(2)
print(test)

[1] 7

2 is the value of the input, and 7 is the value of the output.

 x<- c(5,4,3,2,1)
print(var(x))

[1] 2.5

The command var(x) computes the variance of x, whcih can be a numeric vector, matrix or data frame.

y<- sum(x) 
z<- mean(x)
n<- length(x)
m<- (x-z)^2
a<- sum(m)
sd<- (1/(n-1))*a
print(sd)

[1] 2.5

y= sum of x z= mean of x n= number of x m= square of x minus mean a= sum of the bars sd= variance

Exercise 11

BMI <- function(h,w){ux<- h/(w^2)
                          return(ux)}
test <- BMI(55,1.65)
print(test)

[1] 20.20202

w= weight of body in kg h= height of body in m

Exercise 12

Week 1 practical content:

• Basic operation in R

• Use of markdown cells

• Built in help functions in R

• Changing path and verifying location of workspace

• Working with vairables and objects, to perform simple calculations

• Assigning value to object

• The print command

• Creating vectors and matrices, as well as their manipulation and calculations.

• Transform numbers to characters.

• Rearranging dimensions of matrices

• Create user defined functions

• Calculation of variance

Score: 10.5/12

Feedback: Your work has a lot of clarity. And I actually realized a lot of my errors from your answers. You also had very simple and easy to understand codes. Great job!

For exercise 10, the correct answer is:

N<-5

x<-c(5,4,3,2,1)

SV<-(1/(N-1))*sum((x-sum(x)/N))^2)

SV