最近年中總結(jié)，我們學(xué)習(xí)一下基礎(chǔ)知識(shí)

R版本

?；鶊D繪制

清除當(dāng)前環(huán)境中的變量

rm(list=ls())

設(shè)置工作目錄

setwd("C:/Users/Dell/Desktop/R_Plots/23sankey/")

使用riverplot包繪制桑基圖

# 安裝并加載所需的R包
#install.packages("riverplot")
library(riverplot)

# 構(gòu)建測(cè)序數(shù)據(jù)集
nodes <- c( LETTERS[1:5] )
nodes
## [1] "A" "B" "C" "D" "E"

edges <- list( A = list( C= 6 ), 
               B = list( C= 5 ),
               C = list( D= 4 ),
               E = list( C= 3 )
               )
edges
## $A
## $A$C
## [1] 6
##
##
## $B
## $B$C
## [1] 5
##
##
## $C
## $C$D
## [1] 4
##
##
## $E
## $E$C
## [1] 3

# 使用makeRiver函數(shù)構(gòu)造riverplot對(duì)象
r <- makeRiver( nodes, edges, 
                node_xpos= c( 1,1,2,3,3 ),
                node_labels= c( A= "Node A", B= "Node B", C= "Node C", D= "Node D", E= "Node E" ),
                node_styles= list( A= list( col= "yellow" ), D= list( col= "blue" ), E= list( col= "red" )))
r
## $edges
##        ID N1 N2 Value
## A->C A->C  A  C     6
## B->C B->C  B  C     5
## C->D C->D  C  D     4
## E->C E->C  E  C     3
## 
## $nodes
##   ID x labels
## A  A 1 Node A
## B  B 1 Node B
## C  C 2 Node C
## D  D 3 Node D
## E  E 3 Node E
## 
## $styles
## $styles$A
## $styles$A$col
## [1] "yellow"
## 
## 
## $styles$D
## $styles$D$col
## [1] "blue"
## 
## 
## $styles$E
## $styles$E$col
## [1] "red"
## 
## 
## 
## attr(,"class")
## [1] "list"      "riverplot"

# 使用riverplot函數(shù)繪制?；鶊D
riverplot(r)

image

# 繪制一個(gè)DNA雙螺旋
# a DNA strand
plot.new()
par( usr= c( 0, 4, -2.5, 2.5 ) )

w <- 0.4
cols <- c( "blue", "green" )
init <- c( -0.8, -0.5 )
pos  <- c( 1, -1 )
step <- 0.5

# Draw a curved segment
for( i in rep( rep( c( 1, 2 ), each= 2 ), 5 ) ) {
  curveseg( init[i], init[i] + step, pos[1], pos[2], width= w, col= cols[i] )
  init[i] <- init[i] + step
  pos <- pos * -1
}

image

使用ggforce包繪制桑基圖

# 安裝并加載所需的R包
#install.packages("ggforce")
library(ggforce)

# 構(gòu)建示例數(shù)據(jù)
data <- reshape2::melt(Titanic)
head(data)
##  Class    Sex   Age Survived value
## 1   1st   Male Child       No     0
## 2   2nd   Male Child       No     0
## 3   3rd   Male Child       No    35
## 4  Crew   Male Child       No     0
## 5   1st Female Child       No     0
## 6   2nd Female Child       No     0

data <- gather_set_data(data, 1:4)
head(data)
##   Class    Sex   Age Survived value id     x    y
## 1   1st   Male Child       No     0  1 Class  1st
## 2   2nd   Male Child       No     0  2 Class  2nd
## 3   3rd   Male Child       No    35  3 Class  3rd
## 4  Crew   Male Child       No     0  4 Class Crew
## 5   1st Female Child       No     0  5 Class  1st
## 6   2nd Female Child       No     0  6 Class  2nd

# 使用geom_parallel_setsh函數(shù)繪制?；鶊D
ggplot(data, aes(x, id = id, split = y, value = value)) +
  geom_parallel_sets(aes(fill = Sex), alpha = 0.5, axis.width = 0.1) +
  geom_parallel_sets_axes(axis.width = 0.2,fill="black",color="red") +
  geom_parallel_sets_labels(colour = 'white',angle = 45) +
  theme_bw()

image

使用ggalluvial包繪制?；鶊D

# 安裝并加載所需的R包
#install.packages("ggalluvial")
library(ggalluvial)

# 使用geom_alluvium函數(shù)繪制桑基圖
admissions <- as.data.frame(UCBAdmissions)
head(admissions)
##      Admit Gender Dept Freq
## 1 Admitted   Male    A  512
## 2 Rejected   Male    A  313
## 3 Admitted Female    A   89
## 4 Rejected Female    A   19
## 5 Admitted   Male    B  353
## 6 Rejected   Male    B  207

ggplot(admissions,
       aes(y = Freq, axis1 = Gender, axis2 = Dept)) +
  geom_alluvium(aes(fill = Admit), width = 1/12) +
  geom_stratum(width = 1/12, fill = "black", color = "grey") +
  geom_label(stat = "stratum", aes(label = after_stat(stratum))) +
  scale_x_discrete(limits = c("Gender", "Dept"), expand = c(.05, .05)) +
  scale_fill_brewer(type = "qual", palette = "Set1") +
  ggtitle("UC Berkeley admissions and rejections, by sex and department")

image

data <- as.data.frame(Titanic)
head(data)
##   Class    Sex   Age Survived Freq
## 1   1st   Male Child       No    0
## 2   2nd   Male Child       No    0
## 3   3rd   Male Child       No   35
## 4  Crew   Male Child       No    0
## 5   1st Female Child       No    0
## 6   2nd Female Child       No    0

ggplot(data,
       aes(y = Freq,
           axis1 = Survived, axis2 = Sex, axis3 = Class)) +
  geom_alluvium(aes(fill = Class),width = 0, 
                knot.pos = 0, reverse = FALSE) +
  guides(fill = FALSE) +
  geom_stratum(width = 1/8, reverse = FALSE) +
  geom_text(stat = "stratum", aes(label = after_stat(stratum)),reverse = FALSE) +
  scale_x_continuous(breaks = 1:3, labels = c("Survived", "Sex", "Class")) +
  coord_flip() +
  ggtitle("Titanic survival by class and sex")

image

data(vaccinations)
levels(vaccinations$response) <- rev(levels(vaccinations$response))
head(vaccinations)
##      survey freq subject response start_date   end_date
## 1 ms153_NSA   48       1  Missing 2010-09-22 2010-10-25
## 2 ms153_NSA    9       2  Missing 2010-09-22 2010-10-25
## 3 ms153_NSA   66       3  Missing 2010-09-22 2010-10-25
## 4 ms153_NSA    1       4  Missing 2010-09-22 2010-10-25
## 5 ms153_NSA   11       5  Missing 2010-09-22 2010-10-25
## 6 ms153_NSA    1       6  Missing 2010-09-22 2010-10-25

ggplot(vaccinations,
       aes(x = survey, stratum = response, alluvium = subject,
           y = freq,
           fill = response, label = response)) +
  scale_x_discrete(expand = c(.1, .1)) +
  geom_flow() +
  geom_stratum(alpha = .5) +
  geom_text(stat = "stratum", size = 4) +
  theme(legend.position = "none") +
  ggtitle("vaccination survey responses at three points in time")

image

origin版本（非代碼，手動(dòng)操作）

數(shù)據(jù)準(zhǔn)備

在之前的文章中有提到按“F11”鍵就可以快速進(jìn)入origin的“Origin central”直接套用模板去學(xué)習(xí)作圖，如下圖，在新版的Origin 2019已將“Origin centra1”改為“Learning center”。今天我們就直接用它的實(shí)例數(shù)據(jù)作圖。

###

雙擊實(shí)例中的圖表即可打開(kāi)實(shí)例圖表的工程文件，我這里只需數(shù)據(jù)，所以復(fù)制了一份到文件夾Folder1中，數(shù)據(jù)為歷史上著名的泰坦尼克號(hào)事故中旅客和船員的是否獲救記錄（如下圖）。數(shù)據(jù)只要是原始的分類記錄即可，不需要手動(dòng)計(jì)數(shù)。注意，Origin 2019的數(shù)據(jù)介紹弄錯(cuò)了，嗯，希望它接下來(lái)改進(jìn)吧。