--- 大師，大師，618買的什么書呀，好奇呢。
··· 一本R語(yǔ)言繪圖的書，可花了呢。

"Beautiful Visualization with R" provides a comprehensive introduction to the many types of visualisation that you can create with R. As well as foundational visualisations like bar charts, scatterplots, and histogram, this book will teach you about more complex tools like 3d plots, ternary plots, polar coordinate plots and more! Read this book to learn how to create visually compelling plots that help you understand your data. ——Hadley Wickham RStudio 首席科學(xué)家，萊斯大學(xué)統(tǒng)計(jì)系助理教授，ggplot2等軟件包開發(fā)者

公元2019年5月底得知出版消息，旋即下單，約莫6月5日拆封，開閱。太貴，開卷有益。于端午假期草過一遍，略有所得，以饗讀者。

本書基本上分為三個(gè)部分：R語(yǔ)言編程與繪圖基礎(chǔ)、可視化實(shí)戰(zhàn)和論文中學(xué)術(shù)圖表的升級(jí)技能（tips)，其中第二部分是大量的案例，按照繪圖類型不同來區(qū)分。竊以為這樣的安排挺好的，我們學(xué)習(xí)可視化技能基本上是靠案例來學(xué)習(xí)的。其實(shí)R語(yǔ)言本身也倡導(dǎo)這種case-study的方式，君不見R里面充滿了而各種example。

首先，我們?yōu)槭裁匆梢暬?？因?yàn)槲覀兿氚褦?shù)據(jù)變現(xiàn)：一圖勝千言。而且一張圖上能表征的信息越多越好，當(dāng)然是在人類的理解范圍內(nèi)。一張圖基本的元素就是點(diǎn)線面以及大小形狀顏色，一張好的圖就是合理地組合這些元素，做的比較好的當(dāng)然是ggplot2的圖形語(yǔ)法了。本書也是基于ggplot2語(yǔ)法來的，很多圖是由ggplot2及其擴(kuò)展包實(shí)現(xiàn)的。讀者朋友用R做可視化一定看過《ggplot2：數(shù)據(jù)分析與圖形藝術(shù)》一書咯，這是一本圣經(jīng)級(jí)別的書，偏理論一點(diǎn)，例子盡可能的簡(jiǎn)單。

相比之下，這本書就更加偏向應(yīng)用了，例子給的詳盡也盡量做到了精美。所以叫他指南也是有一定的道理的。這里舉幾個(gè)例子。

#EasyCharts團(tuán)隊(duì)出品，
#如需使用與深入學(xué)習(xí)，請(qǐng)聯(lián)系微信：EasyCharts

#---------------------------------------圖5-1-2核密度估計(jì)峰巒圖--------------------------------------
library(ggplot2)
library(ggridges)
library(RColorBrewer)

ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = `Month`, fill = ..density..)) + 
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.00,size = 0.3) + 
  scale_fill_gradientn(colours = colorRampPalette(rev(brewer.pal(11,'Spectral')))(32))

###------------------------------自定義編寫代碼實(shí)現(xiàn)：圖5-1-2核密度估計(jì)峰巒圖-------------------------------
library(reshape2)

colormap <- colorRampPalette(rev(brewer.pal(11,'Spectral')))(32)

dt<-lincoln_weather[,c("Month","Mean Temperature [F]")]
splitdata<-split(dt,dt$Month)
xmax<-max(dt$`Mean Temperature [F]`)*1.1
xmin<-min(dt$`Mean Temperature [F]`)*1.1


N<-length(splitdata)
labels_y<-names(splitdata)

mydata<-data.frame(x=numeric(),y=numeric(),variable=numeric()) #創(chuàng)建空的Data.Frame

for (i in 1:N){
  tempy<-density(splitdata[[i]][2]$`Mean Temperature [F]`,bw = 3.37,from=xmin, to=xmax)
  newdata<-data.frame(x=tempy$x,y=tempy$y)
  newdata$variable<-i
  mydata<-rbind(mydata,newdata)
}

Step<-max(mydata$y)*0.6
mydata$offest<--as.numeric(mydata$variable)*Step
mydata$V1_density_offest<-mydata$y+mydata$offest

p<-ggplot()
for (i in 1:N){
  p<-p+ geom_linerange(data=mydata[mydata$variable==i,],aes(x=x,ymin=offest,ymax=V1_density_offest,group=variable,color=y),size =1, alpha =1) +
    geom_line(data=mydata[mydata$variable==i,],aes(x=x, y=V1_density_offest),color="black",size=0.5)
}

p+scale_color_gradientn(colours=colormap,name="Density")+
  scale_y_continuous(breaks=seq(-Step,-Step*N,-Step),labels=labels_y)+
  xlab("Mean Temperature [F]")+
  ylab("Month")+
  theme_classic()+
  theme(
    panel.background=element_rect(fill="white",colour=NA),
    panel.grid.major.x = element_line(colour = "grey80",size=.25),
    panel.grid.major.y = element_line(colour = "grey60",size=.25),
    axis.line = element_blank(),
    text=element_text(size=15,colour = "black"),
    plot.title=element_text(size=15,hjust=.5),
    legend.position="right"
  )

#EasyCharts團(tuán)隊(duì)出品，
#如有問題修正與深入學(xué)習(xí)，可聯(lián)系微信：EasyCharts

library(ggplot2)
library(grid)
library(RColorBrewer)
library(dplyr)
install.packages("SuppDists")
library(SuppDists) #提供rJohnson()函數(shù)

# somewhat hackish solution to:
# https://twitter.com/EamonCaddigan/status/646759751242620928
# based mostly on copy/pasting from ggplot2 geom_violin source:
# https://github.com/hadley/ggplot2/blob/master/R/geom-violin.r

"%||%" <- function(a, b) {
  if (!is.null(a)) a else b
}

color<-brewer.pal(7,"Set2")[c(1,2,4,5)]


geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
                             position = "dodge", trim = TRUE, scale = "area",
                             show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomFlatViolin,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      trim = trim,
      scale = scale,
      ...
    )
  )
}


GeomFlatViolin <-
  ggproto("GeomFlatViolin", Geom,
          setup_data = function(data, params) {
            data$width <- data$width %||%
              params$width %||% (resolution(data$x, FALSE) * 0.9)
            
            # ymin, ymax, xmin, and xmax define the bounding rectangle for each group
            data %>%
              group_by(group) %>%
              mutate(ymin = min(y),
                     ymax = max(y),
                     xmin = x,
                     xmax = x + width / 2)
            
          },
          
          draw_group = function(data, panel_scales, coord) {
            # Find the points for the line to go all the way around
            data <- transform(data, xminv = x,
                              xmaxv = x + violinwidth * (xmax - x)) #利用transform函數(shù)為數(shù)據(jù)框mydata增加數(shù)據(jù)
            
            newdata <- rbind(plyr::arrange(transform(data, x = xmaxv), -y),plyr::arrange(transform(data, x = xminv), y))
            newdata_Polygon <- rbind(newdata, newdata[1,])
            newdata_Polygon$colour<-NA
            
            newdata_Path <- plyr::arrange(transform(data, x = xmaxv), -y)
            
            ggplot2:::ggname("geom_flat_violin", grobTree(
              GeomPolygon$draw_panel(newdata_Polygon, panel_scales, coord),
              GeomPath$draw_panel(newdata_Path, panel_scales, coord))
            )
          },
          
          draw_key = draw_key_polygon,
          
          default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
                            alpha = NA, linetype = "solid"),
          
          required_aes = c("x", "y")
  )

# "%||%" <- getFromNamespace("%||%", "ggplot2")
# "%>%"  <- getFromNamespace("%>%", "magrittr")

set.seed(141079)

# Generate sample data -------------------------------------------------------
#findParams函數(shù)參考：https://github.com/hadley/boxplots-paper

findParams <- function(mu, sigma, skew, kurt) {
  value <- .C("JohnsonMomentFitR", as.double(mu), as.double(sigma),
              as.double(skew), as.double(kurt - 3), gamma = double(1),
              delta = double(1), xi = double(1), lambda = double(1),
              type = integer(1), PACKAGE = "SuppDists")
  
  list(gamma = value$gamma, delta = value$delta,
       xi = value$xi, lambda = value$lambda,
       type = c("SN", "SL", "SU", "SB")[value$type])
}

# 均值為3，標(biāo)準(zhǔn)差為1的正態(tài)分布
n <- rnorm(100,3,1)
# Johnson分布的偏斜度2.2和峰度13
s <- rJohnson(100, findParams(3, 1, 2., 13.1))
# Johnson分布的偏斜度0和峰度20）
k <- rJohnson(100, findParams(3, 1, 2.2, 20))
# 兩個(gè)峰的均值μ1，μ2分別為1.89和3.79，σ1 = σ2 =0.31
mm <- rnorm(100, rep(c(2, 4), each = 50) * sqrt(0.9), sqrt(0.1))

mydata <- data.frame(
  Class = factor(rep(c("n", "s", "k", "mm"), each = 100),
                 c("n", "s", "k", "mm")),
  Value = c(n, s, k, mm)+3
)
#-------------------------------------------------------------

colnames(mydata)<-c("Class", "Value")

d <- group_by(mydata, Class) %>%
  summarize(mean = mean(Value),
            sd = sd(Value))

plot1<-ggplot(mydata, aes(Class, Value, fill=Class))  +
  geom_flat_violin(position=position_nudge(x=.2)) +
  geom_jitter(aes(color=Class), width=.1) +
  geom_pointrange(aes(y=mean, ymin=mean-sd, ymax=mean+sd),
                  data=d, size=1, position=position_nudge(x=.2)) +
  coord_flip() + 
  theme_bw() +
  theme( axis.text = element_text(size=13),
         axis.title =  element_text(size=15),
         legend.position="none")

plot2<-ggplot(mydata, aes(x=Class, y=Value))  +
  geom_flat_violin(aes(fill=Class),position=position_nudge(x=.25),color="black") +
  geom_jitter(aes(color=Class), width=0.1) +
  geom_boxplot(width=.1,position=position_nudge(x=0.25),fill="white",size=0.5) +
  coord_flip() + 
  theme_bw() +
  theme( axis.text = element_text(size=13),
         axis.title =  element_text(size=15),
         legend.position="none")
library(gridExtra) 
grid.arrange(plot1,plot2,ncol = 2, nrow = 1)

云雨圖

作為一本以案例為主的指南書，非常適于我們可視化初學(xué)者，因?yàn)槲覀兒芏鄷r(shí)候不知道原來數(shù)據(jù)還可以這樣展示。所以對(duì)于資歷一般的我們，看到才可能想到，想到才可能做到，做到才可能得到，得到才可能失去，失去才可能知道適不適合自己。

任何一張圖都離不開具體的實(shí)際問題，有時(shí)候理解實(shí)際問題要比繪圖難的多，數(shù)據(jù)是連續(xù)的還是離散的，離散的用點(diǎn)，連續(xù)的用線，把自己的數(shù)據(jù)分到以下類別中能更好地幫助我們選擇相應(yīng)的繪圖類型。

結(jié)合案例可以思考哪些類型的數(shù)據(jù)我是可以用這個(gè)圖來展示的，要做這張圖需要什么樣的數(shù)據(jù)類型呢？可視化的大部分工作是在整理數(shù)據(jù)，可以感覺到本書的作者也是個(gè)tidyverse語(yǔ)法的愛好者。當(dāng)然這不是一本數(shù)據(jù)處理的書，不是《R語(yǔ)言數(shù)據(jù)科學(xué)》所以我們主要關(guān)心的還是每張圖的細(xì)節(jié)修飾，也許在大量的實(shí)踐之后，你會(huì)覺得作者做的遠(yuǎn)遠(yuǎn)不夠，也采用了很多默認(rèn)的參數(shù)，但是操千曲而后笑聲,觀千劍而后識(shí)器。通過執(zhí)行作者的代碼。也可以學(xué)到不少R編程的知識(shí)，當(dāng)然了如果你已經(jīng)是大牛了也許就沒有興趣看這本書了。

雖然本書的代碼和數(shù)據(jù)都是公布在github的要運(yùn)行不必買書的。碰到我是一個(gè)喜歡積累的人也喜歡做一些摘抄，有時(shí)候遇到驚艷的繪圖代碼也會(huì)記在ggplot2的那本書上，但是由于他偏理論，很多類型的圖表沒有涉及，以至于有的句子不知道摘抄在哪。有了這本書好了，R語(yǔ)言繪圖代碼有地方放了。包括但不限于R語(yǔ)言可視化，可以把自己處理數(shù)據(jù)學(xué)術(shù)繪圖的心得體會(huì)寫在相應(yīng)的章節(jié)，以后遇到類似的問題就可以參考解決。這不失是一個(gè)比較笨的方法，學(xué)習(xí)要有學(xué)生思維嘛。

我還是比較懷念當(dāng)時(shí)拿著鉛筆在紙上寫代碼的年紀(jì)呢！

有兩點(diǎn)書中沒有涉及一個(gè)是空間數(shù)據(jù)，比如地圖，另一個(gè)關(guān)系型數(shù)據(jù)可視化主題網(wǎng)絡(luò)圖（Network）沒有涉及，使我覺得這本書是不完整的，至少不是那么完整。然后是多維數(shù)據(jù)可視化中heatmap做的有些草草了，就是把pheatmap的example拿過來演示一下，沒有之美之說。柱形圖、散點(diǎn)圖、熱圖這三種圖在學(xué)術(shù)文章中是最常見的，其中熱圖可以用來描述類別比較（分組）、數(shù)據(jù)關(guān)系（相關(guān)性）、數(shù)量關(guān)系（豐度），所以他的席位不應(yīng)該排這么少。

在閱讀的過程中我產(chǎn)生一種想法就是：科研繪圖亦應(yīng)該有分級(jí)制度：學(xué)術(shù)文章級(jí)別以及學(xué)術(shù)報(bào)告級(jí)別。這兩個(gè)在主題設(shè)置、顏色配置要求是不一樣的。本書關(guān)于學(xué)術(shù)圖表主題設(shè)置的討論我覺得也是有益的。

代碼在這||Beautiful-Visualization-with-R

韓愈《答李翊書》：“始者非三代兩漢之書不敢觀．非圣人之志不敢存，處若忘，行若遺，儼乎其若恩，茫乎其若迷，當(dāng)其取予心而注于手也，惟陳言之務(wù)去，戛戛乎其難哉！”

《樊紹述墓志銘》：“必出于己，不蹈襲前人一言一句，又何其難也?！?/p>