Related
I would like an official source for drawing the relief over a map of Switzerland.
I downloaded https://cms.geo.admin.ch/ogd/topography/DHM25_BM_SHP.zip to use the dhm25_p.shp-File
Now using the code
aux <- st_read(dsn="dhm25_p.shp")
auxx <- as_Spatial(aux)
auxxx <- as.data.frame(auxx)
ggplot() +
# draw the relief
geom_raster(
data = auxxx,
inherit.aes = FALSE,
aes(
x = coords.x1,
y = coords.x2,
alpha = coords.x3
)
)
I'll get the error
Error in `geom_raster()`:
! Problem while converting geom to grob.
ℹ Error occurred in the 1st layer.
Caused by error:
! cannot allocate vector of size 6539542.5 Gb
A shapefile of points is generally not a good source for mapping continuous phenomena such as elevation. It is better to use raster data.
Here is a simple way to make an elevation map for Switzerland
library(terra)
library(geodata)
x <- geodata::elevation_30s("Switzerland", ".")
plot(x)
Add contour lines
v <- as.contour(x, levels=c(500,1000,3000))
lines(v)
Or show shaded relief
slope <- terrain(x, "slope", unit="radians")
aspect <- terrain(x, "aspect", unit="radians")
hill <- shade(slope, aspect, 40, 270)
plot(hill, col=gray(seq(0,1,.01)), legend=F, axes=F, mar=1)
To show relief and elevation
plot(hill, col=gray(seq(0,1,.01)), legend=F, axes=F)
plot(x, col=terrain.colors(25, alpha=.5), add=T, axes=F, legend=T)
You can do the same things with the Swiss government data from the website you point to in your (now hidden) answer. But it takes some more work if you want to remove the areas outside of Switzerland.
y <- rast("DHM200.asc")
# Assign the coordinate reference system (Landesvermessung 1903)
crs(y) <- "EPSG:21781"
# get the outline of the country and project it to the crs of the raster data
swz <- geodata::gadm("Switzerland", level=1, path=".")
pswz <- project(swz, y)
# remove values for areas outside of Switzerland
y <- mask(y, pswz)
plot(y)
lines (pswz)
And with ggplot you can use geom_spatraster
library(tidyterra)
library(ggplot2)
ggplot() + geom_spatraster(data = y)
For posterity, leveranging also on MPB_2022 and Robert, see how you can replicate the same map using ggplot2 + tidyterra (as explained in detail in https://dieghernan.github.io/202210_tidyterra-hillshade/):
library(terra)
library(geodata)
library(tidyterra)
library(ggplot2)
x <- geodata::elevation_30s("Switzerland", ".")
slope <- terrain(x, "slope", unit = "radians")
aspect <- terrain(x, "aspect", unit = "radians")
hill <- shade(slope, aspect, 40, 270)
# Hillshading, but we need a vector of colors
pal_greys <- hcl.colors(1000, "Grays")
# Get a vector of colors based on the value of shades
# Create index
hill_col <- hill %>%
# Rename layer
select(shades = 1) %>%
mutate(index_col = round(scales::rescale(shades, to = c(1, length(pal_greys))))) %>%
pull(index_col) %>%
pal_greys[.]
head(unique(hill_col), 10)
# Plot
ggplot() +
# Add our hill shade and use fill with the vector color
geom_spatraster(data = hill, fill = hill_col, maxcell = Inf, alpha = 1) +
# And add the initial raster with some alpha
geom_spatraster(data = x) +
# Add an hypstometric tint
scale_fill_hypso_tint_c(
palette = "dem_poster",
# Need alpha to show the hill
alpha = 0.5 ) +
theme_minimal() +
labs(fill="Elevation")
I am trying to plot in R a raster layer with lines/polygon objects in R and each time I fail miserably with errors. I tried to do this in base R, ggplot2 and using levelplot but can't get the right result.
Source data can be found here.
What I need to do in the plot (all in one plot) is to:
1) zoom in a certain area defined as NIG. T
2) Display raster r values on a scale with cuts intervals.
3) Plot the country boundaries(shpAfr in base R and ggplot2 or world.outlines.spin levelplot). 4) Finally, include shpWater polygon layer (with col="blue" fill and contours).
library(raster)
library(maptools)
library(rasterVis)
library(viridis)
library(sf)
library(rgdal)
library(ggplot2)
r <- raster("raster_example.tif")
crs(r) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +to wgs84=0,0,0"
NIG <- c(2,14.5,4,14)
Reg_name <- "Nigeria"
shpAfr <- readOGR(dsn="Africa.shp")
proj4string(shpAfr) # describes data’s current coordinate reference system
#st_read(system.file("shape/nc.shp", package="sf"))
# Import water polygon
shpWater <- readOGR(dsn="waterbodies_africa.shp")
shpWater.count <- nrow(shpWater#data)
shpWater$id <- 1:shpWater.count
shpWater.fort <- fortify(shpWater, region='id')
# Import Africa admin map
shpAfr <- readOGR(dsn="Africa.shp")
shpAfr.count <- nrow(shpAfr#data)
shpAfr$id <- 1:shpAfr.count
shpAfr.fort <- fortify(shpAfr, region='id')
# Set colour intervals for plotting:
cuts=seq(0,1,0.1) #set breaks
Trying in base R, my problem is I can get the water shape fill in the right colour (fill and contour should be blue). If I try to plot both wrld_simpl and shpWater as polygon() I get into even bigger troubles.
plot(r, xlim = NIG[1:2], ylim = NIG[3:4],
breaks=cuts, col = rev(plasma(11)))
lines(wrld_simpl,lwd = 1.5)
lines(shpWater, col="blue") # works but cannot fill the polygon
polygon(shpWater, col = "blue", border = "blue") # getting error here
Error in as.double(y) :
cannot coerce type 'S4' to vector of type 'double'
Ok, so now I try ggplot2, but I can't find a way to include a raster here without getting an error.
lon <- seq(r#extent#xmin,r#extent#xmax,
(r#extent#xmax-r#extent#xmin)/r#ncols)
lat <- seq(r#extent#ymin,r#extent#ymax,
(r#extent#ymax-r#extent#ymin)/r#nrows)
Plot1 <- ggplot()+
geom_polygon(aes(x = long, y = lat, group=id),
data = shpAfr.fort, color ="grey27", fill ="grey",
alpha = .4, size = .2)+
geom_raster(data = test, aes(fill=values))+ ## here it goes bad
#geom_tile(data=test_df, aes(x=x, y=y, fill=value), alpha=0.8) +
#scale_fill_viridis() +
geom_polygon(aes(x = long, y = lat, group=id),
data = shpWater.fort, color ="lightskyblue2", fill ="lightskyblue2",
size = .2)+coord_equal()+
theme_minimal()+
coord_map(xlim = Region[[3]][1:2],ylim = Region[[3]][3:4])
plot(Plot1)
Finally, I tried the levelplot and AGAIN failed.
mapTheme <- rasterTheme(region = rev(brewer.pal(10, "RdBu")))
# Get world outlines:
world.outlines <- map("world", plot=FALSE)
world.outlines.sp <- map2SpatialLines(world.outlines, proj4string = CRS("+proj=longlat"))
# Plot raster and polygon:
Plot2 <- levelplot(r,par.settings = mapTheme,pretty=TRUE,margin = F,
xlim = NIG[1:2],ylim = NIG[3:4],
col.regions=colorRampPalette(c("light blue","blue", "red")),
main=paste0("test")) + layer(sp.lines(world.outlines.sp, col = "black", lwd = 0.5))
plot(Plot2 + layer(sp.lines(world.outlines.sp, col = "black", lwd = 0.5))
#Error: Attempted to create layer with no stat.
My results so far:
1) first image does not have the polygons filled with blue
2) second image has clearly world outlines not in the right location
:
You would have probably have had answers a lot earlier if you had made a simple reprex, e.g. like this
library(raster)
r <- raster(res=1/12)
values(r) <- sample(100, ncell(r), replace=TRUE)
filename <- system.file("external/lux.shp", package="raster")
v <- shapefile(filename)
zoom in a certain area
One way to zoom is to use crop (alternatively use the ext argument in plot)
x <- crop(r, v)
Display raster r values on a scale with cuts intervals
cuts <- c(0,20,60,100)
plot(x, breaks=cuts, col=rainbow(3))
or
y <- cut(x, cuts)
Plot the country boundaries
lines(v)
Finally, include polygon layer (with col="blue" fill and contours).
plot(v[c(1,3),], col="blue", border="red", lwd=2, add=TRUE)
6 months later but I feel this question. My two thoughts are (1) I have had luck with plotting geom_sf and geom_stars together. You have to change your raster to a df before changing to a geom_stars. and (2) regardless of method, you need all datasets in the same projection - check with crs() and set all to the same with st_transform()
I didn't actually test this with your data but something like:
make raster into a df
test.df = as.data.frame (test, xy=TRUE) # Convert to data.frame, keeping the
coordinates
class(test.df)
convert to geom_stars
test.stars = st_as_stars(test.df)
try your plot
Plot1 <- ggplot()+
geom_stars(data = test, aes(fill=values))+ #need to plot raster first I think?
scale_fill_identity( name = "", breaks = cuts,labels = "")+
geom_sf(data = shpAfr.fort, color ="grey27", size = .2)+
geom_sf(data = shpWater.fort, color ="lightskyblue2", fill
="lightskyblue2", size = .2)+
theme_minimal()+
coord_sf( xlim = NIG[1:2], ylim = NIG[3:4]),expand = FALSE)
Plot1
I need to produce a lattice xyplot and fit it in a 8 cm x 8 cm pdf document.
I already made this plot. It is perfectly proportional on a 7 in x 7 in graph. I have been trying to scale it proportionally to a 8 cm x 8 cm graph, but with little success: the command "scales" works only on axis font label (but not on ticks length for instance), a standard "cex" in the xyplot works only on symbol size. I'd like to scale proportionally the whole plot (distance of labels from axis, tick lengths, legend etc...).
Thanks!
Here is a possible code:
# libraries
library(lattice)
library(grid)
library(RColorBrewer)
#creating dataset
x <- rnorm(100,10,3)
y <- rnorm(100,3,10)
z <- seq(1,100)
data <- data.frame(x,y)
data$z <- z
data$col <- heat.colors(100)
#making well scaled plot
pdf("plot.pdf")
my.legend <- packGrob(
draw.colorkey(key=list(col = heat.colors,at = do.breaks(range(data$z,na.rm=T),100))),
textGrob(expression(paste("z (no units)")), x = -.3, y = 0.5, just = c("left", "centre")),
height=unit(2, "lines"),side="top", dynamic=T)
xyplot(y~x, data, aspect="fill", type=c("p","g"), pch=21, col=grey(.2), fill=data$col, xlab=list(label=expression(paste("x axis label"[bla],", ",mu,"-"))),ylab=list(label=expression(paste("y axis label"[bla],", ",mu,"-"))),
legend=list(right=list(fun=my.legend)),
panel=function(x,y,...){
panel.xyplot(x,y,...)
}
)
dev.off()
#trying to make a 8cm x 8cm plot
pdf("plot_small.pdf",width=8/2.54,height=8/2.54)
my.legend <- packGrob(
draw.colorkey(key=list(col = heat.colors,at = do.breaks(range(data$z,na.rm=T),100))),
textGrob(expression(paste("z (no units)")), x = -.3, y = 0.5, just = c("left", "centre")),
height=unit(2, "lines"),side="top", dynamic=T)
xyplot(y~x, data, aspect="fill", type=c("p","g"), pch=21, col=grey(.2), fill=data$col, cex=.5, xlab=list(label=expression(paste("x axis label"[bla],", ",mu,"-")),cex=.5),ylab=list(label=expression(paste("y axis label"[bla],", ",mu,"-")),cex=.5),
legend=list(right=list(fun=my.legend)),
panel=function(x,y,...){
panel.xyplot(x,y,...)
},
scales=list(cex=.5)
)
dev.off()
I want to plot a 3D plot using R. My data set is independent, which means the values of x, y, and z are not dependent on each other. The plot I want is given in this picture:
This plot was drawn by someone using MATLAB. How can I can do the same kind of Plot using R?
Since you posted your image file, it appears you are not trying to make a 3d scatterplot, rather a 2d scatterplot with a continuous color scale to indicate the value of a third variable.
Option 1: For this approach I would use ggplot2
# make data
mydata <- data.frame(x = rnorm(100, 10, 3),
y = rnorm(100, 5, 10),
z = rpois(100, 20))
ggplot(mydata, aes(x,y)) + geom_point(aes(color = z)) + theme_bw()
Which produces:
Option 2: To make a 3d scatterplot, use the cloud function from the lattice package.
library(lattice)
# make some data
x <- runif(20)
y <- rnorm(20)
z <- rpois(20, 5) / 5
cloud(z ~ x * y)
I usually do these kinds of plots with the base plotting functions and some helper functions for the color levels and color legend from the sinkr package (you need the devtools package to install from GitHib).
Example:
#library(devtools)
#install_github("marchtaylor/sinkr")
library(sinkr)
# example data
grd <- expand.grid(
x=seq(nrow(volcano)),
y=seq(ncol(volcano))
)
grd$z <- c(volcano)
# plot
COL <- val2col(grd$z, col=jetPal(100))
op <- par(no.readonly = TRUE)
layout(matrix(1:2,1,2), widths=c(4,1), heights=4)
par(mar=c(4,4,1,1))
plot(grd$x, grd$y, col=COL, pch=20)
par(mar=c(4,1,1,4))
imageScale(grd$z, col=jetPal(100), axis.pos=4)
mtext("z", side=4, line=3)
par(op)
Result:
How to fill area under and above (sp)line with gradient color?
This example has been drawn in Inkscape - BUT I NEED vertical gradient - NOT horizontal.
Interval from zero to positive == from white to red.
Interval from zero to negative == from white to red.
Is there any package which could do this?
I fabricated some source data....
set.seed(1)
x<-seq(from = -10, to = 10, by = 0.25)
data <- data.frame(value = sample(x, 25, replace = TRUE), time = 1:25)
plot(data$time, data$value, type = "n")
my.spline <- smooth.spline(data$time, data$value, df = 15)
lines(my.spline$x, my.spline$y, lwd = 2.5, col = "blue")
abline(h = 0)
And here's an approach in base R, where we fill the entire plot area with rectangles of graduated colour, and subsequently fill the inverse of the area of interest with white.
shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...) {
# x, y: the x and y coordinates
# col: a vector of colours (hex, numeric, character), or a colorRampPalette
# n: the vertical resolution of the gradient
# ...: further args to plot()
plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
e <- par('usr')
height <- diff(e[3:4])/(n-1)
y_up <- seq(0, e[4], height)
y_down <- seq(0, e[3], -height)
ncolor <- max(length(y_up), length(y_down))
pal <- if(!is.function(col)) colorRampPalette(col)(ncolor) else col(ncolor)
# plot rectangles to simulate colour gradient
sapply(seq_len(n),
function(i) {
rect(min(x), y_up[i], max(x), y_up[i] + height, col=pal[i], border=NA)
rect(min(x), y_down[i], max(x), y_down[i] - height, col=pal[i], border=NA)
})
# plot white polygons representing the inverse of the area of interest
polygon(c(min(x), x, max(x), rev(x)),
c(e[4], ifelse(y > 0, y, 0),
rep(e[4], length(y) + 1)), col='white', border=NA)
polygon(c(min(x), x, max(x), rev(x)),
c(e[3], ifelse(y < 0, y, 0),
rep(e[3], length(y) + 1)), col='white', border=NA)
lines(x, y)
abline(h=0)
box()
}
Here are some examples:
xy <- curve(sin, -10, 10, n = 1000)
shade(xy$x, xy$y, c('white', 'blue'), 1000)
Or with colour specified by a colour ramp palette:
shade(xy$x, xy$y, heat.colors, 1000)
And applied to your data, though we first interpolate the points to a finer resolution (if we don't do this, the gradient doesn't closely follow the line where it crosses zero).
xy <- approx(my.spline$x, my.spline$y, n=1000)
shade(xy$x, xy$y, c('white', 'red'), 1000)
Here's one approach, which relies heavily on several R spatial packages.
The basic idea is to:
Plot an empty plot, the canvas onto which subsequent elements will be laid down. (Doing this first also lets you retrieve the user coordinates of the plot, needed in subsequent steps.)
Use a vectorized call to rect() to lay down a background wash of color. Getting the fiddly details of the color gradient is actually the trickiest part of doing this.
Use topology functions in rgeos to find first the closed rectangles in your figure, and then their complement. Plotting the complement with a white fill over the background wash covers up the color everywhere except within the polygons, just what you want.
Finally, use plot(..., add=TRUE), lines(), abline(), etc. to lay down whatever other details you'd like the plot to display.
library(sp)
library(rgeos)
library(raster)
library(grid)
## Extract some coordinates
x <- my.spline$x
y <- my.spline$y
hh <- 0
xy <- cbind(x,y)
## Plot an empty plot to make its coordinates available
## for next two sections
plot(data$time, data$value, type = "n", axes=FALSE, xlab="", ylab="")
## Prepare data to be used later by rect to draw the colored background
COL <- colorRampPalette(c("red", "white", "red"))(200)
xx <- par("usr")[1:2]
yy <- c(seq(min(y), hh, length.out=100), seq(hh, max(y), length.out=101))
## Prepare a mask to cover colored background (except within polygons)
## (a) Make SpatialPolygons object from plot's boundaries
EE <- as(extent(par("usr")), "SpatialPolygons")
## (b) Make SpatialPolygons object containing all closed polygons
SL1 <- SpatialLines(list(Lines(Line(xy), "A")))
SL2 <- SpatialLines(list(Lines(Line(cbind(c(0,25),c(0,0))), "B")))
polys <- gPolygonize(gNode(rbind(SL1,SL2)))
## (c) Find their difference
mask <- EE - polys
## Put everything together in a plot
plot(data$time, data$value, type = "n")
rect(xx[1], yy[-201], xx[2], yy[-1], col=COL, border=NA)
plot(mask, col="white", add=TRUE)
abline(h = hh)
plot(polys, border="red", lwd=1.5, add=TRUE)
lines(my.spline$x, my.spline$y, col = "red", lwd = 1.5)
Another possibility which uses functions from grid and gridSVG packages.
We start by generating additional data points by linear interpolation, according to methods described by #kohske here. The basic plot will then consist of two separate polygons, one for negative values and one for positive values.
After the plot has been rendered, grid.ls is used to show a list of grobs, i.e. all building block of the plot. In the list we will (among other things) find two geom_area.polygons; one representing the polygon for values <= 0, and one for values >= 0.
The fill of the polygon grobs is then manipulated using gridSVG functions: custom color gradients are created with linearGradient, and the fill of the grobs are replaced using grid.gradientFill.
The manipulation of grob gradients is nicely described in chapter 7 in the MSc thesis of Simon Potter, one of the authors of the gridSVG package.
library(grid)
library(gridSVG)
library(ggplot2)
# create a data frame of spline values
d <- data.frame(x = my.spline$x, y = my.spline$y)
# create interpolated points
d <- d[order(d$x),]
new_d <- do.call("rbind",
sapply(1:(nrow(d) -1), function(i){
f <- lm(x ~ y, d[i:(i+1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata = data.frame(y = 0))
if(d[i, ]$x < r & r < d[i+1, ]$x)
return(data.frame(x = r, y = 0))
else return(NULL)
})
)
# combine original and interpolated data
d2 <- rbind(d, new_d)
d2
# set up basic plot
ggplot(data = d2, aes(x = x, y = y)) +
geom_area(data = subset(d2, y <= 0)) +
geom_area(data = subset(d2, y >= 0)) +
geom_line() +
geom_abline(intercept = 0, slope = 0) +
theme_bw()
# list the name of grobs and look for relevant polygons
# note that the exact numbers of the grobs may differ
grid.ls()
# GRID.gTableParent.878
# ...
# panel.3-4-3-4
# ...
# areas.gTree.834
# geom_area.polygon.832 <~~ polygon for negative values
# areas.gTree.838
# geom_area.polygon.836 <~~ polygon for positive values
# create a linear gradient for negative values, from white to red
col_neg <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(1, "npc"), y1 = unit(0, "npc"))
# replace fill of 'negative grob' with a gradient fill
grid.gradientFill("geom_area.polygon.832", col_neg, group = FALSE)
# create a linear gradient for positive values, from white to red
col_pos <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
# replace fill of 'positive grob' with a gradient fill
grid.gradientFill("geom_area.polygon.836", col_pos, group = FALSE)
# generate SVG output
grid.export("myplot.svg")
You could easily create different colour gradients for positive and negative polygons. E.g. if you want negative values to run from white to blue instead, replace col_pos above with:
col_pos <- linearGradient(col = c("white", "blue"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
This is a terrible way to trick ggplot into doing what you want. Essentially, I make a giant grid of points that are under the curve. Since there is no way of setting a gradient within a single polygon, you have to make separate polygons, hence the grid. It will be slow if you set the pixels too low.
gen.bar <- function(x, ymax, ypixel) {
if (ymax < 0) ypixel <- -abs(ypixel)
else ypixel <- abs(ypixel)
expand.grid(x=x, y=seq(0,ymax, by = ypixel))
}
# data must be in x order.
find.height <- function (x, data.x, data.y) {
base <- findInterval(x, data.x)
run <- data.x[base+1] - data.x[base]
rise <- data.y[base+1] - data.y[base]
data.y[base] + ((rise/run) * (x - data.x[base]))
}
make.grid.under.curve <- function(data.x, data.y, xpixel, ypixel) {
desired.points <- sort(unique(c(seq(min(data.x), max(data.x), xpixel), data.x)))
desired.points <- desired.points[-length(desired.points)]
heights <- find.height(desired.points, data.x, data.y)
do.call(rbind,
mapply(gen.bar, desired.points, heights,
MoreArgs = list(ypixel), SIMPLIFY=FALSE))
}
xpixel = 0.01
ypixel = 0.01
library(scales)
grid <- make.grid.under.curve(data$time, data$value, xpixel, ypixel)
ggplot(grid, aes(xmin = x, ymin = y, xmax = x+xpixel, ymax = y+ypixel,
fill=abs(y))) + geom_rect()
The colours aren't what you wanted, but it is probably too slow for serious use anyway.