Exposição dos Resultados

a) Atributos básicos:

Comando:
data(meuse.alt)
ma<-meuse.alt
summary(ma$alt)


Min. 1st Qu. Median Mean 3rd Qu. Max.
28.90 35.70 37.00 37.46 38.00 55.00

b) Histograma


data(meuse.alt)
ma <-meuse.alt

x.norm<-ma$alt
h<-hist(x.norm,breaks=10)
xhist<-c(min(h$breaks),h$breaks)
yhist<-c(0,h$density,0)
xfit<-seq(28, 56, by=0.5)
yfit<-dnorm(xfit,mean=mean(x.norm),sd=sd(x.norm))
plot(xhist,yhist,type="s",ylim=c(0,max(yhist,yfit)),xlab="Zn",ylab="Frequência relativa",main="Histograma de Altitudes ")
lines(xfit,yfit,col="blue")






Histograma unimodal, assimétrico à direita (cauda direita mais alongada).


c) Coeficiente de Assimetria:

data(meuse.alt)
ma<-meuse.alt
skewness(ma$alt)

[1] 2.000082


d) Caso a assimetria seja muito grande, gerar um novo atributo calculando o logaritmo:

data(meuse.alt)
ma <-meuse.alt
x.norm<-log(ma$alt)
h<-hist(x.norm,breaks=10)
xhist<-c(min(h$breaks),h$breaks)
yhist<-c(0,h$density,0)
xfit<-seq(3.35, 4.05, by=0.01)
yfit<-dnorm(xfit,mean=mean(x.norm),sd=sd(x.norm))
plot(xhist,yhist,type="s",ylim=c(0,max(yhist,yfit)),xlab="Zn",ylab="Frequência relativa",main="Histograma de log(Alt) ")
lines(xfit,yfit,col="blue")




data(meuse.alt)

ma<-meuse.alt
skewness(log(ma$alt))

Coeficiente de assimetria: [1] 1.610345


e) Mapa base:
data(meuse.alt)
plot(meuse.alt[,2],meuse.alt[,3],xlab="Xloc",ylab="Yloc",main="Mapa Base dos pontos de coleta")




f) Semivariograma omnidirecional experimental:

data(meuse.alt)
ma<-gstat(id="alt",formula=log(alt)~1,locations=~x+y,data=meuse.alt)
plot(variogram(ma),xlab="Distância",ylab="Semivariância",main="Semivariograma omnidirecional experimental de Alt")





g) Um ajuste de um modelo teórico ao semivariograma obtido anteriormente:

data(meuse.alt)
vgm1<-variogram(log(alt)~1,locations=~x+y,data=meuse.alt)
x=range(vgm1[,2])
y=range(vgm1[,3])
plot(x,y,asp=100000,type="n",main="Ajuste de um modelo teórico ao semivariograma de Alt")
points(vgm1[,2],vgm1[,3],col="blue",cex=1.5)
lines(vgm1[,2],vgm1[,3],col="blue")
f<-fit.variogram(vgm1,vgm(0.002,"Exp",1800,0.006))
v<-vgm(f$psill[2],"Exp",f$range[2],f$psill[1])
ff<-variogramLine(v,maxdist=1800,n=15,min=100)
points(ff[,1],ff[,2],col="red")
lines(ff[,1],ff[,2],col="red")


Modelo ajustado
> v
model psill range
1 Nug 0.0007736096 0.0000
2 Exp 0.0045326051 241.1351




h) Um modelo de bloco (2d) da região predizendo o valor do atributo nos nós com krigagem ordinária:

data(meuse.alt)
coordinates(meuse.alt)=~x+y
data(meuse.grid)
gridded(meuse.grid)=~x+y
m<- vgm(0.0045326051,"Exp",241.1351, 0.0007736096)
x<-krige(log(alt)~1, meuse.alt, meuse.grid, model = m)
spplot(x["var1.pred"], main = "Predição de krigagem ordinária")









i) Um mapa de isoteores do atributo:

s.grid<-GridTopology(c(178260,329220),c(40,40),c(90,120))
s.grid<-SpatialPoints(s.grid)
#spatial points
data(meuse.alt)
m<- vgm(0.0045326051,"Exp",241.1351, 0.0007736096)
xx<-krige(log(alt)~1,~x+y,model=m,data=meuse.alt,newd=s.grid)
dfxx<-as.data.frame(xx)
mz<-matrix(dfxx[,3],nrow=90,ncol=120,byrow=FALSE)
x<-seq(178300,181860,by=40)
y<-seq(329500,334260,by=40)
contour(x,y,nlevels=10,mz,xlab="Xloc",ylab="Yloc",main="Mapa de Isoteores de Alt")





j) Diagrama de Bloco do Atributo Baseado em Krigagem Ordinária.

s.grid<-GridTopology(c(178260,329220),c(40,40),c(90,120))
s.grid<-SpatialPoints(s.grid)
#spatial points
data(meuse.alt)
m<- vgm(0.0045326051,"Exp",241.1351, 0.0007736096)
xx<-krige(log(alt)~1,~x+y,model=m,data=meuse.alt,newd=s.grid)
dfxx<-as.data.frame(xx)
mz<-matrix(dfxx[,3],nrow=90,ncol=120,byrow=FALSE)

persp(x=seq(178300,181860,by=40),y=seq(329500,334260,by=40),mz,xlab="Xloc",ylab="Yloc",main="Altitude",col="red")