在ggplot2中绘制一个重新调整的成对距离矩阵

时间:2018-02-07 14:16:18

标签: r ggplot2 tidyr pairwise

加载库并创建可重现的示例

#Load libraries
set.seed(123)
library(tidyr)
library(ggplot2)

#Creating a fake pairwise matrix
locs <- 5
tmp <- matrix(runif(n = locs*locs),nrow = locs,ncol = locs)
tmp[upper.tri(tmp,diag = T)] <- NA
colnames(tmp) <- LETTERS[1:locs]
rownames(tmp) <-  LETTERS[1:locs]
tmp

#Converting into a data frame
tmp1 <- as.data.frame(cbind(rownames(tmp),as.data.frame(tmp)))
names(tmp1)[1] <- "locA"
rownames(tmp1) <- NULL
head(tmp1)

#Changing it to long form and getting rid of NAs
tmp1 <- gather(tmp1, key = "locB",value = "value",-locA)
tmp1 <- tmp1[!is.na(tmp1$value),]
tmp1

#Making a tiled plot based on default levels
ggplot(tmp1, aes(x = locA, y=locB, fill=value, label=round(value,3)))+
  geom_tile(color="black")+
  geom_text(size=5,color="white")

但是出于更具生物意义的原因,我想改变这些比较的顺序

#biological order
my.order <- c("A","C","D","B","E")
my.order

#re-leveling
tmp1$locA <- factor(tmp1$locA, levels = my.order,ordered = T)
tmp1$locB <- factor(tmp1$locB, levels = my.order,ordered = T)
tmp1

#the releveled plot
ggplot(tmp1, aes(x = locA, y=locB, fill=value, label=round(value,3)))+
  geom_tile(color="black")+
  geom_text(size=5,color="white")

我正试图找到一种方法来获得“B-C”&amp; “B-D”比较用下对角线表示。

Trying to fix this issue

我试图找到一个带有完整矩阵和lower.tri()的解决方案,但到目前为止失败了

#here is the full matrix
x <- tmp
x[is.na(x)] <- 0
y <- t(tmp)
y[is.na(y)] <- 0
full.matrix <- x+y
full.matrix

#the function lower.tri might be useful in this context
lower.tri(full.matrix)

2 个答案:

答案 0 :(得分:1)

从创建tmpfull.matrix之后开始,如果您运行:

reordered_mat <- full.matrix[match(my.order, rownames(full.matrix)), 
                             match(my.order, colnames(full.matrix))]

lt_reordered_mat <- replace(reordered_mat, !lower.tri(reordered_mat), NA)

tmp1 <- as.data.frame(cbind(rownames(lt_reordered_mat),as.data.frame(lt_reordered_mat)))

然后重新运行所有tmp1创建代码并重新排序,那么您应该得到所需的结果:

enter image description here

完全可重现的代码:

#Load libraries
set.seed(123)
library(tidyr)
library(ggplot2)

#Creating a fake pairwise matrix
locs <- 5
tmp <- matrix(runif(n = locs*locs),nrow = locs,ncol = locs)
tmp[upper.tri(tmp,diag = T)] <- NA
colnames(tmp) <- LETTERS[1:locs]
rownames(tmp) <-  LETTERS[1:locs]

x <- tmp
x[is.na(x)] <- 0
y <- t(tmp)
y[is.na(y)] <- 0
full.matrix <- x+y


my.order <- c("A","C","D","B","E")

reordered_mat <- full.matrix[match(my.order, rownames(full.matrix)), 
                             match(my.order, colnames(full.matrix))]
lt_reordered_mat <- replace(reordered_mat, !lower.tri(reordered_mat), NA)
tmp1 <- as.data.frame(cbind(rownames(lt_reordered_mat),as.data.frame(lt_reordered_mat)))
names(tmp1)[1] <- "locA"
rownames(tmp1) <- NULL

#Changing it to long form and getting rid of NAs
tmp1 <- gather(tmp1, key = "locB",value = "value",-locA)
tmp1 <- tmp1[!is.na(tmp1$value),]


#re-leveling
tmp1$locA <- factor(tmp1$locA, levels = my.order,ordered = T)
tmp1$locB <- factor(tmp1$locB, levels = my.order,ordered = T)

#the releveled plot
ggplot(tmp1, aes(x = locA, y=locB, fill=value, label=round(value,3)))+
  geom_tile(color="black")+
  geom_text(size=5,color="white")

答案 1 :(得分:0)

正如Mike H.提供的答案,我创造了一个略有不同的解决方案。我认为他的答案更好,因为它更简洁,不使用for循环。

    import { trigger, state, style, transition,
    animate, group, query, stagger, keyframes
} from '@angular/animations';

export const SlideInOutAnimation = [
    trigger('slideInOut', [
    state('in', style({
        'height': '*', 'opacity': '1', 'overflow': 'hidden', 'visibility': 'visible'
    })),
    state('out', style({
        'height': '0px', 'opacity': '0', 'overflow': 'hidden', 'visibility': 'hidden'
    })),
    transition('in => out', [group([
        animate('.25s ease-in-out', style({
            'opacity': '0'
        })),
        animate('.6s ease-in-out', style({
            'height': '0px'
        })),
        animate('1s ease-in-out', style({
            'visibility': 'hidden'
        }))
    ]
    )]),
    transition('out => in', [group([
        animate('.25s ease-in-out', style({
            'visibility': 'visible'
        })),
        animate('.6s ease-in-out', style({
            'height': '*'
        })),
        animate('1s ease-in-out', style({
            'opacity': '1'
        }))
    ]
    )])
])
]