Is it possible in R to create a color key like the one below? (this one comes from the software Grid Analysis and Display System - Grads).
There are two features that I can't reproduce in R:
The sequence is non linear however it is displayed as if
Values bigger than 200 are grey / Values smaller than 0 are white
I'm using levelplot from rastervis that plots rasters using the lattice levelplot:
require(raster)
require(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F","#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600",
"#D53E4F","#FF6A6A"))
my.at = c(0,1,5,10,15,20,25,30,40,50,75,100,150,200)
myColorkey <- list(at=my.at,
space="bottom",
labels=list(at=my.at))
p=levelplot(r, par.settings=mapTheme,at = my.at, colorkey=myColorkey,margin=F)
print(p)
The result:
As you can see, both values smaller than 0 and bigger than 200 are white, I've no idea how to set values bigger than or smaller than a certain value to appear as a specific color. Morover, how can I make the space between consecutive thick marks in the color key to have the same size although the intervals are not the same?
This is a workaround for equally sized intervals for non linear sequences:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F",
"#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600", "#D53E4F","#FF6A6A"))
my.at=c(0,1,5,10,15,20,25,30,40,50,75,100,150,200)
my.brks=seq(0, 200, by=15)
myColorkey <- list(at=my.brks, labels=list(at=my.brks, labels=my.at), space="bottom")
p=levelplot(r, par.settings=mapTheme, at=my.at, colorkey=myColorkey, margin=F)
print(p)
This could be a solution for values smaller 0 and greater than 200:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('white','#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F",
"#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600", "#D53E4F","#FF6A6A", "gray"))
max(values(r))
min(values(r))
my.at=c(min(values(r)), 0,1,5,10,15,20,25,30,40,50,75,100,150,200, max(values(r)))
my.brks=seq(0, 200, by=13)
myColorkey <- list(at=my.brks, labels=list(at=my.brks, labels=c(-276,0,1,5,10,15,20,25,30,40,50,75,100,150,200, 388)), space="bottom")
p=levelplot(r, par.settings=mapTheme, at=my.at, colorkey=myColorkey, margin=F)
print(p)
Your colors are not progressing from light to dark. You can use the RColorBrewer package to fix this.
library(RColorBrewer)
reds = brewer.pal(5, "YlOrRd")
greens = brewer.pal(3, "Greens")
blues = brewer.pal(5, "Blues")
mapTheme <- rasterTheme(region=c('white', blues, greens, reds, "gray"))
This is a very helpful workaround. While not addressing question 1, something I found useful for question 2 (adding triangles for values below/above the limits of the colorbar range) can be achieved by adding this:
library(s2dverification)
data_array <- array(Z, dim = c(length(X), length(Y)))
PlotEquiMap(data_array, X, Y,bar_limits=c(0,200),col_inf='white',col_sup='gray')
raster with colorbar
Another solution with updates to lattice:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
levelplot(r, margin=F, at=c(-Inf, seq(0, 200, 20), Inf),
colorkey = list(tri.lower = TRUE, tri.upper = TRUE))
As long as you add "-Inf" and "Inf" to your at definition, the option to add triangles to the colorbar is activated.
Related
As much as I looked at other questions I couldn't solve my problem (I'm new in R).
I simply need to plot a raster where the minimum value (let's say color red) goes to zero (white) and from zero to maximum (color blue) continuously.
I would like to create that color palette independently if the data is symmetrically distributed in negative and positive values.
Let's say I have a raster with this values:
library(raster)
values <- c(seq(-2000,0,by=1),seq(1,499,by=1))
values <- sample(values)
r <- raster(ncol=50,nrow=50)
r <- setValues(r,values)
plot(r)
If this has already been resolved in another question, I would appreciate any information.
So, you can use RColorBrewer or colorRampPalette to achieve this (or a combination of both) and by setting breaks.
library(raster)
library(RColorBrewer)
breakpoints <- c(-2000, seq(0, 500, 55.6))
colors <- c("red", RColorBrewer::brewer.pal(9, "Blues"))
plot(r, breaks = breakpoints, col = colors)
Output
You can also do something similar with colorRampPalette by setting two unique colors. Then, in parenthesis, define how many colors on the gradient you want.
colors <- c("red", colorRampPalette(c("steelblue1", "steelblue4"))(9))
You can also use these both in conjunction with one another.
colors <- c("red", colorRampPalette(RColorBrewer::brewer.pal(9, "Blues"))(11))
If you want red also continuous, then you could create a gradient for both.
breakpoints <- c(seq(-2000, -1, 222), seq(0, 500, 55.6))
colors <- c(RColorBrewer::brewer.pal(9, "Reds"), RColorBrewer::brewer.pal(9, "Blues"))
plot(r, breaks = breakpoints, col = colors)
Output
It's a little easier to set these using ggplot. You essentially need to rescale the values on a scale of 0 to 1 to make 0 the "midpoint".
library(tidyverse)
library(ggplot2)
rdf <- as.data.frame(r, xy = TRUE)
rdf %>%
ggplot() +
geom_raster(aes(x, y, fill = layer)) +
scale_fill_gradientn(
colours = colorRampPalette(rev(RColorBrewer::brewer.pal(11, "RdBu")))(255),
values = c(1.0, (0 - min(rdf$layer)) / (max(rdf$layer) - min(rdf$layer)), 0)
)
Output
I am trying to improve the color shadings of a levelplot. Please take a look at the code below:
# Load required packages
library(raster)
library(rasterVis)
library(viridis)
# Download file
download.file('https://www.dropbox.com/s/caya1ja5ukpih9e/raster_thiago.tif?dl=1',
destfile="~/Desktop/raster_thiago.tif", method="auto")
# Open file
r <- readAll(raster("~/Desktop/raster_thiago.tif"))
# Raster version
plot(r, col=viridis_pal(option="D")(255))
Please note how this map looks sharp when plotted with raster::plot. The color shadings are smooth, and you can't see any "contours" between them. However, sadly raster plots are not as customizable as levelplots.
Now, take a look at this attempt to do the same with RasterVis:
# RasterVis version
levelplot(r, margin=FALSE,
par.settings=rasterTheme(viridis_pal(option = "D")(255)))
Do you see how this map is not as sharp as the previous one? It looks like the color palette doesn't have the same resolution, and you can see how the edges between the color gradients are not as smooth.
Is there any way to improve this look? I've tried to play around with the par.settings and col.regions arguments, but none of them seems to work. I am probably missing something...
With levelplot(), you will also need to explicitly supply an at = argument, a numeric vector giving the breakpoints between the levels to which the colors in col.regions = correspond. Here is a simple reproducible example:
library(rasterVis)
library(viridis)
## Example raster
f <- system.file("external/test.grd", package="raster")
r <- raster(f)
## Option 1: Use `at=` and `col.regions=` to set color gradient
nlev <- 200
my.at <- seq(from = cellStats(r, "min"),
to = cellStats(r, "max"),
length.out = nlev + 1)
my.cols <- viridis_pal(option = "D")(nlev)
levelplot(r, margin = FALSE,
at = my.at,
col.regions = my.cols)
## Option 2: Pass options via `par.settings = rasterTheme()`
##
## (NOTE: this only works for nlev up to 100)
nlev <- 100
my.at <- seq(cellStats(r, "min"), cellStats(r, "max"),
length.out = nlev + 1)
my.theme <- rasterTheme(viridis_pal(option = "D")(nlev))
levelplot(r, margin = FALSE,
at = my.at,
par.settings = my.theme)
To see that this works, compare plots drawn using nlev = 10 and nlev = 200:
I'd like to suggest an option 3 using maxpixels
require(raster)
require(rasterVis)
pal=colorRampPalette(c("#4575B4","#74ADD1","#E0F3F8","white","#FEE090","#F46D43","#D73027"))
proj <- CRS('+proj=longlat +datum=WGS84')
df <- expand.grid(x = seq(-2, 2, .01), y = seq(-2, 2, .01))
df$z <- with(df, (3*x^2 + y)*exp(-x^2-y^2))
r <- rasterFromXYZ(df, crs=proj)
my.brks=seq(-0.6,1.2,by=0.2)
my.labels=as.character(round(my.brks,digits=1))
Default plot
levelplot(r, col.regions=pal, margin=FALSE,at=my.brks,scales=list(draw=FALSE),xlab=NULL,ylab=NULL)
If maxpixels is set, the result looks smoother just like raster::plot()
levelplot(r, col.regions=pal, margin=FALSE,at=my.brks,scales=list(draw=FALSE),xlab=NULL,ylab=NULL, maxpixels = 1e6)
I have a SpatialPolygonsDataFrame with 213 Ecoregions to plot.
My issue is that I'm not able to organize the legend in a way that I could indeed read the legend. I'm new to r and I've been trying this for 2 days now, I feel really stupid... I wonder if anyone could give me some hint on how to achieve this goal.
#### Download and unzip ecoregions ####
#the reference for this ecoregions data: https://doi.org/10.1093/biosci/bix014
#Don't forget to change the path to a path of your own
dir_eco<-"C:/Users/thai/Desktop/Ecologicos/w2"
download.file("https://storage.googleapis.com/teow2016/Ecoregions2017.zip",
file.path(paste0(dir_eco,"/","Ecoregions2017.zip",sep="")))
unzip("Ecoregions2017.zip")
#Read this shapefile
#install.packages("rgdal")
library(rgdal)
ecoreg_shp<- readOGR("Ecoregions2017.shp")
#Crop to a smaller extent
xmin=-120; xmax=-35; ymin=-60; ymin2=-40; ymax=35
limits2 <- c(xmin, xmax, ymin2, ymax) # Just from mexico to Uruguay.
ecoreg_shp<-crop(ecoreg_shp,limits2)
# Color palette - one color for each attribute level
n <- 213
color = grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
# pie(rep(1,n), col=sample(color, n)) #just to take a look at the colors
col_samp<-sample(color, n)
ecoreg_shp#data$COLOR<-col_samp #put the colors in the polygons data frame
#Plot
png(file="29_ecoreg2.png", width=3000, height=3000, units="px", res=300)
par(mar=c(50,0.3,1.5,0),pty="s")
spplot(ecoreg_shp, zcol = "ECO_NAME", col.regions = ecoreg_shp#data$COLOR,
colorkey = list(space = "bottom", height = 1))
dev.off()
Now, this is how this plot looks like:
I've managed to put this legend at the right of the map, but gets also too overlayed... I've tried to do colorkey = FALSE and set a separate legend...
#Plot the map with no legend
spplot(ecoreg_shp, zcol = "ECO_NAME", col.regions = ecoreg_shp#data$COLOR,
colorkey = FALSE)
#Now, just the legend
legend("bottom",legend=ecoreg_shp#data$ECO_NAME,fill=ecoreg_shp#data$COLOR, ncol=3)
But doesn't work.. I get a message that plot.new has not been called yet
I've managed to do a lot of things with the legend, but I can't make it good... Like the legend item below the map in 2 or 3 columns in a long figure... Actually doesn't matter the format at all, I just wanted to be able to make a good figure. Can anyone point me in some direction? I'm trying to learn ggplot2, but I don't know r enough yet for using such a difficult package.
Thank you in advance, any tip is much appreciated.
As said in the comments, you will not really be able to distinguish between colors. You should define a classification with multiple levels and choose similar colors for similar ecoregions.
Nevertheless, you can create an image only for this long legend as follows. I used a reproducible example as I do not have your dataset but I use the same names as yours so that you can directly use the script:
library(sp)
library(rgdal)
n <- 213
dsn <- system.file("vectors", package = "rgdal")[1]
ecoreg_shp <- readOGR(dsn = dsn, layer = "cities")
ecoreg_shp <- ecoreg_shp[1:n,]
# Color palette - one color for each attribute level
color <- grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = T)]
col_samp <- sample(color, n)
ecoreg_shp#data$COLOR <- col_samp #put the colors in the polygons data frame
ecoreg_shp#data$ECO_NAME <- ecoreg_shp#data$NAME
# Define a grid to plot the legend
grid.dim <- c(45, 5)
ecoreg_shp#data$ROW <- rep(rev(1:grid.dim[1]), by = grid.dim[2], length.out = n)
ecoreg_shp#data$COL <- rep(1:grid.dim[2], each = grid.dim[1], length.out = n)
# Plot the legend
png(file = "legend.png",
width = 21, height = 29.7,
units = "cm", res = 300)
par(mai = c(0, 0, 0, 0))
plot(ecoreg_shp#data$COL,
ecoreg_shp#data$ROW,
pch = 22, cex = 2,
bg = ecoreg_shp#data$COLOR,
xlim = c(0.8, grid.dim[2] + 1),
xaxs = "i")
text(ecoreg_shp#data$COL,
ecoreg_shp#data$ROW,
ecoreg_shp#data$ECO_NAME,
pos = 4, cex = 0.75)
dev.off()
The result:
I want to plot a matrix of z values with x rows and y columns as a surface similar to this graph from MATLAB.
Surface plot:
Code to generate matrix:
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 0.240)# 2013 length
y<-seq(from = -241.440, to = 241.440, by = 0.240)
matrix_fun<-matrix(data = 0, nrow = length(x), ncol = length(y))
# Generate two dimensional travel distance probability density function
for (i in 1:length(x)) {
for (j in 1:length(y)){
dxy<-sqrt(x[i]^2+y[j]^2)
prob<-1/(scale^(shape)*gamma(shape))*dxy^(shape-1)*exp(-(dxy/scale))
matrix_fun[i,j]<-prob
}}
# Rescale 2-d pdf to sum to 1
a<-sum(matrix_fun)
matrix_scale<-matrix_fun/a
I am able to generate surface plots using a couple methods (persp(), persp3d(), surface3d()) but the colors aren't displaying the z values (the probabilities held within the matrix). The z values only seem to display as heights not as differentiated colors as in the MATLAB figure.
Example of graph code and graphs:
library(rgl)
persp3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
surface3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
persp(x=x, y=y, z=matrix_scale, theta=30, phi=30, col=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)), border=NA)
Image of the last graph
Any other tips to recreate the image in R would be most appreciated (i.e. legend bar, axis tick marks, etc.)
So here's a ggplot solution which seems to come a little bit closer to the MATLAB plot
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 2.40)
y<-seq(from = -241.440, to = 241.440, by = 2.40)
df <- expand.grid(x=x,y=y)
df$dxy <- with(df,sqrt(x^2+y^2))
df$prob <- dgamma(df$dxy,shape=shape,scale=scale)
df$prob <- df$prob/sum(df$prob)
library(ggplot2)
library(colorRamps) # for matlab.like(...)
library(scales) # for labels=scientific
ggplot(df, aes(x,y))+
geom_tile(aes(fill=prob))+
scale_fill_gradientn(colours=matlab.like(10), labels=scientific)
BTW: You can generate your data frame of probabilities much more efficiently using the built-in dgamma(...) function, rather than calculating it yourself.
In line with alexis_laz's comment, here is an example using filled.contour. You might want to increase your by to 2.40 since the finer granularity increases the time it takes to generate the plot by a lot but doesn't improve quality.
filled.contour(x = x, y = y, z = matrix_scale, color = terrain.colors)
# terrain.colors is in the base grDevices package
If you want something closer to your color scheme above, you can fiddle with the rainbow function:
filled.contour(x = x, y = y, z = matrix_scale,
color = (function(n, ...) rep(rev(rainbow(n/2, ...)[1:9]), each = 3)))
Finer granularity:
filled.contour(x = x, y = y, z = matrix_scale, nlevels = 150,
color = (function(n, ...)
rev(rep(rainbow(50, start = 0, end = 0.75, ...), each = 3))[5:150]))
I have following data and plot:
pos <- rep(1:2000, 20)
xv =c(rep(1:20, each = 2000))
# colrs <- unique(xv)
colrs <- xv # edits
yv =rnorm(2000*20, 0.5, 0.1)
xv = lapply(unique(xv), function(x) pos[xv==x])
to.add = cumsum(sapply(xv, max) + 1000)
bp <- c(xv[[1]], unlist(lapply(2:length(xv), function(x) xv[[x]] + to.add[x-1])))
plot (bp,yv, pch = "*", col = colrs)
I have few issues in this plot I could not figure out.
(1) I want to use different color for different group or two different color for different groups (i.e xv), but when I tried color function in terms to be beautiful mixture. Although I need to highlight some points (for example bp 4000 to 4500 for example with blue color)
(2) Instead of bp positions I want to put a tick mark and label with the group.
Thank you, appreciate your help.
Edits: with help of the following answer (with slight different approach in case I have unbalanced number in each group will work) I could get the similar plot. But still question remaining regarding colors is what if I want to use two alternate colors in alternate group ?
You can solve your colour issue by repeating the colour index however many times each group has a point plotted, like so:
plot (bp,yv, pch = "*", col = rep(colrs,each=2000))
The default colour palette (see ?palette or palette() ) will wrap around itself and you might want to specify your own to get 20 distinct colours.
To relabel the x axis, try plotting without the axis and then specifying the points and labels manually.
plot (bp,yv, pch = "*", col = rep(colrs,each=2000),xaxt="n")
axis(1,at=seq(1000,58000,3000),labels=1:20)
If you are trying to squeeze a lot of labels in there, you might have to shrink the text (cex.axis)or spin the labels 90 degrees (las=2).
plot (bp,yv, pch = "*", col = rep(colrs,each=2000),xaxt="n")
axis(1,at=seq(1000,58000,3000),labels=1:20,cex.axis=0.7,las=2)
Result:
One way is you could use a nested ifelse.
I'm still learning R, but one way it could be done would look something like:
plot(whatev$x, whatev$y, col=ifelse(xv<2000,red,ifelse(2000<xv & xv<4000,yellow,blue)))
You could nest as many of these as you want to have specificity on the colors and the intervals. The ifelse command is of form ifelse(TEST, True, False).
A simpler way would be to use the unique groups in xv to assign rainbow colors.
colrs=rainbow(length(unique(xv))) #Or colrs=rainbow(length(xv)) if xv is unique.
plot(whatev$x, whatev$y, col=colrs)
I hope I got all that right. I'm still learning R myself.
I'm going to go out on a limb and guess that your real data are something like 2000 values of things from 20 different groups. For instance, heights of 2000 plants of 20 different species. In such a case, you might want to look at the dotplot() function (or as illustrated below, dotplot.table()) in the lattice package.
Generate matrix of hypothetical values:
set.seed(1)
myY <- sapply( seq_len(20), function(x) rnorm(2000, x^(1/3)))
Transpose matrix to get groups as rows
myY <- t(myY)
Provide names of groups to matrix:
dimnames(myY)[[1]]<-paste("group", seq_len(nrow(myY)))
Load lattice package
library(lattice)
Generate dotplot
dotplot(myY, horizontal = FALSE, panel = function(x, y, horizontal, ...) {
panel.dotplot(x = x, y = y, horizontal = horizontal, jitter.x = TRUE,
col = seq_len(20)[x], pch = "*", cex = 1.5)
}, scales = list(x = list(rot = 90))
)
Which looks like (with unfortunate y-axis labeling):
Seeing that #JohnCLK is requesting a way of colouring by values on the x axis, I tried these demos in ggplot2-- each uses a dummy variable that is coded based on values or ranges to be highlighted in the other variables.
So, first set up the data, as in the question:
pos <- rep(1:2000, 20)
xv <- c(rep(1:20, each = 2000))
yv <- (2000*20, 0.5, 0.1)
xv <- lapply(unique(xv), function(x) pos[xv==x])
to.add <- cumsum(sapply(xv, max) + 1000)
bp <- c(xv[[1]], unlist(lapply(2:length(xv), function(x) xv[[x]] + to.add[x-1])))
Then load ggplot2, prepare a couple of utility functions, and set the default theme:
library("ggplot2")
make.png <- function(p, fName) {
png(fName, width=640, height=480, units="px")
print(p)
dev.off()
}
make.plot <- function(df) {
p <- ggplot(df,
aes(x = bp,
y = yv,
colour = highlight))
p <- p + geom_point()
p <- p + opts(legend.position = "none")
return(p)
}
theme_set( theme_bw() )
Draw a plot which highlights values in a defined range on the vertical axis:
# highlight a horizontal band
df <- data.frame(cbind(bp, yv))
df$highlight <- 0
df$highlight[ df$yv >= 0.4 & df$yv < 0.45 ] <- 1
p <- make.plot(df)
print(p)
make.png(p, "demo_horizontal.png")
Next draw a plot which highlights values in a defined range on the x axis, a vertical band:
# highlight a vertical band
df$highlight <- 0
df$highlight[ df$bp >= 38000 & df$bp < 42000 ] <- 1
p <- make.plot(df)
print(p)
make.png(p, "demo_vertical.png")
And finally draw a plot which highlights alternating vertical bands, by x value:
# highlight alternating bands
library("gtools")
alt.band.width <- 2000
df$highlight <- as.integer(df$bp / alt.band.width)
df$highlight <- ifelse(odd(df$highlight), 1, 0)
p <- make.plot(df)
print(p)
make.png(p, "demo_alternating.png")
Hope this helps; it was good practice anyway.