R 带条件的热图

我研究了一些rnaseq数据，需要在确定的基因转录本上用点绘制热图。我不知道如何使用ggpplot或pheatmap来实现这一点。因此，我必须使用inkscape手动将每个点放在绘图上。这太过分了，而且浪费时间。下图是inkscape中的图像：

我用以下代码绘制了基本图：

pal <- colorRampPalette(c("blue","white","red"))
a<-pal(200)
my_sample_col <- data.frame(Condition = 
c("ALZxCon","PAxCon","PSPxCon"))
rownames(my_sample_col)<- colnames(transcript.table[,1:3])
my_colour <- list(Condition = c(ALZxCon = "lightblue",PAxCon = 
"pink",PSPxCon = "yellow"))

pheatmap(transcript.table[,1:3],annotation_col = 
my_sample_col,annotation_colors = my_colour[1],
color=a,show_colnames = F,cellheight = 15,cex=1,cluster_rows = 
F,cluster_cols = F,
fontsize_row = 10,gaps_col = c(1,2),cellwidth = 15)

---

pal我个人不太喜欢pheatmap之类的函数，正是因为你无法定制你想要的每一个细节。我将使用ggplot2显示一个备选方案

首先，ggplot喜欢长格式的数据，我将按如下方式进行：

# Loading in your data
z <- "log2FC(AZ),log2FC(PA),log2FC(PSP),Sig(AZ),Sig(PA),Sig(PSP)
ABCA7_ENST000002633094,-0.2,-0.3,-0.2,Not Sig,FDR<0.05,FDR<0.05
ABCA7_ENST0000043319,-0.6,-0.37,-0.7,FDR<0.05,FDR<0.05,FDR<0.05"
tab <- read.table(text=z, header = T, sep = ",")

# Converting to long format
lfc <- tab[,1:3]
pval <- tab[,4:6]
colnames(lfc) <- colnames(pval) <- c("AZ", "PA", "PSP")

lfc  <- reshape2::melt(as.matrix(lfc))
pval <- reshape2::melt(as.matrix(pval))

df <- cbind(lfc, pval = pval$value)

#加载数据
z就我个人而言，我不太喜欢pheatmap之类的功能，正是因为你无法定制你想要的每一个细节。我将使用ggplot2显示一个备选方案

首先，ggplot喜欢长格式的数据，我将按如下方式进行：

# Loading in your data
z <- "log2FC(AZ),log2FC(PA),log2FC(PSP),Sig(AZ),Sig(PA),Sig(PSP)
ABCA7_ENST000002633094,-0.2,-0.3,-0.2,Not Sig,FDR<0.05,FDR<0.05
ABCA7_ENST0000043319,-0.6,-0.37,-0.7,FDR<0.05,FDR<0.05,FDR<0.05"
tab <- read.table(text=z, header = T, sep = ",")

# Converting to long format
lfc <- tab[,1:3]
pval <- tab[,4:6]
colnames(lfc) <- colnames(pval) <- c("AZ", "PA", "PSP")

lfc  <- reshape2::melt(as.matrix(lfc))
pval <- reshape2::melt(as.matrix(pval))

df <- cbind(lfc, pval = pval$value)

#加载数据
z如果您添加一个包含少量数据样本的最小工作示例，将更容易提供帮助。请不要以图像形式提供数据。这需要任何想帮你的人都把它全部输入。我已经做了更正。谢谢，guysYou没有提供任何可复制的数据。请看，如果您添加一个包含少量数据样本的最小工作示例，将更容易提供帮助。请不要以图像形式提供数据。这需要任何想帮你的人都把它全部输入。我已经做了更正。谢谢，guysYou没有提供任何可复制的数据。伙计，你救了我的命，非常感谢。愿宇宙中所有的神保佑你。谢谢你救了我的命，非常感谢。愿宇宙中所有的神保佑你。谢谢它确实工作得很好。
anno <- data.frame(x = levels(df$Var2),
                   y = "Condition")

library(ggnewscale)

ggplot(df, aes(Var2, Var1)) +
  # Important for ggnewscale is to specify a fill in the layer/geom itself
  geom_tile(aes(fill = value),
            width = 0.9, colour = "grey50") +
  geom_point(data = df[df$pval == "FDR<0.05",]) +
  scale_fill_gradientn(colours = c("blue", "white", "red"),
                       limits = c(-1,1)*max(abs(df$value)),
                       name = expression(atop("Log"[2]*" Fold","Change"))) +
  # Set new scale fill after you've specified the scale for the heatmap
  new_scale_fill() +
  geom_tile(data = anno, aes(x, y, fill = x),
            width = 0.9, height = 0.8, colour = "grey50") +
  scale_fill_discrete(name = "Condition") +
  scale_x_discrete(name = "", expand = c(0,0)) +
  scale_y_discrete(name = "", expand = c(0,0),
                   limits = c(levels(df$Var1), "Condition"),
                   position = "right") +
  coord_equal() +
  theme(panel.background = element_blank(),
        axis.ticks = element_blank(),
        axis.text.x = element_blank(),
        axis.text.y = element_text(face = c(rep("plain", nlevels(df$Var1)), "bold")))