Resultados

Item (A) - Estatísticas básicas para o Atributo


Códigos:

data(jura)

g <- prediction.dat

summary(g$Pb)

Min. 1st Qu. Median Mean 3rd Qu. Max.

18.96 36.52 46.40 53.92 60.40 229.60


Segundo os resultados, podemos notar que a média [53,92] é maior que a mediana [46.40], que também é maior que a moda.


Item (B) - Histograma

Códigos:

data(jura)

g <- prediction.dat

x.norm<- g$Pb

h<-hist(x.norm,breaks=7)

xhist<-c(min(h$breaks),h$breaks)

yhist<-c(0,h$density,0)

xfit<-seq(0, 250, 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="Pb",ylab="Frequência relativa",main="Histograma de Pb ")

lines(xfit,yfit,col="red")

O histograma acima apresenta grande assimetria à direita, portanto será necessário gerar um novo atributo calculando o logaritmo.


Item (C) - Coeficiente de assimetria

Códigos:

data(jura)

g <- prediction.dat 

skewness(g$Pb)

[1] 2.890612

Item (D) - Novo atributo calculado com logaritimo 

Códigos:

data(jura)

g <- prediction.dat

x.norm<- log(g$Pb)

h<-hist(x.norm,breaks=7)

xhist<-c(min(h$breaks),h$breaks)

yhist<-c(0,h$density,0)

xfit<-seq(2, 6, 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 Pb")

lines(xfit,yfit,col="red")

Os valores positivos dos coeficientes continuam a demonstrar,mesmo depois da geração de um novo atributo, que o histograma acima ainda apresenta uma pequena assimetria positiva à direita.

Item (E) - Mapa base dos Pontos de Coleta

Códigos:

data(jura)

plot(prediction.dat[,1],prediction.dat[,2],xlab="Xloc",ylab="Yloc",main="Mapa base dos pontos de coleta")


O espaçamento regular entre os pontos de coleta indica uma amostragem ( processo estatístico de seleção de uma amostra) sistemática, mesmo que haja acúmulo de pontos ou espaços em branco no mapa base acima.

Item (F) - Semivariograma omnidirecional experimental

Códigos:

data(jura)

g <- gstat(id="Pb", formula=log(Pb)~1, locations=~Xloc+Yloc, data= prediction.dat)

graf<-variogram(g)

plot(graf, main="Semivariograma omnidirecional experimental de Pb",xlab="Distância",ylab="Semivariância")

O semivariograma analisa o grau de dependência espacial entre amostras dentro de um campo experimental, além de definir parâmetros necessários para a estimativa de valores para locais não amostrados, através da técnica de krigagem (Salviano, 1996). O variograma é a ferramenta básica, que permite descrever quantitativamente a variação no espaço de um fenômeno regionalizado (Huijbregts, 1975). A natureza estrutural de um conjunto de dados (assumido pela variável regionalizada) é definida a partir da comparação de valores tomados simultaneamente em dois pontos, segundo uma determinada direção.

O semivariograma obtido apresenta um alcance de 2.0, efeito de pepita 0,05 e um patamar 0,15.

Item (G) - Ajuste de um modelo teórico ao semivariograma obtido em (F)

Códigos:

data(jura)

vgm1<-variogram(log(Pb)~1, locations=~Xloc+Yloc, data=prediction.dat)

x=range(vgm1[,2])

y=range(vgm1[,3])

plot(x,y, asp = 10, type = "n", main="Ajuste de um modelo teórico ao semivariograma")

points(vgm1[,2],vgm1[,3],col="blue",cex=1.5)

lines(vgm1[,2],vgm1[,3],col="blue")

f<-fit.variogram(vgm1,vgm(0.19, "Exp", 1.2, 0.08))

v<-vgm(f$psill[2], "Exp",f$range[2],f$psill[1])

ff<-variogram.line(v,maxdist=2.2 ,n = 15 , min = 0.05811439 )

points(ff[,1],ff[,2],col = "red")

lines(ff[,1],ff[,2], col = "red")

O modelo de ajuste exponencial se mostrou o modelo mais aproximado ideal para ser utilizado.

Item (H) - Modelo de bloco (2d) da região predizendo o valor do atributo 

nos nós com krigagem ordinária

Códigos:

data(jura)
gridded(jura.grid)=~Xloc+Yloc
plot(jura.grid)
title("Modelo de Bloco 2D")

Códigos:

data(jura)
jura.grid=juragrid.dat
coordinates(jura.grid) = ~Xloc+Yloc
gridded(jura.grid) = TRUE
m <- vgm(0.12645599,"Exp", 0.1593586, 0.04550649)
x <- krige(log(Pb)~1, jura, jura.grid, model = m)
spplot(x["var1.pred"], main = "Predição de Krigagem Ordinária")

O mapa de krigagem ordinária representa a previsão do valor pontual de uma variável regionalizada em um determinado local. No caso, a variável é o elementro chumbo na área amostrada. Krigagem é um procendimento de interpolação exato que leva em consideração todos os valores observados coletados no mapa base. Em comparação com o mapa de isoteores, o mapa de krigagem representa a mesma informação, porém o código utilizado é diferente, o que o torna mais compreensível e preciso.

Item (I) - Mapa de isoteores do atributo

Códigos:

s.grid<-GridTopology(c(1.2,1.6),c(0.09,0.09),c(50,50))
s.grid<-SpatialPoints(s.grid)
#spatial points
data(jura)
m <- vgm(0.12645599,"Exp", 0.1593586, 0.04550649)
xx <- krige(log(Pb)~1, ~Xloc+Yloc, model = m, data = prediction.dat, newd = s.grid)
dfxx<-as.data.frame(xx)
mz<-matrix(dfxx[,3], nrow=50, ncol=50, byrow=FALSE)
contour(x =seq(1.0,5.9,by= 0.1), y=seq(1,5.9,by=0.1),mz,nlevels=15, xlab="Xloc",ylab="Yloc",main="Mapa de Isoteores de Pb")

Um mapa de isoteores é obtido através da interpolação de curvas de nível que, no caso, são curva de teores.É semelhante a um mapa topográfico em que os valores das curvas são cotas em metros,, retratando a morfologia e topografia de uma região. Já no mapa de isoteores, as cotas são trocadas pelos teores de chumbo (em ppm), mostrando o padrão de concentração do elemento na região amostrada.

O mapa obtido apresenta o da concentração de chumbo na região da cordilheira.

Análise comparativa:

 

 

Analizando a sobreposição dos mapas de Isoteores, de pontos de coleta e o mapa de krigagem acima, podemos concluir que os dados obtidos foram coletados numa cadeia de montanhas, mais precisamente a Cordilheira de Montanhas Jura.Podemos concluir também que o mapa de krigagem ordinária respeita o limite dos dados coletados no mapa base, dando a eles o mesmo formato. O valor dos teores de chumbo encontrados variam conforme a localização do ponto de coleta em relação a área fonte