某小区业主群QQ聊天记录，时间跨度将近一年半，历经从业委会选举到换物业公司全过程，应该还是比较有代表性和戏剧性的一段时期。
聊天记录通过QQ消息面板导出为文本格式。
1、读取并整理数据
> library(pacman)
> p_load(dplyr, stringr)
>
> dt <- data.table::fread("./data_set/业委会工作群.txt",
> sep="\n",encoding = "UTF-8",
> header = F,blank.lines.skip = T)
> head(dt)
## V1
## 1: 2018-08-24 11:32:44 (2643202289)
## 2: 一户一票勺11人
## 3: 2018-08-24 11:33:34 (576284020)
## 4: 这个最好是 到时候 各个 候选委员上台 当面来个简短的介绍，比较好，了解比较直观\r
## 然后在投票 是不是好一点\r光看图 眼下几位 都还是不错的，盲目的投也不大好吧
## 5: 2018-08-24 11:35:09 (2643202289)
## 6: @5-1-1504 邓 我刚说了本周日上午开大会现场，他们会上台
> # 因为QQ群分享文件也会有时间戳信息，所以不能用时间来标记。使用日期标记
> # 提取日期时间用户名信息到向量a中
> ptn <- "[2019]{4}+-+[0-9]{2}+-+[0-9]{2}"
> a <- str_subset(dt$V1, ptn)
>
> # 用'-----'符号替换a
> dt$V1[str_detect(dt$V1, ptn)] <- "-----"
> # 拼接所有字符串，用'-----'符号切分
> b <- paste0(dt$V1, collapse = "") %>%
> str_split("-----") %>% unlist()
>
> length(a)
## [1] 13744
> # 需要去掉开头的空行
> length(b)
## [1] 13745
> df <- tibble(a = a, txt = b[2:13745])
>
> # 将a列拆分为date、time、user
> df <- tidyr::separate(df, a, into = c("date", "time", "user"), sep = " ")
>
> # 将date转换为日期型
> df$date <- as.Date(df$date)
> head(df)
## # A tibble: 6 x 4
## date time user txt
## <date> <chr> <chr> <chr>
## 1 2019-01-01 15:32:~ 12-1-2804怡日健(250~ 不交物业费也可以交停车费
## 2 2019-01-01 15:42:~ 7-2-502(50356990~ @22-2-2902李 现在最好一个月一交，管委会要求我们年后才能选聘新的物业~
## 3 2019-01-01 16:33:~ 22-2-2902李(67596~ 谢谢各位的解答[表情]
## 4 2019-01-01 16:54:~ 12-1-aa02(455351~ 有没有废品回收的电话？
## 5 2019-01-01 17:38:~ 22-1-801杨(404454~ 各位，物业管理费怎么交啊？
## 6 2019-01-01 17:39:~ 10/1/2604 暂时别交，年后换物业公司了再交
> # 去掉user为“系统消息”的行
> df <- df %>% filter(!str_detect(user,"系统消息"))
>
> df[sample(nrow(df), 5), ]
## # A tibble: 5 x 4
## date time user txt
## <date> <chr> <chr> <chr>
## 1 2019-05-21 12:23:46 12-1-2怡日健(250614780) @马革裹尸 @宣传员
## 2 2019-06-11 20:48:28 22-2-204(951781731) [图片]
## 3 2019-02-27 20:38:28 21-2-2300(345353385) 这么看来估计比康城物业还差！
## 4 2019-04-15 14:27:43 22栋1-1001(609385192) 记者采访 在家的业主做下向导 物业抢~
## 5 2019-02-26 11:59:44 19-1-1801<nailstand@qq.c~ 没用
可以看到，有的内容就只有“[图片]”，还有的只有“[表情]”，这些无用信息将在后面清除。
2、数据集格式转化
将同一用户的发言信息合并在一起。
> df2 <- df %>%
> # 注意顺序
+ select(txt, user) %>%
+ unstack() %>% t()
> text <- df2 %>% lapply(paste, collapse = " ") %>% unlist
> df3 <- data.frame(user = dimnames(df2)[[2]], text = text)
> # 因子型转换为字符型
> df3 <- purrr::map_if(df3, is.factor, as.character)
>
> # 预处理函数
> preprocessor = function(x) {
+ # 清除非中文字符
+ x <- gsub("[^\u4E00-\u9FA5]", "", x)
+ # 清除“表情”、“图片”
+ x <- gsub("表情|图片", " ", x)
+ # 多个空格转换为一个
+ x <- gsub("\\s+", " ", x)
+ # 清除收尾的空格
+ x <- trimws(x, which = "both")
+ return(x)
+ }
>
> df3$text <- preprocessor(df3$text)
3、中文分词
> p_load(jiebaR, cidian)
>
> decode_scel(scel = "./dict/日常用语大词库.scel", output = "./dict/rc.txt")
> user <- "./dict/rc.txt"
> stopwords <- "./dict/stopwords_wf.txt"
> wk <- worker(user = user, stop_word = stopwords)
> df3$words <- lapply(df3$text, segment, wk) %>%
+ lapply(paste0, collapse = " ") %>% unlist
> df3 <- df3 %>% as_tibble %>% select(-text) %>% filter(words != "")
> df3$words[1]
## [1] "取 快递 的位 置 楼栋 阿姨 收 给钱 喝不起 啤酒 没得 垃圾 卖楼 滴水 满意 厉害
+ 轻点 会就 睡着 真的 舒服 重手 疼 几天 掉 砖 组织 收集 证据 掉 砖 面积 维修
+ 进度 掉 砖 比例 已报 告 危险 墙面 速度 维修 掉 砖 情况 发生 事故 好像 年
+ 开发商 就解放了 出钱 修理 拖时间 拖 一年 是一年 在小区 住 天 外墙 修 几天
+ 维权 干嘛 地下 车位 打扫 地下车库 他妈 得一 层 灰 收费 违停 物业 配 拖车
+ 一期 业委 主任 贪污 公款 支持 业委 哪家 物业公司 中标 哪家 中标 进度 一步
+ 发群 里 咯 参与 报名 意味着 拦路 效果 奇佳 坚定 支持 业委 更换 垃圾 物业"
4、分析常用话题词汇
> p_load(text2vec, ggplot2)
>
> it <- itoken(df3$words, ids = df3$user, progressbar = F)
>
> vocab <- create_vocabulary(it)
> vocab
## Number of docs: 728
## 0 stopwords: ...
## ngram_min = 1; ngram_max = 1
## Vocabulary:
## term term_count doc_count
## 1: 一丁 1 1
## 2: 一万 1 1
## 3: 一万个 1 1
## 4: 一万元 1 1
## 5: 一下周 1 1
## ---
## 14588: 说 612 200
## 14589: 小区 719 229
## 14590: 业委会 785 226
## 14591: 业主 833 217
## 14592: 物业 1742 385
> # 设置画图字体
> p_load(showtext)
>
> font_add("PingFang", regular = "PingFang Regular.ttf")
> showtext_auto()
>
> vocab %>% filter(term_count > 5) %>% arrange(-term_count) %>%
+ ggplot(aes(term, term_count)) +
+ geom_jitter(alpha = 0.1, size = 2.5, width = 0.25, height = 0.25) +
+ geom_text(aes(label = term), check_overlap = TRUE, vjust = 1.5) +
+ geom_abline(color = "red") + labs(x = NULL, y = NULL) +
+ theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())
词频统计
词语都聚集到一起了，放大Y轴再看看：
> vocab %>% filter(term_count > 10 & term_count < 220) %>%
arrange(-term_count) %>%
+ ggplot(aes(term, term_count)) +
+ geom_jitter(alpha = 0.1, size = 2.5, width = 0.25, height = 0.25) +
+ geom_text(aes(label = term), check_overlap = TRUE, vjust = 1.5) +
+ geom_abline(color = "red") + labs(x = NULL, y = NULL) +
+ theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())
放大Y轴
去掉单字的分词，再看看：
> vocab %>% filter(str_length(term) > 1) %>%
+ filter(term_count > 10 & term_count < 220) %>%
+ arrange(-term_count) %>%
+ ggplot(aes(term, term_count)) +
+ geom_jitter(alpha = 0.1, size = 2.5, width = 0.25, height = 0.25) +
+ geom_text(aes(label = term), check_overlap = TRUE, vjust = 1.5) +
+ geom_abline(color = "red") + labs(x = NULL, y = NULL) +
+ theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())
去掉单字
查看频率最高的15个词：
> vocab %>% filter(str_length(term) > 1) %>%
+ select(term, term_count) %>% top_n(15) %>%
+ ggplot(aes(term_count, reorder(term, term_count))) +
+ geom_col() + labs(x = NULL, y = NULL)
词频最高的15个词
词云图：
> p_load(wordcloud2)
>
> vocab %>% select(term, term_count) %>%
+ filter(term_count > 10) %>% arrange(-term_count) %>%
+ wordcloud2(size = 1, color = "random-dark",
+ backgroundColor = "white", minRotation = -pi/4,
+ maxRotation = pi/4, fontFamily = "PingFang")
词云图
创建dtm矩阵：
> # 使用hash词向量
> vectorize.hash <- hash_vectorizer(hash_size = 2^14, ngram = c(1L, 2L))
> dtm <- create_dtm(it, vectorizer = vectorize.hash)
> dim(dtm)
## [1] 728 16384
> # 将dtm转换为矩阵
> dtm.mat <- as.matrix(dtm)
转换为矩阵是因为R对矩阵的计算效果更高。后续可基于dtm矩阵做更多的分析。
