今天分享的学习笔记：异常绘图数据转换方法（对数法，评分法，踢值法，颜色法），用于对热图进行修饰。

ggplot2中绘制热图时，有时候会遇到数据的组间差异太大，导致可视化结果不明显（颜色区分度较低），因此学习几种对特殊数据的处理方法，使热图呈现的效果更好。

生成原始数据

创建一组数据，包含4个不同的样本（a等4行），5个不同的变量（Grp1等5列），其中不同样本间的均值差异较大。

> data <- c(rnorm(5,mean=5),rnorm(5,mean=20),rnorm(5,mean=100),c(600,700,800,900,10000))> data <- c(rnorm(5,mean=5),rnorm(5,mean=20),rnorm(5,mean=100),c(600,700,800,900,10000))> #rnorm函数能够随机生成一组正态分布的数据> data <- matrix(data,ncol = 5,byrow=T)> #将数据转化为矩阵格式> data <- as.data.frame(data) #转化为数据框> rownames(data) <- letters[1:4] #行名设置为小写字母abcd> colnames(data) <- paste("Grp",1:5,sep="_") #列名设置为Grp+序号> data #查看一下当前的数据      Grp_1      Grp_2      Grp_3      Grp_4        Grp_5a   4.31371   6.520402   5.049561   5.013933     6.716523b  18.68553  19.702193  20.845860  21.102063    19.592703c  99.00071  99.310800  99.422325 101.114502   100.693449d 600.00000 700.000000 800.000000 900.000000 10000.000000

转换数据形式

刚刚创建的原始数据是4行5列的数据框，需要将其转化成类似id~value的长数据形式（行数变多，列数减小，实际数据表达内容相同）

这种长数据用于后续的ggplot2作图使用，该转换过程的原理和方法我之前的笔记中有记录，欢迎查阅。

> data$ID <- rownames(data) #添加新列，列的内容为当前数据框的行名> data_1 <- melt(data,id.vars = c("ID")) #将矩阵融合变成长类型（用于绘图，列数少，看起来又窄又长）> head(data_1) #查看当前数据的前几行  ID variable      value1  a    Grp_1   4.3137102  b    Grp_1  18.6855323  c    Grp_1  99.0007134  d    Grp_1 600.000000 #在此可以发现这一个的值和前面的相比很大很突出。5  a    Grp_2   6.5204026  b    Grp_2  19.702193

绘图结果

利用ggplot函数绘制热图，可以发现下图中只有右上角的颜色比较深，其他区域没有明显差别，这样的结果看不出差异性，需要对数据进一步转换。

p <- ggplot(data_1,aes(x=variable,y=ID)) +  xlab("samples") + theme_bw() +   theme(panel.grid.major = element_blank()) + theme(legend.key = element_blank()) +  theme(axis.text.x = element_text(angle=45,hjust = 1,vjust = 1)) +  theme(legend.position = "top") + geom_tile(aes(fill=value)) +  scale_fill_gradient(low="white",high="blue")p 

数据的转换方法

根据资料提供的信息，这里介绍对数法、评分法、踢值法、颜色法四种方案。

对数法

对数函数能够将数据之间的相对差异性进行转换，根据对数的图像可以看出，特大数值的差异性被压缩，相对投影长度变小，以便于和较小数值处于同一基准规则进行差异比较。

因此，首先将原始data数据经过对数转化，然后再对转化后的数据添加ID列并转成长数据形式（简称为“两步走”）

> data_l <- log2(data+1) #对原始数据进行对数运算> data_l #查看转换后的数据     Grp_1    Grp_2    Grp_3    Grp_4     Grp_5a 2.545781 2.076924 2.316681 2.473611  2.919831b 4.302711 4.432475 4.355503 4.441871  4.439853c 6.675369 6.675384 6.687525 6.650458  6.659354d 9.231221 9.453271 9.645658 9.815383 13.287857> data_l$ID <- rownames(data_l) #对转换后的数据添加新列，内容为数据的行名> data_lm <- melt(data_l,id.vars = c("ID")) #对数据进行融合，转化成长数据用于绘图

需要注意的是，这两步骤不能调换顺序，因为我测试时先添加了ID导致对数转化失败，应该先对数值进行处理。

重新绘图之后，出现了肉眼可见的差异哈哈哈哈哈！

p <- ggplot(data_lm,aes(x=variable,y=ID)) +  xlab("samples") +ylab(NULL) +  theme_bw() + theme(panel.grid.major = element_blank()) +  theme(legend.key = element_blank()) + theme(legend.position = "top") +  theme(axis.text.x = element_text(angle = 45,hjust = 1,vjust = 1)) +  geom_tile(aes(fill=value)) + scale_fill_gradient(low="green",high = "blue")p

对数法虽然有用，但也有局限性。

比如上面生成的图中绿色部分的区分度仍然很低，接下来用新的测试数据来演示另外三种方式。

评分法

原名叫Z-score转化法，顾名思义：就是将成正态分布的数据中的原始分数转换为z分数，而z分数能够真实的反应一个分数距离平均数的相对标准距离，通过这种方式保留数据的真实差异。
首先，重新创建一个特殊的数据集，用于该方法的演示。可以看出不论是同一行（样品内）还是同一列（变量内），数值的差异幅度都很大。

> data  Grp_1 Grp_2 Grp_3 Grp_4   Grp_5a   6.6  20.9 100.1 600.0     5.2b  20.8  99.8 700.0   3.7    19.2c 100.0 800.0   6.2  21.4    98.6d 900.0   3.3  20.3 101.1 10000.0

先去除数据中的干扰项，然后标准化并设定列名，完成后输出查看这个时候的数据状态。

data <- data[apply(data,1,var)!=0,] #去除干扰项，"!="表示不等于> data_s <- as.data.frame(t(apply(data,1,scale))) #对数据进行标准化并转化成数据框> colnames(data_s) <- colnames(data) #设置列名> data_s #查看标准化处理后数据状态       Grp_1      Grp_2      Grp_3      Grp_4      Grp_5a -0.5456953 -0.4899405 -0.1811446  1.7679341 -0.5511538b -0.4940465 -0.2301542  1.7747592 -0.5511674 -0.4993911c -0.3139042  1.7740182 -0.5936858 -0.5483481 -0.3180801d -0.2983707 -0.5033986 -0.4995116 -0.4810369  1.7823177

对处理后的数据进行“两步走”操作，然后将value的值转化成z分数格式。

> data_s$ID <- rownames(data_s) #添加新的一列，内容为数据的行名> data_s_m <- melt(data_s,id.vars = c("ID")) #以新添加的行为标准融合数据> data_s_m$value <- as.numeric(prettyNum(data_s_m$value,digits=2)) #将value的值转化为分数格式

进行绘图可以发现，此时数据之间的差异性可视化效果明显。

p <- ggplot(data_s_m,aes(x=variable,y=ID)) + xlab("samples") +  ylab(NULL) +theme_bw() + theme(panel.grid.major = element_blank()) +  theme(axis.text.x = element_text(angle=45,hjust = 1,vjust=1)) +  geom_tile(aes(fill=value)) +scale_fill_gradient(low="pink",high="blue") +  geom_text(aes(label=value))p

踢值法

这个也叫抹去异常值法，就是将特别离谱的数据全部抹去（用正常值代替），在实际应用中需要酌情考虑。
这里使用上一个方法中创建的数据做演示。

核心处理就一行，把大于100的值全变成100即可。

data_3[data_3>100] <- 100 #将大于100的值变成100

然后进行标准“两步走”，生成的最终数据就没有特别离谱的值，可以放心用于绘图。

> data_3$ID = rownames(data_3) #添加新列ID> data_3_m <- melt(data_3, id.vars=c("ID")) #以 ID列为准融合数据> head(data_3_m) #查看融合后数据的前几行  ID variable value1  a    Grp_1   6.62  b    Grp_1  20.83  c    Grp_1 100.04  d    Grp_1 100.05  a    Grp_2  20.96  b    Grp_2  99.8

绘制图像，发现数据之间的差异性比较明显，但是这种方法的准确性比较差，损失了一些数据的趋势信息。

p <- ggplot(data_3_m,aes(x=variable,y=ID)) +  xlab("samples") +  ylab(NULL) +  theme_bw() +   theme(panel.grid.major= element_blank()) +  theme(legend.key=element_blank()) +  theme(axis.text.x=element_text(angle=45,hjust=1,vjust=1)) +  geom_tile(aes(fill=value)) +   scale_fill_gradient(low = "red",high="green") +  geom_text(aes(label=value))p  

颜色法

也称为非线性颜色法，这种方法很妙，简直妙的呱呱叫! 体现出了一种“山不过来，我就过去”的思想。

颜色在最小值到最大值之间是均匀分布的。如果最小值到最大值之间用100个颜色区分，其中每一个值都会赋予一个颜色。非线性颜色则是对数据比较小但密集的地方赋予更多颜色，数据大但分布散的地方赋予更少颜色，这样既能加大区分度，又不影响原始数值。

图里颜色看不出明显差异，先不管数据有啥问题，直接把颜色改成差异的就完事儿，使可视化结果趋于明显。

首先，创建用于示例的数据： 先进行“两步走”，然后再利用summary函数获取value变量的数据信息（最小值，一分位值，中位值，三分位值，最大值）

> data_4$ID=rownames(data_4) #添加新 ID列> data_4_m <- melt(data_4,id.vars = c("ID")) #融合数据，生成用于绘图的数据格式> summary_v <- summary(data_4_m$value) #计算数据的最小值，一分位值，中位值，三分位值，最大值> summary_v #查看上一行计算的结果    Min.  1st Qu.   Median     Mean  3rd Qu.     Max.     3.30    16.05    60.00   681.36   225.82 10000.00 

在最小值和第一四分位数之间划出6个区间，第一四分位数和中位数之间划出6个区间，中位数和第三四分位数之间划出5个区间，最后的数划出5个区间，并查看划分结果。

> break_v <- unique(c(seq(summary_v[1]*0.95,summary_v[2],length=6),+                     seq(summary_v[2],summary_v[3],length=6),+                     seq(summary_v[3],summary_v[5],length=5),+                     seq(summary_v[5],summary_v[6]*1.05,length=5)))> break_v #查看划分的结果 [1]     3.1350     5.7180     8.3010    10.8840    13.4670    16.0500    24.8400    33.6300 [9]    42.4200    51.2100    60.0000   101.4562   142.9125   184.3687   225.8250  2794.3687[17]  5362.9125  7931.4562 10500.0000

用新划分的区间数值替换原来的数值，并查看当前的数值状态。

> data_4_m$value <- cut(data_4_m$value,breaks = break_v,+                       labels = break_v[2:length(break_v)]) #利用刚刚生成的划分区间设置切割标签> break_v=unique(data_4_m$value) > head（data_4_m，3） #查看当前的数据状态   ID variable      value1   a    Grp_1      8.3012   b    Grp_1      24.843   c    Grp_1  101.45625

判断一下生成的数据value列是否为因子格式，然后设置颜色并生成一系列颜色值。

> is.factor(data_4_m$value) # 判断一下当前数据的value列是否为因子格式[1] TRUE> gradient_1=c("yellow","blue","green") #设置颜色> col <- colorRampPalette(gradient_1)(length(break_v)) #利用划分的区间结果生成一组颜色值> col #查看所生成的颜色数据[1] "#FFFF00" "#999966" "#3232CC" "#0033CB" "#009965" "#00FF00"

用新生成的颜色值进行填充绘图，可以看出数据间颜色差异性比较明显。

p <- ggplot(data_4_m,aes(x=variable,y=ID)) +  xlab("sam") +  ylab(NULL) +  theme_bw() +  theme(panel.grid.major = element_blank()) +  theme(legend.key = element_blank()) +   theme(axis.text.x=element_text(angle=35,hjust = 0.9,vjust = 0.9)) +  geom_tile(aes(fill=value))#利用颜色填充信息p <- p + scale_fill_manual(values = col)p

本笔记参考学习资料：http://www.ehbio.com/Bioinfo_R_course/Rplots.html#ggplot2_heatmapnonlinear