2018 年元旦的那个夜晚我就在和丁文亮一起爬妹子图网站。到今年,我也算是陪伴了妹子图这个网站一整年了,一年来是闲着没事就爬爬里面的图片。现在爬起图片网站来是毫无压力了。既然年终了,我就帮妹子图网站来个年度报告吧!
所以这个时候要在这里挂个警示牌了:
友情提示:本文内容少儿不宜。
首先妹子图网站的地址是:妹子图电脑版,这个网站上有总页数:

但是观察这个网站的封面图,你会发现只有标题、日期和浏览量,没有该套图的分类。
而这个网站的手机版的地址是:妹子图手机版,这个手机版的网站的封面上有标题、日期、浏览量和分类。所以我们主要是爬所有套图的这四个变量。

下面就可以开始爬了。
首先我们从妹子图电脑版上爬取总页数:
R1 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 页。下面把它们爬下来:
R1 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
R1 2
| library(io) qwrite(df, 'meizitu.rds')
|
整理一下数据:
R1 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 年的数据,首先统计每个月的浏览总次数:
R1 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/')
|

发现下半年的浏览量远不如上半年,猜想可能是下半年发图量减少了,下面统计一下各个月份的发图次数:
R1 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/')
|

妹子图网站每个月的发图量很稳定,看来下半年浏览量的大幅下滑是真的网友们肾虚了!
下面再按周统计浏览量:
R1 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/')
|

看来宅男们看起妹子来不分周一还是周末,每天都看。
今年浏览量排名前十的套图:
R1 2 3 4
| knitr::kable(df %>% arrange(desc(view)) %>% select(c('date', 'title', 'link')) %>% slice(1:10))
|
下面我想画一幅词云图,看看哪些词更能吸引访客的眼球,这里需要两个词典:
stopwords.txt:停用词词典,里面包含的单词不会被分词,而是直接去除;
dictionary.txt:用户辞典,里面包含的单词不会被分开。
R1 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 年各个类别的平均浏览量:
R1 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/')
|

还是都喜欢性感的!
分月比较各个月每个类别的平均浏览量:
R1 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/')
|

这样不是很方便类别之间进行比较,下面这样更容易比较:
R1 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 年的今天分类比较:
R1 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 年以来一直在走下坡路。
再统计妹子图网站的平均浏览量:
R1 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 等产品,这些东西将网站的流量分流出一部分;
- 妹子图网站的很大一部分流量可能不是真实用户,而是各种网络爬虫,比较妹子图网站是大家最爱爬的网站之一,然而后来妹子图网站不断升级反爬机制,导致爬取难度增加;
- 图片网站的竞争在加剧,很多新的图片网站涌现出来;
- 网络速度的提升使得用户不再 满足于图片浏览,而更多的选择浏览一些视频,所以图片不再受欢迎;
- 一些社交平台对妹子图网站的打击力度加剧,例如妹子图网站在微信里面是打不开的。
- 等等。。。
Amy Shamblen