【R語言 資料分析】豆瓣電影R語言爬蟲和資料分析
阿新 • • 發佈：2019-02-17
主要內容：
1、r語言爬蟲 rvest包的使用。
2、r語言字串處理stringr包的使用。
3、r語言聚合dplyr 包的使用。
4、r語言視覺化ggplot 包的使用。
5、r語言畫詞雲圖worldcloud2 包的使用。
6、正則表示式 str_match 的使用
7、sapply的用法。
8、字串切割函式str_split的 用法。
程式碼片段1（字串切割和字串正則匹配）：
> (a <- "2017-12-25")
[1] "2017-12-25"
> (b <- str_split(a,"-"))
[[1]]
[1] "2017" "12" "25" 程式碼片段2（sapply函式 運用，功能強大，類似scala map函式，可自定義函式作用於每個元素）
(d <- c(1,2,3,4,5,6,7,8,9))
#每個元素乘以2
(e <- sapply(d,function(x) x*2))
程式碼片段3（rvest爬蟲 管道%>%解析法）：
# 讀取網頁內容
page <- html_session(url)
# 獲取電影的連結
movie_url <- html_nodes(page, 'p>a' 程式碼片段4（dplyr包 group_by 和summarise 的用法，分組求和）
# 聚合操作
groupby_countrys <- group_by(df, countries)
df <- summarise(groupby_countrys, Freq = sum(Freq))程式碼片段5（arrange 排序功能）
# 降序排序
df <- arrange(df, desc(Freq 程式碼片段6（ggplot 畫條形圖）
# 1、參評人數最多的Top10的電影
# 配置畫圖的資料
p <- ggplot(data = arrange(raw_data, desc(evalue_users))[1:10,],
mapping = aes(x = reorder(movie_name,-evalue_users),
y = evalue_users)) +
# 限制y周的顯示範圍
coord_cartesian(ylim = c(500000, 750000)) +
# 格式化y軸標籤的數值
scale_y_continuous(breaks = seq(500000, 750000, 100000),
labels = paste0(round(seq(500000, 750000, 100000)/10000, 2), 'W')) +
# 繪製條形圖
geom_bar(stat = 'identity', fill = 'steelblue') +
# 新增軸標籤和標題
labs(x = NULL, y = '評價人數', title = '評價人數最多的top10電影') +
# 設定x軸標籤以60度傾斜
theme(axis.text.x = element_text(angle = 60, vjust = 0.5),
plot.title = element_text(hjust = 0.5, colour = 'brown', face = 'bold'))
p
全部原始碼學習：
rm(list=ls())
gc()
options(scipen = 200)
library(rvest)
library(stringr)
library(dplyr)
library(wordcloud2)
library(ggplot2)
##################################爬蟲部分###########################################
# 指定需要抓取的URL
url <- 'https://zhuanlan.zhihu.com/p/22561617'
# 讀取網頁內容
page <- html_session(url)
# 獲取電影的連結
movie_url <- html_nodes(page, 'p>a') %>% html_attr("href")
# 獲取電影名稱
movie_name <- html_nodes(page, 'p>a') %>% html_text()
# 獲取電影的其他描述資訊
describe <- html_nodes(page, 'p') %>% html_text()
# 篩選出需要的子集
describe <- describe[16:443]
# 通過正則表示式匹配評分
score <- as.numeric(str_match(describe, '.* (.*?)分')[,2])
# 通過正則表示式匹配評價人數
evalue_users <- as.numeric(str_match(describe, '分 (.*?)人評價')[,2])
# 通過正則表示式匹配電影年份
year <- as.numeric(str_match(describe, '評價 (.*?) /')[,2])
# 由於生產國和電影型別用/分割，且沒有固定的規律，故將生產國和電影型別存入到一個變數中
other <- sapply(str_split(describe, '/', n = 2),'[',2)
# 構建資料框
raw_data <- data.frame(movie_name, movie_url,score,evalue_users,year,other)
head(raw_data)
# 將抓取的資料寫出到本地
write.csv(raw_data, 'E:/ID/data/movies.csv', row.names = FALSE)
###############################資料處理部分#############################################
# 需要將電影的其他描述資訊進行拆分
# 前往搜狗官網，下載所有國家名稱的字典，再利用“深藍詞庫轉換”工具，將scel格式的字典轉換成txt
# http://pinyin.sogou.com/dict/detail/index/12347
countrys <- readLines(file.choose())
# 把資料集中的other變數進行切割
cut_other <- str_split(raw_data$other, '/')
head(cut_other)
# 刪除所有空字串
cut_other <- sapply(cut_other, function(x) x[x != " "])
# 剔除字串中的收尾空格
cut_other <- sapply(cut_other, str_trim)
head(cut_other)
# 提取出所有關於電影所屬國家的資訊
movie_country <- sapply(cut_other, function(x,y) x[x %in% y], countrys)
head(movie_country)
# 提取出所有關於電影所屬型別的資訊
movie_type <- sapply(cut_other, function(x,y) x[!x %in% y], countrys)
head(movie_type)
# 資料分析
# 1、參評人數最多的Top10的電影
# 配置畫圖的資料
p <- ggplot(data = arrange(raw_data, desc(evalue_users))[1:10,],
mapping = aes(x = reorder(movie_name,-evalue_users),
y = evalue_users)) +
# 限制y周的顯示範圍
coord_cartesian(ylim = c(500000, 750000)) +
# 格式化y軸標籤的數值
scale_y_continuous(breaks = seq(500000, 750000, 100000),
labels = paste0(round(seq(500000, 750000, 100000)/10000, 2), 'W')) +
# 繪製條形圖
geom_bar(stat = 'identity', fill = 'steelblue') +
# 新增軸標籤和標題
labs(x = NULL, y = '評價人數', title = '評價人數最多的top10電影') +
# 設定x軸標籤以60度傾斜
theme(axis.text.x = element_text(angle = 60, vjust = 0.5),
plot.title = element_text(hjust = 0.5, colour = 'brown', face = 'bold'))
p
# 2、一部經典的電影需要多少國家或地區合拍
# 統計每一部電影合拍的國家數
movie_contain_countrys <- sapply(movie_country, length)
table(movie_contain_countrys)
# 由於電影的製作包含5個國家及以上的分別只有1部電影，故將5個國家及以上的當做1組
# 轉化為資料框
df <- as.data.frame(table(movie_contain_countrys))
# 資料框變數的重新命名
names(df)[1] <- 'countries'
# 資料型別轉換
df$countries <- as.numeric(as.character(df$countries))
df$countries <- ifelse(df$countries<=4, df$countries, '5+')
# 聚合操作
groupby_countrys <- group_by(df, countries)
df <- summarise(groupby_countrys, Freq = sum(Freq))
# 資料型別轉換，便於後面視覺化
df$countries <- factor(df$countries)
df
# 運用環形圖對上面的資料進行視覺化
# 定義資料，用於畫圖
df$ymax <- cumsum(df$Freq)
df$ymin <- c(0, cumsum(df$Freq)[-length(df$ymax)])
# 生成圖例標籤
labels <- paste0(df$countries,'(',round(df$Freq/sum(df$Freq)*100,2),'%',')')
# 繪圖
p <- ggplot(data = df, mapping = aes(xmin = 3, xmax = 4, ymin = ymin,
ymax = ymax, fill = countries)) +
# 矩形幾何圖
geom_rect(size = 5) +
# 極座標變換
coord_polar(theta = 'y') +
# 環形圖
xlim(1,4) +
# 新增標題
labs(x = NULL, y =NULL, title = '一部電影需要多少國家合作') +
# 設定圖例
scale_fill_discrete(breaks = df$countries, labels = labels) +
theme(legend.position = 'right',
plot.title = element_text(hjust = 0.5, colour = 'brown', face = 'bold'),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
panel.background = element_blank()
)
p
# 3、經典電影產量top10都是哪些國家
# 羅列出所有電影的拍攝國家
top_countris <- unlist(movie_country)
# 頻數統計，並構造資料框
df <- as.data.frame(table(top_countris))
# 降序排序
df <- arrange(df, desc(Freq))
df
# 香港，中國大陸和臺灣入圍前十，分別是第5，第7和第10名。前三的歸美國，英國和日本。美國絕對是量產的國家，遠遠超過第二名的英國。
# 運用文字雲對上面的資料進行視覺化
wordcloud2(df, backgroundColor = 'black', rotateRatio = 2)
# 4、這些經典電影主要都是屬於什麼型別
# 羅列出所有電影的型別
top_type <- unlist(movie_type)
# 構造資料框
df <- as.data.frame(table(top_type))
# 降序排序
df <- arrange(df, desc(Freq))
df
# 由於幾乎所有的電影都貼上劇情這個標籤，我們暫不考慮這個型別，看看其他的型別top15分佈
# 去除第一行的（劇情）型別
df <- df[-1,]
df$top_type <- as.character(df$top_type)
# 我們使用條形圖來反饋上面的資料情況
# 提取出前15的型別
df$top_type <- ifelse(df$top_type %in% df$top_type[1:15], df$top_type, '其他')
# 資料聚合
groupby_top_type <- group_by(df, top_type)
df <- summarise(groupby_top_type, Freq = sum(Freq))
# 排序
df <- arrange(df, desc(Freq))
# 構造數值標籤
labels <- paste(round(df$Freq/sum(df$Freq)*100,2),'%')
p <- ggplot(data = df, mapping = aes(x = reorder(df$top_type, Freq), y = Freq)) +
# 繪製條形圖
geom_bar(stat = 'identity', fill = 'steelblue') +
# 新增文字標籤
geom_text(aes(label = labels), size = 3, colour = 'black',
position = position_stack(vjust = 0.5), angle = 30) +
# 新增軸標籤
labs(x = '電影型別', y = '電影數量', title = 'top15的電影型別') +
# 重組x軸的標籤
scale_x_discrete(limits = c(df$top_type[df$top_type!='其他'],'其他')) +
# 主題設定
theme(plot.title = element_text(hjust = 0.5, colour = 'brown', face = 'bold'),
panel.background = element_blank())
p
# 前三名的電影型別分別為愛情、喜劇和犯罪
# 5、哪些年代的電影好評度比較高
# 根據年份的倒數第二位，判讀所屬年代
raw_data$yearS <- paste0(str_sub(raw_data$year,3,3),'0','S')
# 對年代聚合
groupbyYS <- group_by(raw_data, yearS)
yearS_movies <- summarise(groupbyYS, counts = n())
# 繪圖
p <- ggplot(data = yearS_movies,
mapping = aes(x = reorder(yearS, -counts),
y = counts)) +
# 繪製條形圖
geom_bar(stat = 'identity', fill = 'steelblue') +
# 新增軸標籤和標題
labs(x = '年代', y = '電影數量', title = '各年代的好評電影數量') +
# 主題設定
theme(plot.title = element_text(hjust = 0.5, colour = 'brown', face = 'bold'),
panel.background = element_blank())
p
# 6、評分top5的電影型別
# 所有電影型別
types <- unique(unlist(movie_type))
# 定義空的資料框物件
df = data.frame()
# 通過迴圈，抓取出不同標籤所對應的電影評分
for (type in types){
res = sapply(movie_type, function(x) x == type)
index = which(sapply(res, any) == 1)
df = rbind(df,data.frame(type,score = raw_data[index, 'score']))
}
# 按電影所屬型別，進行summary操作
type_score <- aggregate(df$score, by = list(df$type), summary)
# 資料集進行橫向拼接為資料框
type_score <- cbind(Group = type_score$Group.1, as.data.frame(type_score$x))
# 按平均得分排序
type_score <- arrange(type_score, desc(Mean))
type_score
# 單從電影型別的平均得分來看，災難片、恐怖片和兒童片位居前三，儘管分別只有3部，2部和12部。
# 7、評論人數和評分之間的關係
p <- ggplot(data = raw_data, mapping = aes(x = evalue_users, y = score)) +
# 繪製散點圖
geom_point(colour = 'steelblue') +
# 新增一元線性迴歸擬合線
geom_smooth(method = 'lm', colour = 'red') +
# 新增軸標籤和標題
labs(x = '評論人數', y = '評分', title = '評論人數與評分的關係') +
# 設定x軸的標籤格式
scale_x_continuous(breaks = seq(30000, 750000, 100000),
labels = paste0(round(seq(30000, 750000, 100000)/10000, 2), 'W')) +
scale_y_continuous(breaks = seq(8, 9.6, 0.2)) +
# 主題設定
theme(plot.title = element_text(hjust = 0.5, colour = 'brown', face = 'bold'))
p