3D geographic plot with RGL - r

I am very new to reshape and rgl, to see if I had understood correctly I am going through the code presented in http://www.r-bloggers.com/creating-3d-geographical-plots-in-r-using-rgl/ , it seems to work with the dataset presented in the website, but not with mine and i do not understand why, but what i get is only a grey image.
This is a link to my dataset http://www.mediafire.com/download/8ifpssvdyr665g7/sig.RData
as in the example the two columns are lat and long, the third is a value.
Is this the best way to plot data which are not on a grid?
Any help is greatly appreciated
library(rgl)
library(reshape)
rgl.clear(type = c("shapes"))
load("sig.RData")
calls = sig
calls=as.matrix(calls)
dimnames(calls) <- list(NULL, c("lat","long","total"))
calls<-as.data.frame(calls)
head(calls)
bin_size = 0.5
calls$long_bin = cut(calls$long, seq(min(calls$long), max(calls$long), bin_size))
calls$lat_bin = cut(calls$lat, seq(min(calls$lat), max(calls$lat), bin_size))
calls$total = log(calls$total) / 3 #need to do this to flatten out totals
calls = melt(calls[,3:5])
calls = cast(calls, lat_bin~long_bin, fun = sum, fill = 0)
calls = calls[,2:(ncol(calls)-1)]
calls = as.matrix(calls)
# simple black and white plot
x = (1: nrow(calls))
z = (1: ncol(calls))
rgl.surface(x, z, calls)
rgl.bringtotop()
rgl.pop()
# nicer colored plot
ylim <- range(calls)
ylen <- ylim[2] - ylim[1] + 1
col <- topo.colors(ylen)[ calls-ylim[1]+1 ]
x = (1: nrow(calls))
z = (1: ncol(calls))
rgl.bg(sphere=FALSE, color=c("black"), lit=FALSE)
rgl.viewpoint( theta = 300, phi = 30, fov = 170, zoom = 0.03)
rgl.surface(x, z, calls, color = col, shininess = 10)
rgl.bringtotop()

Related

How to create a matrix of evenly-spaced points within an angled polygon, given the corner coordinates [R]

Given some example random data, with UTM coordinates for each corner:
test<-structure(list(name = c("P11C1", "P11C2", "P11C3", "P11C4"),
east = c(6404807.016, 6404808.797, 6404786.695, 6404784.761
), north = c(497179.4834, 497159.1862, 497156.6599, 497176.4444
), plot_num = c(11, 11, 11, 11)), row.names = c(NA, -4L), class = c("tbl_df",
"tbl", "data.frame"))
If we plot this as a polygon. we can see a tilted rectangle (this is because this shape is generated using real differential-GPS captured coordinates on the ground):
library(ggplot2)
ggplot(test) + geom_polygon(aes(east, north))
My question is, how can I generate points among custom dimensions
that are evenly spaced within this polygon? For instance, if I want
to generate a grid of evenly spaced 10x11 points within this grid. Can anyone suggest a neat to do this, given the corner points? I have hundreds of discrete plots for which I would then like to loop/map a solution over. I assume this
involves some simple geometry, but with the added confusion of a
tilted plot, I've gotten really confused and could not find a similar
solution here on SO or elsewhere! FYI in this instance I am not
expecting projection to be an issue since it is UTM coordinates, but
a spatial solution that accounts for global projections would be cool
to see, too!
You could use this little function:
gridify <- function(x, y, grid_x = 10, grid_y = 10) {
x <- sort(x)
y <- sort(y)
xvals <- do.call(rbind, Map(function(a, b) seq(b, a, length = grid_x),
a = seq(x[1], x[3], length = grid_y),
b = seq(x[2], x[4], length = grid_y)))
yvals <- do.call(rbind, Map(function(a, b) seq(a, b, length = grid_y),
a = seq(y[1], y[3], length = grid_x),
b = seq(y[2], y[4], length = grid_x)))
as.data.frame(cbind(x = c(xvals), y = c(t(yvals))))
}
So for example, to plot a 10 by 11 grid, we would do:
ggplot(test) +
geom_polygon(aes(east, north)) +
geom_point(data = gridify(x = test$east, y = test$north, grid_x = 11),
aes(x, y), color = 'red') +
coord_equal()
And we can scale to arbitrary numbers of points:
library(ggplot2)
ggplot(test) +
geom_polygon(aes(east, north)) +
geom_point(data = gridify(x = test$east, y = test$north, 50, 50),
aes(x, y), color = 'red') +
coord_equal()

Find coordinates for overlapping hexagonal bins between hexbin objects

I have two spatial datasets with coordinates indicating observations of a species and want to estimate the area of overlap among these datasets. Since point coordinates cannot represent an area, one has to bin the coordinates using similar x (longitude) and y (latitude) categories for both datasets.
For this task, I found the practical hexbin package, which does hexagonal binning. The package is great, but at least I fail to find a function that directly outputs the coordinates / IDs of overlapping bins among hexbin objects. For example, the hdiffplot returns a nice graphical overview of overlapping bins, but how to extract this information for further analysis?
library(hexbin)
set.seed(1); df1 <- data.frame(x = rnorm(10, 0, 5), y = rnorm(10, 0, 5))
set.seed(2); df2 <- data.frame(x = rnorm(10, 0, 5), y = rnorm(10, 0, 5))
xrange <- c(floor(min(c(df1$x, df2$x))-1), ceiling(max(c(df1$x, df2$x))+1))
#-/+1 just to make the plot nicer
yrange <- c(floor(min(c(df1$y, df2$y))-1), ceiling(max(c(df1$y, df2$y)))+1)
hb1 <- hexbin(df1$x, df1$y, xbins = 10, xbnds = xrange, ybnds = yrange)
hb2 <- hexbin(df2$x, df2$y, xbins = 10, xbnds = xrange, ybnds = yrange)
hdiffplot(hb1,hb2, xbnds = xrange, ybnds = yrange)
I figured out a solution to this problem while making the question. Will post it here in hopes that it will help someone one day.
You can extract the coordinates using the hcell2xy function. Here is a little function to find the unique and overlapping coordinates for bin centroids:
#' #title Print overlapping and unique bin centroid coordinates for two hexbin objects
#' #param bin1,bin2 two objects of class hexbin.
#' #details The hexbin objects for comparison, bin1 and bin2, must have the same plotting limits and cell size.
#' #return Returns a list of data frames with unique coordinates for \code{bin1} and \code{bin2} as well as overlapping coordinates among bins.
hdiffcoords <- function(bin1, bin2) {
## Checks modified from: https://github.com/edzer/hexbin/blob/master/R/hdiffplot.R
if(is.null(bin1) | is.null(bin1)) {
stop("Need 2 hex bin objects")
} else {
if(bin1#shape != bin2#shape)
stop("Bin objects must have same shape parameter")
if(all(bin1#xbnds == bin2#xbnds) & all(bin1#ybnds == bin2#ybnds))
equal.bounds <- TRUE
else stop("Bin objects need the same xbnds and ybnds")
if(bin1#xbins != bin2#xbins)
stop("Bin objects need the same number of bins")
}
## Find overlapping and unique bins
hd1 <- data.frame(hcell2xy(bin1), count_bin1 = bin1#count, cell_bin1 = bin1#cell)
hd2 <- data.frame(hcell2xy(bin2), count_bin2 = bin2#count, cell_bin2 = bin2#cell)
overlapping_hd1 <- apply(hd1, 1, function(r, A){ sum(A$x==r[1] & A$y==r[2]) }, hd2)
overlapping_hd2 <- apply(hd2, 1, function(r, A){ sum(A$x==r[1] & A$y==r[2]) }, hd1)
overlaps <- merge(hd1[as.logical(overlapping_hd1),], hd2[as.logical(overlapping_hd2),])
unique_hd1 <- hd1[!as.logical(overlapping_hd1),]
unique_hd2 <- hd2[!as.logical(overlapping_hd2),]
## Return list of data.frames
list(unique_bin1 = unique_hd1, unique_bin2 = unique_hd2, overlapping = overlaps)
}
This information should be the same than returned by hdiffplot in graphical format:
df <- hdiffcoords(hb1, hb2)
library(ggplot2)
ggplot() +
geom_point(data = df$unique_bin1, aes(x = x, y = y), color = "red", size = 10) +
geom_point(data = df$unique_bin2, aes(x = x, y = y), color = "cyan", size = 10) +
geom_point(data = df$overlapping, aes(x = x, y = y), color = "green", size = 10) + theme_bw()
Any comments/corrections are appreciated.

Adding layer of interpolated values to ggplot chart in R

I have created the following dataframe in R to generate a plot using ggplot
library(data.table)
library(ggplot2)
library(plotly)
df <- data.frame("X_Frequency" = c(5, 10, 55, 180, 300, 360, 1000, 2000)
, "X_Axis" = c(0.009185742, 0.207822221, 0.067542222, 0.002597778,
0.002597778, 0.001454756, 0.001454756 , 0.001454756))
Next I have generated a plot using ggplot
B <- ggplot(data = df,
mapping = aes(x = X_Frequency, y = X_Axis)) +
geom_line() + labs(x = "Frequency(Hz)", y="Axis")
B <- ggplotly(B, dynamicTicks = TRUE)###Hovering enabled
B <- layout(B, yaxis = list(type = "log"))##X Y log scales enabled
B <- layout(B, xaxis = list(type = "log"))
B
I have created the following dataframe df241 with interpolated values between various observations in df1. First we create the slopes
df$X_Slope2 <- 0### Initiate slope column
for(i in 2:nrow(df)){
df$X_Slope2[i] = (df$X_Axis[i] - df$X_Axis[i-1]) /
(df$X_Frequency[i] - df$X_Frequency[i - 1])
}
Next we assign the respective slopes to all values
df_new <- bind_cols(df %>%
select(X_Frequency, X_Axis, X_Slope2) %>%
complete(., expand(., X_Frequency = 5:2000))
Now we calculate the interpolated values of X-Frequency, X_Axis from the df_new using slopes
for(i in 1: nrow(df241)){
if(is.na(df241$X_Axis[i]) == T){
df241$X_Axis[i] = df241$X_Slope2[i] *
(df241$X_Frequency[i] - df241$X_Frequency[i-1]) +
df241$X_Axis[i-1] } else {
df241$X_Axis[i] = df241$X_Axis[i]}}
I want to place these interpolated values from df241 on the original chart B generated above. How can this be accomplished. I request someone to help me.
Note: I have tried generating a new plot based df_new dataframe. but the chart appears very different from the original chart -B.
It might be simpler to use the approx function for your interpolation. I believe this gets a similar result as your interpolation steps.
df_interp <- approx(df$X_Frequency, df$X_Axis, xout = 5:2000) %>%
as_tibble() %>%
rename(X_Frequency = x, X_Axis = y)
A linear interpolation may look unexpected on a log-log scale. I was unable to run your code as provided (is df241 created somewhere?), so I'm not sure if this is what you encountered when you said the chart with the interpolated values appears very different.
B <- ggplot(data = df,
mapping = aes(x = X_Frequency, y = X_Axis)) +
geom_line() +
geom_point(data = df_interp, size = 0.1, color = "blue") +
labs(x = "Frequency(Hz)", y="Axis")
B <- ggplotly(B, dynamicTicks = TRUE)###Hovering enabled
B <- layout(B, yaxis = list(type = "log"))##X Y log scales enabled
B <- layout(B, xaxis = list(type = "log"))
B
Edit: interpolation on log scale
Alternatively, you could interpolate using log-transformed inputs, and then use exp to convert back onto the original scale:
df_interp <- approx(log(df$X_Frequency), log(df$X_Axis), xout = log(5:2000)) %>%
as_tibble() %>%
mutate(X_Frequency = exp(x),
X_Axis = exp(y))
Which would result in this:

drawing a circle with the coefficients shown as an arrow between the variables in ggplot 2

Suppose I have the following data frame:
df <- data.frame(A1 = c(0,3.5,0,2.1), A2 =c(0.9,0,0,0.6), A3 = c(0,0.3,0,0.3),A4= c(0,1.9,0,0))
rownames(df) <- names(df)
every element df(i,j) is the strength of relation between ith column and jth row (they are mutually connected, meaning strength between 1 to j is different from strength between j to i). A "0" entry means there is no relation.
Now I would like to draw a circle, with the variables on the perimeter of the circle, and an arrow that shows which variables are connected to each other, and hopefully show the strength of the connection based on the width of the arrow.
So, the final product I wish to be something like this:
Is it even possible to do something like that with ggplot2?
Thanks in advance.
igraph
We start by making a graph from your adjacency matrix:
df <- t(df)
ga <- graph.adjacency(as.matrix(df), weighted = TRUE, mode = "directed")
Then, plot a circle:
par(mar = rep(0.25, 4))
pts <- seq(0, 2*pi, l = 100)
plot(cbind(sin(pts), cos(pts)), type = "l", frame = F, xaxt = "n", yaxt = "n")
Finally, plot the graph:
plot.igraph(ga,
vertex.label = V(ga)$name,
edge.width = E(ga)$weight,
edge.curved = TRUE,
edge.label = E(ga)$weight,
layout = layout_in_circle(ga, order = V(ga)),
add = T)
Output below. You can customize your graph (e.g. curvature and colors of edges, shapes of vertices) as desired.
ggplot2
The main idea is to set up three sets of geoms: the circle, the nodes (vertices), and the lines (edges). First, we load some packages, and prep the circle and nodes:
library(ggplot2)
library(tidyr)
library(dplyr)
# For circle
pts <- seq(0, 2*pi, l = 100)
# For nodes
theta <- seq(0, 2*pi, l = nrow(df) + 1)[1:nrow(df)]
l <- data.frame(x = sin(theta), y = cos(theta), v = names(df),
stringsAsFactors = FALSE)
The edges are a little bit more involved. I make a function to make coordinates for the lines, given an origin and destination:
make_edge <- function(origin, dest, l, shrink = .9) {
# l is the layout matrix for the nodes that we made previously
data.frame(
x0 = l$x[l$v == origin],
y0 = l$y[l$v == origin],
x1 = l$x[l$v == dest],
y1 = l$y[l$v == dest]
) * shrink
}
Then, we make an adjacency graph, and bind the edge coordinates to it:
gr <- gather(mutate(df, dest = names(df)), origin, wt, -dest)
gr <- gr[gr$wt != 0, ]
edges <- do.call(rbind,
mapply(make_edge, gr$origin, gr$dest, list(l), shrink = .94, SIMPLIFY = F)
)
ga <- cbind(gr, edges)
Finally, we plot:
ggplot() +
geom_path(data = data.frame(x = sin(pts), y = cos(pts)), aes(x, y)) +
geom_label(data = l, aes(x, y, label = v)) +
geom_curve(data = ga,
aes(x = x0, y = y0, xend = x1, yend = y1, size = wt, colour = origin),
alpha = 0.8,
curvature = 0.1,
arrow = arrow(length = unit(2, "mm"))) +
scale_size_continuous(range=c(.25,2), guide = FALSE) +
theme_void()
Output:
I wrote a little package that does this kind of thing. Here's a small demo vignette https://github.com/mkearney/lavplot/blob/master/vignettes/demo.Rmd. Image of plot provided below.

How to create a shaded error bar "box" for a scatterplot in R or MATLAB

I would like to create a simple scatter plot in R or MATLAB involving two variables $x$ and $y$ which have errors associated with them, $\epsilon_x$ and $\epsilon_y$.
Instead of adding error-bars, however, I was hoping to create a "shaded box" around each $(x,y)$ pair where the height of the box ranges from ($y - \epsilon_y$) to ($y + \epsilon_y$) and the width of the box ranges from ($x - \epsilon_y$) to ($x + \epsilon_y$) .
Is this possible in R or MATLAB? If so, what package or code can I use to generate these plots. Ideally, I would like the package to also support asymmetric error bounds.
You could do it in matlab by creating the following function:
function errorBox(x,y,epsx,epsy)
%# make sure inputs are all column vectors
x = x(:); y = y(:); epsx = epsx(:); epsy = epsy(:);
%# define the corner points of the error boxes
errBoxX = [x-epsx, x-epsx, x+epsx, x+epsx];
errBoxY = [y-epsy, y+epsy, y+epsy, y-epsy];
%# plot the transparant errorboxes
fill(errBoxX',errBoxY','b','FaceAlpha',0.3,'EdgeAlpha',0)
end
x, y, epsx and epsy can all be vectors.
Example:
x = randn(1,5); y = randn(1,5);
epsx = rand(1,5)/5;
epsy = rand(1,5)/5;
plot(x,y,'rx')
hold on
errorBox(x,y,epsx,epsy)
Result:
It's probably easier using the ggplot2. First create some data:
set.seed(1)
dd = data.frame(x = 1:5, eps_x = rnorm(5, 0, 0.1), y = rnorm(5), eps_y = rnorm(5, 0, 0.1))
##Save space later
dd$xmin = dd$x - dd$eps_x
dd$xmax = dd$x + dd$eps_x
dd$ymin = dd$y - dd$eps_y
dd$ymax = dd$y + dd$eps_y
Then use the rectangle geom in ggplot2:
library(ggplot2)
ggplot(dd) +
geom_rect(aes( xmax = xmax, xmin=xmin, ymin=ymin, ymax = ymax))
gives the first plot. Of course, you don't need to use ggplot2, to get something similar in base graphics, try:
plot(0, 0, xlim=c(0.5, 5.5), ylim=c(-1, 1), type="n")
for(i in 1:nrow(dd)){
d = dd[i,]
polygon(c(d$xmin, d$xmax, d$xmax, d$xmin), c(d$ymin, d$ymin, d$ymax,d$ymax), col="grey80")
}
to get the second plot.
Here's how to do it using Matlab (with asymmetric intervals). Converting to symmetric ones should be trivial.
%# define some random data
x = rand(5,1)*10;y = rand(5,1)*10;
%# ex, ey have two columns for lower/upper bounds
ex = abs(randn(5,2))*0.3;ey=abs(randn(5,2));
%# create vertices, faces, for patches
vertx = bsxfun(#minus,y,ey(:,[1 2 2 1]))';
verty = bsxfun(#minus,y,ey(:,[1 1 2 2]))';
vertices = [vertx(:),verty(:)];
faces = bsxfun(#plus,[1 2 3 4],(0:4:(length(x)-1)*4)');
%# create patch
patch(struct('faces',faces,'vertices',vertices),'FaceColor',[0.5 0.5 0.5]);
%# add "centers" - note, the intervals are asymmetric
hold on, plot(x,y,'oy','MarkerFaceColor','r')
It's simple with the ggplot2 package in R.
# An example data frame
dat <- data.frame(x = 1:5, y = 5:1, ex = (1:5)/10, ey = (5:1)/10)
# Plot
library(ggplot2)
ggplot(dat) +
geom_rect(aes(xmin = x - ex, xmax = x + ex, ymin = y - ey, ymax = y + ey),
fill = "grey") +
geom_point(aes(x = x, y = y))
In the aes function inside geom_rect the size of the rectangle is defined by ex and ey around x and y.
Here's a MATLAB answer:
x = randn(1,5); y = 3-2*x + randn(1,5);
ex = (.1+rand(1,5))/5; ey = (.2+rand(1,5))/3;
plot(x,y,'ro')
patch([x-ex;x+ex;x+ex;x-ex],[y-ey;y-ey;y+ey;y+ey],[.9 .9 .9],'facealpha',.2,'linestyle','none')

Resources