round(cor(mtcars), digits = 2)
## mpg cyl disp hp drat wt qsec vs am gear carb
## mpg 1.00 -0.85 -0.85 -0.78 0.68 -0.87 0.42 0.66 0.60 0.48 -0.55
## cyl -0.85 1.00 0.90 0.83 -0.70 0.78 -0.59 -0.81 -0.52 -0.49 0.53
## disp -0.85 0.90 1.00 0.79 -0.71 0.89 -0.43 -0.71 -0.59 -0.56 0.39
## hp -0.78 0.83 0.79 1.00 -0.45 0.66 -0.71 -0.72 -0.24 -0.13 0.75
## drat 0.68 -0.70 -0.71 -0.45 1.00 -0.71 0.09 0.44 0.71 0.70 -0.09
## wt -0.87 0.78 0.89 0.66 -0.71 1.00 -0.17 -0.55 -0.69 -0.58 0.43
## qsec 0.42 -0.59 -0.43 -0.71 0.09 -0.17 1.00 0.74 -0.23 -0.21 -0.66
## vs 0.66 -0.81 -0.71 -0.72 0.44 -0.55 0.74 1.00 0.17 0.21 -0.57
## am 0.60 -0.52 -0.59 -0.24 0.71 -0.69 -0.23 0.17 1.00 0.79 0.06
## gear 0.48 -0.49 -0.56 -0.13 0.70 -0.58 -0.21 0.21 0.79 1.00 0.27
## carb -0.55 0.53 0.39 0.75 -0.09 0.43 -0.66 -0.57 0.06 0.27 1.00
# 如果没有安装则安装
# install.packages("corrplot")
library(corrplot)
## Warning: package 'corrplot' was built under R version 3.3.2
# 默认选项
corrplot(cor(mtcars))
# 将圆改为正方形，使用黑色文本并调整角度
corrplot(
cor(mtcars),
method = "shade",
shade.col = NA,
tl.col = "black",
tl.srt = 45
)
# 将色块颜色变淡，添加相关系数，去掉图例，并将变量聚类排序
corrplot(
cor(mtcars),
method = "shade",
shade.col = NA,
tl.col = "black",
tl.srt = 1,
col = colorRampPalette(c(
"#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"
))(60),
addCoef.col = "black",
cl.pos = "n",
order = "AOE",
mar = c(5, 5, 5, 5)
)
# 没有则安装
# install.packages("igraph")
library(igraph)
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
# 有向图
gd <- graph(c(1, 2, 2, 3, 2, 4, 1, 4, 5, 5, 3, 6))
plot(gd)
# 无向图，移除标签
gu <- graph(c(1, 2, 2, 3, 2, 4, 1, 4, 5, 5, 3, 6), directed = FALSE)
plot(gu, vertex.label = NA)
set.seed(520)
plot(gd)
library(gcookbook)
## Warning: package 'gcookbook' was built under R version 3.3.2
madmen2
## Name1 Name2
## 1 Abe Drexler Peggy Olson
## 2 Allison Don Draper
## 3 Arthur Case Betty Draper
## 4 Bellhop in Baltimore Sal Romano
## 5 Bethany Van Nuys Don Draper
## 6 Betty Draper Don Draper
## 7 Betty Draper Henry Francis
## 8 Betty Draper Random guy
## 9 Bobbie Barrett Don Draper
## 10 Brooklyn College Student Peggy Olson
## 11 Candace Don Draper
## 12 Don Draper Allison
## 13 Don Draper Bethany Van Nuys
## 14 Don Draper Betty Draper
## 15 Don Draper Bobbie Barrett
## 16 Don Draper Candace
## 17 Don Draper Doris
## 18 Don Draper Faye Miller
## 19 Don Draper Joy
## 20 Don Draper Megan Calvet
## 21 Don Draper Midge Daniels
## 22 Don Draper Rachel Menken
## 23 Don Draper Shelly
## 24 Don Draper Suzanne Farrell
## 25 Don Draper Woman at the Clios party
## 26 Doris Don Draper
## 27 Duck Phillips Peggy Olson
## 28 Elliot Sal Romano
## 29 Faye Miller Don Draper
## 30 Franklin Joan Holloway
## 31 Greg Harris Joan Holloway
## 32 Gudrun Pete Campbell
## 33 Harry Crane Hildy
## 34 Harry Crane Jennifer Crane
## 35 Henry Francis Betty Draper
## 36 Hildy Harry Crane
## 37 Ida Blankenship Roger Sterling
## 38 Jane Siegel Roger Sterling
## 39 Janine Lane Pryce
## 40 Jennifer Crane Harry Crane
## 41 Joan Holloway Franklin
## 42 Joan Holloway Greg Harris
## 43 Joan Holloway Roger Sterling
## 44 Joy Don Draper
## 45 Joyce Ramsay Peggy Olson
## 46 Kitty Romano Sal Romano
## 47 Lane Pryce Janine
## 48 Lane Pryce Rebecca Pryce
## 49 Lane Pryce Toni
## 50 Lee Garner Jr. Sal Romano
## 51 Mark Peggy Olson
## 52 Megan Calvet Don Draper
## 53 Midge Daniels Don Draper
## 54 Mirabelle Ames Roger Sterling
## 55 Mona Sterling Roger Sterling
## 56 Paul Kinsey Peggy Olson
## 57 Peggy Olson Abe Drexler
## 58 Peggy Olson Brooklyn College Student
## 59 Peggy Olson Don Draper
## 60 Peggy Olson Duck Phillips
## 61 Peggy Olson Mark
## 62 Peggy Olson Pete Campbell
## 63 Pete Campbell Gudrun
## 64 Pete Campbell Peggy Olson
## 65 Pete Campbell Playtex bra model
## 66 Pete Campbell Trudy Campbell
## 67 Playtex bra model Pete Campbell
## 68 Rachel Menken Don Draper
## 69 Random guy Betty Draper
## 70 Rebecca Pryce Lane Pryce
## 71 Roger Sterling Betty Draper
## 72 Roger Sterling Ida Blankenship
## 73 Roger Sterling Jane Siegel
## 74 Roger Sterling Joan Holloway
## 75 Roger Sterling Mirabelle Ames
## 76 Roger Sterling Mona Sterling
## 77 Roger Sterling Vicky
## 78 Sal Romano Bellhop in Baltimore
## 79 Sal Romano Kitty Romano
## 80 Shelly Don Draper
## 81 Stan Rizzo Peggy Olson
## 82 Suzanne Farrell Don Draper
## 83 Toni Lane Pryce
## 84 Trudy Campbell Pete Campbell
## 85 Vicky Roger Sterling
## 86 Waitress Don Draper
## 87 Woman at the Clios party Don Draper
g <- graph.data.frame(madmen2, directed = TRUE)
par(mar = c(0, 0, 0, 0))
plot(
g,
layout = layout.fruchterman.reingold,
vertex.size = 8,
edge.arrow.size = 0.5,
vertex.label = NA
)
g <- graph.data.frame(madmen, directed = FALSE)
par(mar = c(0, 0, 0, 0))
plot(g,
layout = layout.circle,
vertex.size = 8,
vertex.label = NA)
presidents
## Qtr1 Qtr2 Qtr3 Qtr4
## 1945 NA 87 82 75
## 1946 63 50 43 32
## 1947 35 60 54 55
## 1948 36 39 NA NA
## 1949 69 57 57 51
## 1950 45 37 46 39
## 1951 36 24 32 23
## 1952 25 32 NA 32
## 1953 59 74 75 60
## 1954 71 61 71 57
## 1955 71 68 79 73
## 1956 76 71 67 75
## 1957 79 62 63 57
## 1958 60 49 48 52
## 1959 57 62 61 66
## 1960 71 62 61 57
## 1961 72 83 71 78
## 1962 79 71 62 74
## 1963 76 64 62 57
## 1964 80 73 69 69
## 1965 71 64 69 62
## 1966 63 46 56 44
## 1967 44 52 38 46
## 1968 36 49 35 44
## 1969 59 65 65 56
## 1970 66 53 61 52
## 1971 51 48 54 49
## 1972 49 61 NA NA
## 1973 68 44 40 27
## 1974 28 25 24 24
str(presidents)
## Time-Series [1:120] from 1945 to 1975: NA 87 82 75 63 50 43 32 35 60 ...
df_presidents <-
data.frame(
rating = as.numeric(presidents),
year = as.numeric(floor(time(presidents))),
quarter = as.numeric(cycle(presidents))
)
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.3.2
p <-
ggplot(df_presidents, aes(x = year, y = quarter, fill = rating))
p + geom_tile()
p + geom_raster()
# 如果没有则安装
# install.packages("rgl")
library(rgl)
## Warning: package 'rgl' was built under R version 3.3.2
##
## Attaching package: 'rgl'
## The following object is masked from 'package:igraph':
##
## %>%
# 使用球形点，缩小点的大小，关闭3D灯光
plot3d(
mtcars$wt,
mtcars$disp,
mtcars$mpg,
type = "s",
size = 0.75,
lit = FALSE
)
# 定义连线函数
interleave <- function(v1, v2)
as.vector(rbind(v1, v2))
# 绘制3D散点图，无坐标刻度和标签
plot3d(
mtcars$wt,
mtcars$disp,
mtcars$mpg,
xlab = "",
ylab = "",
zlab = "",
axes = FALSE,
type = "s",
size = 0.75,
lit = FALSE
)
# 添加投影线
segments3d(
interleave(mtcars$wt, mtcars$wt),
interleave(mtcars$disp, mtcars$disp),
interleave(mtcars$mpg, min(mtcars$mpg)),
alpha = 0.4,
col = "blue"
)
# 绘制盒子
rgl.bbox(
color = "grey60",
emission = "grey50",
xlen = 0,
ylen = 0,
zlen = 0
)
# 设置默认颜色为黑
rgl.material(color = "black")
# 添加坐标刻度和标签，--、++、-+、+-表示坐标轴可取的四个位置
axes3d(edges = c("x--", "y+-", "z--"),
ntick = 6,
cex = 0.75)
mtext3d("Weight", edge = "x--", line = 2)
mtext3d("Displacement", edge = "y+-", line = 3)
mtext3d("MPG", edge = "z--", line = 3)
# 保存绘图
rgl.snapshot("3Dscatter.png", fmt = "png")
library(gcookbook)
c2 <- subset(countries, Year == 2009)
c2 <- c2[complete.cases(c2),]
set.seed(520)
c2 <- c2[sample(1:nrow(c2), 25),]
# 绘制聚类图需要每行都具备有意义的行名
rownames(c2) <- c2$Name
# 去掉对聚类无用的非数值列
c2 <- c2[, 4:7]
# 对各列归一化
c3 <- scale(c2)
hc <- hclust(dist(c3))
# plot(hc)
# 对齐文本
plot(hc, hang = -1)
library(gcookbook)
library(ggplot2)
islice <- subset(isabel , z == min(z))
ggplot(islice, aes(x = x, y = y)) + geom_segment(aes(xend = x + vx / 50, yend =
y + vy / 50), size = 0.25)
## Warning: Removed 3745 rows containing missing values (geom_segment).
islice <- subset(isabel, z == min(z))
every_n <- function(x, by = 2) {
x <- sort(x)
x[seq(1, length(x), by = by)]
}
keepx <- every_n(unique(isabel$x), by = 4)
keepy <- every_n(unique(isabel$y), by = 4)
islice <- subset(islice, x %in% keepx & y %in% keepy)
islice$vxy <- sqrt(islice$x ^ 2 + islice$y ^ 2)
# 加载grid包用于画箭头
# library(grid)
# ggplot(islice, aes(x = x, y = y)) + geom_segment(
# aes(
# xend = x + vx / 50,
# yend = y + vy / 50,
# color = vxy
# ),
# arrow = arrow(length = unit(0.1, "cm")),
# size = 0.6
# ) + scale_color_continuous(low = "grey80", high = "darkred") + geom_path(aes(x =
# long, y = lat, group = group), data = usa) + coord_cartesian(xlim = range(islice$x), ylim =
# range(islice$y))
#
# every_n <- function(x, by = 2) {
# x <- sort(x)
# x[seq(1, length(x), by = by)]
# }
# keepx <- every_n(unique(isabel$x), by = 5)
# keepy <- every_n(unique(isabel$y), by = 5)
# keepz <- every_n(unique(isabel$z), by = 2)
# islice <- subset(isabel, x %in% keepx & y %in% keepy & z %in% keepz)
# islice$vxy <- sqrt(islice$x ^ 2 + islice$y ^ 2)
# 加载grid包用于画箭头
library(grid)
ggplot(islice, aes(x = x, y = y)) + geom_segment(
aes(
xend = x + vx / 50,
yend = y + vy / 50,
color = vxy
),
arrow = arrow(length = unit(0.1, "cm")),
size = 0.5
) + scale_color_continuous(low = "grey80", high = "darkred") + facet_wrap(~
z)
## Warning: Removed 248 rows containing missing values (geom_segment).
library(gcookbook)
library(ggplot2)
ggplot(heightweight, aes(x = heightIn)) + stat_ecdf()
ggplot(heightweight, aes(x = ageYear)) + stat_ecdf()
UCBAdmissions
## , , Dept = A
##
## Gender
## Admit Male Female
## Admitted 512 89
## Rejected 313 19
##
## , , Dept = B
##
## Gender
## Admit Male Female
## Admitted 353 17
## Rejected 207 8
##
## , , Dept = C
##
## Gender
## Admit Male Female
## Admitted 120 202
## Rejected 205 391
##
## , , Dept = D
##
## Gender
## Admit Male Female
## Admitted 138 131
## Rejected 279 244
##
## , , Dept = E
##
## Gender
## Admit Male Female
## Admitted 53 94
## Rejected 138 299
##
## , , Dept = F
##
## Gender
## Admit Male Female
## Admitted 22 24
## Rejected 351 317
ftable(UCBAdmissions)
## Dept A B C D E F
## Admit Gender
## Admitted Male 512 353 120 138 53 22
## Female 89 17 202 131 94 24
## Rejected Male 313 207 205 279 138 351
## Female 19 8 391 244 299 317
dimnames(UCBAdmissions)
## $Admit
## [1] "Admitted" "Rejected"
##
## $Gender
## [1] "Male" "Female"
##
## $Dept
## [1] "A" "B" "C" "D" "E" "F"
# 没有则安装
# install.packages("vcd")
library(vcd)
## Warning: package 'vcd' was built under R version 3.3.2
mosaic(~ Admit + Gender + Dept, data = UCBAdmissions)
# 另一种分割顺序
mosaic(
~ Dept + Gender + Admit,
data = UCBAdmissions,
highlighting = "Admit",
highlighting_fill = c("lightblue", "pink"),
direction = c("v", "h", "v")
)
