I'm a beginner to R and I am trying to plot a surface plot on a specific grid. Basically I have a data-set of points from across the UK containing the longitude, latitude and amount of rainfall for a particular day. Using the following code I can plot this data onto a UK map:
dat <- read.table("~jan1.csv", header=T, sep=",")
names(dat) <- c("gauge", "date", "station", "mm", "lat", "lon", "location", "county", "days")
library(fields)
quilt.plot(cbind(dat$lon,dat$lat),dat$mm)
world(add=TRUE)
So far so good. I can also perform a thin plate spline interpolation (TPS) using:
fit <- Tps(cbind(dat$lon, dat$lat), dat$mm, scale.type="unscaled")
and then I can do a surface plot at a grid scale of my choice e.g.:
surface (fit, nx=100, ny=100)
This effectively gives me a gridded data plot at the resolution of 100*100.
Following help from another user I can now extract this data in a grid by using:
xvals <- seq(-10, 4, len=20)
yvals <- seq(49, 63, len=20)
griddf <- expand.grid(xvals, yvals)
griddg <- predict(fit, x=as.matrix(griddf) )
What I would like to do now is plot the surface plot again using the same grid as the predict function (i.e. same as xvals and yvals) as above? Do you know how I can do this?
Thanks for any help
Once you have predicted your new values in griddg, you can technically re-interpolate with Tps and then proceed with the surface plot and map as before:
Example:
xvals <- seq(-10, 4, len=20)
yvals <- seq(49, 63, len=20)
griddf <- expand.grid(lon=xvals, lat=yvals)
griddg <- predict(fit, x=as.matrix(griddf) )
dat2 <- cbind(griddf, mm=griddg)
head(dat2)
fit <- Tps(cbind(dat2$lon, dat2$lat), dat2$mm, scale.type="unscaled")
surface (fit, nx=100, ny=100)
world(add=TRUE)
For more control over your maps, you could also plot your new grid directly - This is probably more correct in that the above method essentially fits your interpolation Tps twice. This method requires some external functions, but you will have more flexibility in your mapping.
#option 2
source("matrix.poly.r") #http://menugget.blogspot.de/2012/04/create-polygons-from-matrix.html
source("val2col.R") # http://menugget.blogspot.de/2011/09/converting-values-to-color-levels.html
source("image.scale.R") # http://menugget.blogspot.de/2011/08/adding-scale-to-image-plot.html
#new grid and predition
xvals <- seq(-10, 4, len=100)
yvals <- seq(49, 63, len=100)
griddf <- expand.grid(lon=xvals, lat=yvals)
griddg <- predict(fit, x=as.matrix(griddf) )
#make polygons for new grid, calculate color levels
mat <- matrix(griddg, nrow=length(xvals), ncol=length(yvals))
poly <- matrix.poly(xvals, yvals, z=mat, n=seq(mat))
pal <- colorRampPalette(c("blue", "cyan", "yellow", "red"))
COL <- val2col(mat, col=pal(100))
#required packages
library(maps)
library(mapproj)
#plot
png("tmp.png", width=5, height=4, res=400, units="in")
layout(matrix(1:2, nrow=1, ncol=2), widths=c(4,1), heights=4)
par(mar=c(1,1,1,1))
map("world", proj="stereographic", orient=c(mean(yvals),mean(xvals),0), par=NULL, t="n", xlim=range(xvals), ylim=range(yvals))
for(i in seq(poly)){
polygon(mapproject(poly[[i]]), col=COL[i], border=COL[i], lwd=0.3)
}
map("world", proj="stereographic", orient=c(mean(yvals),mean(xvals),0), par=NULL, add=T)
map.grid(col=rgb(0,0,0,0.5), labels=F)
box()
par(mar=c(5,0,5,4))
image.scale(mat, col=pal(100), horiz=FALSE, axes=FALSE, xlab="", ylab="")
axis(4)
mtext("mm", side=4, line=2.5)
box()
dev.off()
Related
I am plotting polygon using R
yy<-c(1217,2343,3255,2129)
xx<-c(61587690.5,61588253.5,61587797.5,61587234.5)
polygon(xx, yy, col="gray", border = "red")
But i want to add 100000 polygon plots to the same chart. How can i add all into one chart.
Here's an example using a list of lists of coordinates. It plots all polygons in the same plot (I leave the question of how discernible they are to you...)
#generate some data
set.seed(123)
n=10
#each 'polygon' is inside a list with xx and yy coordinates
dat <- lapply(1:n,function(x){
res <- list(xx=c(1,2,3,2)+rnorm(4),
yy=c(1,2,3,2)+rnorm(4))
return(res)
})
#create empty plot
plot(0:5,0:5,type='n')
#add polygons
lapply(dat,function(x){polygon(x$xx,x$yy,col="gray",border="red")})
for 2 polygons:
yy<-c(1217,2343,3255,2129)
xx<-c(61587690.5,61588253.5,61587797.5,61587234.5)
plot(xx,yy, type='n')
# plot(0,0, type='n', xlim=c(-5, 5), ylim=c(-200, 100)) # an other plot region
polygon(xx, yy, col="gray", border = "red")
xx <- xx+500
yy <- yy+500
polygon(xx, yy, col="gray", border = "red")
I have acquired some data at a fixed distance R and for various theta (from the vertical axis) and phi (from the x axis) angles so to obtain a 3D representation of the quantity of interest. Please note that while phi spans 360°, theta only spans from 70° to 90°.
I know how to generate a 3D plot with the plot3D package (namely, the persp3D function) or a contour plot, but I would like to draw such contours over a sphere using the theta and phi angles information.
Would you please point me to the appropriate online resource where I can find a suitable solution?
Many thanks and kind regards
Nicola
This isn't exactly a 3d representation (e.g. in rgl), but maybe it gets you started:
library(maps)
library(mapproj)
library(akima)
set.seed(11)
n <- 500
x <- runif(n, min=-180,max=180)
y <- runif(n, min=-90,max=90)
z <- x^2+y^3
PARAM <- NULL
PROJ <- "orthographic"
ORIENT <- c(45,15,0)
XLIM <- c(-180, 180)
YLIM <- c(-90, 90)
nlevels=20
pal <- colorRampPalette(
c("purple4", "blue", "cyan", "yellow", "red", "pink"))
map("world", col=NA, param=PARAM, proj=PROJ, orient=ORIENT, xlim=XLIM, ylim=YLIM)
P <- mapproject(x,y)
incl <- which(!is.na(P$x))
Field <- interp(P$x[incl],P$y[incl],z[incl],
xo=seq(min(P$x[incl]), max(P$x[incl]), length = 100),
yo=seq(min(P$y[incl]), max(P$y[incl]), length = 100)
)
image(Field, add=TRUE, col=pal(nlevels))
points(P$x, P$y, pch=".", cex=2, col=4)
Cont <- contour(Field, add=TRUE, n=nlevels, col="white")
lines(sin(seq(0,2*pi,,100)), cos(seq(0,2*pi,,100)), lwd=3)
I have 7 different categories per each value in X. I am using barplot to plot these categories. Such graph looks fine in colors printer, but what if I want it to be fine in black & white. You can check the graph below. I want to have different colors texture, so the graph looks good in color and black & white printer.
I used densities = c(10,30,40,50,100,60,80) for density parameter in barplot function. Are there any other ways to do different texture in barplot?
Note: I tried the angle value in barplot. However, it isn't a good solution in that case, since not all bars have high values (i.e height of the bar).
Along the lines of my comment, you might find the following helpful:
# data generation ---------------------------------------------------------
set.seed(1)
mat <- matrix(runif(4*7, min=0, max=10), 7, 4)
rownames(mat) <- 1:7
colnames(mat) <- LETTERS[1:4]
# plotting settings -------------------------------------------------------
ylim <- range(mat)*c(1,1.5)
angle1 <- rep(c(45,45,135), length.out=7)
angle2 <- rep(c(45,135,135), length.out=7)
density1 <- seq(5,35,length.out=7)
density2 <- seq(5,35,length.out=7)
col <- 1 # rainbow(7)
# plot --------------------------------------------------------------------
op <- par(mar=c(3,3,1,1))
barplot(mat, beside=TRUE, ylim=ylim, col=col, angle=angle1, density=density1)
barplot(mat, add=TRUE, beside=TRUE, ylim=ylim, col=col, angle=angle2, density=density2)
legend("top", legend=1:7, ncol=7, fill=TRUE, col=col, angle=angle1, density=density1)
par(bg="transparent")
legend("top", legend=1:7, ncol=7, fill=TRUE, col=col, angle=angle2, density=density2)
par(op)
I'm doing PCA and I would like to plot first principal component vs second in R:
pca<-princomp(~.,data=data, na.action=na.omit
plot(pca$scores[,1],pca$scores[,2])
or maybe several principal components:
pairs(pca$scores[,1:4])
however the points are black. How do I appropriately add color to the graphs? How many colors do I need? One for each principal component I am plotting? Or one for each row in my data matrix?
Thanks
EDIT:
my data looks like this:
> data[1:4,1:4]
patient1 patient2 patient3 patient4
2'-PDE 0.0153750 0.4669375 -0.0295625 0.7919375
7A5 2.4105000 0.3635000 1.8550000 1.4080000
A1BG 0.9493333 0.2798333 0.7486667 0.7500000
A2M 0.2420000 1.0385000 1.1605000 1.6777500
So would this be appropriate:
plot(pca$scores[,1:4], pch=20, col=rainbow(dim(data)[1]))
Here are some example plots of PCA. Taken from the here.
z1 <- rnorm(10000, mean=1, sd=1); z2 <- rnorm(10000, mean=3, sd=3); z3 <- rnorm(10000, mean=5, sd=5); z4 <- rnorm(10000, mean=7, sd=7); z5 <- rnorm(10000, mean=9, sd=9); mydata <- matrix(c(z1, z2, z3, z4, z5), 2500, 20, byrow=T, dimnames=list(paste("R", 1:2500, sep=""), paste("C", 1:20, sep="")))
summary(pca)
summary(pca)$importance[, 1:6]
x11(height=6, width=12, pointsize=12); par(mfrow=c(1,2))
mycolors <- c("red", "green", "blue", "magenta", "black") # Define plotting colors. plot(pca$x, pch=20, col=mycolors[sort(rep(1:5, 500))])
plot(pca$x, type="n"); text(pca$x, rownames(pca$x), cex=0.8, col=mycolors[sort(rep(1:5, 500))])
You can use pairs
pairs(pca$x[,1:5], col = mycolors)
Plots a scatter plot for the first two principal components plus the corresponding eigen vectors that are stored in pca$rotation.
library(scatterplot3d)
scatterplot3d(pca$x[,1:3], pch=20, color=mycolors[sort(rep(1:5, 500))])
Same as above, but plots the first three principal components in 3D scatter plot.
library(rgl); rgl.open(); offset <- 50; par3d(windowRect=c(offset, offset, 640+offset, 640+offset)); rm(offset); rgl.clear(); rgl.viewpoint(theta=45, phi=30, fov=60, zoom=1); spheres3d(pca$x[,1], pca$x[,2], pca$x[,3], radius=0.3, color=mycolors, alpha=1, shininess=20); aspect3d(1, 1, 1); axes3d(col='black'); title3d("", "", "PC1", "PC2", "PC3", col='black'); bg3d("
The later creates an interactive 3D scatter plot with Open GL. The rgl library needs to be installed for this. To save a snapshot of the graph, one can use the command rgl.snapshot("test.png").
require(GGally)
ggpairs(pca$x[,1:5])
have some data that I would like to add "stippling" to show where it is "important", as they do in the IPCC plots
At the moment I am really struggling with trying to do this in R.
If I make up some test data and plot it:
data <- array(runif(12*6), dim=c(12,6) )
over <- ifelse(data > 0.5, 1, 0 )
image(1:12, 1:6, data)
What I would like to finally do is over-plot some points based on the array "over" on top of the current image.
Any suggestions!??
This should help - I had do do a similar thing before and wrote a function that I posted here.
#required function from www.menugget.blogspot.com
matrix.poly <- function(x, y, z=mat, n=NULL){
if(missing(z)) stop("Must define matrix 'z'")
if(missing(n)) stop("Must define at least 1 grid location 'n'")
if(missing(x)) x <- seq(0,1,,dim(z)[1])
if(missing(y)) y <- seq(0,1,,dim(z)[2])
poly <- vector(mode="list", length(n))
for(i in seq(length(n))){
ROW <- ((n[i]-1) %% dim(z)[1]) +1
COL <- ((n[i]-1) %/% dim(z)[1]) +1
dist.left <- (x[ROW]-x[ROW-1])/2
dist.right <- (x[ROW+1]-x[ROW])/2
if(ROW==1) dist.left <- dist.right
if(ROW==dim(z)[1]) dist.right <- dist.left
dist.down <- (y[COL]-y[COL-1])/2
dist.up <- (y[COL+1]-y[COL])/2
if(COL==1) dist.down <- dist.up
if(COL==dim(z)[2]) dist.up <- dist.down
xs <- c(x[ROW]-dist.left, x[ROW]-dist.left, x[ROW]+dist.right, x[ROW]+dist.right)
ys <- c(y[COL]-dist.down, y[COL]+dist.up, y[COL]+dist.up, y[COL]-dist.down)
poly[[i]] <- data.frame(x=xs, y=ys)
}
return(poly)
}
#make vector of grids for hatching
incl <- which(over==1)
#make polygons for each grid for hatching
polys <- matrix.poly(1:12, 1:6, z=over, n=incl)
#plot
png("hatched_image.png")
image(1:12, 1:6, data)
for(i in seq(polys)){
polygon(polys[[i]], density=10, angle=45, border=NA)
polygon(polys[[i]], density=10, angle=-45, border=NA)
}
box()
dev.off()
Or, and alternative with "stipples":
png("hatched_image2.png")
image(1:12, 1:6, data)
for(i in seq(polys)){
xran <- range(polys[[i]]$x)
yran <- range(polys[[i]]$y)
xs <- seq(xran[1], xran[2],,5)
ys <- seq(yran[1], yran[2],,5)
grd <- expand.grid(xs,ys)
points(grd, pch=19, cex=0.5)
}
box()
dev.off()
Update:
In (very late) response to Paul Hiemstra's comment, here are two more examples with a matrix of higher resolution. The hatching maintains a nice regular pattern, but it is not nice to look at when broken up. The stippled example is much nicer:
n <- 100
x <- 1:n
y <- 1:n
M <- list(x=x, y=y, z=outer(x, y, FUN = function(x,y){x^2 * y * rlnorm(n^2,0,0.2)}))
image(M)
range(M$z)
incl <- which(M$z>5e5)
polys <- matrix.poly(M$x, M$y, z=M$z, n=incl)
png("hatched_image.png", height=5, width=5, units="in", res=400)
op <- par(mar=c(3,3,1,1))
image(M)
for(i in seq(polys)){
polygon(polys[[i]], density=10, angle=45, border=NA, lwd=0.5)
polygon(polys[[i]], density=10, angle=-45, border=NA, lwd=0.5)
}
box()
par(op)
dev.off()
png("stippled_image.png", height=5, width=5, units="in", res=400)
op <- par(mar=c(3,3,1,1))
image(M)
grd <- expand.grid(x=x, y=y)
points(grd$x[incl], grd$y[incl], pch=".", cex=1.5)
box()
par(op)
dev.off()
Do it using the coordinate positioning mechanism of ?image [1].
data(volcano)
m <- volcano
dimx <- nrow(m)
dimy <- ncol(m)
d1 <- list(x = seq(0, 1, length = dimx), y = seq(0, 1, length = dimy), z = m)
With your 'image' constructed that way you keep the structure with the object, and its
coordinates intact. You can collect multiple matrices into a 3D array or as multiple
elements, but you need to augment image() in order to handle that, so I keep them
separate here.
Make a copy of the data to specify an interesting area.
d2 <- d1
d2$z <- d2$z > 155
Use the coordinates to specify which cells are interesting. This is expensive if you have a very big raster, but it's super easy to do.
pts <- expand.grid(x = d2$x, y = d2$y)
pts$over <- as.vector(d2$z)
Set up the plot.
op <- par(mfcol = c(2, 1))
image(d1)
image(d1)
points(pts$x[pts$over], pts$y[pts$over], cex = 0.7)
par(op)
Don't forget to modify the plotting of points to get different effects, in particular a very dense grid with lots of points will take ages to draw all those little circles. pch = "." is a good choice.
Now, do you have some real data to plot on that nice projection? See examples here for some of the options: http://spatial-analyst.net/wiki/index.php?title=Global_datasets
[1] R has classes for more sophisticated handling of raster data, see package sp and raster
for two different approaches.
This is a solution in the spirit of #mdsummer's comment using ggplot2. I first draw the grid, and then draw +'es at the locations where a certain value has been exceeded. Note that ggplot2 works with data.frame's, not with multi-dimensional arrays or matrices. You can use melt from the reshape package to convert from an array / marix to a data.frame flat structure.
Here is a concrete example using the example data from the geom_tile documentation:
pp <- function (n,r=4) {
x <- seq(-r*pi, r*pi, len=n)
df <- expand.grid(x=x, y=x)
df$r <- sqrt(df$x^2 + df$y^2)
df$z <- cos(df$r^2)*exp(-df$r/6)
df
}
require(ggplot2)
dat = pp(200)
over = dat[,c("x","y")]
over$value = with(dat, ifelse(z > 0.5, 1, 0))
ggplot(aes(x = x, y = y), data = dat) +
geom_raster(aes(fill = z)) +
scale_fill_gradient2() +
geom_point(data = subset(over, value == 1), shape = "+", size = 1)
This is probably coming too late, but I'd like to post my answer as a reference too.
One nice option for spatial data is to use the rasterVis package. Once you have a "base" raster object, and the "mask" object, which you will use to draw the stippling, you can do something like:
require(raster)
require(rasterVis)
# Scratch raster objects
data(volcano)
r1 <- raster(volcano)
# Here we are selecting only values from 160 to 180.
# This will be our "mask" layer.
over <- ifelse(volcano >=160 & volcano <=180, 1, NA)
r2 <- raster(over)
# And this is the key step:
# Converting the "mask" raster to spatial points
r.mask <- rasterToPoints(r2, spatial=TRUE)
# Plot
levelplot(r1, margin=F) +
layer(sp.points(r.mask, pch=20, cex=0.3, alpha=0.8))
which resembles the map that the OP was looking for. Parameters of the points such as color, size and type can be fine tuned. ?sp.points provides all the arguments that can be used to do that.