Kernel: R (R-Project)
In [4]:
Exercise 1
The code help(library) displays the Loading/Attaching and Listing of Packages. How to use the function.
In [23]:
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())
}The library command code executes the command. The library( ) executes an empty command.
Exercise 2
In [9]:
'/projects/ddda6a8e-2bca-47f5-b1d6-79b2c48d0e30/Autumn2016/Week1'
In [36]:
Marked in red as it's a string/ path, which has no value.
Exercise 3
In [14]:
In [16]:
28
In [17]:
0.466666666666667
In [21]:
450
In [22]:
784
In [25]:
In [26]:
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)
In [29]:
614656
In [30]:
60706
In [33]:
3.46410161513775
Exercise 4
In [3]:
[1] "Jingyi,[email protected],BMS353"
Exercise5
In [67]:
- 1
- 3
- 5
- 7
- 9
- 11
- 13
- 15
- 17
- 19
- 21
- 23
- 25
- 27
- 29
In [53]:
- 2
- 4
- 6
- 8
- 10
- 12
- 14
- 16
- 18
- 20
- 22
- 24
- 26
- 28
- 30
In [68]:
In [64]:
In [69]:
15
In [61]:
15
In [70]:
225
In [71]:
240
In [72]:
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.
In [1]:
- 100
- 63
- 7
- 69
- 93
- 90
- 15
- 63
- 26
- 65
- 84
- 44
Exercise 6
In [21]:
[1] "BMS" "353"
In [12]:
[1] "APS" "227"
In [14]:
[1] "MBB" "253"
In [18]:
[1] "BMS" "353" "APS" "227" "MBB" "253"
In [24]:
[1] "BMS" "APS" "MBB"
In [28]:
[1] "BMS" "APS" "MSS" "353" "227" "253"
In [30]:
[1] "BMS353" "APS227" "MSS253"
Exercise 7
In [40]:
| 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.
In [33]:
| 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 [53]:
| 1 | 2 | 3 | 4 | 5 |
| 6 | 7 | 8 | 9 | 10 |
| 11 | 12 | 13 | 14 | 15 |
| 16 | 17 | 18 | 19 | 20 |
In [88]:
| 1 | 2 |
| 6 | 7 |
In [90]:
| 1 | 2 | 4 | 5 |
| 6 | 7 | 9 | 10 |
In [87]:
- 6
- 7
- 8
- 9
- 10
Exercise 8
In [92]:
| 32 | 42 | 18 |
| 20 | 33 | 38 |
| 25 | 28 | 26 |
In [94]:
| 2013-14 | 2014-15 | 2015-16 | |
|---|---|---|---|
| BMS353 | 32 | 42 | 18 |
| APS227 | 20 | 33 | 38 |
| MBB253 | 25 | 28 | 26 |
In [96]:
- 2013-14
- 32
- 2014-15
- 42
- 2015-16
- 18
Exercise 9
In [97]:
| 3 | 98 | 46 | 58 |
| 41 | 50 | 84 | 96 |
| 77 | 15 | 1 | 40 |
In [98]:
| 32 | 64 | 24 | 90 |
| 90 | 67 | 2 | 73 |
| 28 | 48 | 92 | 51 |
In [99]:
| 35 | 162 | 70 | 148 |
| 131 | 117 | 86 | 169 |
| 105 | 63 | 93 | 91 |
In [100]:
| 29 | -34 | -22 | 32 |
| 49 | 17 | -82 | -23 |
| -49 | 33 | 91 | 11 |
In [101]:
| -29 | 34 | 22 | -32 |
| -49 | -17 | 82 | 23 |
| 49 | -33 | -91 | -11 |
In [108]:
| 12692 | 11162 | 11978 |
| 15168 | 14216 | 16172 |
| 7048 | 10857 | 5008 |
| 5942 | 6635 | 7238 | 7190 |
| 8056 | 10342 | 3832 | 13235 |
| 9060 | 8620 | 1364 | 10323 |
| 11616 | 12064 | 5264 | 14268 |
In [111]:
| 1.732051 | 9.899495 | 6.782330 | 7.615773 |
| 6.403124 | 7.071068 | 9.165151 | 9.797959 |
| 8.774964 | 3.872983 | 1.000000 | 6.324555 |
| 5.656854 | 8.000000 | 4.898979 | 9.486833 |
| 9.486833 | 8.185353 | 1.414214 | 8.544004 |
| 5.291503 | 6.928203 | 9.591663 | 7.141428 |
Exercise 10
In [20]:
[1] 7
2 is the value of the input, and 7 is the value of the output.
In [1]:
[1] 2.5
The command var(x) computes the variance of x, whcih can be a numeric vector, matrix or data frame.
In [11]:
[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
In [21]:
[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
In [0]: