Resultados

Clique nas imagens para ampliá-las.

Pacotes utilizados: gstat, moments e sp

A) ESTATÍSTICAS BÁSICAS

data(meuse.all)

m<-meuse.all
summary(m$copper)

Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
14.00	23.00	29.50	39.42	48.00	128.00

B) HISTOGRAMA

data(meuse.all)

m<-meuse.all
x.norm<-m$copper
h<-hist(x.norm,breaks=7)
xhist<-c(min(h$breaks),h$breaks)
yhist<-c(0,h$density,0)
xfit<-seq(0,140,by=1.0)
yfit<-dnorm(xfit,mean=mean(x.norm),sd=sd(x.norm))
plot(xhist,yhist,type="s",ylim=c(0,max(yhist,yfit)),xlab="Cobre",ylab="Frequência relativa",main="Histograma de Teor de Cobre")
lines(xfit,yfit,col="red")

C) COEFICIENTE DE ASSIMETRIA

data(meuse.all)

m<-meuse.all
skewness(m$copper)
[1] 1.457878

D) NOVO ATRIBUTO CALCULANDO O LOGARITMO

data(meuse.all)

m<-meuse.all
x.norm<- log(m$copper)
h<-hist(x.norm,breaks=8)
xhist<-c(min(h$breaks),h$breaks)
yhist<-c(0,h$density,0)
xfit<-seq(2.6, 5.0, by=0.1)
yfit<-dnorm(xfit,mean=mean(x.norm),sd=sd(x.norm))
plot(xhist,yhist,type="s",ylim=c(0,max(yhist,yfit)),xlab="Pb",ylab="Frequência relativa",main="Histograma de Teor de Cobre")
lines(xfit,yfit,col="red")

NOVO COEFICIENTE DE ASSIMETRIA

data(meuse.all)

m<-meuse.all
skewness(log(m$copper))
[1] 0.7101691

E) MAPA BASE

data(meuse.all)
plot(meuse.all[,2],meuse.all[,3],xlab="Xloc",ylab="Yloc",main="Mapa Base dos Pontos de Coleta")

F) SEMIVARIOGRAMA OMNIDIRECIONAL EXPERIMENTAL

data(meuse.all)
m <- gstat(id="copper", formula=log(copper)~1, locations=~x+y, data= meuse.all)
graf<-variogram(m)
plot(graf, main="Semivariograma Omnidirecional Experimental de Cobre",xlab="Distância",ylab="Semivariância")

G) AJUSTE DE UM MODELO TEÓRICO AO SEMIVARIOGRAMA DO ITEM ANTERIOR

data(meuse.all)

vgm1<-variogram(log(copper)~1,locations=~x+y,data=meuse.all)

x=range(vgm1[,2])

y=range(vgm1[,3])
plot(x,y,asp=5000,type="n", main="Ajuste de um modelo teórico ao semivariograma")
f<-fit.variogram(vgm1,vgm(.27,"Sph",750,.11))
points(vgm1[,2],vgm1[,3],col="blue",cex=1.5)
lines(vgm1[,2],vgm1[,3],col="blue")
f<-fit.variogram(vgm1,vgm(.27,"Sph",750,0.11))
v<-vgm(f$psill[2],"Sph",f$range[2],f$psill[1])
ff<-variogramLine(v,maxdist=1542,n=15,min=80)
points(ff[,1],ff[,2],col="red")
lines(ff[,1],ff[,2],col="red")

> v

model psill range

1 Nug 0.08557461 0.000

2 Sph 0.20052095 864.585

H) UM MAPA DE CONCENTRAÇÃO DO ATRIBUTO BASEADO EM KRIGAGEM ORDINÁRIA

data(meuse.all)
coordinates(meuse.all)=~x+y
data(meuse.grid)
gridded(meuse.grid)=~x+y
m <- vgm(0.20052095, "Sph", 864.585, 0.08557461)
x <- krige(log(copper)~1, meuse.all, meuse.grid,model = m)
spplot(x["var1.pred"], main = "Predições de Krigagem Ordinária") 

I)UM MAPA DE ISOTEORES DO ATRIBUTO

s.grid<-GridTopology(c(178260,329460),c(40,40),c(90,120))
s.grid<-SpatialPoints(s.grid)
data(meuse.all)m <- vgm(0.20052095, "Sph", 864.585, 0.08557461)
xx<-krige(log(copper)~1,~x+y,model=m,data=meuse.all,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 Cobre")

K) NOVE SIMULAÇÕES GAUSSIANAS DO ATRIBUTO EM MAPAS DE CONCENTRAÇÃO

s.grid<-GridTopology(c(178260,329460),c(160,160),c(22.5,30))
s.grid<-SpatialPoints(s.grid)

gridded(s.grid)<-TRUE

data(meuse.all)

m <- vgm(0.20052095, "Sph", 864.585, 0.08557461)
xx <- krige(log(copper)~1, ~x+y, model = m, data = meuse.all, newd = s.grid )

X11()

xx <- krige(log(copper)~1, ~x+y, model = m, data = meuse.all, newd = s.grid, nsim=9)

spplot(xx["sim1"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim1")

X11()

spplot(xx["sim2"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim2")

X11()

spplot(xx["sim3"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim3")

X11()

spplot(xx["sim4"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim4")

X11()

spplot(xx["sim5"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim5")

X11()

spplot(xx["sim6"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim6")

X11()

spplot(xx["sim7"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim7")

X11()

spplot(xx["sim8"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim8")

X11()

spplot(xx["sim9"],xlab="Xloc(0-4)",ylab="Yloc(0-4)",main="Valores Simulados-sim9")

X11()

A simulação abaixo tem uma resolução de ~1.333 melhor que as outras, mas apenas levou, para ficar pronta, cerca de 15 vezes o tempo: