R code
FALANA BARAKAT
2025-09-03
## Chapter 2: NUMERICS,ARITHMETIC,ASSIGNMENT, AND VECTORS
## Using R, how would you calculate the square root of half of the
## average of the numbers 25.2, 15, 16.44, 15.3, and 18.6?
x<-mean(c(25.2,15,16.44,15.3,18.6))
x## [1] 18.108b<-sqrt(x/2)
b## [1] 3.008987### Find loge 03.
log(0.3) ## This is a natural log## [1] -1.203973log(0.3,base=10)## this is log of base 10## [1] -0.5228787## Computethe exponential transform of your answer
exp(-1.203973)## [1] 0.2999999## assigning object <-
## Create an object that stores the value 3^2 * 4^1/8
an<-3^2*4^(1/8)
an## [1] 10.70286## Overwrite your object in (a) by itself divided by 2.33. Print the
## result to the console.
an<- an/2.33
## Create a new object with the value −8:2 × 10−13.
new<--8.2*10^(-13)
new## [1] -8.2e-13## Print directly to the console the result of multiplying (b) by (c)
result<-an*new
result## [1] -3.766673e-12## Create and store a sequence of values from 5 to −11 that progresses ## in steps of 0.3.
baz<-seq(5,-11,by=-0.3)
baz## [1] 5.0 4.7 4.4 4.1 3.8 3.5 3.2 2.9 2.6 2.3 2.0 1.7
## [13] 1.4 1.1 0.8 0.5 0.2 -0.1 -0.4 -0.7 -1.0 -1.3 -1.6 -1.9
## [25] -2.2 -2.5 -2.8 -3.1 -3.4 -3.7 -4.0 -4.3 -4.6 -4.9 -5.2 -5.5
## [37] -5.8 -6.1 -6.4 -6.7 -7.0 -7.3 -7.6 -7.9 -8.2 -8.5 -8.8 -9.1
## [49] -9.4 -9.7 -10.0 -10.3 -10.6 -10.9## Overwrite the object from (a) using the same sequence with the
## order reversed.
sort(baz)## [1] -10.9 -10.6 -10.3 -10.0 -9.7 -9.4 -9.1 -8.8 -8.5 -8.2 -7.9 -7.6
## [13] -7.3 -7.0 -6.7 -6.4 -6.1 -5.8 -5.5 -5.2 -4.9 -4.6 -4.3 -4.0
## [25] -3.7 -3.4 -3.1 -2.8 -2.5 -2.2 -1.9 -1.6 -1.3 -1.0 -0.7 -0.4
## [37] -0.1 0.2 0.5 0.8 1.1 1.4 1.7 2.0 2.3 2.6 2.9 3.2
## [49] 3.5 3.8 4.1 4.4 4.7 5.0## Repeat the vector c(-1,3,-5,7,-9) twice, with each element
## repeated 10 times, and store the result. Display the result sorted
## from largest to smallest.
bat<-rep(c(-1,3,-5,7,-9),times=2,each=10)
bat## [1] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 3 3 3 3 3 3 3 3 3 3 -5 -5 -5 -5 -5
## [26] -5 -5 -5 -5 -5 7 7 7 7 7 7 7 7 7 7 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9
## [51] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 3 3 3 3 3 3 3 3 3 3 -5 -5 -5 -5 -5
## [76] -5 -5 -5 -5 -5 7 7 7 7 7 7 7 7 7 7 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9sort(bat)## [1] -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -9 -5 -5 -5 -5 -5
## [26] -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1
## [51] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## [76] 3 3 3 3 3 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7## Create and store a vector that contains, in any configuration, the
## following:
## i. A sequence of integers from 6 to 12 (inclusive)
## ii. A threefold repetition of the value 5.3
## iii. The number −3
## iv. A sequence of nine values starting at 102 and ending at the
## number that is the total length of the vector created in (c)
gat<-c(6:12,rep(5.3,3),-3,seq(102,100,length.out=9))
gat## [1] 6.00 7.00 8.00 9.00 10.00 11.00 12.00 5.30 5.30 5.30
## [11] -3.00 102.00 101.75 101.50 101.25 101.00 100.75 100.50 100.25 100.00length(gat)==20## [1] TRUE## Chapter 3 : Matrices and Array
## Exercise
## Construct and store a 4 × 2 matrix that’s filled row-wise with the
## values 4.3, 3.1, 8.2, 8.2, 3.2, 0.9, 1.6, and 6.5, in that order.
mat<-matrix(data=c(4.3,3.1,8.2,8.2,3.2,0.9,1.6,6.5),nrow=4,ncol=2,byrow=TRUE)
mat## [,1] [,2]
## [1,] 4.3 3.1
## [2,] 8.2 8.2
## [3,] 3.2 0.9
## [4,] 1.6 6.5## Confirm the dimensions of the matrix from (a) are 3 × 2 if you
## remove any one row.
hat<-mat[-1,]
hat## [,1] [,2]
## [1,] 8.2 8.2
## [2,] 3.2 0.9
## [3,] 1.6 6.5dim(hat)## [1] 3 2# c.
mat[,2]<-sort(mat[,2])## overwrite the second column of the matrix and sort it with the same column starting from the smallest to largest
mat## [,1] [,2]
## [1,] 4.3 0.9
## [2,] 8.2 3.1
## [3,] 3.2 6.5
## [4,] 1.6 8.2# d.
matrix(mat[-4,-1])## delete row 4 and column 1 and extract the remaining column## [,1]
## [1,] 0.9
## [2,] 3.1
## [3,] 6.5mat## [,1] [,2]
## [1,] 4.3 0.9
## [2,] 8.2 3.1
## [3,] 3.2 6.5
## [4,] 1.6 8.2# e.
x<-hat[c(2,3),c(1,2)]
x## [,1] [,2]
## [1,] 3.2 0.9
## [2,] 1.6 6.5dim(x)## [1] 2 2#f
mat[c(4,1),c(2,1)]<- -0.5*diag(x)
mat## [,1] [,2]
## [1,] -3.25 -3.25
## [2,] 8.20 3.10
## [3,] 3.20 6.50
## [4,] -1.60 -1.60# matrix operation and algebra
A <- rbind(c(2,5,2),c(6,1,4))
t(A)## [,1] [,2]
## [1,] 2 6
## [2,] 5 1
## [3,] 2 4## scalar multiple of a matrix
sca<-matrix(data=c(2,5,2,6,1,4),byrow=TRUE,nrow=2,ncol=3)
sca## [,1] [,2] [,3]
## [1,] 2 5 2
## [2,] 6 1 4a<-2
a*sca## [,1] [,2] [,3]
## [1,] 4 10 4
## [2,] 12 2 8## matrix addition and subtraction
A<- cbind(c(2,5,2),c(6,1,4))
A## [,1] [,2]
## [1,] 2 6
## [2,] 5 1
## [3,] 2 4B<- cbind(c(4,2,-4),c(-2.1,-7.2,14.8))
B## [,1] [,2]
## [1,] 4 -2.1
## [2,] 2 -7.2
## [3,] -4 14.8A-B## [,1] [,2]
## [1,] -2 8.1
## [2,] 3 8.2
## [3,] 6 -10.8## matrix multiplication
d<-rbind(c(2,5,2),c(6,1,4))
d## [,1] [,2] [,3]
## [1,] 2 5 2
## [2,] 6 1 4e<-cbind(c(3,-1,1),c(-3,1,5))
e## [,1] [,2]
## [1,] 3 -3
## [2,] -1 1
## [3,] 1 5###
A<-matrix(data=c(3,4,1,2),nrow=2,ncol=2)
A## [,1] [,2]
## [1,] 3 1
## [2,] 4 2solve(A) ## to find the inverse## [,1] [,2]
## [1,] 1 -0.5
## [2,] -2 1.5## Exercise
## Create and store a three-dimensional array with six layers of a
## 4 × 2 matrix, filled with a decreasing sequence of values between
## 4.8 and 0.1 of the appropriate length.
var<- array(data=seq(from=4.8,to=0.1,length.out=48),dim=c(4,2,6))
var## , , 1
##
## [,1] [,2]
## [1,] 4.8 4.4
## [2,] 4.7 4.3
## [3,] 4.6 4.2
## [4,] 4.5 4.1
##
## , , 2
##
## [,1] [,2]
## [1,] 4.0 3.6
## [2,] 3.9 3.5
## [3,] 3.8 3.4
## [4,] 3.7 3.3
##
## , , 3
##
## [,1] [,2]
## [1,] 3.2 2.8
## [2,] 3.1 2.7
## [3,] 3.0 2.6
## [4,] 2.9 2.5
##
## , , 4
##
## [,1] [,2]
## [1,] 2.4 2.0
## [2,] 2.3 1.9
## [3,] 2.2 1.8
## [4,] 2.1 1.7
##
## , , 5
##
## [,1] [,2]
## [1,] 1.6 1.2
## [2,] 1.5 1.1
## [3,] 1.4 1.0
## [4,] 1.3 0.9
##
## , , 6
##
## [,1] [,2]
## [1,] 0.8 0.4
## [2,] 0.7 0.3
## [3,] 0.6 0.2
## [4,] 0.5 0.1## Extract and store as a new object the fourth- and first-row ## elements, in that order, of the second column only of all layers(b)
newh<- var[c(4,1),2,]
newh## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 4.1 3.3 2.5 1.7 0.9 0.1
## [2,] 4.4 3.6 2.8 2.0 1.2 0.4## Use a fourfold repetition of the second row of the matrix formed
## in (b) to fill a new array of dimensions 2 × 2 × 2 × 3.
array(data=rep(newh[2,],times=4),dim = c(2,2,2,3))## , , 1, 1
##
## [,1] [,2]
## [1,] 4.4 2.8
## [2,] 3.6 2.0
##
## , , 2, 1
##
## [,1] [,2]
## [1,] 1.2 4.4
## [2,] 0.4 3.6
##
## , , 1, 2
##
## [,1] [,2]
## [1,] 2.8 1.2
## [2,] 2.0 0.4
##
## , , 2, 2
##
## [,1] [,2]
## [1,] 4.4 2.8
## [2,] 3.6 2.0
##
## , , 1, 3
##
## [,1] [,2]
## [1,] 1.2 4.4
## [2,] 0.4 3.6
##
## , , 2, 3
##
## [,1] [,2]
## [1,] 2.8 1.2
## [2,] 2.0 0.4## Chapter 4 : Non Numeric values
## factors
firstname <- c("Liz","Jolene","Susan","Boris","Rochelle","Tim","Simon",
"Amy")
sex.num <- c(0,0,0,1,0,1,1,0)
sex.char <- c("female","female","female","male","female","male","male",
"female")
sex.num.fac <- factor(x=sex.num)
sex.num.fac## [1] 0 0 0 1 0 1 1 0
## Levels: 0 1sex.char.fac <- factor(x=sex.char)
sex.char.fac## [1] female female female male female male male female
## Levels: female malelevels(x=sex.num.fac)## [1] "0" "1"levels(x=sex.char.fac)## [1] "female" "male"levels(x=sex.num.fac) <- c("1","2")
sex.num.fac## [1] 1 1 1 2 1 2 2 1
## Levels: 1 2sex.char.fac[2:5]## [1] female female male female
## Levels: female malesex.char.fac[c(1:3,5,8)]## [1] female female female female female
## Levels: female male## defining and ordering levels
mob <- c("Apr","Jan","Dec","Sep","Nov","Jul","Jul","Jun")
mob[2]## [1] "Jan"mob[3]## [1] "Dec"mob[2]<mob[3]## [1] FALSEms <- c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov",
"Dec")
mob.fac <- factor(x=mob,levels=ms,ordered=TRUE)
mob.fac## [1] Apr Jan Dec Sep Nov Jul Jul Jun
## 12 Levels: Jan < Feb < Mar < Apr < May < Jun < Jul < Aug < Sep < ... < Decmob.fac[2]## [1] Jan
## 12 Levels: Jan < Feb < Mar < Apr < May < Jun < Jul < Aug < Sep < ... < Decmob.fac[3]## [1] Dec
## 12 Levels: Jan < Feb < Mar < Apr < May < Jun < Jul < Aug < Sep < ... < Decmob.fac[2]<mob.fac[3]## [1] TRUEfoo <- c(5.1,3.3,3.1,4)
bar <- c(4.5,1.2)
c(foo,bar)## [1] 5.1 3.3 3.1 4.0 4.5 1.2new.values <- factor(x=c("Oct","Feb","Feb"),levels=levels(mob.fac),
ordered=TRUE)
c(mob.fac,new.values)## [1] Apr Jan Dec Sep Nov Jul Jul Jun Oct Feb Feb
## 12 Levels: Jan < Feb < Mar < Apr < May < Jun < Jul < Aug < Sep < ... < Decas.integer(c(mob.fac,new.values))## [1] 4 1 12 9 11 7 7 6 10 2 2levels(mob.fac)## [1] "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"levels(mob.fac)[c(mob.fac,new.values)]## [1] "Apr" "Jan" "Dec" "Sep" "Nov" "Jul" "Jul" "Jun" "Oct" "Feb" "Feb"mob.new <- levels(mob.fac)[c(mob.fac,new.values)]
mob.new.fac <- factor(x=mob.new,levels=levels(mob.fac),ordered=TRUE)
## cut
Y <- c(0.53,5.4,1.5,3.33,0.45,0.01,2,4.2,1.99,1.01)
br <- c(0,2,4,6)
cut(x=Y,breaks=br)## [1] (0,2] (4,6] (0,2] (2,4] (0,2] (0,2] (0,2] (4,6] (0,2] (0,2]
## Levels: (0,2] (2,4] (4,6]cut(x=Y,breaks=br,right=FALSE)## [1] [0,2) [4,6) [0,2) [2,4) [0,2) [0,2) [2,4) [4,6) [0,2) [0,2)
## Levels: [0,2) [2,4) [4,6)cut(x=Y,breaks=br,right=FALSE,include.lowest=TRUE)## [1] [0,2) [4,6] [0,2) [2,4) [0,2) [0,2) [2,4) [4,6] [0,2) [0,2)
## Levels: [0,2) [2,4) [4,6]lab <- c("Small","Medium","Large")
cut(x=Y,breaks=br,right=FALSE,include.lowest=TRUE,labels=lab)## [1] Small Large Small Medium Small Small Medium Large Small Small
## Levels: Small Medium Large## Store the following vector of 15 values as an object in your
## workspace: c(6,9,7,3,6,7,9,6,3,6,6,7,1,9,1). Identify the following ## elements:
## i. Those equal to 6
## ii. Those greater than or equal to 6
## iii. Those less than 6 + 2
## iv. Those not equal to 6
yat<-c(6,9,7,3,6,7,9,6,3,6,6,7,1,9,1)
yat## [1] 6 9 7 3 6 7 9 6 3 6 6 7 1 9 1length(yat)## [1] 15yat==6## [1] TRUE FALSE FALSE FALSE TRUE FALSE FALSE TRUE FALSE TRUE TRUE FALSE
## [13] FALSE FALSE FALSEyat>=6## [1] TRUE TRUE TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE TRUE
## [13] FALSE TRUE FALSEyat<(6+2)## [1] TRUE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE TRUE TRUE TRUE
## [13] TRUE FALSE TRUEyat!=6## [1] FALSE TRUE TRUE TRUE FALSE TRUE TRUE FALSE TRUE FALSE FALSE TRUE
## [13] TRUE TRUE TRUE## Store the vector c(7,1,7,10,5,9,10,3,10,8) as foo. Identify the
## elements greater than 5 OR equal to 2.(a)
foo<-c(7,1,7,10,5,9,10,3,10,8)
foo## [1] 7 1 7 10 5 9 10 3 10 8foo[(foo>5)|(foo=2)]## [1] 7 1 7 10 5 9 10 3 10 8## Store the vector c(8,8,4,4,5,1,5,6,6,8) as bar. Identify the ## elements less than or equal to 6 AND not equal to 4 (b)
bar<-c(8,8,4,45,1,5,6,6,8)
bar## [1] 8 8 4 45 1 5 6 6 8bar[(bar<=6)&(bar!=4)]## [1] 1 5 6 6## Identify the elements that satisfy (a) in foo AND satisfy (b) in bar
(foo>5)|(foo=2)&(bar<=6)&(bar!=4)## [1] FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE## Store this vector of 10 values: foo <- c(7,5,6,1,2,10,8,3,8,2).
## Then, do the following:
## i. Extract the elements greater than or equal to 5, storing the
## result as bar.
## ii. Display the vector containing those elements from foo that
## remain after omitting all elements that are greater than or
## equal to 5.
foo<-c(7,5,6,1,2,10,8,3,8,2)
foo## [1] 7 5 6 1 2 10 8 3 8 2bar<-foo[foo>=5]
## (ii)
gat<-foo[foo<5]
gat## [1] 1 2 3 2## Use bar from (a)(i) to construct a 2 × 3 matrix called baz, filled ## in
## a row-wise fashion. Then, do the following:
## i. Replace any elements that are equal to 8 with the squared
## value of the element in row 1, column 2 of baz itself.
## ii. Confirm that all values in baz are now less than or equal to 25
## AND greater than 4.
baz<- matrix(data=bar,nrow=2,ncol=3,byrow=TRUE)
baz## [,1] [,2] [,3]
## [1,] 7 5 6
## [2,] 10 8 8# b(i)
baz[baz==8]<-baz[1,2]*2
## b(ii)
all(baz<=25 & baz>4)## [1] TRUE## Create a 3 × 2 × 3 array called qux using the following vector of
## 18 values: c(10,5,1,4,7,4,3,3,1,3,4,3,1,7,8,3,7,3). Then, do the
## following:
## i. Identify the dimension-specific index positions of elements
## that are either 3 OR 4.
## ii. Replace all elements in qux that are less than 3 OR greater
## than or equal to 7 with the value 100.
qux<-c(10,5,1,4,7,4,3,3,1,3,4,3,1,7,8,3,7,3)
qux## [1] 10 5 1 4 7 4 3 3 1 3 4 3 1 7 8 3 7 3length(qux)## [1] 18# c (i)
qux<-array(data=qux,dim=c(3,2,3))
qux## , , 1
##
## [,1] [,2]
## [1,] 10 4
## [2,] 5 7
## [3,] 1 4
##
## , , 2
##
## [,1] [,2]
## [1,] 3 3
## [2,] 3 4
## [3,] 1 3
##
## , , 3
##
## [,1] [,2]
## [1,] 1 3
## [2,] 7 7
## [3,] 8 3## c(i)
matches<-which(qux==3|qux==4,arr.ind=TRUE)
matches## dim1 dim2 dim3
## [1,] 1 2 1
## [2,] 3 2 1
## [3,] 1 1 2
## [4,] 2 1 2
## [5,] 1 2 2
## [6,] 2 2 2
## [7,] 3 2 2
## [8,] 1 2 3
## [9,] 3 2 3## c(ii)
qux[(qux<3)|(qux>=7)]<-100
qux## , , 1
##
## [,1] [,2]
## [1,] 100 4
## [2,] 5 100
## [3,] 100 4
##
## , , 2
##
## [,1] [,2]
## [1,] 3 3
## [2,] 3 4
## [3,] 100 3
##
## , , 3
##
## [,1] [,2]
## [1,] 100 3
## [2,] 100 100
## [3,] 100 3## concatenation
qux<-c("awesome","R","is")
qux## [1] "awesome" "R" "is"length(qux)## [1] 3nchar(qux)## [1] 7 1 2cat(qux[2],qux[3],"totally",qux[1],"!")## cannot assign the result to a new variable## R is totally awesome !paste(qux[2],qux[3],"totally",qux[1],"!")## for the result to be in quote means it can be assigned to an object## [1] "R is totally awesome !"paste(qux[2],qux[3],"totally",qux[1],"!",sep="---") ## sep means to separate a character string## [1] "R---is---totally---awesome---!"paste(qux[2],qux[3],"totally",qux[1],"!",sep="")## [1] "Ristotallyawesome!"cat("Do you think",qux[2]," ",qux[3],qux[1],"?")## Do you think R is awesome ?a<-3
b<-4.4
cat("The value stored as 'a' is",a,".",sep=" ")## The value stored as 'a' is 3 .paste("The value stored as 'b' is ",b,".",sep=" ")## [1] "The value stored as 'b' is 4.4 ."cat("The result of 'a+b' is",a,"+",b,"=",a+b,".",sep=" ")## The result of 'a+b' is 3 + 4.4 = 7.4 .paste("Is",a+b,"less than 10? That's totally ",a+b<10,".",sep=" ")## [1] "Is 7.4 less than 10? That's totally TRUE ."cat("here is a string\n split\n\t to new\b\n\n\tlines")## here is a string
## split
## to new
##
## linescat("I really want a backslash:\\\nand a double:\"")## I really want a backslash:\
## and a double:"## substring and matching
foo<-"This is a character string!"
substr(x=foo,start=21,stop=27)## [1] "string!"substr(x=foo,start=1,stop=4)<-"Here"
foo## [1] "Here is a character string!"bar<-"How much wood could a woodchuck chuck"
sub(pattern="chuck",replacement="hurl",x=bar)## it replace the first instance with a new string## [1] "How much wood could a woodhurl chuck"gsub(pattern="chuck",replacement="hurl",x=bar) ## it replace every instance of pattern## [1] "How much wood could a woodhurl hurl"## Exercise:Re-create exactly the following output:
## "The quick brown fox
## jumped over
## the lazy dogs"
cat("\"The quick brown fox \n\tjumped over\n\t\tthe lazy dogs\"") ##\ use for including double quotes## "The quick brown fox
## jumped over
## the lazy dogs"# Suppose you’ve stored the values num1 <- 4 and num2 <- 0.75.
## Write a line of R code that returns the following string:
## [1] "The result of multiplying 4 by 0.75 is 3"
## Make sure your code produces a string with the correct
## multiplication result for any two numbers stored as num1 and num2
num1<-4
num2<-0.75
paste("The result of multiplying",num1,"by",num2,"is",num1*num2)## [1] "The result of multiplying 4 by 0.75 is 3"cat("The result of multiplying",num1,"by",num2,"is",num1*num2)## The result of multiplying 4 by 0.75 is 3##
bar<-"How much wood could a woodchuck chuck"
## i
glu<-paste(bar,"if a woodchuck could chuck wood")
glu## [1] "How much wood could a woodchuck chuck if a woodchuck could chuck wood"## ii
gsub(pattern="wood",replacement="metal",bar)## [1] "How much metal could a metalchuck chuck"## Store the string "Two 6-packs for $12.99". Then do the following:
## i. Use a check for equality to confirm that the substring
## beginning with character 5 and ending with character 10
## is "6-pack".
## ii. Make it a better deal by changing the price to $10.99.
pack<-"Two 6-packs for $12.99"
pack## [1] "Two 6-packs for $12.99"## i
substr(start=5,stop=10,pack)=="6-pack"## [1] TRUEsub(pattern="\\$12.99",replacement="$10.99",pack)## [1] "Two 6-packs for $10.99"## Chapter 5: Lists and Data Frames
## Create a list that contains, in this order, a sequence of 20 evenly
## spaced numbers between −4 and 4; a 3 × 3 matrix of the logical
## vector c(F,T,T,T,F,T,T,F,F) filled column-wise; a character vector
##with the two strings "don" and "quixote"; and a factor vector containing the ## observations c("LOW","MED","LOW","MED","MED","HIGH").
## Then, do the following:
## i. Extract row elements 2 and 1 of columns 2 and 3, in that
## order, of the logical matrix.
## ii. Use sub to overwrite "quixote" with "Quixote" and "don" with
## "Don" inside the list. Then, using the newly overwritten list
## member, concatenate to the console screen the following
## statement exactly:
## "Windmills! ATTACK!"
## -\Don Quixote/-
## iii. Obtain all values from the sequence between −4 and 4 that
## are greater than 1.
## iv. Using which, determine which indexes in the factor vector are
## assigned the "MED" level.
bar<-list(seq(-4,4,length.out=20), matrix(data=c(F,T,T,T,F,T,T,F,F),nrow=3, ncol=3), harry=c("don","quixiote"), factor(c("LOW","MED","LOW","MED","MED","HIGH")))
bar## [[1]]
## [1] -4.0000000 -3.5789474 -3.1578947 -2.7368421 -2.3157895 -1.8947368
## [7] -1.4736842 -1.0526316 -0.6315789 -0.2105263 0.2105263 0.6315789
## [13] 1.0526316 1.4736842 1.8947368 2.3157895 2.7368421 3.1578947
## [19] 3.5789474 4.0000000
##
## [[2]]
## [,1] [,2] [,3]
## [1,] FALSE TRUE TRUE
## [2,] TRUE FALSE FALSE
## [3,] TRUE TRUE FALSE
##
## $harry
## [1] "don" "quixiote"
##
## [[4]]
## [1] LOW MED LOW MED MED HIGH
## Levels: HIGH LOW MEDbar[[2]][c(2,1),c(2,3)]## [,1] [,2]
## [1,] FALSE FALSE
## [2,] TRUE TRUE## a(ii)
bar[[3]]<-sub(pattern="quixiote",replacement = "Quixiote",x=bar[[3]])
bar[[3]]<- sub(pattern="don",replacement="Don",x=bar[[3]])
bar[[3]]## [1] "Don" "Quixiote"cat("\"Windmills! ATTACK!\"\n\t-\\Don Quixote/-")## "Windmills! ATTACK!"
## -\Don Quixote/-## a(iii)
valu<- -4:4
valu[valu>1]## [1] 2 3 4## a(iv)
which(bar[[4]]=="MED") ## INDEXES IN THE FACTOR EQUAL MED## [1] 2 4 5## Create a new list with the factor vector from (a) as a component named "facs"; the ## numeric vector c(3,2.1,3.3,4,1.5,4.9) as a
## component named "nums"; and a nested list comprised of the first
## three members of the list from (a) (use list slicing to obtain this),
## named "oldlist". Then, do the following:
## i. Extract the elements of "facs" that correspond to elements of
## "nums" that are greater than or equal to 3.
## ii. Add a new member to the list named "flags". This member
## should be a logical vector of length 6, obtained as a twofold
## repetition of the third column of the logical matrix in the
## "oldlist" component.
## iii. Use "flags" and the logical negation operator ! to extract the
## entries of "num" corresponding to FALSE.
## iv. Overwrite the character string vector component of "oldlist"
## with the single character string "Don Quixote".
facs=bar[[4]]
nums<-c(3,2.1,3.3,4,1.5,4.9)
oldlist<-bar[1:3]
newlist<-list(nums=c(3,2.1,3.3,4,1.5,4.9),
oldlist=bar[1:3],
facs=bar[[4]])
newlist## $nums
## [1] 3.0 2.1 3.3 4.0 1.5 4.9
##
## $oldlist
## $oldlist[[1]]
## [1] -4.0000000 -3.5789474 -3.1578947 -2.7368421 -2.3157895 -1.8947368
## [7] -1.4736842 -1.0526316 -0.6315789 -0.2105263 0.2105263 0.6315789
## [13] 1.0526316 1.4736842 1.8947368 2.3157895 2.7368421 3.1578947
## [19] 3.5789474 4.0000000
##
## $oldlist[[2]]
## [,1] [,2] [,3]
## [1,] FALSE TRUE TRUE
## [2,] TRUE FALSE FALSE
## [3,] TRUE TRUE FALSE
##
## $oldlist$harry
## [1] "Don" "Quixiote"
##
##
## $facs
## [1] LOW MED LOW MED MED HIGH
## Levels: HIGH LOW MED## b (i)
newlist$facs[nums>=3]## [1] LOW LOW MED HIGH
## Levels: HIGH LOW MED## b (ii)
newlist$flag <- rep(x=newlist$oldlist[[2]][,3],length.out=6)
newlist## $nums
## [1] 3.0 2.1 3.3 4.0 1.5 4.9
##
## $oldlist
## $oldlist[[1]]
## [1] -4.0000000 -3.5789474 -3.1578947 -2.7368421 -2.3157895 -1.8947368
## [7] -1.4736842 -1.0526316 -0.6315789 -0.2105263 0.2105263 0.6315789
## [13] 1.0526316 1.4736842 1.8947368 2.3157895 2.7368421 3.1578947
## [19] 3.5789474 4.0000000
##
## $oldlist[[2]]
## [,1] [,2] [,3]
## [1,] FALSE TRUE TRUE
## [2,] TRUE FALSE FALSE
## [3,] TRUE TRUE FALSE
##
## $oldlist$harry
## [1] "Don" "Quixiote"
##
##
## $facs
## [1] LOW MED LOW MED MED HIGH
## Levels: HIGH LOW MED
##
## $flag
## [1] TRUE FALSE FALSE TRUE FALSE FALSE## b(iii)
newlist$nums[!newlist$flag]## [1] 2.1 3.3 1.5 4.9## b(iv)
newlist$oldlist[[3]]<-"Don Quixote"
## Data Frame
mydata <- data.frame(person=c("Peter","Lois","Meg","Chris","Stewie"),
age=c(42,40,17,14,1),
sex=factor(c("M","F","F","M","M")))
mydata## person age sex
## 1 Peter 42 M
## 2 Lois 40 F
## 3 Meg 17 F
## 4 Chris 14 M
## 5 Stewie 1 M### Chapter 6 : Special Values,classes and coercion
## Store the following vector:
##foo <- c(13563,-14156,-14319,16981,12921,11979,9568,8833,-12968,8133)
## Then, do the following:
## i. Output all elements of foo that, when raised to a power of 75,
## are NOT infinite.
##ii. Return the elements of foo, excluding those that result in
## negative infinity when raised to a power of 75.
foo <- c(13563,-14156,-14319,16981,12921,11979,9568,8833,-12968,8133)
foo[!is.infinite(foo^75)]## [1] 11979 9568 8833 8133foo[is.finite(foo^75)]## [1] 11979 9568 8833 8133## Consider the following line of code:
## foo <- c(4.3,2.2,NULL,2.4,NaN,3.3,3.1,NULL,3.4,NA)
## Decide yourself which of the following statements are true
## and which are false and then use R to confirm:
## i. The length of foo is 8.
## ii. Calling which(x=is.na(x=foo)) will not result in 4 and 8.
## iii. Checking is.null(x=foo) will provide you with the locations of
## the two NULL values that are present.
## iv. Executing is.na(x=foo[8])+4/NULL will not result in NA.
foo<-c(4.3,2.2,NULL,2.4,NaN,3.3,3.1,NULL,34,NA)
foo## [1] 4.3 2.2 2.4 NaN 3.3 3.1 34.0 NA## a(i)
length(foo) ==8## [1] TRUE## a(ii)
which(x=is.na(x=foo))!= c(4,8)## [1] FALSE FALSE## a(iii)
which(x=is.null(x=foo))## integer(0)## a(iv)
is.na(x=foo[8])+4/NULL## numeric(0)### Chapter 7: Basic Plotting
bar<-c(2,2.2,-1.3,0,0.2)
foo<-c(1.1,2,3.5,3.9,4.2)
plot(foo,bar,type="b",main="My lovely plot",xlab="",ylab="",
col=4,pch=8,lty=2,cex=2.3,lwd=3.3)
plot(foo,bar,type="b",main="My lovely plot",xlab="",ylab="",
col=6,pch=15,lty=3,cex=0.7,lwd=2)
##
weight<-c(55,85,75,42,93,63,58,75,89,67)
height<-c(161,185,174,154,188,178,170,167,181,178)
sex<-factor(c("female","male","male","female","male","male","female","male","male","female"))
sex## [1] female male male female male male female male male female
## Levels: female malecolor_1<-c("female"="blue","male"="red")
color<-color_1[sex]
plot(weight,height,
xlab="Weight(kg)",ylab="Height(cm)",
col=color,pch=18)
legend("topleft",legend=c("female","male"),col=color_1,pch=18)
library(ggplot2)
x<-1:20
y<- c(-1.49,3.37,2.59,-2.78,-3.94,-0.92,6.43,8.51,3.41,-8.23,
-12.01,-6.58,2.87,14.12,9.63,-4.58,-14.78,-11.67,1.17,15.62)
ptype<-rep(NA,length(x=x))
ptype[y>=5] <- "too_big"
ptype[y<=-5] <- "too_small"
ptype[(x>=5&x<=15)&(y>-5&y<5)] <- "sweet"
ptype[(x<5|x>15)&(y>-5&y<5)] <- "standard"
ptype <- factor(x=ptype)
ptype## [1] standard standard standard standard sweet sweet too_big
## [8] too_big sweet too_small too_small too_small sweet too_big
## [15] too_big standard too_small too_small standard too_big
## Levels: standard sweet too_big too_smallmyplot<-qplot(x,y,color=ptype,shape=ptype)+geom_point(size=4)+
geom_line(aes(group=1),color="black",lty=2)+
geom_hline(aes(yintercept = c(-5,5)),col="red")+
geom_segment(aes(x=5,y=-5,xend=5,yend=5),col="red",lty=3)+
geom_segment(aes(x=15,y=-5,xend=15,yend=5),col="red",lty=3)## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.myplot
## Chapter 8: Reading and Writing Files
library(help="datasets")
mydata2<-read.table(file="/Users/USER/OneDrive/Desktop/R CLASS/8.2.1_mydatafile.txt",header=TRUE,sep=" ",na.strings="*",stringsAsFactor=FALSE)
mydata2## person age sex funny age.mon
## 1 Peter NA M High 504
## 2 Lois 40 F <NA> 480
## 3 Meg 17 F Low 204
## 4 Chris 14 M Med 168
## 5 Stewie 1 M High NA
## 6 Brian NA M Med NAwrite.table(x=mydata2,file="C:/Users/USER/OneDrive/Documents/somenewfile.txt ",sep="@",na="??",quote=FALSE,row.names=FALSE)
read.table("somenewfile.txt")## V1
## 1 person@age@sex@funny@age.mon
## 2 Peter@??@M@High@504
## 3 Lois@40@F@??@480
## 4 Meg@17@F@Low@204
## 5 Chris@14@M@Med@168
## 6 Stewie@1@M@High@??
## 7 Brian@??@M@Med@??In the editor, write R code that takes a square character matrix
and checks if any of the character strings on the diagonal (top
left to bottom right) begin with the letter g, lowercase or uppercase. If satisfied, these specific entries should be
overwritten with
the string “HERE”. Otherwise, the entire matrix should be replaced
with an identity matrix of the same dimensions. Then, try your
code on the following matrices, checking the result each time:
i. mymat <- matrix(as.character(1:16),4,4)
ii. mymat <- matrix(c(“DANDELION”,“Hyacinthus”,“Gerbera”,
“MARIGOLD”,“geranium”,“ligularia”,
“Pachysandra”,“SNAPDRAGON”,“GLADIOLUS”),3,3)
iii. mymat <- matrix(c(“GREAT”,“exercises”,“right”,“here”),2,2,
byrow=T)
## chapter 10
mymat <- matrix(as.character(1:16),4,4)
condition<-substr(x=diag(mymat),start=1,stop=1)=="G"|substr(x=diag(mymat),start=1,stop=1)=="g"
if(any(condition)){
diag(mymat)[condition]<-"HERE"
}else{
mymat<-diag(nrow(mymat))
}
mymat## [,1] [,2] [,3] [,4]
## [1,] 1 0 0 0
## [2,] 0 1 0 0
## [3,] 0 0 1 0
## [4,] 0 0 0 1mymat <- matrix(c("DANDELION","Hyacinthus","Gerbera",
"MARIGOLD","geranium","ligularia",
"Pachysandra","SNAPDRAGON","GLADIOLUS"),3,3)
condition<-substr(x=diag(mymat),start=1,stop=1)=="G"|substr(x=diag(mymat),start=1,stop=1)=="g"
if(any(condition)){
diag(mymat)[condition]<-"HERE"
}else{
mymat<-diag(nrow(mymat))
}
mymat## [,1] [,2] [,3]
## [1,] "DANDELION" "MARIGOLD" "Pachysandra"
## [2,] "Hyacinthus" "HERE" "SNAPDRAGON"
## [3,] "Gerbera" "ligularia" "HERE"You can also embed plots, for example:
mymat <- matrix(c("GREAT","exercises","right","here"),2,2,
byrow=T)
condition<-substr(x=diag(mymat),start=1,stop=1)=="G"|substr(x=diag(mymat),start=1,stop=1)=="g"
if(any(condition)){
diag(mymat)[condition]<-"HERE"
}else{
mymat<-diag(nrow(mymat))
}
mymat## [,1] [,2]
## [1,] "HERE" "exercises"
## [2,] "right" "here"##chapter 11
###write a while loop to perform integer factorial calculations.
##i. Using your factorial while loop (or writing one if you didn’t do so earlier), write your own R function, myfac, to compute the factorial of an integer argument int (you may assume int Writing Functions will always be supplied as a non-negative integer). Perform a quick test of the function by computing 5 factorial, which is 120; 12 factorial, which is 479;001;600; and 0 factorial,which is 1.
myfac<-function(int){
i<-1
while(int>1){
i<- i* int
int<- int -1
}
return(i)
}
myfac(5)## [1] 120myfac(12)## [1] 479001600myfac(0)## [1] 1##ii. Write another version of your factorial function, naming it myfac2. This time, you may still assume int will be supplied as an integer but not that it will be non-negative. If negative,the function should return NaN. Test myfac2 on the same three values as previously, but also try using int=-6.
myfac2<- function(int){
if(int<0){
return(NaN)
}
i<-1
while(int>1){
i<-i*int
int<- int-1
}
return(i)
}
myfac2(5)## [1] 120myfac2(12)## [1] 479001600myfac2(0)## [1] 1myfac2(-6)## [1] NaN##chapter 11
warn_test <- function(x){
if(x<=0){
warning("'x' is less than or equal to 0 but setting it to 1 and
continuing")
x <- 1
}
return(5/x)
}
warn_test(0)## Warning in warn_test(0): 'x' is less than or equal to 0 but setting it to 1 and
## continuing## [1] 5warn_test(5)## [1] 1myfibrec2<- function(n){
if(n<0){
warning("Assuming you meant 'n' to be positive -- doing that instead")
n<- n* -1
}else if(n==0){
stop("'n' is uninterpretable at 0")
}
if(n==1||n==2){
return(1)
}else{
return(myfibrec2(n-1)+ myfibrec2(n-2))
}
}
myfibrec2(6)## [1] 8myfibrec2(-3)## Warning in myfibrec2(-3): Assuming you meant 'n' to be positive -- doing that
## instead## [1] 2##chapter 13
plot(quakes$mag,quakes$stations,xlab="Magnitude",ylab="No. of stations")
cov(quakes$mag,quakes$stations)## [1] 7.508181cor(quakes$mag,quakes$stations)## [1] 0.8511824foo <- c(0.6,-0.6,0.1,-0.2,-1.0,0.4,0.3,-1.8,1.1,6.0)
plot(foo,rep(0,10),yaxt="n",ylab="",bty="n",cex=2,cex.axis=1.5,cex.lab=1.5)
abline(h=0,col="gray",lty=2)
arrows(5,0.5,5.9,0.1,lwd=2)
text(5,0.7,labels="outlier?",cex=3)
## Scatterplot
plot(iris[,4],iris[,3],type="n",xlab="petal-width",ylab="petal-length")
points(iris[iris$Species=="setosa",4],
iris[iris$Species=="setosa",3],pch=19,col="black")
points(iris[iris$Species=="virginica",4],
iris[iris$Species=="virginica",3],pch=19,col="gray")
points(iris[iris$Species=="versicolor",4],
iris[iris$Species=="versicolor",3],pch=1,col="black")
legend("topleft",legend=c("setosa","virginica","versicolor"),
col=c("black","gray","black"),pch=c(19,19,1))
## boxplot
data(quakes)
stations.fac<- cut(quakes$stations,breaks=c(0,50,100,150))
head(quakes,10)## lat long depth mag stations
## 1 -20.42 181.62 562 4.8 41
## 2 -20.62 181.03 650 4.2 15
## 3 -26.00 184.10 42 5.4 43
## 4 -17.97 181.66 626 4.1 19
## 5 -20.42 181.96 649 4.0 11
## 6 -19.68 184.31 195 4.0 12
## 7 -11.70 166.10 82 4.8 43
## 8 -28.11 181.93 194 4.4 15
## 9 -28.74 181.74 211 4.7 35
## 10 -17.47 179.59 622 4.3 19boxplot(quakes$mag~stations.fac,xlab="# stations detected",ylab="Magnitude")
library(ggplot2)
data("USArrests")
qplot(USArrests$UrbanPop,geom = "blank")+
geom_histogram(fill="white",color="black",breaks=seq(0,100,10),closed="right")+
geom_vline(mapping=aes(xintercept =c(quantile(USArrests$UrbanPop,0.25), median(USArrests$UrbanPop),quantile(USArrests$UrbanPop,0.75)),linetype = factor(c("The first quantile","Median","The third quantile"))),show.legend = TRUE)+
scale_linetype_manual(values=c(2,3,3))+labs(linetype="")
## continuos random variable
w <- seq(35,95,by=5)
w## [1] 35 40 45 50 55 60 65 70 75 80 85 90 95lower.w <- w>=40 & w<=65
lower.w## [1] FALSE TRUE TRUE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## [13] FALSEupper.w <- w>65 & w<=90
upper.w## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE TRUE
## [13] FALSE ###
fw <- rep(0,length(w))
fw[lower.w] <- (w[lower.w]-40)/625
fw[upper.w] <- (90-w[upper.w])/625
fw## [1] 0.000 0.000 0.008 0.016 0.024 0.032 0.040 0.032 0.024 0.016 0.008 0.000
## [13] 0.000 ###
plot(w,fw,type="l",ylab="f(w)")
abline(h=0,col="red",lty=2)
Suppose you are tasked with computing the precise dosage
amounts of a certain drug in a collection of hypothetical scientific experiments.
These amounts depend upon some predetermined set of “dosage thresholds” (lowdose, meddose, and
highdose), as well as a predetermined dose level factor vector
named doselevel. Look at the following items (i–iv) to see the
intended form of these objects. Then write a set of nested if
statements that produce a new numeric vector called dosage,
according to the following rules:
– First, if there are any instances of “High” in doselevel, perform the following operations:
* Check if lowdose is greater than or equal to 10. If so,overwrite lowdose with 10; otherwise, overwrite lowdose by
itself divided by 2.
* Check if meddose is greater than or equal to 26. If so,overwrite meddose by 26.
* Check if highdose is less than 60. If so, overwrite highdose with 60; otherwise, overwrite highdose by itself
multiplied by 1:5.
* Create a vector named dosage with the value of lowdose repeated (rep) to match the length of doselevel.
* Overwrite the elements in dosage corresponding to the index positions of instances of “Med” in doselevel by meddose.
* Overwrite the elements in dosage corresponding to the index positions of instances of “High” in doselevel by
highdose.
– Otherwise (in other words, if there are no instances of “High” in doselevel), perform the following operations:
* Create a new version of doselevel, a factor vector with levels “Low” and “Med” only, and label these with “Small” and
“Large”, respectively (refer to Section 4.3 for details
or see ?factor).
Check to see if lowdose is less than 15 AND meddose is less than 35. If so, overwrite lowdose
by itself multiplied by 2 and overwrite meddose by itself plus highdose.
* Create a vector named dosage, which is the value of lowdose repeated (rep) to match the length of doselevel.
* Overwrite the elements in dosage corresponding to the index positions of instances of “Large” in doselevel by
meddose.
Now, confirm the following:
i. Given
lowdose <- 12.5
meddose <- 25.3
highdose <- 58.1
doselevel <- factor(c(“Low”,“High”,“High”,“High”,“Low”,“Med”,“Med”),levels=c(“Low”,“Med”,“High”))
the result of dosage after running the nested if statements is
as follows:
R> dosage
####[1] 10.0 60.0 60.0 60.0 10.0 25.3 25.3
ii. Using the same lowdose, meddose, and highdose thresholds as in (i), given
doselevel <- factor(c(“Low”,“Low”,“Low”,“Med”,“Low”,“Med”,“Med”),levels=c(“Low”,“Med”,“High”))
the result of dosage after running the nested if statements is
as follows:
R> dosage
[1] 25.0 25.0 25.0 83.4 25.0 83.4 83.4
Also, doselevel has been overwritten as follows:
R> doselevel
[1] Small Small Small Large Small Large Large
Levels: Small Large
iii. Given
lowdose <- 9
meddose <- 49
highdose <- 61
doselevel <- factor(c(“Low”,“Med”,“Med”),levels=c(“Low”,“Med”,“High”))
R> dosage
[1] 9 49 49
Also, doselevel has been overwritten as follows:
R> doselevel
[1] Small Large Large
Levels: Small Large
iv. Using the same lowdose, meddose, and highdose thresholds as (iii), as well as the same doselevel as (i), the result
of dosage after running the nested if statements is as follows:
R> dosage
[1] 4.5 91.5 91.5 91.5 4.5 26.0 26.0
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that
lowdose <- 12.5
meddose <- 25.3
highdose <- 58.1
doselevel <- factor(c("Low", "High", "High", "High", "Low", "Med", "Med"), levels = c("Low", "Med", "High"))
if(any("High"==doselevel)){
if(lowdose>=10){
lowdose<-10
} else {
lowdose<-lowdose / 2
}
if(meddose >= 26) {
meddose<-26
}
if(highdose < 60){
highdose<-60
} else {
highdose<-highdose* 1.5
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Med"]<-meddose
dosage[doselevel=="High"]<-highdose
} else {
doselevel<-factor(doselevel,levels=c("Low","Med"),labels=c("Small","Large"))
if(lowdose< 15 && meddose < 35){
lowdose<-lowdose * 2
meddose<-meddose + highdose
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Large"]<-meddose
}
dosage## [1] 10.0 60.0 60.0 60.0 10.0 25.3 25.3###
lowdose<-12.5
meddose<-25.3
highdose<-58.1
doselevel<-factor(c("Low","High","High","High","Low","Med",
"Med"),levels=c("Low","Med","High"))
dosage## [1] 10.0 60.0 60.0 60.0 10.0 25.3 25.3####
lowdose <- 12.5
meddose <- 25.3
highdose <- 58.1
doselevel <- factor(c("Low", "High", "High", "High", "Low", "Med", "Med"), levels = c("Low", "Med", "High"))
if(any("High"==doselevel)){
if(lowdose>=10){
lowdose<-10
} else {
lowdose<-lowdose / 2
}
if(meddose >= 26) {
meddose<-26
}
if(highdose < 60){
highdose<-60
} else {
highdose<-highdose* 1.5
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Med"]<-meddose
dosage[doselevel=="High"]<-highdose
} else {
doselevel<-factor(doselevel,levels=c("Low","Med"),labels=c("Small","Large"))
if(lowdose< 15 && meddose < 35){
lowdose<-lowdose * 2
meddose<-meddose + highdose
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Large"]<-meddose
}
dosage## [1] 10.0 60.0 60.0 60.0 10.0 25.3 25.3### ii
lowdose<-12.5
meddose<-25.3
highdose<-58.1
doselevel <- factor(c("Low","Low","Low","Med","Low","Med",
"Med"),levels=c("Low","Med","High"))
if(any("High"==doselevel)){
if(lowdose>=10){
lowdose<-10
} else {
lowdose<-lowdose / 2
}
if(meddose >= 26) {
meddose<-26
}
if(highdose < 60){
highdose<-60
} else {
highdose<-highdose* 1.5
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Med"]<-meddose
dosage[doselevel=="High"]<-highdose
} else {
doselevel<-factor(doselevel,levels=c("Low","Med"),labels=c("Small","Large"))
if(lowdose< 15 && meddose < 35){
lowdose<-lowdose * 2
meddose<-meddose + highdose
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Large"]<-meddose
}
doselevel## [1] Small Small Small Large Small Large Large
## Levels: Small Large### iii
lowdose <- 9
meddose <- 49
highdose <- 61
doselevel <- factor(c("Low","Med","Med"),
levels=c("Low","Med","High"))
if(any("High"==doselevel)){
if(lowdose>=10){
lowdose<-10
} else {
lowdose<-lowdose / 2
}
if(meddose >= 26) {
meddose<-26
}
if(highdose < 60){
highdose<-60
} else {
highdose<-highdose* 1.5
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Med"]<-meddose
dosage[doselevel=="High"]<-highdose
} else {
doselevel<-factor(doselevel,levels=c("Low","Med"),labels=c("Small","Large"))
if(lowdose< 15 && meddose < 35){
lowdose<-lowdose * 2
meddose<-meddose + highdose
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Large"]<-meddose
}
dosage## [1] 9 49 49## iv
lowdose <- 9
meddose <- 49
highdose <- 61
doselevel<-factor(c("Low","High","High","High","Low","Med",
"Med"),levels=c("Low","Med","High"))
if(any("High"==doselevel)){
if(lowdose>=10){
lowdose<-10
} else {
lowdose<-lowdose / 2
}
if(meddose >= 26) {
meddose<-26
}
if(highdose < 60){
highdose<-60
} else {
highdose<-highdose* 1.5
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Med"]<-meddose
dosage[doselevel=="High"]<-highdose
} else {
doselevel<-factor(doselevel,levels=c("Low","Med"),labels=c("Small","Large"))
if(lowdose< 15 && meddose < 35){
lowdose<-lowdose * 2
meddose<-meddose + highdose
}
dosage<-rep(lowdose,length(doselevel))
dosage[doselevel=="Large"]<-meddose
}
dosage## [1] 4.5 91.5 91.5 91.5 4.5 26.0 26.0A quadratic equation in the variable x is often expressed in the following form: k1x2 + k2x + k3 = 0 Here, k1, k2, and k3 are constants. Given values for these constants, you can attempt to find up to two real roots—values of x that satisfy the equation. Write a function that takes k1, k2,and k3 as arguments and finds and returns any solutions (as a numeric vector) in such a situation. This is achieved as follows:
– Evaluate k2^2− 4k1k3. If this is negative, there are no solutions, and an appropriate message should be printed to the console. – If k2^2 − 4k1k3 is zero, then there is one solution, computed by −k2/2k1.
– If k2^2 − 4k1k3 is positive, then there are two solutions, given by (−k2 − (k2^2 − 4k1k3)0:5)/2k1 and (−k2 + (k2^2 − 4k1k3)0:5)/2k1.
– No default values are needed for the three arguments, but the function should check to see whether any are missing.
If so, an appropriate character string message should be returned to the user, informing the user that the calculations are not possible. Now, test your function. i. Confirm the following: * 2x2 − x − 5 has roots 1:850781 and −1:350781. * x2 + x + 1 has no real roots. ii. Attempt to find solutions to the following quadratic equations: * 1:3x2 − 8x − 3:13 * 2:25x2 − 3x + 1 * 1:4x2 − 2:2x − 5:1 * −5x2 + 10:11x − 9:9 iii. Test your programmed response in the function if one of the arguments is missing.
quad<- function(k1,k2,k3,..){
if(any(c(missing(k1),missing(k2),missing(k3)))){
return(k1,k2,k3)
}
quadractic<- (k2^2 - 4*k1*k3 )
if(quadractic<0){
cat("There are no real root")
}else if(quadractic==0){
return(-k2/2*k1)
}else{
a<-((-k2 -(k2^2 -4*k1*k3)^0.5)/(2*k1))
b<-((-k2 + (k2^2 - 4*k1*k3)^0.5)/(2*k1))
cat("The quadractic has two roots which are:",a,"and",b)
}
}
quad(2,-1,-5)## The quadractic has two roots which are: -1.350781 and 1.850781quad(k1=1,k2=1,k3=1)## There are no real root### II
quad(1.3,-8,-3.13)## The quadractic has two roots which are: -0.3691106 and 6.522957quad(2.25,-3,1)## [1] 3.375quad(1.4,-2.2,-5.1)## The quadractic has two roots which are: -1.278312 and 2.84974quad(-5,10.11,-9.9)## There are no real rootproject code
library(forecast)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(ggplot2)
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, unionlibrary(TSstudio)
library(tseries)
jere_csv<- read.csv("C:/Users/USER/OneDrive/Desktop/R CLASS/Documents/icammda_pricemeaslesdata - Copy.csv")
head(jere_csv,10)## Time.Month. Jere
## 1 1 12
## 2 2 7
## 3 3 1
## 4 4 17
## 5 5 50
## 6 6 2
## 7 7 8
## 8 8 166
## 9 9 131
## 10 10 59## converted to time serie
jere_ts<- ts(jere_csv$Jere,start=c(2016,1),frequency = 12)
jere_ts## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2016 12 7 1 17 50 2 8 166 131 59 39 9
## 2017 0 4 0 1 1 0 0 0 1 0 2 6
## 2018 0 2 2 1 2 3 0 0 2 0 11 244
## 2019 343 474 658 468 56 34 0 3 0 1 1 1
## 2020 1 0 41 30 546 275 310 58 262 87 53 178
## 2021 26 205 123 138 174 352 242 271 46 79 90 73
## 2022 157 84 233 134 162 83 138 158 1 0 2 0adf.test(jere_ts)##
## Augmented Dickey-Fuller Test
##
## data: jere_ts
## Dickey-Fuller = -3.8246, Lag order = 4, p-value = 0.02172
## alternative hypothesis: stationaryacf(jere_ts)
## plot of data converted
plot.ts(jere_ts,main="Time series plot of measles incidence in Jere Local Government,Borno State",xlab="Time(month)",ylab="cases")
## Test for seasonality
decomp<- decompose(jere_ts)
plot(decomp)
str(decomp)## List of 6
## $ x : Time-Series [1:84] from 2016 to 2023: 12 7 1 17 50 2 8 166 131 59 ...
## $ seasonal: Time-Series [1:84] from 2016 to 2023: -16.2 23.3 72.3 26.1 54.9 ...
## $ trend : Time-Series [1:84] from 2016 to 2023: NA NA NA NA NA ...
## $ random : Time-Series [1:84] from 2016 to 2023: NA NA NA NA NA ...
## $ figure : num [1:12] -16.2 23.3 72.3 26.1 54.9 ...
## $ type : chr "additive"
## - attr(*, "class")= chr "decomposed.ts"### stationarity check
adf.test(jere_ts)##
## Augmented Dickey-Fuller Test
##
## data: jere_ts
## Dickey-Fuller = -3.8246, Lag order = 4, p-value = 0.02172
## alternative hypothesis: stationary###
jere_diff<- diff(jere_ts)
adf.test(jere_diff)## Warning in adf.test(jere_diff): p-value smaller than printed p-value##
## Augmented Dickey-Fuller Test
##
## data: jere_diff
## Dickey-Fuller = -5.0428, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationary### transformation
jere_date1<- sqrt(jere_ts)
adf.test(jere_date1)##
## Augmented Dickey-Fuller Test
##
## data: jere_date1
## Dickey-Fuller = -3.8558, Lag order = 4, p-value = 0.02027
## alternative hypothesis: stationaryplot(decompose(jere_date1))
plot(jere_date1)
##
plot(jere_date1,xlab="Time",ylab="sqrt",main="transformed data")
### Checking the best model
fit_arima<- auto.arima(jere_date1,ic="aic",trace = T)##
## ARIMA(2,1,2)(1,0,1)[12] with drift : 499.4077
## ARIMA(0,1,0) with drift : 499.3606
## ARIMA(1,1,0)(1,0,0)[12] with drift : 496.8347
## ARIMA(0,1,1)(0,0,1)[12] with drift : 497.1494
## ARIMA(0,1,0) : 497.3669
## ARIMA(1,1,0) with drift : 496.6547
## ARIMA(1,1,0)(0,0,1)[12] with drift : 496.5915
## ARIMA(1,1,0)(1,0,1)[12] with drift : 498.4702
## ARIMA(1,1,0)(0,0,2)[12] with drift : 498.4692
## ARIMA(1,1,0)(1,0,2)[12] with drift : Inf
## ARIMA(0,1,0)(0,0,1)[12] with drift : 497.3204
## ARIMA(2,1,0)(0,0,1)[12] with drift : 497.5704
## ARIMA(1,1,1)(0,0,1)[12] with drift : 497.8492
## ARIMA(2,1,1)(0,0,1)[12] with drift : 499.5704
## ARIMA(1,1,0)(0,0,1)[12] : 494.5929
## ARIMA(1,1,0) : 494.6626
## ARIMA(1,1,0)(1,0,1)[12] : 496.4714
## ARIMA(1,1,0)(0,0,2)[12] : 496.4702
## ARIMA(1,1,0)(1,0,0)[12] : 494.8373
## ARIMA(1,1,0)(1,0,2)[12] : 498.464
## ARIMA(0,1,0)(0,0,1)[12] : 495.3209
## ARIMA(2,1,0)(0,0,1)[12] : 495.5724
## ARIMA(1,1,1)(0,0,1)[12] : 495.8514
## ARIMA(0,1,1)(0,0,1)[12] : 495.1504
## ARIMA(2,1,1)(0,0,1)[12] : 497.5724
##
## Best model: ARIMA(1,1,0)(0,0,1)[12]summary(fit_arima)## Series: jere_date1
## ARIMA(1,1,0)(0,0,1)[12]
##
## Coefficients:
## ar1 sma1
## -0.1856 -0.1842
## s.e. 0.1115 0.1256
##
## sigma^2 = 21.49: log likelihood = -244.3
## AIC=494.59 AICc=494.9 BIC=501.85
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -0.02615164 4.5526 3.078198 NaN Inf 0.4495227 0.01862956### Sarima model
sarima_model<- arima(jere_date1,order=c(1,1,0),seasonal =list(order=c(0,0,1),period=12))
##
checkresiduals(sarima_model)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,1,0)(0,0,1)[12]
## Q* = 27.214, df = 15, p-value = 0.02704
##
## Model df: 2. Total lags used: 17###
resid<- residuals(sarima_model)
autoplot(resid)+ ggtitle("Residual")
##
Box.test(residuals(sarima_model), lag=10, type="Ljung-Box") ##
## Box-Ljung test
##
## data: residuals(sarima_model)
## X-squared = 16.314, df = 10, p-value = 0.091##
sarimal_plot<-forecast(sarima_model,h=24)
sarimal_plot## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2023 -0.20326985 -6.072703 5.666163 -9.179793 8.773253
## Feb 2023 0.05873514 -7.510793 7.628263 -11.517859 11.635329
## Mar 2023 -0.99065818 -10.052644 8.071328 -14.849770 12.868454
## Apr 2023 -0.32484884 -10.648064 9.998366 -16.112844 15.463146
## May 2023 -0.68124201 -12.130561 10.768077 -18.191464 16.828980
## Jun 2023 -0.15975139 -12.633413 12.313910 -19.236570 18.917067
## Jul 2023 -0.53597673 -13.956108 12.884155 -21.060297 19.988343
## Aug 2023 -0.65782193 -14.961919 13.646275 -22.534051 21.218407
## Sep 2023 1.74930633 -13.387224 16.885836 -21.400018 24.898631
## Oct 2023 1.90410117 -14.021409 17.829611 -22.451864 26.260067
## Nov 2023 1.63539480 -15.041811 18.312601 -23.870191 27.140980
## Dec 2023 1.88733016 -15.509121 19.283782 -24.718247 28.492907
## Jan 2024 1.84056413 -15.981054 19.662183 -25.415249 29.096378
## Feb 2024 1.84924517 -16.431257 20.129747 -26.108370 29.806860
## Mar 2024 1.84763373 -16.872452 20.567719 -26.782267 30.477534
## Apr 2024 1.84793286 -17.303106 20.998971 -27.441053 31.136919
## May 2024 1.84787733 -17.724363 21.420117 -28.085280 31.781035
## Jun 2024 1.84788764 -18.136726 21.832502 -28.715942 32.411717
## Jul 2024 1.84788573 -18.540755 22.236526 -29.333849 33.029621
## Aug 2024 1.84788608 -18.936930 22.632703 -29.939748 33.635520
## Sep 2024 1.84788602 -19.325695 23.021467 -30.534311 34.230083
## Oct 2024 1.84788603 -19.707448 23.403220 -31.118153 34.813925
## Nov 2024 1.84788603 -20.082558 23.778330 -31.691833 35.387606
## Dec 2024 1.84788603 -20.451358 24.147130 -32.255865 35.951637plot(sarimal_plot)
###
x_plot<-plot(sarimal_plot,xlab = "Time(month)",ylab="cases")
plot(residuals(sarima_model), ylab="sqrt of cases", xlab="Time(years)",lwd=3)
legend("topleft", c("Measles cases", "Forecast","80% EB",
"95% EB"), cex=0.3, col=c(1, 4,5,8),lty=c(1, 1, 1, 2))
AIC(sarima_model)## [1] 494.5929##
x_sa<- sarimal_plot$mean
x_sa## Jan Feb Mar Apr May Jun
## 2023 -0.20326985 0.05873514 -0.99065818 -0.32484884 -0.68124201 -0.15975139
## 2024 1.84056413 1.84924517 1.84763373 1.84793286 1.84787733 1.84788764
## Jul Aug Sep Oct Nov Dec
## 2023 -0.53597673 -0.65782193 1.74930633 1.90410117 1.63539480 1.88733016
## 2024 1.84788573 1.84788608 1.84788602 1.84788603 1.84788603 1.84788603x_sqrt<-round((x_sa)^2,2)
x_sqrt## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2023 0.04 0.00 0.98 0.11 0.46 0.03 0.29 0.43 3.06 3.63 2.67 3.56
## 2024 3.39 3.42 3.41 3.41 3.41 3.41 3.41 3.41 3.41 3.41 3.41 3.41