2018年元旦的那个夜晚我就在和丁文亮一起爬妹子图网站。到今年，我也算是陪伴了妹子图这个网站一整年了，一年来是闲着没事就爬爬里面的图片。现在爬起图片网站来是毫无压力了。既然年终了，我就帮妹子图网站来个年度报告吧！
所以这个时候要在这里挂个警示牌了：
友情提示：本文内容少儿不宜。
首先妹子图网站的地址是：妹子图电脑版，这个网站上有总页数：
但是观察这个网站的封面图，你会发现只有标题、日期和浏览量，没有该套图的分类。
而这个网站的手机版的地址是：妹子图手机版，这个手机版的网站的封面上有标题、日期、浏览量和分类。所以我们主要是爬所有套图的这四个变量。
下面就可以开始爬了。
首先我们从妹子图电脑版上爬取总页数：
1
2
3
4
5
6
7
8
9
10
11
| library(rvest)
(page_num <- read_html('https://www.mzitu.com/') %>%
html_nodes(xpath = '/html/body/div[2]/div[1]/div[2]/nav/div/a[4]') %>%
html_text() %>%
as.numeric())
|
截止今天这个网站一共是206页。
下面爬https://m.mzitu.com/：
第一页地址：https://m.mzitu.com/page/1/
第二页地址：https://m.mzitu.com/page/2/
先试着爬取第一页的标题、浏览次数、日期和类别，在使用R进行网页爬取时，我比较喜欢使用XPath对网页元素进行定位。所以我们先观察XPath的规律：
找一找XPath的规律：
第一幅套图的XPath分别是：
标题：//*[@id="content"]/article[1]/div/h2/a
日期：//*[@id="content"]/article[1]/div/div/span[2]
浏览次数：//*[@id="content"]/article[1]/div/div/span[3]
分类：//*[@id="content"]/article[1]/div/div/span[1]/a
该页最后一幅套图的XPath是：
标题：//*[@id="content"]/article[24]/div/h2/a
日期：//*[@id="content"]/article[24]/div/div/span[2]
浏览次数：//*[@id="content"]/article[24]/div/div/span[3]
分类：//*[@id="content"]/article[24]/div/div/span[1]/a
XPath怎么来的呢：
可以看到XPath的规律很明显，一个页面有24组套图，一共206页。下面把它们爬下来：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
| library(progress)
df <- data.frame(
date = NA,
view = NA,
title = NA,
link = NA,
categroy = NA
)
pb <- progress_bar$new(total = page_num)
for(m in 1:page_num){
pb$tick(0)
pb$tick()
html <- read_html(paste0('https://m.mzitu.com/page/', m, '/'))
for(i in 1:24){
try(df <- rbind(
df, data.frame(
title = html %>% html_nodes(xpath = paste0('//*[@id="content"]/article[', i, ']/div/h2/a')) %>% html_text(),
date = html %>% html_nodes(xpath = paste0('//*[@id="content"]/article[', i, ']/div/div/span[2]')) %>% html_text(),
view = html %>% html_nodes(xpath = paste0('//*[@id="content"]/article[', i, ']/div/div/span[3]')) %>% html_text(),
link = html %>% html_nodes(xpath = paste0('//*[@id="content"]/article[', i, ']/div/h2/a')) %>% html_attr('href'),
categroy = html %>% html_nodes(xpath = paste0('//*[@id="content"]/article[', i, ']/div/div/span[1]/a')) %>% html_text()
)))
}
}
df <- subset(df, !is.na(df$title))
|
由于爬取比较费时间，大概三分钟吧，所以我们先把df保存起来，避免重复爬取，如果你懒得自己爬了，可以下载我的爬取结果：
meizitu.rds
1
2
| library(io)
qwrite(df, 'meizitu.rds')
|
整理一下数据：
1
2
3
4
5
6
7
8
9
10
11
| library(lubridate)
df <- qread('meizitu.rds')
df <- df %>%
mutate(
date = as.Date(date, format = '%Y-%m-%d'),
view = gsub(pattern = '[,次浏览]', '', view) %>% as.numeric(),
year = year(date),
month = month(date),
week = wday(date)
) %>%
arrange(desc(view))
|
先分析2018年的数据，首先统计每个月的浏览总次数：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
| df2018 <- subset(df, df$year == 2018)
month_view <- df2018 %>%
group_by(month) %>%
summarise(n = sum(view))
library(hrbrthemes)
library(formattable)
ggplot(data = month_view) +
geom_col(aes(x = factor(month), y = n, fill = factor(month))) +
scale_fill_brewer(palette = 'Set3') +
scale_x_discrete(
breaks = month_view$month,
labels = suffix(month_view$month, "月份")) +
scale_y_continuous(
breaks = c(0, 25000000, 50000000, 75000000),
labels = c('0', '2500\n万次', '5000\n万次', '7500\n万次')
) +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
guides(fill = 'none') +
theme(axis.title.x = element_blank()) +
labs(y = '浏览总量',
title = '妹子图网站各个月份的浏览量',
subtitle = '加总每个月的套图浏览量得到的数据。',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
发现下半年的浏览量远不如上半年，猜想可能是下半年发图量减少了，下面统计一下各个月份的发图次数：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
| month_publish <- df2018 %>%
group_by(month) %>%
summarise(n = length(view))
ggplot(data = month_publish) +
geom_col(aes(x = factor(month), y = n, fill = factor(month))) +
scale_fill_brewer(palette = 'Set3') +
scale_x_discrete(
breaks = month_view$month,
labels = suffix(month_view$month, "月份")) +
scale_y_continuous() +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
guides(fill = 'none') +
theme(axis.title.x = element_blank()) +
labs(y = '浏览总量',
title = '妹子图网站各个月份的发图量',
subtitle = '加总每个月的套图发图量得到的数据。',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
妹子图网站每个月的发图量很稳定，看来下半年浏览量的大幅下滑是真的网友们肾虚了！
下面再按周统计浏览量：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
| week_view <- df2018 %>%
group_by(week) %>%
summarise(n = sum(view))
ggplot(data = week_view) +
geom_col(aes(x = factor(week), y = n, fill = factor(week))) +
scale_fill_brewer(palette = 'Set2') +
scale_x_discrete(
breaks = 1:7,
labels = c("周一", "周二", "周三", "周四", "周五", "周六", "周日")
) +
scale_y_continuous(
breaks = seq(0, 80000000, by = 20000000),
labels = c('0', '2000\n万次', '4000\n万次', '6000\n万次', '8000\n万次')
) +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
guides(fill = 'none') +
theme(axis.title.x = element_blank()) +
labs(y = '浏览总量',
title = '妹子图网站周内各天浏览量',
subtitle = '加总周内各天套图浏览量得到的数据。',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
看来宅男们看起妹子来不分周一还是周末，每天都看。
今年浏览量排名前十的套图：
1
2
3
4
| knitr::kable(df %>%
arrange(desc(view)) %>%
select(c('date', 'title', 'link')) %>%
slice(1:10))
|
下面我想画一幅词云图，看看哪些词更能吸引访客的眼球，这里需要两个词典：
stopwords.txt：停用词词典，里面包含的单词不会被分词，而是直接去除；
dictionary.txt：用户辞典，里面包含的单词不会被分开。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
library(jiebaR)
engine_s <- worker(stop_word = "stopwords.txt", user = "dictionary.txt")
df$segment <- paste(segment(df$title, engine_s), collapse = ', ')
library(tidytext)
df2018$segment <- paste(segment(df2018$title, engine_s), collapse = ', ')
df2018 <- df2018 %>%
unnest_tokens(word, segment, token = stringr::str_split, pattern = ", ")
word_count <- df2018 %>%
group_by(word) %>%
summarise(n = sum(view)) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:100)
library(rWordCloud)
d3Cloud(text = word_count$word, size = word_count$n)
|
还是性感女神最受大家喜爱啊！
下面开始统计2018年各个类别的平均浏览量：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
| cat_view <- df2018 %>%
group_by(categroy) %>%
summarise(n = sum(view)/length(view)) %>%
ungroup()
ggplot(data = cat_view) +
geom_col(aes(x = factor(categroy),
y = n,
fill = factor(categroy))) +
scale_fill_brewer(palette = 'PuOr') +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
guides(fill = 'none') +
labs(x = '分类', y = '平均浏览量',
title = '妹子图网站各个类别的平均浏览量',
subtitle = '基于2018年的数据统计',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
还是都喜欢性感的！
分月比较各个月每个类别的平均浏览量：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| cat_view_by_month <- df2018 %>%
group_by(month, categroy) %>%
summarise(n = sum(view)/length(view)) %>%
ungroup()
ggplot(data = cat_view_by_month) +
geom_bar(aes(x = factor(month), y = n, fill = categroy),
stat = 'identity', position = 'stack') +
scale_fill_brewer("分类", palette = 'PuOr') +
scale_x_discrete(
breaks = month_view$month,
labels = suffix(month_view$month, "月")) +
scale_y_continuous(
breaks = seq(0, 2500000, by = 500000),
labels = suffix(seq(0, 250, by = 50), '\n万次')
) +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
labs(x = '月份', y = '平均浏览量',
title = '妹子图网站各个类别的平均浏览量',
subtitle = '基于2018年的数据统计',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
这样不是很方便类别之间进行比较，下面这样更容易比较：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
| ggplot(data = cat_view_by_month) +
geom_bar(aes(x = factor(month), y = n, fill = categroy),
stat = 'identity', position = 'fill') +
scale_fill_brewer("分类", palette = 'PuOr') +
scale_x_discrete(
breaks = month_view$month,
labels = suffix(month_view$month, "月")) +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
labs(x = '月份', y = '平均浏览量',
title = '妹子图网站各个类别的平均浏览量',
subtitle = '基于2018年的数据统计',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
下面我们把所有月份的而不仅仅是2018年的今天分类比较：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| df$ym <- paste0(df$year, '-', df$month, '-01')
cat_view_by_month_all <- df %>%
group_by(ym, categroy) %>%
summarise(n = sum(view)/length(view)) %>%
ungroup()
cat_view_by_month_all$ym <- ymd(cat_view_by_month_all$ym)
ggplot(data = cat_view_by_month_all) +
geom_bar(aes(x = ym, y = n, fill = categroy),
stat = 'identity', position = 'stack') +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
scale_fill_brewer("分类", palette = 'PuOr') +
scale_y_continuous(
breaks = seq(0, 8000000, by = 2000000),
labels = suffix(seq(0, 800, by = 200), '\n万次')
) +
labs(x = '年月', y = '平均浏览量',
title = '妹子图网站各个类别的平均浏览量',
subtitle = '基于全部数据统计',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/')
|
妹子图网站越做越糟糕哎，2017年以来一直在走下坡路。
再统计妹子图网站的平均浏览量：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
| mean_view <- df %>%
group_by(ym) %>%
summarise(n = sum(view)/length(view)) %>%
ungroup() %>%
arrange(ym)
mean_view$ym <- ymd(mean_view$ym)
ggplot(data = mean_view, aes(x = ym, y = n)) +
geom_line(data = cat_view_by_month_all,
aes(x = ym, y = n, color = categroy)) +
geom_line(color = I('#252525')) +
scale_color_brewer("分类", palette = 'Set2') +
scale_y_continuous(
breaks = seq(0, 3500000, by = 500000),
labels = suffix(seq(0, 350, by = 50), '\n万次')
) +
scale_x_date(
breaks = c('2014-01-01', '2015-01-01', '2016-01-01',
'2017-01-01', '2018-01-01', '2019-01-01') %>% ymd(),
labels = c('2014年1月', '2015年1月', '2016年1月',
'2017年1月', '2018年1月', '2019年1月')
) +
geom_text(aes(x = ymd('2018-01-01'), y = 3000000, label = '总和平均\n浏览量'), family = 'STSong') +
geom_segment(x = ymd('2017-02-10'), y = 2000000,
xend = ymd('2017-10-01'), yend = 2800000,
arrow = arrow(length = unit(0.1, "cm")),
size = 0.2) +
theme_ipsum(
base_family = 'STSongti-SC-Bold'
) +
labs(y = '月平均浏览量',
title = '妹子图网站月平均浏览量',
subtitle = '2013年10月～2019年1月',
caption = '数据来源：妹子图网站\nhttps://m.mzitu.com/') +
theme(axis.title.x = element_blank())
|
可以看出妹子图网站大势已去。
不过我想可能不是因为用户对妹子图网站失去了兴趣，而真实原因可能是这样的：
- 妹子图网站后来又推出了公众号、APP等产品，这些东西将网站的流量分流出一部分；
- 妹子图网站的很大一部分流量可能不是真实用户，而是各种网络爬虫，比较妹子图网站是大家最爱爬的网站之一，然而后来妹子图网站不断升级反爬机制，导致爬取难度增加；
- 图片网站的竞争在加剧，很多新的图片网站涌现出来；
- 网络速度的提升使得用户不再 满足于图片浏览，而更多的选择浏览一些视频，所以图片不再受欢迎；
- 一些社交平台对妹子图网站的打击力度加剧，例如妹子图网站在微信里面是打不开的。
- 等等。。。
