目的:
通過探索文件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)