R: plot circular histograms/rose diagrams on map - r

I am trying to plot rose diagrams/ circular histograms on specific coordinates on a map analogous to drawing pie charts on a map as in the package mapplots.
Below is an example generated with mapplots (see below for code), I'd like to replace the pie charts with rose diagrams
The package circular lets me plot the rose diagrams, but I am unable to integrate it with the mapplots package. Any suggestions for alternative packages or code to achieve this?
In response to the question for the code to make the map. It's all based on the mapplots package. I downloaded a shapefile for the map (I think from http://www.freegisdata.org/)
library(mapplots)
library(shapefiles)
xlim = c(-180, 180)
ylim = c(-90, 90)
#load shapefile
wmap = read.shapefile ("xxx")
# define x,y,z for pies
x <- c(-100, 100)
y <- c(50, -50)
z1 <- c(0.25, 0.25, 0.5)
z2 <- c(0.5, 0.2, 0.3)
z <- rbind(z1,z2)
# define radii of the pies
r <- c(5, 10)
# it's easier to have all data in a single df
plot(NA, xlim = xlim, ylim = ylim, cex = 0.75, xlab = NA, ylab = NA)
draw.shape(wmap, col = "grey", border = "NA")
draw.pie(x,y,z,radius = r, col=c("blue", "yellow", "red"))
legend.pie (x = -160, y = -70, labels = c("0", "1", "2"), radius = 5,
bty = "n", cex = 0.5, label.dist=1.5, col = c("blue", "yellow", "red"))
the legend for the pie size can then be added using legend.bubble

Have a look at this example, you can use the map as background an plot your rose diagrams withPlotrix or ggplot2. In either case you would want to overlay multiple of these diagrams on top of your map which is easy to do in ggplot, just have a look at the example.

I discovered subplot() in the package Hmisc, which seems to do exactly what I wanted. Below is my solution (without the map in the background, which can be plotted using mapplots). I am open to suggestions on how to improve this though...
library(Hmisc)
library (circular)
dat <- data.frame(replicate(2,sample(0:360,10,rep=TRUE)))
lat <- c(50, -40)
lon <- c(-100, 20)
# convert to class circular
cir.dat <- as.circular (dat, type ='angles', units = 'degrees', template = 'geographic', modulo = 'asis', zero = 'pi/2', rotation = 'clock')
# function for subplot, plots relative frequencies, see rose.diag for how to adjust the plot
sub.rose <- function(x){
nu <- sum(!is.na(x))
de <- max(hist(x, breaks = (seq(0, 360, 30)), plot = FALSE)$counts)
prop <- nu/de
rose.diag(x, bins = 12, ticks = FALSE, axes = FALSE,
radii.scale = 'linear',
border = NA,
prop = prop,
col = 'black'
)
}
plot(NA, xlim = xlim, ylim = ylim)
for(i in 1:length(lat)){
subplot(sub.rose(cir.dat[,i]), x = lon[i], y = lat[i], size = c(1, 1))
}

Related

Plotting map points returning an unkwown output

Was constructing a series of plots for extracting bathymetric data and an rare output comes out when trying to generate the last b/w plot with my data. Here are my data coord (12sites_lat_long2.txt).
SITE,LAT,LONG
TAD,48.133119,-69.705842
IV,48.034772,-69.340821
LUD,49.161609,-68.173798
SAM,49.130887,-66.500031
NOR,50.163282,-66.467896
PUR,50.151276,-66.325630
NEW,48.263541,-64.735703
PAS,48.017946,-65.265587
BON,48.041124,-65.491133
COR,47.496607,-61.723938
ROO,47.806514,-61.232300
CAO,48.5058323,-64.2231551
And here my code were i downloaded the bathymetric set and ploted
library(marmap)
library(dplyr)
library(SoDA)
library(ade4)
library(adespatial)
library(ggmap)
library(ggplot2)
library(reshape2)
library(dartR)
library(BiocManager)
library(devtools)
library(plotly)
library(directlabels)
sites <- read.table("12sites_lat_long2.txt", header=TRUE,dec=".",sep=",")
#Order the site object and check the sites positions
sites <- sites %>% dplyr::arrange(SITE)
summary(sites)
#Keep only latitude and longitude info
sites_depth <- dplyr::select(sites,LONG,LAT)
#Get the bathimetric Data and build a matrix
#in this case, we get the data from NOAA using the marmap package
bathydata <- marmap::getNOAA.bathy(lon1= -70.2966,
lon2= -60.9692,
lat1= 51.2392,
lat2= 46.6170,
resolution = 1)
#Summarizing the data
summary(bathydata)
#Next, we extract the bathimetric data
#We plot map according to different levels of depth seting colors for each level
blues <- colorRampPalette(c("lightblue", "cadetblue2", "cadetblue1", "white"))
blues <- c("lightsteelblue4", "lightsteelblue3","lightsteelblue2", "lightsteelblue1")
greys <- c(grey(0.6), grey(0.93), grey(0.99))
#And Plot a map with the colors created
plot(bathydata, image = TRUE, land = TRUE, n=1,
bpal = list(c(0, max(bathydata), greys),
c(min(bathydata), 0, blues)))
#add the sampling points and text to the plot
points(sites$LON, sites$LAT, pch = 21, col = "black",
bg = "yellow", cex = 1.3)
text(sites$LON, sites$LAT,sites$SITE, pos = 2)
# plot a map without color
pdf("Marmap_saccharina.pdf")
plot(bathydata, lwd = c(0.3, 1), lty = c(1, 1),
deep = c(-4500, 0), shallow = c(-50, 0),
step = c(500, 0),
col = c("grey", "black"), drawlabels = c(FALSE, FALSE))
scaleBathy(bathydata, deg = 3, x = "bottomleft", inset = 5)
points(sites$LON, sites$LAT, pch = 21, col = "black", bg = "grey", cex = 1)
text(sites$LON, sites$LAT,sites$SITE, pos = 1,cex = 0.5)
dev.off()
The output that I get instead of the map is just
RStudioGD
2
I was expecting a map similar to this one
example
I have searched but have no clue what this output is refering to and were is the error

Single colorkey for raster and points Levelplot R

Using the sample data below, how can I generate rasters and spatial points plot with the same colorkey as in the "manually" joined plot shown below?
library(rasterVis)
library(raster)
library(colorRamps)
col=colorRampPalette(matlab.like2(255))
s <- stack(replicate(2, raster(matrix(runif(100), 10))))
xy <- data.frame(coordinates(sampleRandom(s, 10, sp=TRUE)),
z1=runif(10), z2=runif(10))
levelplot(s, margin=FALSE, at=seq(0, 1, 0.05),col.regions=col)
x=xy$x;y=xy$y;z=xy$z1
levelplot(z ~ x + y,contour=F, panel = panel.levelplot.points,
margin=FALSE,col.regions=col,
par.settings=list(axis.line=list(lwd=3), strip.border=list(lwd=3)),
cex=1.4, scales=list(x=list(cex=1.7),y=list(cex=1.7)),xlab=list(label="Longitude",cex=2),
ylab=list(label="Latitude",cex=2))
Thanks to #fdestch I was able to generate the following plot using:
latticeCombineGrid(mget(rep("pp", 24)), layout = c(3, 8))
following my comments on printing multiple plots with the same colorkey.
An issue that remains to be clarified:
1) How can one decide on the order of panels? That is, which row & column to place a particular plot just as in levelplot using index.cond.
First of all, you should probably make sure that the breaks in the points plot are identical with those defined in the first levelplot.
## raster plot with colorkey disabled
pr <- levelplot(s, margin = FALSE, at = seq(0, 1, 0.05), col.regions = col,
colorkey = FALSE, xlab = list("Longitude", col = "transparent"))
## points plot
pp <- levelplot(z ~ x + y, panel = panel.levelplot.points, cex = 1.4,
contour = FALSE, margin = FALSE, col.regions = col,
colorkey = list(at = seq(0, 1, .05), width = .6, height = .6),
xlab = "Longitude", ylab = "Latitude")
Please note the definition of a transparent xlab when creating the raster plot. This little workaround comes in quite handy when using downViewport later on to ensure that the actual plot boundaries of pr and pp overlap (feel free to run grid.rect() right after print(pr, newpage = FALSE) to see what I mean).
The actual plot arrangement can then easily be achieved by using viewports from the grid package.
library(grid)
library(lattice)
## initialize new grid device
grid.newpage()
## add raster plot
vp1 <- viewport(x = 0, y = 0, width = .5, height = 1,
just = c("left", "bottom"))
pushViewport(vp1)
print(pr, newpage = FALSE)
## add points plot
downViewport(trellis.vpname("page"))
vp2 <- viewport(x = 1, y = 0, width = .75, height = 1,
just = c("left", "bottom"))
pushViewport(vp2)
print(pp, newpage = FALSE)
Here is my solution using latticeExtra::c.trellis:
library(raster)
library(rasterVis)
s <- stack(replicate(2, raster(matrix(runif(100), 10))))
xy <- data.frame(coordinates(sampleRandom(s, 10, sp=TRUE)),
z1=runif(10), z2=runif(10))
## Define theme and breaks
myTheme <- BTCTheme()
my.at <- seq(0, 1, 0.05)
Plot the Raster* object, using rasterVis::levelplot:
p1 <- levelplot(s, margin=FALSE,
at = my.at,
par.settings = myTheme)
Plot the points, using lattice::levelplot:
p2 <- levelplot(z1 ~ x + y, data = xy,
at = my.at,
panel = panel.levelplot.points,
par.settings = myTheme)
Join them with latticeExtra::c.trellis:
p3 <- c(p1, p2, layout = c(3, 1))
Unfortunately, c.trellis does not assign the strip labels correctly, so you have to define them directly:
update(p3,
strip = strip.custom(factor.levels = c(names(s), "Points")))

How to superimpose bar plots in R?

I'm trying to create a figure similar to the one below (taken from Ro, Russell, & Lavie, 2001). In their graph, they are plotting bars for the errors (i.e., accuracy) within the reaction time bars. Basically, what I am looking for is a way to plot bars within bars.
I know there are several challenges with creating a graph like this. First, Hadley points out that it is not possible to create a graph with two scales in ggplot2 because those graphs are fundamentally flawed (see Plot with 2 y axes, one y axis on the left, and another y axis on the right)
Nonetheless, the graph with superimposed bars seems to solve this dual sclaing problem, and I'm trying to figure out a way to create it in R. Any help would be appreciated.
It's fairly easy in base R, by using par(new = T) to add to an existing graph
set.seed(54321) # for reproducibility
data.1 <- sample(1000:2000, 10)
data.2 <- sample(seq(0, 5, 0.1), 10)
# Use xpd = F to avoid plotting the bars below the axis
barplot(data.1, las = 1, col = "black", ylim = c(500, 3000), xpd = F)
par(new = T)
# Plot the new data with a different ylim, but don't plot the axis
barplot(data.2, las = 1, col = "white", ylim = c(0, 30), yaxt = "n")
# Add the axis on the right
axis(4, las = 1)
It is pretty easy to make the bars in ggplot. Here is some example code. No two y-axes though (although look here for a way to do that too).
library(ggplot2)
data.1 <- sample(1000:2000, 10)
data.2 <- sample(500:1000, 10)
library(ggplot2)
ggplot(mapping = aes(x, y)) +
geom_bar(data = data.frame(x = 1:10, y = data.1), width = 0.8, stat = 'identity') +
geom_bar(data = data.frame(x = 1:10, y = data.2), width = 0.4, stat = 'identity', fill = 'white') +
theme_classic() + scale_y_continuous(expand = c(0, 0))

Vertical Histogram

I'd like to do a vertical histogram. Ideally I should be able to put multiple on a single plot per day.
If this could be combined with quantmod experimental chart_Series or some other library capable of drawing bars for a time series that would be great. Please see the attached screenshot. Ideally I could plot something like this.
Is there anything built in or existing libraries that can help with this?
I wrote something a year or so ago to do vertical histograms in base graphics. Here it is, with a usage example.
VerticalHist <- function(x, xscale = NULL, xwidth, hist,
fillCol = "gray80", lineCol = "gray40") {
## x (required) is the x position to draw the histogram
## xscale (optional) is the "height" of the tallest bar (horizontally),
## it has sensible default behavior
## xwidth (required) is the horizontal spacing between histograms
## hist (required) is an object of type "histogram"
## (or a list / df with $breaks and $density)
## fillCol and lineCol... exactly what you think.
binWidth <- hist$breaks[2] - hist$breaks[1]
if (is.null(xscale)) xscale <- xwidth * 0.90 / max(hist$density)
n <- length(hist$density)
x.l <- rep(x, n)
x.r <- x.l + hist$density * xscale
y.b <- hist$breaks[1:n]
y.t <- hist$breaks[2:(n + 1)]
rect(xleft = x.l, ybottom = y.b, xright = x.r, ytop = y.t,
col = fillCol, border = lineCol)
}
## Usage example
require(plyr) ## Just needed for the round_any() in this example
n <- 1000
numberOfHists <- 4
data <- data.frame(ReleaseDOY = rnorm(n, 110, 20),
bin = as.factor(rep(c(1, 2, 3, 4), n / 4)))
binWidth <- 1
binStarts <- c(1, 2, 3, 4)
binMids <- binStarts + binWidth / 2
axisCol <- "gray80"
## Data handling
DOYrange <- range(data$ReleaseDOY)
DOYrange <- c(round_any(DOYrange[1], 15, floor),
round_any(DOYrange[2], 15, ceiling))
## Get the histogram obects
histList <- with(data, tapply(ReleaseDOY, bin, hist, plot = FALSE,
breaks = seq(DOYrange[1], DOYrange[2], by = 5)))
DOYmean <- with(data, tapply(ReleaseDOY, bin, mean))
## Plotting
par(mar = c(5, 5, 1, 1) + .1)
plot(c(0, 5), DOYrange, type = "n",
ann = FALSE, axes = FALSE, xaxs = "i", yaxs = "i")
axis(1, cex.axis = 1.2, col = axisCol)
mtext(side = 1, outer = F, line = 3, "Length at tagging (mm)",
cex = 1.2)
axis(2, cex.axis = 1.2, las = 1, line = -.7, col = "white",
at = c(75, 107, 138, 169),
labels = c("March", "April", "May", "June"), tck = 0)
mtext(side = 2, outer = F, line = 3.5, "Date tagged", cex = 1.2)
box(bty = "L", col = axisCol)
## Gridlines
abline(h = c(60, 92, 123, 154, 184), col = "gray80")
biggestDensity <- max(unlist(lapply(histList, function(h){max(h[[4]])})))
xscale <- binWidth * .9 / biggestDensity
## Plot the histograms
for (lengthBin in 1:numberOfHists) {
VerticalHist(binStarts[lengthBin], xscale = xscale,
xwidth = binWidth, histList[[lengthBin]])
}
Violin plots might be close enough to what you want. They are density plots that have been mirrored through one axis, like a hybrid of a boxplot and a density plot. (Much easier to understanding by example than description. :-) )
Here is a simple (somewhat ugly) example of the ggplot2 implementation of them:
library(ggplot2)
library(lubridate)
data(economics) #sample dataset
# calculate year to group by using lubridate's year function
economics$year<-year(economics$date)
# get a subset
subset<-economics[economics$year>2003&economics$year<2007,]
ggplot(subset,aes(x=date,y=unemploy))+
geom_line()+geom_violin(aes(group=year),alpha=0.5)
A prettier example would be:
ggplot(subset,aes(x=date,y=unemploy))+
geom_violin(aes(group=year,colour=year,fill=year),alpha=0.5,
kernel="rectangular")+ # passes to stat_density, makes violin rectangular
geom_line(size=1.5)+ # make the line (wider than normal)
xlab("Year")+ # label one axis
ylab("Unemployment")+ # label the other
theme_bw()+ # make white background on plot
theme(legend.position = "none") # suppress legend
To include ranges instead of or in addition to the line, you would use geom_linerange or geom_pointrange.
If you use grid graphics then you can create rotated viewports whereever you want them and plot to the rotated viewport. You just need a function that will plot using grid graphics into a specified viewport, I would suggest ggplot2 or possibly lattice for this.
In base graphics you could write your own function to plot the rotated histogram (modify the plot.histogram function or just write your own from scratch using rect or other tools). Then you can use the subplot function from the TeachingDemos package to place the plot wherever you want on a larger plot.

Setting the endscale in filled.contour function

I have to plot a physical variable over a world map at differents moments. So i have to make many plot as how many moments i have to plot. The problem is that my routine set the end of the scale by default, and this make the reading of the plot difficult. I would like to fix the end of the scale, in order to have one scale for all the plots. This is piece of an old code i would reuse
require(reshape)
require(mapdata)
require(mapproj)
df <- read.table('/media/Lacie2/dati/hy.dat',head=F)
names(df) <- c("value", "x", "y")#, "t")
dfc <- cast(df[ ,-4], x ~ y)
mm<-as.matrix(dfc,ncol=480,nrow=241)
filled.contour(x=seq(0,360,length.out=480),y=seq(-90,90,length.out=241),mm,
color.palette = colorRampPalette(c("lightblue", "blue","violet", "black")),
xlab = "Longitude (°)", ylab = "Latitude (°)",
plot.axes = {axis(1); axis(2);
map('world2Hires',
xlim = c(0, 360),
ylim = c(-90, 90),
add = T, col = "black")}
)
I don't understand how to fix the endscale of the ladder. How can i do it?
If you want to plot colors only up to a maximum, then just 'trim' the value that you pass to the plot routine with:
df$trimval <- pmin(df$value, 2)
# the range in the example below is roughly -4.5 to 4.5
... and plot using that value as the z-argument to contour.plot. Indented code and random "value" argument below:
require(reshape)
require(mapdata)
require(mapproj)
df <- data.frame(value=rnorm( 480*241), x=seq(0,360,length.out=480),y=seq(-90,90,length.out=241) )
df$trimval <- pmin(df$value, 2)
dfc <- cast(df[-1], x ~ y)
mm<-as.matrix(dfc,ncol=480,nrow=241)
filled.contour(x=seq(0,360,length.out=480),y=seq(-90,90,length.out=241),mm,
color.palette = colorRampPalette(c("lightblue", "blue","violet", "black")),
xlab = "Longitude (°)", ylab = "Latitude (°)",
plot.axes = {axis(1); axis(2);
map('world2Hires',
xlim = c(0, 360),
ylim = c(-90, 90),
add = T, col = "black")}
)
The color range is therefore maxxed out at 2 and all of the values above 2 are plotted with the color given to 2. (I might mention that I tried using zlim and the results were not as I imagined you would want.)

Resources