【数据挖掘】实验7：高级绘图（上）

library('lattice')

xyplot(wt ~ mpg, data = mtcars, xlab = 'Weight', ylab = 'Miles per Gallon', main = 'lattice包绘制散点图')

names(trellis.par.get())

op <- trellis.par.get()

trellis.par.get('fontsize')

trellis.par.set(fontsize = list(text = 20, points = 20))

xyplot(wt ~ mpg, data = mtcars, xlab = 'Weight', ylab = 'Miles per Gallon', main = 'lattice包绘制散点图')

trellis.par.set(op)

show.settings()

library(lattice)

attach(iris)

xyplot(Sepal.Length ~ Sepal.Width | Species)

detach(iris)

my_panel <- function(x,y){

  panel.lmline(x, y, col = "red", lwd = 1, lty = 2)

  panel.loess(x,y)

  panel.grid(h = -1, v = -1)

  panel.rug(x, y)

  panel.xyplot(x, y)

}

xyplot(mpg ~ wt, data = mtcars, xlab = "Weight", ylab = "Miles per Gallon",main = "Miles per Gallon on Weight", panel = my_panel)

xyplot(Sepal.Length ~ Sepal.Width, group = Species, data = iris,pch = 1:3, col = 1:3, main = 'Sepal.Length VS Sepal.Width', key = list(space = "right", title = "Species", cex.title = 1, cex = 1, text = list(levels(factor(iris$Species))), points=list(pch = 1:3, col= 1:3)))

graph1 <- xyplot(Sepal.Length ~ Sepal.Width | Species, data = iris, main = '栅栏图')

graph2 <- xyplot(Sepal.Length ~ Sepal.Width, group = Species, data = iris, main = '散点图1')

graph3 <- xyplot(Petal.Length ~ Petal.Width, group = Species, data = iris, main = '散点图2')

# split函数

plot(graph1, split = c(1,1,3,1))

plot(graph2, split = c(2,1,3,1),newpage=F)

plot(graph2, split = c(3,1,3,1),newpage=F)

# position函数

plot(graph1, position = c(0, 0, 1/3, 1))

plot(graph2, position = c(1/3, 0, 2/3, 1), newpage = F)

plot(graph3, position = c(2/3, 0, 1, 1), newpage = F)

barchart(VADeaths, main = 'Death Rates in 1940 Virginia(By Group)')

barchart(VADeaths, groups = FALSE, main = list("Death Rates in 1940 Virginia", cex = 1.2))

str(Titanic)

as.data.frame(Titanic)

pic1 <- barchart(Class ~ Freq|Age + Sex, data = as.data.frame(Titanic), groups = Survived, stack = TRUE, auto.key = list(title = "Survived", columns = 2))

pic2 <- barchart(Class ~ Freq|Age + Sex, data = as.data.frame(Titanic), groups = Survived, stack = TRUE, auto.key = list(title = "Survived", columns = 2), scales = list(x = "free"))

pic3 <- update(pic2, panel=function(...){

  panel.grid(h=0,v=-1)

  panel.barchart(...,border = "Transparent")

})

plot(pic1, split = c(1,1,3,1))

plot(pic2, split = c(2,1,3,1), newpage = FALSE)

plot(pic3, split = c(3,1,3,1), newpage = FALSE)

dotplot(VADeaths, pch = 1:4, xlab = 'Death rates per 1000',

        main = list('Death Rates in 1940 Virginia (By Group)', cex = 0.8),

        key = list(column = 4, text = list(colnames(VADeaths)), points = list(pch = 1:4, col =1:4)))

dotplot(VADeaths, group = FALSE, xlab = 'Death rates per 1000',main = list('Death Rates in 1940 Virginia', cex = 0.8))

histogram( ~ height | voice.part, data = singer, nint = 17, layout = c(1,8), xlab = "Height(inches)")

densityplot( ~ height | voice.part, data = singer, layout=c(1, 8), xlab = "Height (inches)",main = "Heights of New York Choral Society singers")

densityplot( ~ height, group = voice.part, data = singer, xlab = "Height (inches)" , plot.points = FALSE,main = "Heights of New York Choral Society singers", lty = 1:8, col = 1:8, lwd = 1.5,key = list(text = list(levels(singer$voice.part)), column = 4, lines = list(lty = 1:8, col = 1:8)))

histogram( ~ height | voice.part, data = singer,

           xlab = "Height (inches)", type = "density",

           panel = function(x, ...) {

          panel.histogram(x, ...)

          panel.mathdensity(dmath = dnorm, col = "black",

          args = list(mean=mean(x),sd=sd(x)))

})

nrow(singer[singer$voice.part == 'Bass 2', ])

stripplot(~ height, group = voice.part, data = singer, xlab = "Height (inches)",

main = "Heights of New York Choral Society singers",

          subset = (voice.part == "Bass 2"),jitter.data=T)

qqmath(~ height | voice.part, data = singer, prepanel = prepanel.qqmathline,

       panel = function(x, ...) {

       panel.qqmathline(x, ...)

       panel.qqmath(x, ...)

       })

qq(voice.part ~ height, aspect = 1, data = singer,subset = (voice.part == "Bass 2" | voice.part == "Tenor 2"))

pic1 <- bwplot( ~ height | voice.part, data=singer, xlab="Height (inches)")

pic2 <- bwplot(voice.part ~ height, data=singer, xlab="Height (inches)")

plot(pic1, split = c(1, 1, 2, 1))

plot(pic2, split = c(2, 1, 2, 1), newpage = FALSE)

xyplot(Sepal.Length~Sepal.Width|Species,data=iris)

splom(iris[, 1:4], groups = iris$Species, pscales = 0, pch = 1:3, col = 1:3, varnames = colnames(iris)[1:4],key = list(columns = 3, text = list(levels(iris$Species)), points = list(pch = 1:3, col = 1:3)))

data(Cars93, package = "MASS")

cor.Cars93 <-cor(Cars93[, !sapply(Cars93, is.factor)], use = "pair")

levelplot(cor.Cars93, scales = list(x=list(rot=90)))

contourplot(volcano, cuts = 20)

par.set <-list(axis.line = list(col = "transparent"), clip = list(panel = "off")) # 去除边框，不削减面板范围

cloud(Sepal.Length ~ Petal.Length * Petal.Width, data = iris, groups = Species,

        pch = 1:3,col= 1:3, # 点颜色及样式

        screen = list(z = 20, x = -70, y =0), # 调节三维散点图的展示角度

        par.settings = par.set,

        scales = list(col = "black"), # 加箭头指示

        key=list(column=3, text=list(levels(iris$Species)), points = list(pch = 1:3, col = 1:3)))

par.set <-list(axis.line = list(col = "transparent"), clip = list(panel = "off")) # 去除边框，不削减面板范围

wireframe(volcano, shade = TRUE, par.settings = par.set, aspect = c(61/87, 0.4))

library(ggplot2)

qplot(Species, Sepal.Length, data = iris, geom = "boxplot", fill = Species,main = "依据种类分组的花萼长度箱线图")

qplot(Species, Sepal.Length, data = iris, geom = c("violin", "jitter"), fill = Species,main = "依据种类分组的花萼长度小提琴图")

qplot(Sepal.Length, Sepal.Width, data = iris, colour = Species, shape = Species,main = "绘制花萼长度和花萼宽度的散点图")

qplot(Sepal.Length, Sepal.Width, data = iris, geom = c("point", "smooth"), facets = ~Species,colour = Species, main = "绘制分面板的散点图")

plot(iris$Sepal.Length, iris$Sepal.Width)

library(ggplot2)

ggplot(data= iris, aes(x = Sepal.Length, y = Sepal.Width)) + #绘制底层画布

geom_point(color = "darkred") #在画布上添加点

ggplot(data = iris, aes(x = Sepal.Length, y = Sepal.Width, colour = Species, shape = Species))

#  方法1

ggplot(data = iris, aes(x = Sepal.Length, y = Sepal.Width, colour = Species, shape = Species))+geom_point()

# 方法2

ggplot(data = iris) + geom_point(aes(x = Sepal.Length, y = Sepal.Width, colour = Species, shape = Species))

# 方法1

ggplot(iris) + geom_bar(aes(x=Sepal.Length), stat="bin", binwidth = 0.5)

# 方法2

ggplot(iris) + stat_bin(aes(x=Sepal.Length), geom="bar", binwidth = 0.5)

set.seed(1234) # 设置随机种子

my_iris <- iris[sample(1:150, 100, replace = FALSE),] # 随机抽样

p <- ggplot(my_iris) + geom_bar(aes(x = Species, fill = Species))

p # 左图

p$scales # 查看p的标尺参数

p + scale_fill_manual(

  values = c("orange", "olivedrab", "navy"), # 颜色设置

  breaks = c("setosa", "versicolor", "virginica"), # 图例和轴要显示的分段点

  name = "my_Species", # 图例和轴使用的名称

  labels = c("set", "ver", "vir") # 图例使用的标签

  ) # 右图

ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, colour = Species))+

  scale_color_manual(values = c("orange", "olivedrab", "navy"))+

  geom_point(size = 2)

ggplot(iris,aes(x = Sepal.Length, y = Sepal.Width, colour = Species))+

  scale_color_brewer(palette = "Set1")+

  geom_point(size=2)

# 饼图 = 堆叠长条图 + polar coordinates

pie <- ggplot(my_iris, aes(x = factor(1), fill = Species)) +geom_bar(width = 1)

pie + coord_polar(theta = "y")

# 靶心图 = 饼图 + polar coordinates

pie + coord_polar()

#锯齿图 = 柱状图 + polar coordinates

cxc <- ggplot(my_iris, aes(x = Species)) +geom_bar(width = 1, colour = "black")

cxc + coord_polar()

library(ggplot2)

library(tidyr)

library(dplyr)

my_iris1 <- iris %>% gather(feature_name, feature_value, one_of(c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width"))) # 数据变换

ggplot(my_iris1) +geom_violin(aes(x = Species, y = feature_value)) + facet_grid(feature_name ~ Species, scales = "free") # 分面

ggplot(my_iris1) + geom_violin(aes(x = Species, y = feature_value)) + facet_wrap(~ feature_name + Species, scales = "free")

ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, colour = Species))+geom_point(size = 2)

ggsave(file = "mygraph.pdf", width = 5, height = 4)