1、 基于网络集群识别的自动化聚类
共现关系聚类，利用社交网络分析（Social Network Analysis, SNA）来构建知识图谱，然后进行集群的识别（Community Detection），从而给文本基本单元进行自动分类。
随便文本代替即可，包括两列，一列为文档名或编号，一列为文本内容。
storagebottles <- read.csv("dataset/ali/storagebottles0905.csv",
header = F) %>%
set_names(c("sku_name", "sku_price", "sku_sale_volume", "sku_score",
"sku_ship", "sku_isNewin", "sku_isPromotion",
"sku_isTopselling", "shop_name", "sku_link", "category4")) %>%
distinct(.keep_all = T)
df <- select(storagebottles, sku_id, sku_name)
# akc用于自动化的共现关系网络构建和集群识别
library(pacman)
p_load(dplyr, akc)
# 数据清洗
# rmParentheses=T清除小括号及其小括号内的内容
# 清除前后空格
# 清除所有空字符和数字字符
# 英文转小写
clean_data <- keyword_clean(df = df,
id = "sku_id",
keyword = "sku_name")
# 关键词根据词干和词元归并
# 例如，“good boy”和“good boys”分别出现了5次和 9次，这两个短语具有相同的词元（“good boy”）
# 所以最后会被归并为出现次数最多的“good boys”
merge_data <- keyword_merge(clean_data)
merge_data
## # A tibble: 1,199 × 2
## id keyword
## <chr> <chr>
## 1 3256803118990386 "0.4l-1.7l stainless steel airtight coffee container storage canister se…
## 2 3256803826538697 "1-100pcs empty silver aluminum tins cans screw top round candle spice t…
## 3 3256804186933336 "1-30ml straight draw perfume refill tools set plastic diffuser syringe …
## 4 3256804187105399 "1-30ml straight draw perfume refill tools set plastic diffuser syringe …
## 5 3256803725515784 "1/10pcs plastic 70/86mm storage cap ribbed lids regular mouth screw cap…
## 6 3256804252879281 "1/2/3/4/5 pcs portable squeeze travel bottle facial bath bottle contain…
## 7 3256804202452859 "1/2/3/5 ml mini glass sample vials perfume bottle laboratory liquid fra…
## 8 3256804206267630 "1/2/3/5 ml mini glass sample vials perfume bottle laboratory liquid fra…
## 9 3256803534413593 "1/2/3/5 ml roll on bottle refillable empty glass essential oils perfume…
## 10 3256803873654482 "1/2/3pcs kitchen gadgets fresh herb keeper container clear spice fridge…
## # … with 1,189 more rows
# 关键词自动分类
# ?tidygraph::group_graph可以寻找更多识别算法
grouped_data <- keyword_group(merge_data,
# 默认集群算法
com_detect_fun = group_fast_greedy,
# 只对词频最大的200个词进行分类
top = 200)
grouped_data
## # A tbl_graph: 2 nodes and 1 edges
## #
## # An unrooted tree
## #
## # Node Data: 2 × 3 (active)
## name freq group
## <chr> <int> <int>
## 1 2021new chili cans women' 1 1
## 2 s self-defense high concentration anti wolf spray portable self-defense spray … 1 2
## #
## # Edge Data: 1 × 3
## from to n
## <int> <int> <int>
## 1 1 2 1
# 转换为数据框
# name列保存的是关键词信息，freq列是关键词的词频，而group列则保存了关键词所属的类
as_tibble(grouped_data)
## # A tibble: 2 × 3
## name freq group
## <chr> <int> <int>
## 1 2021new chili cans women' 1 1
## 2 s self-defense high concentration anti wolf spray portable self-defense spray … 1 2
# 结果输出
# 表格输出,对每个聚类中词频最高的10个关键词进行表格显示
keyword_table(grouped_data, top = 10)
## # A tibble: 2 × 2
## Group `Keywords (TOP 10)`
## <int> <chr>
## 1 1 2021new chili cans women' (1)
## 2 2 s self-defense high concentration anti wolf spray portable self-defense spray cans (…
# 可视化输出
keyword_vis(grouped_data)
000018.jpg
2、基于主题模型的分类
p_load(tidytext, topicmodels)
# 使用akc包带的数据
tidy_data <- keyword_clean(bibli_data_table, lemmatize = F) %>%
keyword_merge(reduce_form = "stem")
# 生成DTM
dtm_data <- count(tidy_data, id, keyword) %>%
cast_dtm(id, keyword, n)
# LDA分析
lda_data <- LDA(dtm_data, k = 2, control = list(seed = 2022))
lda_data
## A LDA_VEM topic model with 2 topics.
# 查看关键词所属主题的概率
lda_topic <- tidy(lda_data, matrix = "beta")
lda_topic
## # A tibble: 6,200 × 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 austerity 0.000314
## 2 2 austerity 0.000430
## 3 1 community capacity 0.000195
## 4 2 community capacity 0.000177
## 5 1 library professionals 0.000612
## 6 2 library professionals 0.000505
## 7 1 public libraries 0.0181
## 8 2 public libraries 0.00948
## 9 1 public service delivery 0.000362
## 10 2 public service delivery 0.0000106
## # … with 6,190 more rows
# 查看每个主题概率最高的5个关键词
topic_terms <- lda_topic %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta)
p_load(ggplot2)
# 使用条形图进行展示
topic_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = F) +
facet_wrap(~ topic, scales = "free") +
coord_flip() +
scale_x_reordered()
条形图展示
# 判断文档属于哪个主题
lda_gamma <- tidy(lda_data, matrix = "gamma")
lda_gamma
## # A tibble: 1,942 × 3
## document topic gamma
## <chr> <int> <dbl>
## 1 1 1 0.516
## 2 2 1 0.496
## 3 3 1 0.490
## 4 4 1 0.471
## 5 5 1 0.495
## 6 6 1 0.508
## 7 7 1 0.497
## 8 8 1 0.498
## 9 9 1 0.508
## 10 10 1 0.503
## # … with 1,932 more rows
# 每个文档中每个关键词的数量及其所属主题
assignments <- augment(lda_data, data = dtm_data)
assignments
## # A tibble: 5,365 × 4
## document term count .topic
## <chr> <chr> <dbl> <dbl>
## 1 1 austerity 1 2
## 2 719 austerity 1 2
## 3 1 community capacity 1 1
## 4 1 library professionals 1 1
## 5 522 library professionals 1 1
## 6 863 library professionals 1 1
## 7 1 public libraries 1 1
## 8 2 public libraries 1 1
## 9 49 public libraries 1 1
## 10 51 public libraries 1 1
## # … with 5,355 more rows
