Raster or RGB data cube plotting with lattice package - r

Suppose I have this very simple 2x2 RGB datacube that I want to plot:
set.seed(2017)
dc <- array(runif(12), dim = c(2,2,3))
I can plot this just by rasterizing the datacube:
plot(as.raster(dc), interpolate = FALSE)
But I would like to plot this data cube with the lattice package (for uniformity sake since I am mainly using it for other plotting too).
Is this possible? I am looking at levelplot, but am not able to make it work.

The problem you have is that lattice needs a matrix, that is a numeric matrix, and rasters of RGB become a factor matrix:
r <-as.raster(dc)
r
gives this result:
[,1] [,2]
[1,] "#ECC478" "#780AAC"
[2,] "#89C546" "#4A6F01"
to use it as lattice you need to transform this into a numeric matrix, this looks long but it seems is the only way to ensure to keep the order:
m <- matrix(as.numeric(as.factor(as.vector(as.matrix(r)))), ncol= 2)
levelplot(m, panel = panel.levelplot.raster)
The problem you will get here is that you won't keep the same RGB colors, but it's a lattice solution.

Ok, this turned out to be quite an endeavor with levelplot.
I convert the RGB hex color values from raster to integers, and then use these values to map them to the color palette of the raster.
set.seed(2017)
dc <- array(runif(12), dim = c(2,2,3))
plot(as.raster(dc), interpolate = FALSE)
# convert color hexadecimals to integers
rgbInt <- apply(as.raster(dc), MARGIN = c(1,2),
FUN = function(str){strtoi(substring(str, 2), base = 16)})
rgbIntUnq <- unique(as.vector(rgbInt))
lattice::levelplot(x = t(rgbInt), # turn so rows become columns
at = c(0,rgbIntUnq),
col.regions = sprintf("#%06X", rgbIntUnq[order(rgbIntUnq)]), # to hex
ylim = c(nrow(rgbInt) + 0.5, 1 - 0.5), # plot from top to bottom
xlab = '', ylab = '')
The legend can also be removed with colorkey = FALSE property.
I wonder whether there are simpler ways to do the same.

Related

Chord Plot for a Correlation matrix. R

I want to create a Chord plot for a correlation matrix. Where the links represent the correlations in a color gradient from -1 to 1 (blue to red). I want just to represent those links that have an actual correlation.
This is an example dataset:
c1<-c(0,0,0.5,-0.2,0.1,-0.8)
c2<-c(0.2,0.8,-0.5,0,0,0)
c3<-c(0,0,-0.2,0,0,0.1)
mat<-rbind(c1,c2,c3)
rownames(mat) = paste0("S", 1:3)
colnames(mat) = paste0("E", 1:6)
df = data.frame(from = rep(rownames(mat), times = ncol(mat)),
to = rep(colnames(mat), each = nrow(mat)),
value = as.vector(mat),
stringsAsFactors = FALSE)
A simple way to represent this in a chord plot would be like:
windows()
chordDiagram(df, big.gap = 30)
circos.clear()
However, it represents all the links, even if the value is 0. How can I create a color gradient for the value, from -1 to 1 with the 0 being white?
Thanks
Assuming you are using the circlize package you can adjust the colours manually based on a range by writing a function and then inputting it in the col argument of the chordDiagram() function:
library(circlize)
cols = colorRamp2(c(-1,0,1),c("blue","white","red"),transparency = 0.3)
chordDiagram(mat,col=cols,big.gap=30)
I used the matrix to plot the chord diagram but the data frame should produce the same results. However, I don't understand what you mean when you say all links are represented even if the value is 0 since for example, S1 to E1 is 0 but there is no link between the two

From rastermap package to ggplot2

My problem: I want to draw a map obtained via rastermap package with ggplot2.
Searching for alternatives to ggmap package I found the rastermap package which provides an easy way to obtain maps from external sources. The readme provides a very simple example:
# install.packages("devtools")
devtools::install_github("hadley/rastermap")
houston <- fetch_region(c(-95.80204, -94.92313), c(29.38048, 30.14344),
stamen("terrain"))
houston
plot(houston)
The problem comes whether I try to plot using ggplot. So far I've tried several ways but none of them seems to work. Is it possible? Any idea?
rastermap generates a matrix of colours in hexadecimal strings (#RRGGBB format). It may be simplest to convert this to a more common form for spatial data, a multiband raster brick, with separate layers for the red, green and blue.
We can write a short helper function to convert hexadecimal strings into the separate integer values (i.e. this is the reverse of the rgb() function):
un_rgb = function (x) {
x = unlist(str_split(x, ''))
r = paste0(x[2], x[3])
g = paste0(x[4], x[5])
b = paste0(x[6], x[7])
strtoi(c(r,g,b), 16)
}
Using this function we convert the rastermap matrix into a three band raster brick:
library(raster)
m = as.matrix(houston)
l=lapply(m[], un_rgb)
r=g=b=matrix(, dim(m)[1], dim(m)[2])
r[] = sapply(l, function(i) i[1])
g[] = sapply(l, function(i) i[2])
b[] = sapply(l, function(i) i[3])
rgb.brick = brick(raster(r), raster(g), raster(b))
And set the extent of the new raster to that of the original rastermap
extent(rgb.brick) = extent(matrix(unlist(attributes(houston)$bb), nrow=2))
Now that we have a more usual form of raster object, we can do various things with it. For example, we can plot it in ggplot using library(RStoolbox):
ggRGB(rgb.brick, r=1, g=2, b=3)
Or we can save it as an image to use as an annotation background in ggplot:
png('test.png', dim(rgb.brick)[2], dim(rgb.brick)[1])
plotRGB(rgb.brick, 1, 2, 3)
dev.off()
img <- png::readPNG("test.png")
gr <- grid::rasterGrob(img, interpolate=TRUE)
ggplot() + annotation_custom(gr, -Inf, Inf, -Inf, Inf)
Why would you want an alternative? You can get a stamen map from ggmap:
library(ggmap)
ggmap(get_stamenmap(c(-95.80204, 29.38048, -94.92313, 30.14344))) +
# some points to plot
geom_point(aes(x = seq(-95.5, -95.2, 0.1), y = seq(29.7, 30, 0.1)), color = "red")

colorRamp returns 0

I'm trying to plot lines and color the lines based on the probability of that connection. Given a vector of probabilities, I use:
colfunc <- colorRamp(c("white", "red"))
colors <- colfunc(probs)
colors is then an nx3 matrix of rgb values. However, colfunc quite often returns a 0 value, so when i attempt to plot using these colors, R complains
Error in col2rgb(colors) : numerical color values must be positive
Is there an error in the way I am defining my color function?
Your function works fine, I think, but it doesn't return colors you can use with plot, because plot wants a color, not RGB values in a matrix.
There's probably a better way, but you can simply covert the matrix:
probs <- runif(10)
colors <- colfunc(probs)
my_col = apply(colors, MARGIN = 1, function(x) rgb(x[1]/255, x[2]/255, x[3]/255))
plot(1:10, 1:10, col = my_col) # should work fine
or you could just wrap your function
better_colfunc <- function(x, ramp = colorRamp(c("white", "red"))) {
colors <- ramp(x)
colors = apply(colors, MARGIN = 1, function(x) rgb(x[1]/255, x[2]/255, x[3]/255))
return(colors)
}
plot(1:10, 1:10, col = better_colfunc(probs, ramp = colfunc))
As for "colfunc quite often returns a 0 value", and other issues, you'll need to share both some data (what do your probs look like?) as well as perhaps the actual plotting code. See here for tips on making reproducible questions.
I am a bit confused what you are trying to do...the col2rgb function returns rgb values, so if you already have those then what do you want?
Or if you want rgb, why not use:
col2rgb(c("white", "red"))

contour plot of a custom function in R

I'm working with some custom functions and I need to draw contours for them based on multiple values for the parameters.
Here is an example function:
I need to draw such a contour plot:
Any idea?
Thanks.
First you construct a function, fourvar that takes those four parameters as arguments. In this case you could have done it with 3 variables one of which was lambda_2 over lambda_1. Alpha1 is fixed at 2 so alpha_1/alpha_2 will vary over 0-10.
fourvar <- function(a1,a2,l1,l2){
a1* integrate( function(x) {(1-x)^(a1-1)*(1-x^(l2/l1) )^a2} , 0 , 1)$value }
The trick is to realize that the integrate function returns a list and you only want the 'value' part of that list so it can be Vectorize()-ed.
Second you construct a matrix using that function:
mat <- outer( seq(.01, 10, length=100),
seq(.01, 10, length=100),
Vectorize( function(x,y) fourvar(a1=2, x/2, l1=2, l2=y/2) ) )
Then the task of creating the plot with labels in those positions can only be done easily with lattice::contourplot. After doing a reasonable amount of searching it does appear that the solution to geom_contour labeling is still a work in progress in ggplot2. The only labeling strategy I found is in an external package. However, the 'directlabels' package's function directlabel does not seem to have sufficient control to spread the labels out correctly in this case. In other examples that I have seen, it does spread the labels around the plot area. I suppose I could look at the code, but since it depends on the 'proto'-package, it will probably be weirdly encapsulated so I haven't looked.
require(reshape2)
mmat <- melt(mat)
str(mmat) # to see the names in the melted matrix
g <- ggplot(mmat, aes(x=Var1, y=Var2, z=value) )
g <- g+stat_contour(aes(col = ..level..), breaks=seq(.1, .9, .1) )
g <- g + scale_colour_continuous(low = "#000000", high = "#000000") # make black
install.packages("directlabels", repos="http://r-forge.r-project.org", type="source")
require(directlabels)
direct.label(g)
Note that these are the index positions from the matrix rather than the ratios of parameters, but that should be pretty easy to fix.
This, on the other hand, is how easilyy one can construct it in lattice (and I think it looks "cleaner":
require(lattice)
contourplot(mat, at=seq(.1,.9,.1))
As I think the question is still relevant, there have been some developments in the contour plot labeling in the metR package. Adding to the previous example will give you nice contour labeling also with ggplot2
require(metR)
g + geom_text_contour(rotate = TRUE, nudge_x = 3, nudge_y = 5)

Easiest way to plot inequalities with hatched fill?

Refer to the above plot. I have drawn the equations in excel and then shaded by hand. You can see it is not very neat. You can see there are six zones, each bounded by two or more equations. What is the easiest way to draw inequalities and shade the regions using hatched patterns ?
To build up on #agstudy's answer, here's a quick-and-dirty way to represent inequalities in R:
plot(NA,xlim=c(0,1),ylim=c(0,1), xaxs="i",yaxs="i") # Empty plot
a <- curve(x^2, add = TRUE) # First curve
b <- curve(2*x^2-0.2, add = TRUE) # Second curve
names(a) <- c('xA','yA')
names(b) <- c('xB','yB')
with(as.list(c(b,a)),{
id <- yB<=yA
# b<a area
polygon(x = c(xB[id], rev(xA[id])),
y = c(yB[id], rev(yA[id])),
density=10, angle=0, border=NULL)
# a>b area
polygon(x = c(xB[!id], rev(xA[!id])),
y = c(yB[!id], rev(yA[!id])),
density=10, angle=90, border=NULL)
})
If the area in question is surrounded by more than 2 equations, just add more conditions:
plot(NA,xlim=c(0,1),ylim=c(0,1), xaxs="i",yaxs="i") # Empty plot
a <- curve(x^2, add = TRUE) # First curve
b <- curve(2*x^2-0.2, add = TRUE) # Second curve
d <- curve(0.5*x^2+0.2, add = TRUE) # Third curve
names(a) <- c('xA','yA')
names(b) <- c('xB','yB')
names(d) <- c('xD','yD')
with(as.list(c(a,b,d)),{
# Basically you have three conditions:
# curve a is below curve b, curve b is below curve d and curve d is above curve a
# assign to each curve coordinates the two conditions that concerns it.
idA <- yA<=yD & yA<=yB
idB <- yB>=yA & yB<=yD
idD <- yD<=yB & yD>=yA
polygon(x = c(xB[idB], xD[idD], rev(xA[idA])),
y = c(yB[idB], yD[idD], rev(yA[idA])),
density=10, angle=0, border=NULL)
})
In R, there is only limited support for fill patterns and they can only be
applied to rectangles and polygons.This is and only within the traditional graphics, no ggplot2 or lattice.
It is possible to fill a rectangle or polygon with a set of lines drawn
at a certain angle, with a specific separation between the lines. A density
argument controls the separation between the lines (in terms of lines per inch)
and an angle argument controls the angle of the lines.
here an example from the help:
plot(c(1, 9), 1:2, type = "n")
polygon(1:9, c(2,1,2,1,NA,2,1,2,1),
density = c(10, 20), angle = c(-45, 45))
EDIT
Another option is to use alpha blending to differentiate between regions. Here using #plannapus example and gridBase package to superpose polygons, you can do something like this :
library(gridBase)
vps <- baseViewports()
pushViewport(vps$figure,vps$plot)
with(as.list(c(a,b,d)),{
grid.polygon(x = xA, y = yA,gp =gpar(fill='red',lty=1,alpha=0.2))
grid.polygon(x = xB, y = yB,gp =gpar(fill='green',lty=2,alpha=0.2))
grid.polygon(x = xD, y = yD,gp =gpar(fill='blue',lty=3,alpha=0.2))
}
)
upViewport(2)
There are several submissions on the MATLAB Central File Exchange that will produce hatched plots in various ways for you.
I think a tool that will come handy for you here is gnuplot.
Take a look at the following demos:
feelbetween
statistics
some tricks

Resources