I would like to add a 2nd y-axis (right) and a 2nd x-axis (top) to the following (lattice) levelplot. These axes should only indicate certain rows and columns (no labels) and thus mimick base-graphics' rug function. How can this be done?
library(lattice)
library(latticeExtra)
## Generate a correlation matrix
d <- 50
L <- diag(1:d)
set.seed(271)
L[lower.tri(L)] <- runif(choose(d,2))
Sigma <- L %*% t(L)
P <- cor(Sigma)
## Panel function
my_panel <- function(...) {
panel.levelplot(...)
panel.abline(h = (1:4)*10, v = (1:4)*10, lty = 2)
panel.axis(side = "top", at = (1:50)-0.5, draw.labels = FALSE) # maybe a panel axis could do it? why not centered?
}
## Plot
obj1 <- levelplot(P, xlab = "Column", ylab = "Row",
col.regions = grey(c(seq(1, 0, length.out = 600))),
panel = my_panel)
obj2 <- xyplot(NA~NA, ylim = c(0, 50),
scales = list(x = list(at = (1:50)-0.5, labels = rep("", 50)),
y = list(at = (1:50)-0.5, labels = rep("", 50))))
doubleYScale(obj1, obj2, use.style = FALSE) # idea based on latticeExtra; only gives a 2nd y-axis, though
You were onto a good idea with panel.rug(), but were stymied by lattice's default clipping of its plotting to the panel's interior. To get around that, you can turn off clipping via the par.settings= argument. If you want to suppress the plotting of default axis tick marks on the right and top panel borders, you can do so using the tck= argument, as shown below.
my_panel <- function(...) {
panel.levelplot(...)
panel.abline(h = (1:4)*10, v = (1:4)*10, lty = 2)
## Have panel.rug print tick marks starting at 1 npc (edge of panel)
## and extending to 1.02 npc (slightly outside of panel). (See ?unit)
panel.rug(x = (1:51)-0.5, y = (1:51)-0.5,
start = 1, end = 1.02,
col="black")
}
levelplot(P, xlab = "Column", ylab = "Row",
col.regions = grey(c(seq(1, 0, length.out = 600))),
## Suppress default scales on right and top sides, by setting their
## tick lengths to zero
scales = list(tck=c(1,0)),
## Turn off clipping, so that panel.rug can plot outside of the panel
par.settings = list(clip = list(panel = "off")),
panel = my_panel)
Related
I made a plot using plot() using RStudio.
x = X$pos
y = X$anc
z = data.frame(x,y)
#cut in segments
my_segments = c(52660, 106784, 151429, 192098, 233666,
273857, 307933, 343048, 373099, 408960,
441545, 472813, 497822, 518561, 537471,
556747, 571683, 591232, 599519, 616567,
625727, 633744)
my_cuts = cut(x,my_segments, labels = FALSE)
my_cuts[is.na(my_cuts)] = 0
This is the code:
#create subset of segments
z_alt = z
z_alt[my_cuts %% 2 == 0,] = NA
#plot green, then alternating segments in blue
plot(z, type="p", cex = 0.3,pch = 16,
col="black",
lwd=0.2,
frame.plot = F,
xaxt = 'n', # removes x labels,
ylim = c(0.3, 0.7),
las = 2,
xlim = c(0, 633744),
cex.lab=1.5, # size of axis labels
ann = FALSE, # remove axis titles
mgp = c(3, 0.7, 0))
lines(z_alt,col="red", lwd=0.2)
# adjust y axis label size
par(cex.axis= 1.2, tck=-0.03)
If you see, some black dots are separated, but other black dots have red connecting lines. Does anyone know how to remove these annoying lines?. I just want black and red dots. Many thanks
there is no need to call the points in a second function. you can try to directly set the color in the plot function using a color vector.
# create some data as you have not provided some
set.seed(123)
df <- data.frame(x=1:100,y=runif(100))
# some sgment breaks
my_segments <- c(0,10,20,50,60)
gr <- cut(df$x, my_segments,labels = FALSE, right = T)
gr[is.na(gr)] <- 0
# create color vector with 1 == black, and 2 == red
df$color <- ifelse(gr %% 2 == 0, 1, 2)
# and the plot
plot(df$x, df$y, col = df$color, pch = 16)
The problem here is that you are using lines to add your z_alt. As the name of the function suggests, you will be adding lines. Use points instead.
z <- runif(20,0,1)
z_alt <- runif(20,0.8,1.2)
plot(z, type="p", col="black", pch = 16, lwd=0.2, ylim = c(0,1.4))
points(z_alt, col = "red", pch = 16, lwd = 0.2)
The title is pretty much self-descriptive. I want to do a heatmap-like plot with lattice, showing the data values as well, something like in here
However, in my case, I want to color the plot according to one variable (fold.change), but show the values of another variable (p.value).
It would be optimal that the color range is green-white-red, and the white is on 0 (negative fold.change values in green, and positive ones in red).
My last question would be how to change the text size of the title and axis text, remove axis title, and rotate x axis text 45 degrees; I don't find this information in the documentation. Thanks!
This is my MWE so far:
library(lattice)
library(latticeExtra)
library(RColorBrewer)
pv.df <- data.frame(compound = rep(LETTERS[1:8], each = 3),
comparison = rep(c("a/b", "b/c", "a/c"), 8),
p.value = runif(24, 0, 1),
fold.change = runif(24, -2, 6))
myPanel <- function(x, y, z, ...) {
panel.levelplot(x,y,z,...)
panel.text(x, y, round(z,1))
}
cols <- rev(colorRampPalette(brewer.pal(6, "RdYlGn"))(20))
png(filename = "test.png", height = 1000, width = 600)
print(
levelplot(fold.change ~ comparison*compound,
pv.df,
panel = myPanel,
col.regions = cols,
colorkey = list(col = cols,
at = do.breaks(range(pv.df$fold.change), 20)),
scales = list(x = list(rot = 90)),
main = "Total FAME abundance - TREATMENT",
type = "g")
)
dev.off()
Which produces this plot:
Thanks!
There are several parts to your question. Let's address them one by one:
1: Change labels. This can be done by varying the 3rd argument for panel.text():
myPanel <- function(x, y, z, ...) {
panel.levelplot(x, y, z, ...)
panel.text(x, y, round(pv.df$p.value, 2))
}
2: Change color scale with white positioned at 0. Calculate how long each segment of the color scale should be, then define each segment separately:
color.ramp.length <- 20
negative.length <- round(abs(range(pv.df$fold.change)[1]) /
diff(range(pv.df$fold.change)) *
color.ramp.length)
positive.length <- color.ramp.length - negative.length
cols <- c(colorRampPalette(c("seagreen", "white"))(negative.length),
colorRampPalette(c("white", "firebrick"))(positive.length))
(Note: you can use other color options from here. I just find the colors associated with "red" / "green" an eye sore.)
3: Modify axis titles / labels. Specify the relevant arguments in levelplot().
levelplot(fold.change ~ comparison*compound,
pv.df,
panel = myPanel,
col.regions = cols,
colorkey = list(col = cols,
at = do.breaks(range(pv.df$fold.change),
color.ramp.length)),
xlab = "", ylab = "", # remove axis titles
scales = list(x = list(rot = 45), # change rotation for x-axis text
cex = 0.8), # change font size for x- & y-axis text
main = list(label = "Total FAME abundance - TREATMENT",
cex = 1.5)) # change font size for plot title
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")))
I have two trellis objects which I would like to combine using c.trellis from latticeExtra (the two figures can be downloaded here). As you can see below, the resulting plot inherits the tick labels from the first figure, whereas the labels from the second figure are discarded. Is it possible to keep different y-axis tick labels when using c.trellis?
library(latticeExtra)
rsq_plt <- readRDS("rsq.rds")
err_plt <- readRDS("err.rds")
latticeExtra:::c.trellis(rsq_plt, err_plt, layout = c(1, 2))
Just for the record, it seems like I finally came up with a proper solution thanks to the comprehensive customization options for trellis plots. Disabling scales in the upper plot (via scales = list(draw = FALSE); note that the file 'rsq.rds' has changed online) prior to performing c.trellis and subsequently update-ing the combined plot with customized y-axes solved the issue.
## combine plots and increase left padding
plt <- latticeExtra:::c.trellis(rsq_plt, err_plt, layout = c(1, 2))
plt <- update(plt,
scales = list(draw = FALSE),
par.settings = list(
layout.widths = list(left.padding = 6, right.padding = 0),
layout.heights = list(top.padding = 0, bottom.padding = 0)
))
## custom panel.axis
panel.fun <- function(...) {
# allow to draw labels outside panel
trellis.par.set("clip", list(panel = "off", strip = "off"))
# add upper y-axis
if (panel.number() == 1) {
panel.axis("left", at = 1, tck = .5, outside = TRUE,
labels = expression("r"^2))
panel.abline(v = 1, lty = 3, lwd = 1, col = "red")
panel.dotplot(lwd = .5, ...)
}
# add lower y-axis
if (panel.number() == 2) {
panel.axis("left", at = 2:4, outside = TRUE, tck = .5,
labels = c("MAE", "ME", "RMSE"))
panel.abline(v = 0, lty = 3, lwd = 1, col = "red")
panel.dotplot(..., lwd = 0.5)
}
}
## apply custom axes
update(plt, panel = panel.fun)
I want to visualize time series data with a 'scatter plot' and a histogram on the right side, but I haven't been able to figure out how to turn OFF the histogram on the upper side.
Code Example:
install.packages("psych")
library(psych)
data = matrix(rnorm(n=100000,mean=2,sd=1.5), nrow = 100, ncol=1000)
fs = list()
fs$p_Z = 1*(data>2)
n_p = 1;
for(i in floor(seq(1,dim(data)[2],length.out=n_p)))
{
scatter.hist(x = rep(1:length(data[,i])), y = data[,i],
xlab = 'observations',
ylab = 'log(TPM)',
title = 'Mixture Plot',
col = c("red","blue")[fs$p_Z[,i]+1],
correl = FALSE, ellipse = FALSE, smooth = FALSE)
}
Result:
Expected Result:
Same as the one I have but with no histogram on the upper side. I.e., ONLY the histogram on the right side for log(TPM).
Note: I am using psych package, scatter.hist function which seemed easy and nice to use, but couldn't find how to turn off one histogram.
Where flexibility ends, hacking begins. If you look at scatter.hist function, you will see that it is pretty basic usage of R base graphics. Following modified code would create the plot you want:
scat.hist <- function(x, y, xlab = NULL, ylab = NULL, title = "", ...) {
## Create layout
layout(matrix(c(1,2),1,2,byrow=TRUE), c(3,1), c(1,3))
## Plot scatter
par(mar=c(5,5,3,1))
plot(x= x, y = y, xlab = xlab, ylab = ylab, main = title, ...)
## Right histogram
yhist <- hist(y, plot = FALSE, breaks = 11)
par(mar=c(5,2,3,1))
mp <- barplot(yhist$density, space=0, horiz=TRUE, axes = FALSE)
## Density
d <- density(y, na.rm = TRUE, bw = "nrd", adjust = 1.2)
temp <- d$y
d$y <- (mp[length(mp)] - mp[1] + 1) * (d$x - min(yhist$breaks))/(max(yhist$breaks) - min(yhist$breaks))
d$x <- temp
lines(d)
}
Let's try it for the first row:
i = 1
scat.hist(x = seq_along(data[,i]), y = data[,i], col = c("red", "blue")[fs$p_Z[,i]+1], xlab = 'observations', ylab = 'log(TPM)', title = 'Mixture Plot')