R语言可视化作图笔记（4）多维数据可视化

多维数据可视化

热力图（Heat map）

热力图对数据的要求很多

• 数据必须要统一范围
• 横纵坐标皆须重新排序（利用seriation::seriate）

数据预处理可以减小大区间的数据给小区间数据的影响，如同2D密度图和地图上一样。重新排序横纵坐标可以方便我们对观察量进行分组，查找奇异点等。

以iris绘制热力图

library(plotly)
library(seriation)

data <- iris[,1:4]
data_rescaled <- scale(data, center = TRUE, scale=TRUE)  # 标准化数据

# 通过不同方法(例GW)比较欧式距离得到新排序
rowdist<-dist(data_rescaled,method = "minkowski", p=2)
coldist<-dist(t(data_rescaled),method = "minkowski", p=2)
order1<-seriate(rowdist, method = "GW")  
order2<-seriate(coldist, method = "GW")      # 详见 ?seriate
ord1<-get_order(order1)
ord2<-get_order(order2)
data_rescaled <- data_rescaled[rev(ord1),ord2]

# 绘图
plot_ly(x=colnames(data_rescaled), y=rownames(data_rescaled), 
        z=data_rescaled, type="heatmap", colors =colorRamp(c("yellow", "red")))%>% 
  layout(title = "Heatmap")

对于不同的热力图，可用seriation::criterion计算多样的 cost function values （成本/代价函数值） 来比较。例如比较上图与原排序

result <- criterion(rowdist, order = order1, method = c("Least_squares","Path_length"))
result <- rbind(result,criterion(coldist, order = order2,method = c("Least_squares","Path_length")))
result <- rbind(result,criterion(rowdist, method = c("Least_squares","Path_length")))
result <- rbind(result,criterion(coldist, method = c("Least_squares","Path_length")))
rownames(result) <- c("row.GW","col.GW","row.Raw","col.Raw")
result

#         Least_squares Path_length
# row.GW   77301629.626    68.20059
# col.GW       2001.572    27.75786
# row.Raw  77552408.650   194.57013
# col.Raw      2110.617    42.20774

【当然通过计算成本函数值来比较热力图也仅仅时从数学角度，仅作参考。】

平行坐标图（Parallel coordinate plot）

列的排序方式对平行坐标图也是非常重要，基于好的绘图，相似的观察量会有趋同的路径。这里取之前用GW得到的列排序绘图，并以Sepal.Width的值上色

ord=ord2
dims0=list()
for( i in 1:ncol(data_rescaled) ){
  dims0[[i]]=list( label=colnames(data_rescaled)[ord[i]],
                   values=as.formula(paste("~",colnames(data_rescaled)[ord[i]])))
}

p <- as.data.frame(data_rescaled) %>%
  plot_ly(type = 'parcoords',
          line = list(color = ~Petal.Width),
          dimensions = dims0
  )%>%layout(title = "Parallel coordinate plot")
ggplotly(p)

但是基于本例，笔者认为原排序应该是适合，图如下

【原图在Rstudio上并不能完整画出，需要在浏览器中显示。】

并行雷达图

graphics

data0 <- as.data.frame(data_rescaled[ord1,][1:16,])     # 取排序后的前16个为例
stars(data0, key.loc=c(15,2), draw.segments=F, col.stars =rep("LightBlue", nrow(data0)))

ggplot2

library(scales)
library(ggplot2)

data1 <- data0%>% mutate_all(funs(rescale))
data1$id <- as.numeric(rownames(data0))
data2 <- data1%>%tidyr::gather(variable, value, -id, factor_key=T)%>%arrange(id)
data2 %>%
  ggplot(aes(x=variable, y=value, group=id)) + 
  geom_polygon(fill="grey") + 
  coord_polar() + theme_bw() + facet_wrap(~ id) + 
  theme(axis.text.x = element_text(size = 5))

plotly（可以交互的图，很好玩）

library(dplyr)
library(plotly)

Ps=list()
nPlot=4    # 因为plotly画的图比较大，这就取4个为例
pe_radar <- data0 %>%
  add_rownames( var = "group" ) %>%
  mutate_each(funs(rescale), -group)

for (i in 1:nPlot){
  Ps[[i]] <- htmltools::tags$div(
    plot_ly(type = 'scatterpolar',  
            r=as.numeric(pe_radar[i,-1]),
            theta= colnames(pe_radar)[-1], 
            fill="toself")%>%
      layout(title=pe_radar$group[i]), style="width: 50%;")  # 每行两图
}

h <-htmltools::tags$div(style = "display: flex; flex-wrap: wrap", Ps)
htmltools::browsable(h)

有相似分布状况的两个观察量（小雷达图）可以归为一组。并行雷达图很多时候并不好用，因为人对图形的感知量度有限，不过有时会有意想不到的惊喜。感知量度详见 笔记（2） 。

重叠区间（overlapping interval）

另外在笔记（2） 我们画过一张mpg数据按displ区间上色的图

用facet_grid可以将上图按类并行显示

library(ggplot2)

data0 <- mpg
groups <- cut_interval(data0$displ,4)
data0$groups <- groups
ggplot(data0) +
  geom_point(aes(x=hwy, y=cty, color = groups))+
  facet_grid(groups~.)   # 改成(~groups)就会横向排列

有时直接按绝对的区间并行并不好，这是就会用要重叠（overlap）的区间，下图中各区间的重叠部分取10%

# 划区间
Agerange <- lattice::equal.count(data0$displ, number=4, overlap=0.10)
L<-matrix(unlist(levels(Agerange)), ncol=2, byrow = T)
L1<-data.frame(Lower=L[,1],Upper=L[,2], Interval=factor(1:nrow(L)))

# 分组
index=c()
Class=c()
for(i in 1:nrow(L)){
  Cl=paste("[", L1$Lower[i], ",", L1$Upper[i], "]", sep="")
  ind=which(data0$displ>=L1$Lower[i] & data0$displ<=L1$Upper[i])
  index=c(index,ind)
  Class=c(Class, rep(Cl, length(ind)))
}
df<-data0[index,]
df$Class<-as.factor(Class)

# 绘图
ggplot(df, aes(x=hwy, y=cty, color = groups))+ 
  geom_point()+
  facet_grid(Class~.)

会发现上图相较原图，所有的区间上下有10%的重叠，这对图像的显示并不会有太大改变，但有重叠区间的并行图上观察量的渐进有时更加明显

其他

总之，不论是热力图，平行左边图还是并行雷达图都不是绝对的，需要各位自己斟酌。同样在散点图上是否要用重叠区间也需按情况讨论。