Solución Tarea 3 PDF
Solución Tarea 3 PDF
Solución Tarea 3 PDF
TAREA No.3
Profesor: Dr. Ciro Velasco Cruz
Alumna: Victoria Lucia Carmona Mota
Considere la base de datos en el archivo: selling.csv (para detalles de la base de datos ver
problema7, pagina 171 del libro de Banerjee (2004)). Ademas, considere el modelo siguiente
Y = XB + (1)
donde: Y es el vector de observaciones que es contiene los valores de logSellingPrice, X es
la matrix de covariables, que incluye un intercepto, LivingArea, Age, OtherArea, Bedrooms y
Bathrooms como covariables en el modelo.
Haga lo siguiente:
Soluci
on:
1
Figure 1: Grafica de Curvas de nivel: Datos Selling
2.- Ajuste el modelo anterior donde asuma que Nn (0, 2 I). Con los residuales, construya
un variograma emprico y adicione un variograma exponencial. Comente los resultados
obtenidos.
lm.selling <- lm(logSellingPr ~ LivingArea+Age+OtherArea+Bedrooms+Bathrooms,
data = selling.frame)
summary(lm.selling)
selling.resid <- resid(lm.selling)
Call:
lm(formula = logSellingPr ~ LivingArea + Age + OtherArea + Bedrooms +
Bathrooms, data = selling.frame)
Residuals:
Min 1Q Median 3Q Max
-0.59097 -0.08838 0.01131 0.12211 0.54161
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.023e+01 1.739e-01 58.809 < 2e-16 ***
LivingArea 6.010e-04 7.083e-05 8.486 4.5e-12 ***
Age -9.806e-03 2.990e-03 -3.279 0.00169 **
OtherArea 1.514e-04 1.240e-04 1.221 0.22655
Bedrooms -2.049e-02 5.400e-02 -0.379 0.70559
Bathrooms -4.084e-02 8.949e-02 -0.456 0.64965
2
---
Signif. codes: 0 ?***? 0.001 ?**? 0.01 ?*? 0.05 ?.? 0.1 ? ? 1
3
Desarrollando las ecuaciones de manera que se obtengan distribuciones conocidas, se obtienen
formas conocidas para , 2 , 2 , pero no para , por lo tanto se usa el algoritmo de Metropolis-
Hasting para este parametro.
1 1
1. p( | resto) Np [(X t X) X t (Y W ), 2 (X t X) ]
1 1 (Y XB) 1 1
2. p(W | resto) Nn I + 2 H() , ( 2 I + 2 H())
2 2
(Y X W )t (Y X W )
2 n
3. p( | resto) Gamma-Inv a0 + , b0 +
2 2
W t H()W
2 n
4. p( | resto) Gamma-Inv c0 + , d0 +
2 2
1 t
5. p( | resto) exp W H()W Gamma(a0 , b0 )
2 2
Para obtener muestras de las distribuciones posteriores, se usaron los algoritmos de Metropolis-
Hasting y Gibbs sampling implementados en un programa en R. Se realizaron r = 5000 repeti-
ciones con un burn-in = 500, mas adelante se presentan algunas graficas que muestran el
comportamiento de la distribucion posterior de cada elemento de = (, 2 , 2 , ) y al final
del documento se agrega el programa realizado en R.
Para la distribucion posterior de 2 L2 = 3.748371 exp26 y para los residuales del punto 2
es L2 = 9.12511 exp18 . Es claro que la funcion de perdida es menor mediante metodos
Bayesianos.
funci
on de p
erdida
> colMeans(Betaposterior[-(1:500), ])
[1] -1.981076e-03 3.488315e-02 3.916945e-05 4.273111e+00 8.069902e-01
4
Figure 2: Distribucion Posterior: Covariables LivingArea y OtherArea
5
Figure 4: Distribucion Posterior: Covariable Bathrooms
6
Figure 6: Trace plot: Algoritmo de Metropolis Hasting
7
4.- Construya la distribucion predictiva para predecir la respuesta en el punto que tiene la
siguiente informacion: Longitude= 91.1174, Latitude= 30.506, LivingArea= 938 sqft,
Age= 25, OtherArea= 332 sqft, Bedrooms= 3, Bathrooms= 1. Presente resultados, y
tambien un histograma, como la estimacion la distribucion predictiva.
5.- Con los residuales del ajuste Bayesiano del modelo (para esto use el estimador del residual
usando la funcion cuadratica de perdida), ajuste un variograma emprico (tal como lo hara
un estudiante con formacion en estadstica frecuentista) y compare este variograma con el
obtenido en el punto 2 (arriba).
6.- Con los residuales Bayesianos, arriba, calcule yAdjusted = ResidualesBayes + 0 , donde 0 es
el estimador puntual Bayesiano del intercepto. Estime la respuesta promedio de yAdjusted en
la region geografica definifa en la tabla de abajo, lo mas preciso posible (es decir, discretize
la region, lo mas finamente posible).
Table 1:
V
ertice Latitude Longitude
1 -91.15 30.45
2 -91.1 30.45
3 -91.1 30.48
4 -91.15 30.48
8
require(mvtnorm)
require(MASS)
require(survival)
require(coda)
suppressPackageStartupMessages(library(MCMCpack))
k<-ncol(X)
n<-nrow(X)
#Funci
on condicional para Beta.
aux2<-solve(t(X)%*%X)
condBeta = function(X, Y, W, tau2, aux2)
{
Beta<-rmvnorm(1, mean=(aux2%*%t(X)%*%t(Y-W)), sigma=tau2*aux2)
return(Beta)
}
#Funci
on condicional para W
#Funci
on condicional para sigma2
c0=1
d0=1
condsigma2 = function(W, c0, d0, dist, rho)
{
H<-VecH(rho)
tau2<- rinvgamma(1, shape=c0+(n/2), scale=d0+((W)%*%solve(H)%*%t(W))/2)
return(tau2)
9
}
#Funci
on condicional para Rho mediante Metropolis Hasting
#funci
on de covarianza espacial
dist<-iDist(coords)
VecH= function(rho)
{
H<-exp(-dist/rho)
return(H)
}
#condicional de rho
a1=1
b1=5
condprho<-function(sigma2, rho)
{
H<-VecH(rho)
exp(-(W)%*%(solve(H)%*%t(W))/(2*sigma2))*dgamma(1, a1, b1)
}
##Metropolis de rho
rho0 <- 0.7
MetroRho<-function(sigma2)
{
rho_estrella <- runif(1)
a<- condprho(sigma2, rho_estrella)
if(a!="NaN" & a!="Inf" & a!="-Inf" & a!=0)
{
rp= condprho(sigma2, rho_estrella)/condprho(sigma2, rho0)
cat("rp=", rp, "\n")
if(rp > 1)
{
rho=rho_estrella
rho0=rho_estrella
}
else
{
if(runif(1) < rp)
{
rho=rho_estrella
rho0=rho_estrella
}
}
}
return(rho)
}
#Gibbs sampling
r<-5000
burning<-500
10
Betaposterior<-matrix(0, nrow=r, ncol=k)
rhoposterior<-vector(mode = "numeric", length = r)
sigmaposterior<-vector(mode = "numeric", length = r)
tauposterior<-vector(mode = "numeric", length = r)
Beta<-c(.0006, -.0098, .0001, .002, .0004)
W<-rep(0.5, n)
rho<-.1
sigma2<-1.5
tau2<-1.2
for(l in 1:r)
{
rho<-MetroRho(sigma2)
rhoposterior[l]<-rho
sigma2<-condsigma2(W, c0, d0, dist, rho)
sigmaposterior[l]<-sigma2
cat("sigma2=", sigma2, "\n")
tau2<-condtau2(Y, X, W, Beta, a0, b0)
cat("tau2=", tau2, "\n")
tauposterior[l]<-tau2
W<-condW(X, Y, sigma2, tau2, rho, Beta)
Beta <- condBeta(X, Y, W, tau2, aux2)
Betaposterior[l, ]<-Beta
cat("Beta=", Beta, "\n")
}
11