CS计算机代考程序代写 # Lecture 6 Analysis

# Lecture 6 Analysis
# Author: Chris Hansman
# Email: chansman@imperial.ac.uk
# Date : 14/02/32

#Loading Libraries
library(tidyverse)

#————————————————–#
#Section 1: Loading Data
#————————————————–#
yields0105 <- read_csv("yields0105.csv") #--------------------------------------------------# #Section 2: Plotting Yield Curve from 2001-2005 #--------------------------------------------------# #Gathering Data into a Single Column for Plotting yield_gather <- yields0105 %>%
gather(., value=”Yield”) %>%
group_by(key) %>%
mutate(number=1)%>%
mutate(Date=cumsum(number))

#Plotting Yields Over Time
ggplot(data=yield_gather, aes(x=Date, y=Yield)) +
geom_line( aes(color = key)) +
theme_minimal()
ggsave(“yield_0105.pdf”, width=8, height=4)

#————————————————–#
#Section 3: Creating Changes in Yields Over Time
#————————————————–#
yields_diff <- yields0105 %>%
mutate_all(funs(.-lag(.))) %>%
filter(is.na(DGS3MO)==FALSE)

#Gathering Data into a Single Column for Plotting
yield_diff_gather <- yields_diff %>%
gather(., value=”Yield_Difference”) %>% group_by(key) %>%
mutate(number=1)%>%
mutate(Date=cumsum(number))

#Plotting Yields Differences Over Time
ggplot(data=yield_diff_gather, aes(x=Date, y=Yield_Difference)) +
geom_line( aes(color = key)) +
theme_minimal() + ylab(“Yield Difference”)
ggsave(“yield_diff0105.pdf”, width=8, height=4)

#————————————————–#
#Section 4: Performing Principal Components Analysis
#————————————————–#
#Demeaning the Data and converting to matrix form
x_tilde <- yields_diff %>%
mutate_all(funs(.-mean(.)))
x_tilde <- as.matrix(x_tilde) #Storing Means alpha <- yields_diff %>%
summarize_all(funs(mean(.))) %>%
as.matrix %>%
t()

#Computing Covariance Matrix
Sigma_x <- cov(x_tilde) #Computing corr Matrix rho_x <- cor(x_tilde) #Performing Eigendecomposition Lambda<-diag(eigen(Sigma_x)$values) Gamma<-eigen(Sigma_x)$vector #Creating Principal Components Variables p <- t(Gamma)%*%t(x_tilde) p <- as_tibble(t(p)) #--------------------------------------------------# #Section 5: Plotting Loadings on First Three Principal Components #--------------------------------------------------# #Loading On First Principal Component p1_loadings <- as_tibble(Gamma[,1]) %>%
mutate(number=1)%>%
mutate(bond=cumsum(number))

#Loading On Second Principal Component
p2_loadings <- as_tibble(Gamma[,2]) %>%
mutate(number=1)%>%
mutate(bond=cumsum(number))

#Loading On Third Principal Component
p3_loadings <- as_tibble(Gamma[,3]) %>%
mutate(number=1)%>%
mutate(bond=cumsum(number))

# Plotting Loadings on First Principal Component
ggplot(p1_loadings, aes(y=value, x=factor(bond))) +
geom_bar(stat=”identity”) +
scale_x_discrete(breaks = 1:9, labels=c(“3 Month”,”6 Month”,”1 Year”,”2 Year”,”3 Year”, “5 Year”, “7 Year”, “10 Year”, “20 Year”))+
xlab(“Treasury”)+
ylab(“Loading”)+
theme_minimal()
ggsave(“p1_loading.pdf”, width=6, height=4)

# Plotting Loadings on First Principal Component
ggplot(p2_loadings, aes(y=value, x=factor(bond))) +
geom_bar(stat=”identity”) +
scale_x_discrete(breaks = 1:9, labels=c(“3 Month”,”6 Month”,”1 Year”,”2 Year”,”3 Year”, “5 Year”, “7 Year”, “10 Year”, “20 Year”))+
xlab(“Treasury”)+
ylab(“Loading”)+
theme_minimal()
ggsave(“p2_loading.pdf”, width=6, height=4)

# Plotting Loadings on First Principal Component
ggplot(p3_loadings, aes(y=value, x=factor(bond))) +
geom_bar(stat=”identity”) +
scale_x_discrete(breaks = 1:9, labels=c(“3 Month”,”6 Month”,”1 Year”,”2 Year”,”3 Year”, “5 Year”, “7 Year”, “10 Year”, “20 Year”))+
xlab(“Treasury”)+
ylab(“Loading”)+
theme_minimal()
ggsave(“p3_loading.pdf”, width=6, height=4)

#————————————————–#
#Section 6: Plotting Cumulative Principal Components
#————————————————–#
#Cumulative Principal Components
p_cumulative <- p %>%
mutate_all(funs(cumsum(.))) %>%
mutate(number=1)%>%
mutate(Date=cumsum(number))

#Plotting First Principal Component
ggplot(data=p_cumulative) +
geom_line(aes(x=Date, y=V1), color=”blue”)+
ylab(“First Principal Component”)+
theme_minimal()
ggsave(“p1_time.pdf”, width=6, height=4)

#Plotting Second Principal Component
ggplot(data=p_cumulative) +
geom_line(aes(x=Date, y=V2), color=”red”)+
ylab(“Second Principal Component”)+
theme_minimal()
ggsave(“p2_time.pdf”, width=6, height=4)

#Plotting First Two Principal Components
ggplot(data=p_cumulative) +
geom_line(aes(x=Date, y=V1), color=”blue”)+
geom_line(aes(x=Date, y=V2), color=”red”)+
ylab(“First Two Principal Components”)+
theme_minimal()
ggsave(“p12_time.pdf”, width=6, height=4)

#————————————————–#
#Section 7: Predicting Using First Two Principal Components
#————————————————–#
#Extracting First Two Principal Components
p_firsttwo<-p %>%
select(V1, V2) %>%
as.matrix() %>%
t()

#Extrating First Two Eigenvectors
Gamma_firsttwo <- Gamma[,1:2] #Predicted Values of xhat_t xhat_t=rep(alpha, ncol(p_firsttwo)) + Gamma_firsttwo%*%p_firsttwo xhat_t<-as.tibble(t(xhat_t)) #Cumulative Values of xhat_t xhat_c_t <-xhat_t %>%
mutate_all(funs(cumsum(.)))

#Formatting Data For Plotting: Predicted Yield Changes
xhat_t_gather <- xhat_t %>%
gather(., value=”Yield”) %>%
group_by(key) %>%
mutate(number=1)%>%
mutate(Date=cumsum(number))

#Plotting Predicted Yield Changes
ggplot(data=xhat_t_gather, aes(x=Date, y=Yield)) +
geom_line( aes(color = key)) +
theme_minimal() + ylab(“Predicted Yield Changes”)
ggsave(“predicted_yield_diff.pdf”, width=8, height=4)

#Formatting Data For Plotting: Predicted Yields
xhat_c_t_gather <- xhat_c_t %>%
gather(., value=”Yield”) %>%
group_by(key) %>%
mutate(number=1)%>%
mutate(Date=cumsum(number))

#Plotting Predicted Yields
ggplot(data=xhat_c_t_gather, aes(x=Date, y=Yield)) +
geom_line( aes(color = key)) +
theme_minimal() + ylab(“Predicted Yield”)
ggsave(“predicted_yield.pdf”, width=8, height=4)

#————————————————–#
#Section 8: Plotting Fraction of Variance Explained
#————————————————–#
# Plotting Fraction of Variance Explained
ggplot(prop_var, aes(y=value, x=factor(Component))) +
geom_bar(stat=”identity”, fill=”red”) +
xlab(“Principal Component”)+
ylab(“Fraction of Variance”)+
theme_minimal()
ggsave(“frac_Var.pdf”, width=6, height=4)

Leave a Reply

Your email address will not be published. Required fields are marked *