quinta-feira, 2 de outubro de 2008

Coeficiente Beta e gráfico da Petrobras e Vale condicionado ao Ibovespa

### A relação entre Vale (e Petrobras) e Ibovespa em períodos antes e depois crise. Veja que loucura Dani!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
b1<-cov(ibov,petr)/var(ibov)
b1 [1] 0.6258915
b2<-cov(ibov,vale)/var(ibov)
b2 [1] 0.5187367
cor(petr,vale)
coplot(petr~vale ibov)
## vendo efeito período ####
1) Período estacionário do Ibovespa
b1<-cov(ibov[1:127],petr[1:127])/var(ibov[1:127])
b2<-cov(ibov[1:127],vale[1:127])/var(ibov[1:127])
b1
[1] -0.2014692
b2
[1] -0.3504139
cor(petr[1:127],vale[1:127])
coplot(petr[1:127]~vale[1:127] ibov[1:127])
##### 2) Período crescente do ibovespa, pós 14/04/2008 a 20/05/2008
b1<-cov(ibov[128:152],petr[128:152])/var(ibov[128:152])
b2<-cov(ibov[128:152],vale[128:152])/var(ibov[128:152])
b1
[1] 3.101659
b2
[1] 0.01888223
cor(petr[128:152],vale[128:152])
coplot(petr[128:152]~vale[128:152]ibov[128:152])
##### 3) Período decrescente do ibovespa, pós ##20/05/2008
b1<-cov(ibov[153:245],petr[153:245])/var(ibov[153:245])
b2<-cov(ibov[153:245],vale[153:245])/var(ibov[153:245])
b1
[1] 1.062324
b2
[1] 1.219344
cor(petr[153:245],vale[153:245])
coplot(petr[153:245]~vale[153:245] ibov[153:245])
###### Vendo em partes
ib<-rep(0,245)
ib[128:152]<-1
ib[153:245]<-2
ib
coplot(vale~petr ib)
libary(lattice)
xyplot(vale~petr ib)

Análise de Intervenção

### Um dos procedimentos. Verificação de outliers usando distâncias de cooks.
set.seed(125)
ar<-lm(y[2:n]~y[1:(n-1)])
summary(ar)
cooks <- cooks.distance(ar)
plot(cooks,ylab="Cooks distances")
obs<-1:(n-1)
identify(1:(n-1),cooks,obs)
dummy<-rep(0,(n-1))
dummy[79]<-1
dummy
ar<-lm(y[2:n]~y[1:(n-1)]+dummy)
summary(ar)
### ou, de forma um pouco parecida
dummy2<-rep(0,n)
dummy2[80]<-1
dummy2
ar<-arima(y, order = c(1, 0, 0),xreg=dummy2)
ar

Duration

########### Valor presente (pv e pp) e Duration #### Exercíco introdutório m<-1000 n<-20
c<-rep(m/n,n)
c
t<-1:n
r<-c(0.05,0.04,0.045,.049,0.0499,0.0501,0.051,0.055, 0.06)
pv<-function(c,r,M)sum(c/((1+r)^t))+M/(1+r)^n pp<-sapply (r,function(j) pv(c,j,m))
pp
dp<-sapply(1:length(r),function(k)(pp[k]-pp[1])/pp[1])
dp*100
dp*100 [1] 0.0000000 13.5903263 6.5039682 1.2568559 [5] 0.1247278 -0.1245165 -1.2357217 -5.9751912 [9] -11.4699212 duration <- function(c, r, M,p) { n <- length(c) ( sum((c*t)/((1+r)^t)) + M*n/((1+r)^n))/p } duration(c, .05, m,pv(c,0.05,m))
durations<-sapply(r, function(rr) duration(c, rr, m,pv(c,rr,m)))
durations [1] 13.08532 13.54472 13.31615 13.13165 13.08996 13.08068 [7] 13.03892 12.85262 12.61844 dr<-sapply(1:length(r),function(h)(r[h]-r[1])) dr*100
aprox<-function(dur,taxa,d)((-1*dur)/(1+taxa))*d
aproximacao<-aprox(durations[1],r[1],dr[2:length(dr)]) aproximacao plot(r[2:length(r)],aproximacao,type="l",col=3, xlab="taxa de juros", ylab="preço")
lines(dp[2:length(r)],lty=3)
########### Gráfico em 3d########
taxa <- seq(0.04, 0.06, length= 80)
preco <- seq(800, 1135, length= 80)
fun <- function(taxa,preco) { d<-(sum((50*(1:n))/((1+taxa)^(1:n))) + 1000*n/((1+taxa)^n))/preco }
duration.3d <- outer(taxa, preco, fun)
op <- par(bg = "white") persp(taxa, preco, duration.3d, theta = 80, phi = 30, expand = 0.5, col = "lightblue")