R语言-探索多个变量

目的:

　　通过探索文件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)