Related
The results of the plot can be normally arranged in grids. I currently have an issue by plotting the results of the ctree function from the party package in a grid. This question is a duplicate of a question from 6 years and 8 months ago (Plot of BinaryTree (ctree, party) ignores plot option of par()). It was opted that gridExtra could provide a solution. However, till now no solution for this issue has been given. Consider the example below.
library(party)
library(gridExtra)
#Create random dataframe
dfA <- data.frame(x=c(rnorm(50, 5), rnorm(50, 2)),
y=c(rbinom(50, 1, .9), rbinom(50, 1, .1)))
#Duplicate dataframe
dfB <- dfA
#Plot in base R wit par (does not work)
par(mfrow = c(1, 2))
plot(party::ctree(y~x, data=dfA))
plot(party::ctree(y~x, data=dfB))
#Try to organize in a grid wit gridExtra (does not work)
treeA <- party::ctree(y~x, data=dfA)
treeB <- party::ctree(y~x, data=dfB)
grobA <- arrangeGrob(plot(treeA))
grobB <- arrangeGrob(plot(treeB))
grid.arrange(grobA, grobB, ncol=2)
Error in gList(list(wrapvp = list(x = 0.5, y = 0.5, width = 1, height = 1, :
only 'grobs' allowed in "gList"
The arrangeGrob(plot(treeA)) and arrangeGrob(plot(treeB)) also return an error stating Error in vapply(x$grobs, as.character, character(1)) : values must be length 1, but FUN(X[[1]]) result is length 0
Does someone known how plot the results of the ctree function in a grid?
Thank you in advance.
## grab the scene as a grid object
library(gridExtra)
library(gridGraphics)
library(grid)
list.to.pass <- list('plot(ctree(y~x, data=dfA))',
'plot(ctree(y~x, data=dfB))')
out<-list()
for (i in c(1,2)){
print(i)
formula(list.to.pass[[i]])
out[[i]] <- grid.grab()
print(out[[i]])
dev.off()
}
grid.arrange(out[[1]], out[[2]], nrow = 1,ncol=2)
You will get:
The plots in party and its successor package partykit are implemented in grid and hence the base graphics options from par() such as mfrow do not work. You can use grid.layout() to achieve similar results. Doing so in plain grid is a bit technical but the code should not be too hard to follow:
grid.newpage()
pushViewport(viewport(layout = grid.layout(1, 2)))
pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1))
plot(treeA, newpage = FALSE)
popViewport()
pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2))
plot(treeB, newpage = FALSE)
popViewport()
The reason for the newpage = FALSE argument is that by default the plot is drawn on a new page, rather than adding to a potentially existing plot.
I created a few plots with the filled.contour function. Then I would like to plot two of the plots next to each other. Therefore I used the grid.arrange function.
This is my code:
install.packages("gridExtra")
install.packages("lattice")
install.packages("grid")
library(lattice)
library(gridExtra)
library(grid)
# Fake data
x <- c(1:10)
y <- c(1:10)
z<-matrix(data=c(1:100), nrow=10, ncol=10, byrow = FALSE)
p1<-filled.contour(x,y,z, color = terrain.colors, asp = 1) # simple
# Lay out both plots
grid.arrange(p1,p1, ncol=2)
But what I get is:
Error in gList(list(wrapvp = list(x = 0.5, y = 0.5, width = 1, height
= 1, : only 'grobs' allowed in "gList"
Thats why I tried this:
install.packages("gridExtra")
install.packages("lattice")
install.packages("grid")
library(lattice)
library(gridExtra)
library(grid)
# Fake data (taken from the fill.contour help examples)
x <- c(1:10)
y <- c(1:10)
z<-matrix(data=c(1:100), nrow=10, ncol=10, byrow = FALSE)
p1<-filled.contour(x,y,z, color = terrain.colors, asp = 1) # simple
p1<-grob(p1)
is.grob(p1)
# Lay out both plots
grid.arrange(p1,p1, ncol=2)
But this does not work either. Can you help me please?
As #eipi10 pointed out, filled.contour is base graphics, so you should use base arrangement functions, i.e. par(mfrow = c(1,2)) to arrange two plots side by side.
EDIT: apparently filled contour is famous for defeating all layout attempts. I tried par(plt...) layout() and par(mfrow...) I found filled.countour3 as a workaround as described here:
http://wiki.cbr.washington.edu/qerm/sites/qerm/images/e/ec/Example_4_panel_contour_plot_with_one_legend.R
and in question 14758391 on this site. Sorry for the confusion
My problem is different from this Side-by-side plots with ggplot2.
Two reasons: 1) With aheatmap() function, the heatmap by aheatmap() and barplots by other functions cann't save in one picture when i use gridExtra.
2) I want "barplots correspond to the rows/columns of the heatmap". I have tried with gridExtra, but the picture changed with the different data sets.
I want to merge some barplots with a heatmap, such that a left/right barplot correspond to the rows of the heatmap, and further that a top/bottom barplot correspond to the columns of the heatmap.
Like this picture (and a barplot in the bottom)
MATLAB Bar graph + HeatMap/Imagesc
Now the aheatmap() in NMF package is used and the code as followings (but I
cann't add barplots):
n <- 50; p <- 20
x <- abs(rmatrix(n, p, rnorm, mean=4, sd=1))
x[1:10, seq(1, 10, 2)] <- x[1:10, seq(1, 10, 2)] + 3
x[11:20, seq(2, 10, 2)] <- x[11:20, seq(2, 10, 2)] + 2
rownames(x) <- paste("ROW", 1:n)
colnames(x) <- paste("COL", 1:p)
annotation = data.frame(Var1 = factor(1:p %% 2 == 0, labels = c("Class1", "Class2")), Var2 = 1:10)
aheatmap(x, annCol = annotation, Rowv=FALSE)
Any suggestions to add barplots using aheatmap() or even using other packages?
What about something along these lines to begin with?
m <- matrix(abs(rnorm(25 * 10)), ncol = 25)
plotMyHeat <- function(x) {
x <- t(x)
l <- matrix(c(1,2), ncol = 2)
layout(l)
op <- par(mar = c(2,2,1,0))
image(x)
par(mar = c(2,1,1,1))
barplot(rowMeans(x),horiz = TRUE, yaxs = "i")
par(op)
}
plotMyHeat(m)
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.
I searched a lot of questions about heatmap throughout the site and packages, but I still have a problem.
I have clustered data (kmeans/EM/DBscan..), and I want to create a heatmap by grouping the same cluster. I want the similar color patterns to be grouped in the heatmap, so generally, it looks like a block-diagonal.
I tried to order the data by the cluster number and display it,
k = kmeans(data, 3)
d = data.frame(data)
d = data.frame(d, k$cluster)
d = d[order(d$k.cluster),]
heatmap(as.matrix(d))
but it is still not sorted and looks like this link: But, I want it to be sorted by its cluster number and looked like this:
Can I do this in R?
I searched lots of packages and tried many ways, but I still have a problem.
Thanks a lot.
You can do this using reshape2 and ggplot2 as follows:
library(reshape2)
library(ggplot2)
# Create dummy data
set.seed(123)
df <- data.frame(
a = sample(1:5, 1000, replace=TRUE),
b = sample(1:5, 1000, replace=TRUE),
c = sample(1:5, 1000, replace=TRUE)
)
# Perform clustering
k <- kmeans(df, 3)
# Append id and cluster
dfc <- cbind(df, id=seq(nrow(df)), cluster=k$cluster)
# Add idsort, the id number ordered by cluster
dfc$idsort <- dfc$id[order(dfc$cluster)]
dfc$idsort <- order(dfc$idsort)
# use reshape2::melt to create data.frame in long format
dfm <- melt(dfc, id.vars=c("id", "idsort"))
ggplot(dfm, aes(x=variable, y=idsort)) + geom_tile(aes(fill=value))
You should set Rowv and Colv to NA if you don't want the dendrograms and the subseuent ordering. BTW, You should also put of the scaling. Using the df of Andrie :
heatmap(as.matrix(df)[order(k$cluster),],Rowv=NA,Colv=NA,scale="none",labRow=NA)
In fact, this whole heatmap is based on image(). You can hack away using image to construct a plot exactly like you want. Heatmap is using layout() internally, so it will be diffucult to set the margins. With image you could do eg :
myHeatmap <- function(x,ord,xlab="",ylab="",main="My Heatmap",
col=heat.colors(5), ...){
op <- par(mar=c(3,0,2,0)+0.1)
on.exit(par(op))
nc <- NCOL(x)
nr <- NROW(x)
labCol <- names(x)
x <- t(x[ord,])
image(1L:nc, 1L:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 +
c(0, nr), axes = FALSE, xlab=xlab, ylab=ylab, main=main,
col=col,...)
axis(1, 1L:nc, labels = labCol, las = 2, line = -0.5, tick = 0)
axis(2, 1L:nr, labels = NA, las = 2, line = -0.5, tick = 0)
}
library(RColorBrewer)
myHeatmap(df,order(k$cluster),col=brewer.pal(5,"BuGn"))
To produce a plot that has less margins on the side. You can also manipulate axes, colors, ... You should definitely take a look at the RColorBrewerpackage
(This custom function is based on the internal plotting used by heatmap btw, simplified for the illustration and to get rid of all the dendrogram stuff)