客服电话
APP下载
迪恩网络APP
随时随地掌握行业动态
官方微信
扫描二维码
关注迪恩网络微信公众号
|
目的: 通过探索文件pseudo_facebook.tsv数据来学会多个变量的分析流程 通过探索diamonds数据集来探索多个变量 通过酸奶数据集探索多变量数据 知识点: 散点图 dplyr汇总数据 比例图 第三个变量加入到图形中 简介: 如果在探索多变量的时候,我们通常会把额外的变量用多维的图形来进行展示,例如性别,年份等 案例分析: 一:facebook数据集分析 思路:根据性别进行划分数据集,x轴为年龄,y轴为好友数,然后根据中位数进行绘制 或根据数据进行划分来进行绘制 1.分析男性,女性的不同年龄段的好友的中位数(设想的受众规模) library(ggplot2) pf <- read.csv('pseudo_facebook.tsv',sep='\t')
图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 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)+
图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)
|
请发表评论