Desenvolvimento

Trabalho 6 Jura Cr 

1) Mapa de concentração do teor de “cromo(Cr)” no data set Jura, através dos parâmetros de um modelo esférico omnidireconal de semivariograma

Parâmetros:

  model    psill     range

1   Nug 28.72708 0.0000000

2   Sph 92.29840 0.4768911

data(jura)

jura.grid <- juragrid.dat

coordinates(jura.grid)=~Xloc+Yloc

gridded(jura.grid) = TRUE

class(jura.grid)

coordinates(jura.pred)=~Xloc+Yloc

class(jura.pred)

m <- vgm(92.29840,"Sph",0.4768911,28.72708)

x <- krige(Cr~1, jura.pred, jura.grid, model=m)

spplot(x[1], main='Predição de Krigagem Ordinária - Cr')

2) Mapa base

data(jura)

coordinates(prediction.dat) <-c("Xloc","Yloc")

bubble(prediction.dat, "Cr",maxsize = 2.5,main = "Concentração de Cr (ppm)")

3) O sumário da variável

data(jura)

ht <- prediction.dat

summary(ht$Cr)

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

   8.72   27.44   34.84   35.07   42.22   67.60

 4) histograma

data(jura)

ht <- prediction.dat

x.norm<- ht$Cr

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

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

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

xfit<-seq(0, 70, 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="Concentração de Cr(ppm)",ylab="Frequência relativa",main="Histograma de Cr ")

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

5) Box splot

data(jura)

h <-prediction.dat

boxplot(h$Cr)

6) Variograma experimental 

data(jura)

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

graf<-variogram(g)

plot(graf,main="Variograma experimental de Cr",xlab="Distância",ylab="Semivariância")

7) Variograma ajustado

data(jura)

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

x=range(vgm1[,2])
y=range(vgm1[,3])
plot(x,y,asp=0.01,type="n",main="Variograma ajustado - Cr")
points(vgm1[,2],vgm1[,3], col = "blue", cex = 1.5)
lines(vgm1[,2],vgm1[,3], col = "blue")
f<-fit.variogram(vgm1,vgm(120,"Sph",0.5,46))
v<-vgm(f$psill[2],"Sph",f$range[2],f$psill[1])
ff<-variogram.line(v, maxdist=2.2, n = 15, min = 0.05811439)
points(ff[,1],ff[,2], col = "violet")
lines(ff[,1],ff[,2], col = "violet")

8) Mapa de isoteores (isopletas, contornos)

s.grid<-GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid<-SpatialPoints(s.grid)

data(jura)

m <- vgm(92.29840,"Sph",0.4768911,28.72708)

xx <- krige(Cr~1, ~Xloc+Yloc,data=prediction.dat, model = m,newd=s.grid)

dfxx <- as.data.frame(xx)

mz <- matrix(dfxx[,3], nrow=50, ncol=50, byrow=FALSE)#especificação do grid

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

contour(x =seq(1,5.9,by= 0.1), y=seq(1,5.9,by=0.1),nmz,nlevels=10, xlab="Xloc",ylab="Yloc",main="Mapa de Isoteores de Cr")

9) Mapa de contornos preenchidos

s.grid <- GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid <- SpatialPoints(s.grid)#spatial points definição do grid

data(jura) # dados

m <- vgm(.92.29840, "Sph", 0.4768911, 28.72708) # modelo já ajustado de variograma

xx <- krige(Cr~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)

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

filled.contour(x, y,nmz,nlevels=10,color=terrain.colors, xlab="Xloc",ylab="Yloc",main="Mapa de contornos preenchidos - Cr")

10) Um digrama de bloco

s.grid <- GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid <- SpatialPoints(s.grid)

data(jura) # dados

m <- vgm(92.29840, "Sph", 0.4768911, 28.72708) xx <- krige(Cr~1, ~Xloc+Yloc, model = m, data = prediction.dat, newd = s.grid)

#krigagem

dfxx <- as.data.frame(xx)

mz <- matrix(dfxx[,3], nrow=50, ncol=50, byrow=FALSE)

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

persp(x =seq(1,5.9,by= 0.1), y=seq(1,5.9,by=0.1),nmz,xlab="Xloc",ylab="Yloc",main="Diagrama de bloco de Cr",theta=20,phi=30, col="green")

Trabalho 15 Jura Pb Ni 

1) Mapa base

• Pb

data(jura)

coordinates(prediction.dat) <-c("Xloc","Yloc")

bubble(prediction.dat, "Pb",maxsize = 2.5,main = "Concentração de Pb (ppm)")

• Ni

data(jura)

coordinates(prediction.dat) <-c("Xloc","Yloc")

bubble(prediction.dat, "Ni",maxsize = 2.5,main = "Concentração de Ni (ppm)")

 2) Sumários de Pb e Ni

• Pb

 data(jura)

 ht <- prediction.dat

 summary(ht$Pb)

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

  18.96   36.52   46.40   53.92   60.40  229.60

• Ni

data(jura)

 ht <- prediction.dat

 summary(ht$Ni)

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

   4.20   13.80   20.56   19.73   25.42   53.20

3) Histogramas de Pb e Ni

• Pb

data(jura)

ht <- prediction.dat

x.norm<- ht$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="Concentração de Pb(ppm)",ylab="Frequência relativa",main="Histograma de Pb ")

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

• Ni

data(jura)

g <- prediction.dat

x.norm<- g$Ni

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

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

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

xfit<-seq(0, 55, 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 Ni ")

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

4) Box-plots de Pb e Ni

• Pb

data(jura)

h <-prediction.dat

boxplot(h$Pb)

• Ni

data(jura)

h <-prediction.dat

boxplot(h$Ni)

5) Dispersograma entre Pb e Ni

data(jura)

h <- prediction.dat

plot (h$Pb,h$Ni,Xlab="Pb",Ylab="Ni")

6) Coeficiente de correlação Pb e Ni

data(jura)

cor(g$Pb,g$Ni)

[1] 0.3081438

7) Reta de regressão Pb e Ni

data(jura)

x<-prediction.dat$Pb

y<-prediction.dat$Ni

regress<-lm(y ~ x)#regressão linear

xlm<-seq(0, 5, by = 5)#valores de Pb

ylm=regress$coefficients[1]+xlm*regress$coefficients[2]

plot(1:95, 1:95, type ="n", xlab="Pb", ylab="Ni")

points(x,y)#amostra

lines(xlm,ylm,col="red")

summary(regress)

Call:

lm(formula = y ~ x)

Residuals:

     Min       1Q   Median       3Q      Max

-17.4258  -5.6410   0.5902   5.1284  23.4042

Coefficients:

            Estimate Std. Error t value Pr(>|t|)   

(Intercept) 15.13916    1.00972  14.993  < 2e-16 ***

x            0.08515    0.01640   5.193 4.22e-07 ***

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 7.847 on 257 degrees of freedom

Multiple R-squared:  0.09495,   Adjusted R-squared:  0.09143

F-statistic: 26.96 on 1 and 257 DF,  p-value: 4.22e-07

 8) Variograma experimental cruzado Pb e Ni.

data(jura)

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

graf<-variogram(g)

p1<-plot(graf,xlab="lag",ylab="semivariance",main="semivariograma cruzado Pb-Ni")

g <- gstat( formula=Ni~1, locations=~Xloc+Yloc, data= prediction.dat)

graf<-variogram(g)

p2<-plot(graf,xlab="lag",ylab="semivariance",main="semivariograma Ni")

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

graf<-variogram(g)

p3<-plot(graf,xlab="lag",ylab="semivariance",main="semivariograma Pb")

print(p1,split=c(1,1,2,2),more=TRUE)

print(p2,split=c(1,2,2,2),more=TRUE)

print(p3,split=c(2,1,2,2))

9) Mapa de isoteores (isopletas, contornos)

• Pb

s.grid<-GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid<-SpatialPoints(s.grid)

data(jura)

m <- vgm(409.7052,"Sph",0.2286313, 185.7162)

xx <- krige(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)

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

contour(x =seq(1,5.9,by= 0.1), y=seq(1,5.9,by=0.1),nmz,nlevels=10, xlab="Xloc",ylab="Yloc",main="Mapa de Isoteores de Pb")

• Ni

s.grid<-GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid<-SpatialPoints(s.grid)

data(jura)

m <- vgm(71.18374,"Sph",1.382506, 11.75440)

xx <- krige(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)

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

contour(x =seq(1,5.9,by= 0.1), y=seq(1,5.9,by=0.1),mz,nlevels=10,xlab="Xloc",ylab="Yloc",main="Mapa de Isoteores de Ni")

10) Mapa de contornos preenchidos

• Pb

s.grid <- GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid <- SpatialPoints(s.grid)

data(jura)

m <- vgm(409.7052, "Sph", 0.2286313,185.7162) 

xx <- krige(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)

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

filled.contour(x, y,nmz,nlevels=10,color=terrain.colors, xlab="Xloc",ylab="Yloc",main="Mapa de Isoteores de Pb")

• Ni

s.grid <- GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid <- SpatialPoints(s.grid)

data(jura)

m <- vgm(71.18374, "Sph", 1.382506, .11.75440) # modelo já ajustado de variograma

xx <- krige(Ni~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)#especificação do grid

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

filled.contour(x, y,nmz,nlevels=10,color=terrain.colors, xlab="Xloc",ylab="Yloc",main="Mapa de contornos preenchidos - Ni")

11) Um digrama de bloco

• Pb

s.grid <- GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid <- SpatialPoints(s.grid)

data(jura)

m <- vgm(409.7052, "Sph", 0.2286313,185.7162) # modelo já ajustado de variograma

xx <- krige(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)#especificação do grid

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

persp(x =seq(1,5.9,by= 0.1), y=seq(1,5.9,by=0.1),nmz,xlab="Xloc",ylab="Yloc",main="Diagrama de bloco de Pb",theta=20,phi=30, col="green")

• Ni

s.grid <- GridTopology(c(1,1),c(0.1,0.1),c(50,50))

s.grid <- SpatialPoints(s.grid)

data(jura)

m <- vgm(71.18374, "Sph", 1.382506, .11.75440) # modelo já ajustado de variograma

xx <- krige(Ni~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)#especificação do grid

nmz <- matrix(nrow=50, ncol=50)

for (i in 1:50)

for (j in 1:50)

{nmz[i,j]=mz[i,51-j]}

x =seq(1.0,5.9,by= 0.1)

y=seq(1,5.9,by=0.1)

persp(x =seq(1,5.9,by= 0.1), y=seq(1,5.9,by=0.1),nmz,xlab="Xloc",ylab="Yloc",main="Diagrama de bloco de Ni",theta=20,phi=30, col="green")