CODEWITHSUNDEEP
rplotkrigingspdf
maycca
maycca

Reputation: 4090

set automatic colors levels in .filled.contour ? (kriging)

I have a hard time to automatically create colors using filled.contour displaying kriging plot, avoiding specifying levels().

I can plot my results and see the legend, but why my colors are repetitive? Thus, why interval 4.5 - 5.0 has the same color as the 7.0 - 7.5? and how can I fix it?

filled.contour(x = seq(0,1, length.out = nrow(predmat3)),
           y = seq(0,1, length.out = ncol(predmat3)),
           z = predmat3,
           col = brewer.pal(5,"Purples"), nlevels = 5)

enter image description here

Quite long reproductible example, adapted from https://rpubs.com/nabilabd/118172 (calculates kriging by sampling voronoi tesselation data for interpolation points)

library(sp)
library(gstat)
library(RColorBrewer)

# https://rpubs.com/nabilabd/118172
# packages for manipulation & visualization
suppressPackageStartupMessages({
  library(dplyr) # for "glimpse"
  library(ggplot2)
  library(scales) # for "comma"
  library(magrittr)
})

data(meuse)

# create spdf
meuse.spdf<-meuse

# convert to spdf
coordinates(meuse.spdf) <- ~ x + y



# calculate voronoi tesselation - will be needed to create underlying point data
voronoipolygons = function(layer) {
  require(deldir)
  crds = layer@coords
  z = deldir(crds[,1], crds[,2])
  w = tile.list(z)
  polys = vector(mode='list', length=length(w))
  require(sp)
  for (i in seq(along=polys)) {
    pcrds = cbind(w[[i]]$x, w[[i]]$y)
    pcrds = rbind(pcrds, pcrds[1,])
    polys[[i]] = Polygons(list(Polygon(pcrds)), ID=as.character(i))
  }
  SP = SpatialPolygons(polys)
  voronoi = SpatialPolygonsDataFrame(SP, data=data.frame(dummy = seq(length(SP)), row.names=sapply(slot(SP, 'polygons'), 
                                                                                                   function(x) slot(x, 'ID'))))
}
meuse.voro <- voronoipolygons(meuse.spdf)   

# create underlying grid
s.grid <- spsample(meuse.voro, type = "regular", n = 6000)

# calculate kriging
 # create variogram
lzn.vgm <- variogram(log(zinc)~1, meuse.spdf) # calculates sample variogram values 
lzn.fit <- fit.variogram(lzn.vgm, model=vgm(1, "Sph", 900, 1)) # fit model

plot(lzn.vgm, lzn.fit) # plot the sample values, along with the fit model

# calculate kriging
lzn.kriged <- krige(log(zinc) ~ 1, meuse.spdf, s.grid, model=lzn.fit)


# extract the unique x and y locations in the grid
ux<-unique(coordinates(lzn.kriged)[,1])
uy<-unique(coordinates(lzn.kriged)[,2])

# extract the predicted values and format var1.pred into a matrix of gridded values
predmat3 <- matrix(lzn.kriged$var1.pred, length(ux), length(uy))

# display the data???

filled.contour(x = seq(0,1, length.out = nrow(predmat3)),
           y = seq(0,1, length.out = ncol(predmat3)),
           z = predmat3,
           col = brewer.pal(5,"Purples"), nlevels = 5)

Upvotes: 2

Views: 552

Answers (1)

erc
erc

Reputation: 10133

You need 6 colours for the legend but only specified 5, so simply change to:

filled.contour(x = seq(0,1, length.out = nrow(predmat3)),
               y = seq(0,1, length.out = ncol(predmat3)),
               z = predmat3,
               col = brewer.pal(6,"Purples"), nlevels = 5)

enter image description here

Upvotes: 2

Related Questions