Вопрос по r, matrix, plot, heatmap – объединяя два участка в г

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)

enter image description here

Мне нужно подавить имена в столбцах 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)

enter image description here

Я намереваюсь повернуть первый график так, чтобы X1-X10 соответствовали тому же на втором графике, и есть связь между метками на втором графике и первым графиком. Вывод будет выглядеть так:

enter image description here Как я могу это сделать ?

Edits: на основе комментариев о add = TRUE .... Я пытаюсь добавить полигон к графику тепловой карты, как показано ниже. Но я не мог найти координаты .. Стратегия построить таким образом и перевернуть фактическую цифру позже ... помощь очень ценится ...

enter image description here

labRow=NA, labCol=NA в вашемheatmap Звонок избавится от ярлыков. thelatemail
тепловая карта (mmat, keep.dendro = F, Rowv = NA, Colv = NA, labRow = NA, labCol = NA, add = TRUE) позволит добавить вторую часть. Вам не нужно снова использовать plot, просто многоугольник и plot работают нормально, однако вам может понадобиться повернуть данные самой матрицы, чтобы повернуть карту тепла ... у меня нет полного решения, только подсказка .. SHRram

Ваш Ответ

3   ответа
11

но в нем есть некоторые идеи, которые могут помочь вам создать один ...

По сравнению сbase графическая система,grid система (на которой обаggplot2 а такжеlattice основаны) имеетmuch лучшая поддержка для размещения нескольких графических элементов в составном графике. Он использует «окна просмотра» указать места на участке; окна просмотра любой высоты, ширины и степени поворота могут быть «вытолкнуты»; в любое место в пределах существующего участка. Затем, после толкания, они могут быть нанесены на график и, в конце концов, удалены, так что другой участок может быть размещен в другом месте в основной области построения.

Если бы это был мой проект, я бы, вероятно, работал надgridрешение на основе (либеральное использование более высокого уровняlattice или жеggplot2 участки).gridBase Пакет, однако, предоставляет некоторую поддержку для объединенияbase а такжеgrid графика, и я использовал это в приведенном ниже примере.

(Подробнее о том, что я сделал ниже, см.grid.pdf, viewports.pdf, а такжеrotated.pdf виньетки, расположенные вfile.path(.Library, "grid", "doc"), а также виньетка, которая открывается, набрав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()

enter image description here

Ох - я просто предположил, что вы хотели относиться к нам обоим справедливо: =)
Я случайно присудил награду (нельзя отменить) на этот ответ, скорее другой полный ответ, к счастью от того же автора .... jon
вы, вероятно, хотите использоватьupViewport а не всплывающее, если вы хотите иметь возможность вернуться обратно к месту.
@ JoshO 'Brien спасибо большое решение и за идеи ... как вы сказали, это может быть точкой, с которой нужно начинать, особенно с того, что нужно сделать в следующем разделе: text (vard $ position, 0.7, vard $ position, srt = 90), текст (vard $ position, -0.7, vard $ Names) jon
@baptiste - Хороший вопрос. Поскольку нет никакого компенсирующего преимущества при использованииpopViewport()Я должен тренироваться по умолчаниюupViewport(), Я начну с редактирования ответа выше;)
13

gridрешение на основе Единственный действительно вовлеченный бит - это функцияconvertToColors(); он берет числовую матрицу (возможно, включая NA) и преобразует ее в цветовые строки sRGB (например,"#FFFFFF) представляет цвета на красно-беломheat.colors() масштаб. Красный соответствует минимальному значению в матрице, белый соответствует максимальному значению, иNAс прозрачны.

Кроме этого, я думаю, что код неплохо показывает, сколькоgrid функции не более сложные, и значительно более последовательные и гибкие, чем низкоуровневыеbase графические функции.

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()

enter image description here

спасибо за умное решение .... похоже, что сетка - это хорошие уроки, и спасибо, что тоже это поняли. У меня есть небольшой вопрос - расположение баров совпадает с треугольником только тогда, когда в графическом интерфейсе разработано новое построение, если какой-либо график уже открыт другого размера, тогда существует несоответствие между верхним прямоугольником и частью треугольника ... jon
@jon - Я тоже немного озадачен этим поведением. Я изменил свой код для вызоваgrid.newpage() вместоplot.new(), чтобы подчеркнуть, что для этого требуется новое графическое устройство, но я не уверен на 100%, почему.
0

Я обнаружил ошибку в этой строке кода:

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

Решено путем замены "T" сTRUE (Без кавычек)

Похожие вопросы