15

这是我打算合并的两个图:

首先是热图图的半矩阵。.........................................

# plot 1 , heatmap plot
set.seed (123)
 myd <- data.frame ( matrix(sample (c(1, 0, -1), 500, replace = "T"), 50))

mmat <-  cor(myd)
diag(mmat) <- NA
mmat[upper.tri (mmat)] <- NA
heatmap (mmat, keep.dendro = F, Rowv = NA, Colv = NA)

在此处输入图像描述

我需要抑制 x 和 y 列中的名称并将它们放在对角线中。

第二个图,请注意第一个图中的名称/标签对应于第二个图中的名称(x1 到 X10):

  vard <- data.frame ( position = c(1, 10, 15, 18, 20, 23, 24, 30, 35, 40), 
          Names =paste ("X", 1:10, sep = ""))
    plot(vard$position, vard$position - vard$position,
                type = "n", axes = FALSE, xlab = "", ylab = NULL, yaxt = "n")
    polygon(c(0, max(vard$position + 0.08 * max(vard$position)),
                max(vard$position) + 0.08 * max(vard$position),
                0), 0.2 * c(-0.3, -0.3, 0.3, 0.3), col = "green4")
    segments(vard$position, -0.3, vard$position,                0.3)
    text(vard$position, 0.7, vard$position,
                    srt = 90)
    text(vard$position, -0.7, vard$Names)

在此处输入图像描述

我打算旋转第一个图,以便 X1 到 X10 应该对应于第二个图中的相同,并且第二个图中的标签与第一个图之间存在连接。输出如下所示:

在此处输入图像描述 我怎样才能做到这一点 ?

编辑:基于关于 add = TRUE ....的评论我正在尝试将多边形添加到热图图中,如下所示。但我找不到坐标..以这种方式绘制策略并稍后翻转实际数字......非常感谢......

在此处输入图像描述

4

3 回答 3

13

这是一个完全基于网格的解决方案。唯一真正涉及的部分是函数convertToColors();它采用一个数字矩阵(可能包括 NA)并将其转换为 sRGB 颜色字符串(例如"#FFFFFF),以表示红色到白色的颜色heat.colors()。红色对应矩阵中的最小值,白色对应最大值,NAs是透明的。

除此之外,我认为代码在显示有多少网格函数并不比低级基本图形函数更复杂、更一致和更灵活方面做得很好。

library(grid)

## Data: heatmap
set.seed (123)
myd <- data.frame ( matrix(sample (c(1, 0, -1), 500, replace = "T"), 50))
mmat <-  cor(myd)
diag(mmat) <- NA
mmat[upper.tri (mmat)] <- NA
## Data: Positions
vard <- c(1, 10, 15, 18, 20, 23, 24, 30, 35, 40)

## Construct a function to convert a numeric matrix to a matrix of color names.
## The lowest value in the matrix maps to red, the highest to white,
## and the NAs to "transparent".
convertToColors <- function(mat) {
    # Produce 'normalized' version of matrix, with values ranging from 0 to 1
    rng <- range(mat, na.rm = TRUE)
    m <- (mat - rng[1])/diff(rng)
    # Convert to a matrix of sRGB color strings
    m2 <- m; class(m2) <- "character"
    m2[!is.na(m2)] <- rgb(colorRamp(heat.colors(10))(m[!is.na(m)]), max = 255)
    m2[is.na(m2)] <- "transparent"
    return(m2)
}

## Initialize plot and prepare two viewports
grid.newpage()
heatmapViewport <- viewport(height=1/sqrt(2), width=1/sqrt(2), angle = -135) 
annotationViewport <- viewport(y = 0.7, height = 0.4)

## Plot heat map
pushViewport(heatmapViewport)
    grid.raster(t(convertToColors(mmat)), interpolate = FALSE)
upViewport()

## Precompute x-locations of text and segment elements
n <- nrow(mmat)
v_x <- vard/max(vard)
X_x <- seq(0, 1, len=n)

## Plot the annotated green bar and line segments
pushViewport(annotationViewport)
    ## Green rectangle
    grid.polygon(x = c(0,0,1,1,0), y = c(.45,.55,.55,.45,.45),
                 gp = gpar(fill = "green4"))
    pushViewport(viewport(width = (n-1)/n))
        ## Segments and text marking vard values
        grid.segments(x0 = v_x, x1 = v_x, y0 = 0.3, y1 = 0.7)
        grid.text(label = vard, x = v_x, y = 0.75, rot = 90)
        ## Text marking heatmap column names (X1-X10)
        grid.text(paste0("X", seq_along(X_x)), x = X_x, y=0.05,
                  gp = gpar(fontface="bold"))
        ## Angled lines
        grid.segments(x0 = v_x, x1 = X_x, y0 = 0.29, y1 = 0.09)
    upViewport()
upViewport()

在此处输入图像描述

于 2012-07-18T03:44:56.840 回答
11

This isn't really a full answer, but there are some ideas in it that might help you construct one...

Compared to the base graphical system, the grid system (on which both ggplot2 and lattice are based) has much better support for arranging multiple graphical elements in a compound plot. It uses 'viewports' to specify locations in a plot; viewports of any height, width and degree of rotation can be 'pushed' to any location within an existing plot. Then, once pushed, they can be plotted into and, finally, stepped up from so that another plot can be placed elsewhere in the main plotting area.

If this were my project, I'd probably work towards a fully grid-based solution (making liberal use of higher-level lattice or ggplot2 plots). The gridBase package, however, does provide some support for combining base and grid graphics, and I've used that in the example below.

(For more details on what I've done in the following, see the grid.pdf, viewports.pdf, and rotated.pdf vignettes located in file.path(.Library, "grid", "doc"), as well as the vignette that is opened by typing vignette("gridBase", package="gridBase")).

## Load required packages
library(lattice); library(grid); library(gridBase)

## Construct example dataset
set.seed (123)
myd <- data.frame ( matrix(sample (c(1, 0, -1), 500, replace = "T"), 50))
mmat <-  cor(myd)
diag(mmat) <- NA
mmat[upper.tri (mmat)] <- NA

## Reformat data for input to `lattice::levelplot()`
grid <- data.frame(expand.grid(x = rownames(mmat), y = colnames(mmat)), 
                   z = as.vector(mmat))

## Open a plotting device    
plot.new()     

## Push viewport that will contain the levelplot; plot it; up viewport.
pushViewport(viewport(y = 0.6, height = 0.8, width = 0.8, angle=135))
    lp <- levelplot(z~y*x, grid, colorkey=FALSE, 
                    col.regions=heat.colors(100), aspect=1,
                    scales = list(draw=FALSE), xlab="", ylab="", 
                    par.settings=list(axis.line=list(col="white")))
    plot(lp, newpage=FALSE)
upViewport()

## Push viewport that will contain the green bar; plot it; up viewport.
pushViewport(viewport(y = 0.7, height=0.2))
    # Use the gridBase::gridOMI to determine the location within the plot.
    # occupied by the current viewport, then set that location via par() call
    par(omi = gridOMI(), new=TRUE, mar = c(0,0,0,0))
    plot(0:1, 0:1,type = "n", axes = FALSE, xlab = "", ylab = "", yaxt = "n")
    polygon(x=c(0,0,1,1,0), y = c(.4,.6,.6,.4,.4), col = "green4")
upViewport()

在此处输入图像描述

于 2012-07-15T22:58:59.677 回答
0

我在这行代码中遇到了错误:

myd <- data.frame ( matrix(sample (c(1, 0, -1), 500, replace = "T"), 50))

通过将“T”替换为TRUE(无引号)解决

于 2017-06-02T04:51:01.820 回答