目的:
通过探索文件pseudo_facebook.tsv数据来学会多个变量的分析流程
通过探索diamonds数据集来探索多个变量
通过酸奶数据集探索多变量数据
知识点:
散点图
dplyr汇总数据
比例图
第三个变量加入到图形中
简介:
如果在探索多变量的时候,我们通常会把额外的变量用多维的图形来进行展示,例如性别,年份等
案例分析:
一:facebook数据集分析
思路:根据性别进行划分数据集,x轴为年龄,y轴为好友数,然后根据中位数进行绘制
或根据数据进行划分来进行绘制
1.分析男性,女性的不同年龄段的好友的中位数(设想的受众规模)
library(ggplot2)
pf <- read.csv('pseudo_facebook.tsv',sep='\t')
#1.查看年龄和性别的的箱线图
ggplot(aes(x = gender, y = age),
data = subset(pf, !is.na(gender))) + geom_boxplot()
#2.根据性别查看年龄和好友数的中位数比较
ggplot(aes(x=age,y=friend_count),
data=subset(pf,!is.na(gender)))+
geom_line(aes(color=gender),stat = 'summary',fun.y=median)
图1 图2
图1表示女性的年龄比男性要高
图2反应了在60岁之前女性的好友数要多于男性
2.整合数据框架
library(dplyr)
pf.fc_by_age_gender <- pf %>%
filter(!is.na(gender)) %>%
group_by(age,gender) %>%
summarise(mean_friend_count = mean(friend_count),
median_friend_count = median(friend_count),
n = n()) %>%
ungroup() %>%
arrange(age)
3.绘制图形
ggplot(aes(x=age,y=median_friend_count),data=pf.fc_by_age_gender)+
geom_line(aes(color=gender))
图3
图3反应了在60岁之前女性的好友数要多于男性
4.男性女性好友数量的比例
#将年龄按照性别进行横排列
library(reshape2)
pf.fc_by_age_gender.wide <- dcast(pf.fc_by_age_gender,
age ~ gender,
value.var = 'median_friend_count')
ggplot(aes(x=age,y=female/male),
data = pf.fc_by_age_gender.wide)+
geom_line()+
geom_hline(yintercept = 1,alpha=0.3,linetype=2)
图4
根据图4可以反应出在20岁左右女性好友的数量是男性的2倍多,在60岁的女性的数量任然是超过男性的,65岁之后女性的好友的数量低于男性
5.分析每个年份加入的好友数量
思路:创建年份变量然后,根据年份进行分组,最后再根据年龄和好友数进行绘制
#1.计算加入的年份加在数据集上
#2.将年份进行切分
#3.绘制每个区间的图形
pf$year_joined <- floor(with(pf,2014-tenure/365))
pf$year_joined.bucket <- cut(pf$year_joined,
c(2004,2009,2011,2012,2014))
ggplot(aes(x=age,y=friend_count),
data=subset(pf,!is.na(year_joined.bucket)))+
geom_line(aes(color=year_joined.bucket),stat = 'summary',func.y=median)
图5
图5可以反应出2004,2009年使用faceboo的年轻人所占的好友数量是相当多的
6.分析好友率(使用天数和新的申请好友的关系)
#1.friendships_initiated/tenure表示使用期和新的好友的比例
#2.划分数据集,找出至少使用一天的用户
#3.根据年份的区间进行绘制
#4.做出年份区间的大致趋势
ggplot(aes(x=tenure,y=friendships_initiated/tenure),
data=subset(pf,tenure>=1))+
geom_line(aes(color=year_joined.bucket),stat='summary',fun.y=mean) ggplot(aes(x=tenure,y=friendships_initiated/tenure),
data=subset(pf,tenure>=1))+
geom_smooth(aes(color=year_joined.bucket))
图6 图7
图6和图7反应了使用的时间越久所得到的的好友数量就越少
二:分析酸奶数据集(找出酸奶的口味,时间,价格的关系)
1.做出价格的直方图
yo <- read.csv('yogurt.csv')
yo$id <- factor(yo$id)
ggplot(aes(x=price),data=yo)+
geom_histogram()
图8
图8反应了价格越高的酸奶数量越多
2.分析大部分家庭一次性购买多少份酸奶
#将所有的口味的数量全部整合起来生成一个新的变量all.purchase
yo <- transform(yo,all.purchases=strawberry+blueberry+plain+pina.colada+mixed.berry)
qplot(x=all.purchases,data=yo,fill=I('#099dd9'),binwidth=1)
图9
图9反应了大多数家庭一次性购买了1,2份酸奶
3.分析价格和时间的关系
ggplot(aes(x=time,y=price),data=yo)+
geom_point(alpha=1/4,shape=21,fill=I('#f79420'),position = 'jitter')
图10
图10反应了随着时间的增长,价格也随之增长
4.分析抽样家庭的样本购买情况
#1.设置种子起始
#2.从总量中获取16个随机的家庭id
#3.根据获取的随机id进行绘制
set.seed(4230)
sample.ids <- sample(levels(yo$id),16)
ggplot(aes(x=time,y=price),
data=subset(yo,id %in% sample.ids))+
facet_wrap(~ id)+
geom_line()+
geom_point(aes(size=all.purchases),pch=1)
图11
图11反应了家庭在购买酸奶习惯
5.做出散点矩阵图,在该图中可以找到每一个变量和其他变量之间的联系
library('GGally')
theme_set(theme_minimal(20))
set.seed(1836)
pf_subset <- pf[,c(2:15)]
ggpairs(pf_subset[sample.int(nrow(pf_subset),1000),])
图12
图12中有直方图,散点图,线图,和每个变量和其他变量之间的联系,具有很多细节的参考价值
三:分析钻石数据集
1.重量(克拉)和价格的关系
#在x轴和y轴上去掉1%的异常数据
ggplot(aes(x=carat,y=price),data=diamonds)+
scale_x_continuous(lim=c(0,quantile(diamonds$carat,0.99)))+
scale_y_continuous(lim=c(0,quantile(diamonds$price,0.99)))+
geom_point(alpha=1/4,color='#f79420')+
geom_smooth(method = 'lm')
图12
图12基本上反应出重量越重价格越高,但是由于渐近线并没有吻合数据集的开头的结尾,如果尝试去做预测,会错过些关键数据
2.钻石销售总体的关系
library(ggplot2)
library(GGally)
library(scales)
library(memisc) # 从数据集获取10000个样本数据进行分析
set.seed(20022012)
diamond_samp <- diamonds[sample(1:length(diamonds$price), 10000), ]
ggpairs(diamond_samp,lower= list(continuous = wrap("points", shape = I('.'))),
upper = list(combo = wrap("box", outlier.shape = I('.'))))
图13
图13反应了钻石市场的基本信息
3.钻石的需求
library(gridExtra)
p1 <- ggplot(aes(x=price,fill=I('#099dd9')),data=diamonds)+
geom_histogram(binwidth=100)
p2 <- ggplot(aes(x=price,fill=I('#f79420')),data=diamonds)+
geom_histogram(binwidth=0.01)+
scale_x_log10()
grid.arrange(p1,p2,ncol=1)
图14
图14的下图反应了在1000,10000美金之间的钻石的销售是最多的
4.价格和净度的关系
#1.转换克拉变量
cuberoot_trans = function() trans_new('cuberoot',
transform = function(x) x^(1/3),
inverse = function(x) x^3) library(RColorBrewer)
ggplot(aes(x = carat, y = price,color=clarity), data = diamonds) +
geom_point(alpha = 0.5, size = 1, position = 'jitter') +
scale_color_brewer(type = 'div',
guide = guide_legend(title = 'Clarity', reverse = T,
override.aes = list(alpha = 1, size = 2))) +
scale_x_continuous(trans = cuberoot_trans(), limits = c(0.2, 3),
breaks = c(0.2, 0.5, 1, 2, 3)) +
scale_y_continuous(trans = log10_trans(), limits = c(350, 15000),
breaks = c(350, 1000, 5000, 10000, 15000)) +
ggtitle('Price (log10) by Cube-Root of Carat and Clarity')
图15
图15反应了净度越高价格也就越高
5.价格和切工的关系
ggplot(aes(x = carat, y = price, color = cut), data = diamonds) +
geom_point(alpha = 0.5, size = 1, position = 'jitter') +
scale_color_brewer(type = 'div',
guide = guide_legend(title = 'Clarity', reverse = T,
override.aes = list(alpha = 1, size = 2))) +
scale_x_continuous(trans = cuberoot_trans(), limits = c(0.2, 3),
breaks = c(0.2, 0.5, 1, 2, 3)) +
scale_y_continuous(trans = log10_trans(), limits = c(350, 15000),
breaks = c(350, 1000, 5000, 10000, 15000)) +
ggtitle('Price (log10) by Cube-Root of Carat and Clarity')
图16
图16反应了切工和价格没有关系
6.价格和颜色的关系
ggplot(aes(x = carat, y = price, color = color), data = diamonds) +
geom_point(alpha = 0.5, size = 1, position = 'jitter') +
scale_color_brewer(type = 'div',
guide = guide_legend(title = 'Color', reverse = F,
override.aes = list(alpha = 1, size = 2))) +
scale_x_continuous(trans = cuberoot_trans(), limits = c(0.2, 3),
breaks = c(0.2, 0.5, 1, 2, 3)) +
scale_y_continuous(trans = log10_trans(), limits = c(350, 15000),
breaks = c(350, 1000, 5000, 10000, 15000)) +
ggtitle('Price (log10) by Cube-Root of Carat and color')
图17
图17反应了颜色和价格的关系,价格上D>E>F>G>H>I>J
7.线性模型,可以通过线性模型对数据进行查看
#在lm(x~y)中,x是解释变量,y是结果变量
#I表示使用R内部的表达式,再将其用于递归
#可以添加更多的变量来扩展该模型
m1 <- lm(I(log(price)) ~ I(carat^(1/3)), data = diamonds)
m2 <- update(m1, ~ . + carat)
m3 <- update(m2, ~ . + cut)
m4 <- update(m3, ~ . + color)
m5 <- update(m4, ~ . + clarity)
mtable(m1, m2, m3, m4, m5)
#1.构建新的钻石线性模型来进行分析
#2.数据集只采用价格小于10000和GIA认证的钻石
#3.额外添加重量,切工,颜色,净度进行分析
load('BigDiamonds.Rda')
diamondsbig$logprice = log(diamondsbig$price)
m1 <- lm(logprice ~ I(carat^(1/3)),
data=diamondsbig[diamondsbig$price<10000
&diamondsbig$cert == 'GIA',])
m2 <- update(m1,~ . + carat)
m3 <- update(m2,~ . + cut)
m4 <- update(m3,~ . + color)
m5 <- update(m4,~ . + clarity)
mtable(m1,m2,m3,m4,m5)