Chapter 11 文本分析项目案例

# 数据处理
library(tidyverse)

# 文本数据分析
library(quanteda)
library(quanteda.textstats)
library(quanteda.textplots)
library(tidytext)
require(readtext)
library(jiebaR) #中文分词

# 表格输出
library(DT)
library(flextable)

# 整洁模型输出
library(broom)

# 计算置信区间
library(rcompanion)

# 可视化
library(cowplot)
library("RColorBrewer")
library(ggpubr) # add r values in regression lines
# 显示中文
library(showtext)
showtext_auto()

# 统计建模
library(lme4)
library(lsmeans)
library(rstatix)

# remove scientific notation
options(scipen=999)

#filter function
`%!in%` <- Negate(`%in%`)

案例11.1 狄仁杰小说翻译文体风格

详细背景请看原文献

研究背景

研究问题

研究方法

数据收集

   研究选取了“狄公案”系列中已出版的17本著作，将其文本数字化。分析仅针对书籍的正文部分，序言、后记及其他非主体内容均被剔除。为确保故事结构的完整性，每本书作为一个独立单元处理。

   17本书首先被导入R语言环境（R Core Team, 2018），并利用quanteda程序包（Benoit等, 2018）中的corpus函数转换为语料库。接着，语料库文件被进一步转化为文档-特征矩阵。在此过程中，文本首先经过分词处理并转换为小写形式，数字、标点及符号均被移除。

数据加工

dee.raw =readtext("data/ch11/*.txt", docvarsfrom = "filenames")

dee.corpus = corpus(dee.raw)

dee.corpus.summary = data.frame(summary(dee.corpus))

dee.dfm <- dfm(dee.corpus, 
               remove_numbers = TRUE, 
               remove_punct = TRUE, 
               remove_symbols = TRUE
               #remove = stopwords("english")
               )

dee.corpus.summary%>%
    flextable()%>%
    set_caption(caption = "Table 1. Number of types, tokens, and sentences of each book in the Judge Dee series.")

Lexical diversity

lexical.diversity <- textstat_lexdiv(dee.dfm, measure = "all")%>%
            mutate(across(where(is.numeric), ~ round(., 3)))


lexical.mattr <- textstat_lexdiv(tokens(dee.corpus), 
                                 measure = "MATTR", 
                                 MATTR_window = 500)

Syntactic complexity

metrics_SCA <- read_csv("data/ch11/metrics_SCA.csv")

metrics_SCA.ci = metrics_SCA%>%
  filter(text !="01.txt")%>%
  gather("measures", "values", -c("text"))%>%
  groupwiseMean(values ~ measures,
                data = .,
                conf = 0.95,
                digits = 3)

Readability

readability <- textstat_readability(dee.corpus, measure = "all")

readability.df = readability%>%
   as.data.frame()%>%
   select(document, ARI, Flesch, FOG, Coleman.Liau.short, Dale.Chall, Spache)

readability.ci = readability%>%
   as.data.frame()%>%
   select(document, ARI, Flesch, FOG, Coleman.Liau.short, Dale.Chall, Spache)%>%
  filter(document !="01_Celebrated-Cases.txt")%>%
  gather("measures", "values", -c("document"))%>%
  groupwiseMean(values ~ measures,
                data = .,
                conf = 0.95,
                digits = 3)

研究结果

描述性图表

Lexical diversity

lexical.diversity.df = lexical.diversity%>%
  as.data.frame()%>%
  dplyr::select(document, TTR,C,R)%>%
  left_join(lexical.mattr)%>%
  bind_cols(entropy)%>%
  rename("entropy" = "...6" )%>%
 mutate(across(where(is.numeric), round, 2))

lexical.diversity.df%>%
  flextable()%>%
  set_caption(caption = "Table A1. Lexical diversity measures for each text book.")

# write_csv(lexical.diversity.df,
#           file = paste(dir.tbl,
#                        paste("lexical.diversity.df",
#                              Sys.Date(),
#                              "csv",
#                              sep = "."),
#                        sep = "") )

lexical.diversity.ci = lexical.diversity.df%>%
  filter(document !="01_Celebrated-Cases.txt")%>%
  gather("measures", "values", -c("document"))%>%
  groupwiseMean(values ~ measures,
                data = .,
                conf = 0.95,
                digits = 3)

Syntactic complexity

metrics_SCA%>%
  mutate(across(where(is.numeric), round, 2))%>%
  flextable()%>%
  set_caption(caption = "Table A2. Readability measures for each text book.")

Readability

readability%>%
  as.data.frame()%>%
  dplyr::select(document,ARI,Flesch, FOG, "Coleman.Liau.short", "Dale.Chall", Spache)%>%
  mutate(across(where(is.numeric), round, 2))%>%
  flextable()%>%
  set_caption(caption = "Table A3. Readability measures for each text book.")


# write_csv(readability.df,
#           file = paste(dir.tbl,
#                        paste("readability.df",
#                              Sys.Date(),
#                              "csv",
#                              sep = "."),
#                        sep = "") )

数据建模

lexical diversity

# t-tests
t.test(lexical.diversity$TTR[2:17], 
       mu = lexical.diversity$TTR[1], 
       alternative = "greater")

t.test(lexical.diversity$C[2:17], 
       mu = lexical.diversity$C[1], 
       alternative = "greater")

t.test(lexical.diversity$R[2:17], 
       mu = lexical.diversity$R[1], 
       alternative = "greater")

t.test(lexical.mattr$MATTR[2:17], 
       mu = lexical.mattr$MATTR[1], 
       alternative = "greater")


entropy = textstat_entropy(dee.dfm)$entropy

t.test(entropy[2:17], mu = entropy[1])

Syntactic complexity

# mean length of clause (MLC): number of words divided by number of clauses;
t.test(metrics_SCA$MLC[2:17], mu = metrics_SCA$MLC[1],  alternative = "less")

t.test(metrics_SCA$MLS[2:17], mu = metrics_SCA$MLS[1], alternative = "less")

t.test(metrics_SCA$MLT[2:17], mu = metrics_SCA$MLT[1], alternative = "less")

t.test(metrics_SCA$"C/S"[2:17], mu = metrics_SCA$"C/S"[1], alternative = "less")

t.test(metrics_SCA$"C/T"[2:17], mu = metrics_SCA$"C/T"[1], alternative = "less")

t.test(metrics_SCA$"CT/T"[2:17], mu = metrics_SCA$"CT/T"[1], alternative = "less")

t.test(metrics_SCA$"DC/C"[2:17], mu = metrics_SCA$"DC/C"[1], alternative = "less")

t.test(metrics_SCA$"DC/T"[2:17], mu = metrics_SCA$"DC/T"[1], alternative = "less")

t.test(metrics_SCA$"CP/C"[2:17], mu = metrics_SCA$"CP/C"[1], alternative = "less")

t.test(metrics_SCA$"CP/T"[2:17], mu = metrics_SCA$"CP/T"[1], alternative = "less")

t.test(metrics_SCA$"T/S"[2:17], mu = metrics_SCA$"T/S"[1], alternative = "less")

t.test(metrics_SCA$"CN/C"[2:17], mu = metrics_SCA$"CN/C"[1], alternative = "less")

t.test(metrics_SCA$"CN/T"[2:17], mu = metrics_SCA$"CN/T"[1], alternative = "less")

t.test(metrics_SCA$"VP/T"[2:17], mu = metrics_SCA$"VP/T"[1], alternative = "less")

Readability

t.test(readability$ARI[2:17], mu = readability$ARI[1], alternative = "less")

t.test(readability$Flesch[2:17], mu = readability$Flesch[1], alternative = "greater")

t.test(readability$FOG[2:17], mu = readability$FOG[1], alternative = "less")

t.test(readability$Coleman.Liau.short[2:17], mu = readability$Coleman.Liau.short[1], alternative = "less")

t.test(readability$Dale.Chall[2:17], mu = readability$Dale.Chall[1], alternative = "greater")

t.test(readability$Spache[2:17], mu = readability$Spache[1], alternative = "less")

# t.test(readability$meanSentenceLength[2:17], mu = readability$meanSentenceLength[1])

# t.test(readability$meanWordSyllables[2:17], mu = readability$meanWordSyllables[1])

研究结论

   狄公案系列侦探小说的英译文本在词汇多样性及复杂度上均低于原创文本，但在句法复杂度上反而更高。根据约束语言理论，翻译过程中涉及的双语系统激活与持续语码转换等复杂认知机制，会额外增加译者的认知负荷并降低其工作记忆容量，从而导致译者更倾向于采用简化策略。此外，源语文本也在一定程度上限制了译者对词汇资源的调用空间。相比之下，作者高罗佩在进行原创写作时能够充分调用其全部语言储备，因而创作出词汇丰富度更高的文本。

   作为译者，高罗佩（Robert van Gulik）对自身的中介者角色有着清醒认知，始终秉持着将中国古代公案小说引介至西方世界的使命感。为实现这一目标，他在译文中刻意采用了符合西方读者阅读习惯的句法结构，甚或存在过度使用之嫌。译本文句复杂度较高的现象，亦可与显化效应（explicitation effect）相关联——鉴于故事发生的中国在地理与文化层面均与西方读者存在巨大隔阂，译者不得不通过精细重构句式，将原文隐含的信息予以显性呈现。

   译文文本的阅读难度可能反而高于原创文本。这表明，相较于原创作品，译文要么含有更长的句子，要么使用了更复杂的词汇。鉴于译文的词汇多样性较低，我们可以推断句法复杂性是导致其可读性相对较低的主因。正如前文所述，译文中出现的复杂句式结构，很可能是译者竭力传达源文本信息的必然结果——由此导致的可读性损耗，实非译者本意。

案例11.2 汉语失语症话语产出

详细背景请看原文献

研究背景

研究问题及假设

研究方法

数据收集

数据处理

### Jieba 分词
text = "口语话语产出越来越被视为评估失语症患者（PWA）语言能力的重要来源。"
# 创建一个默认的分词器
seg1 <- worker()
# 使用seg1进行分词
segment(text, seg1)
# 
# seg3 <- worker(user = "demo_data/dict-ch-user-demo.txt", #设置自定义词典
#                # 设置停用词
#                stop_word = "demo_data/stopwords-ch-demo.txt")
# 
# segment(text, seg3)

### 汉语失语症语料分词
# 导入被试信息

subjects_all <- read_csv("data/ch11/subjects.all4corelexV2.csv", 
                         na = "NA")

## 导入语料
df.clean <- read_csv("data/ch11/df.all.clean.2022-10-05.csv")%>%
  mutate(subject = dplyr::recode(subject,"/JiangLin40a2.cha"="/JiangLin40a.cha",
                          "/JiangLin40a1.cha"="/JiangLin40a.cha",
                          "/JiangLin01a2.cha"="/JiangLin01a.cha",
                          "/JiangLin01a1.cha"="/JiangLin01a.cha",
                          "/JiangLin70a1.cha"="/JiangLin70a.cha",
                          "/JiangLin70a2.cha"="/JiangLin70a.cha",
                          "/JiangLin08a2.cha"= "/JiangLin08a.cha",
                          "/JiangLin08a1.cha"= "/JiangLin08a.cha"))%>%
  filter(!is.na(task))%>%
  mutate(subject = str_remove(subject,"\\/"),
         subject = str_remove(subject,".cha"))%>%
  left_join(subjects_all)%>%
  mutate(normative = as.character(normative))%>%
  filter(normative != "0")%>%
  filter(include == "Y")%>%
  select(-Onset_Date, -Video_Date, -Informed_Consent)

## 批量分词

my_seg <- worker(bylines = T, 
                 #user = "demo_data/dict-ch-user-demo.txt", 
                 symbol=T)

df.tokenised =  df.clean%>%
  mutate(clean = str_replace_all(clean_new, 
                                 c(" 一 个 " = " 一个 ", " 一 条 " = "一条"," 一 场 " = " 一场 ",
                                    " 一 把 " = " 一把 ", " 一 群 " = " 一群 ", " 一 次 " = " 一次 ",
                                    " 一 辆 " = " 一辆 ", " 一 只 " = " 一只 ", " 一 天 " = " 一天 ",
                                   " 一 下 " = " 一下 ", " 一 张 " = " 一张 ", " 一 道 " = " 一道 ",
                                   " 一 起 " = " 一起 "," 一 步 " = " 一步 "," 一 看 " = " 一看 ",
                                   " 一 匹 " = " 一匹 "," 一 觉 " = " 一觉 "," 一 件 " = " 一件 ",
                                   "一 位" = "一位","一 架" = "一架","一 项" = "一项",
                                   " 发 洪水 " = " 发洪水 "," 发 大水 " = " 发大水 ", 
                                   " 一 队 " = " 一队 ")))%>%
  # 分词
  unnest_tokens(word, ## new tokens unnested
                clean, ## original larger units
                token = function(x)   ## self-defined tokenization method
                segment(x, jiebar = my_seg)
                 )%>%
  #filter non-words
  filter(str_detect(word, "\\w"))%>%
  #filter english words
  filter(!str_detect(word, "[a-zA-Z]"))%>%
  filter(word !="_")%>%
  mutate(task = dplyr::recode(task, "@task2"="Pic-Window","@task3"="Pic-Umbrella",
                       "@task4"="Pic-CatRescue","@task5"="Pic-Flood",
                       "@task6"="S-TortioseHare",
                       "@task7"="S-CryWolf","@task8"="Proc-FriedRice"))%>%
  filter(task %!in% c("@task1", "@task10", "@task11", "@task9"))

## 计算被试年龄和教育程度
age.aq.edu.stroke = df.tokenised%>%
    select(subject, Age, Gender, group, normative, Education_Level, 
           PostOnsetMonth, Aphasia_Type, AQ)%>%
    distinct()%>%
    mutate(AQ = as.numeric(AQ))%>%
    group_by( normative)%>%
    summarise(n = n(),
            mean.age = round(mean(Age),1),
            max.age = round(max(Age),1),
            min.age = round(min(Age),1),
            sd.age = round(sd(Age),1),
            mean.edu = round(mean(Education_Level, na.rm = TRUE),1),
            sd.edu = round(sd(Education_Level,  na.rm = TRUE),1),
            max.edu= round(max(Education_Level, na.rm = TRUE),1),
            min.edu = round(min(Education_Level, na.rm = TRUE),1),
            mean.AQ = round(mean(AQ, na.rm = TRUE),1),
            sd.AQ = round(sd(AQ, na.rm = TRUE),1),
            max.AQ= round(max(AQ, na.rm = TRUE),1),
            min.AQ = round(min(AQ, na.rm = TRUE),1),
            mean.stroke = round(mean(PostOnsetMonth, na.rm = TRUE),1),
            sd.stroke = round(sd(PostOnsetMonth, na.rm = TRUE),1))

## 被试年龄和教育程度统计分析
age.aq.edu.stroke.t.test = df.tokenised%>%
    select(subject, Age, Gender, group, normative, Education_Level, Aphasia_Type)%>%
    distinct()%>%
    gather(measures, values, c("Age", "Education_Level"))%>%
    filter(normative %in%c("1","2","3"))%>%
    group_by(measures)%>%
    rstatix::t_test(values~ normative)

age.aq.edu.stroke%>%
  filter(normative != "4")%>%
    flextable()%>%
    set_caption(caption = "Table 1 Demographic information for all individuals. ")

age.aq.edu.stroke.t.test%>%
    flextable()%>%
    set_caption(caption = "Table 2. Statistical tests of age and years of education among three groups.")

### 计算词汇丰富度
chinese.TTR = df.tokenised%>%
    mutate(word2 = dplyr::recode(word,
                        #task 2
                        "电视机"="电视","窗"="窗户","电视机"="电视",
                        "男孩"="小孩","小朋友"="小孩","足球"="球",
                        #task3
                        "雨伞"="伞","孩子"="小孩","小孩子"="小孩",
                        "母亲"="妈妈","电视机"="电视","电视机"="电视",
                        #task4
                        "女孩"="小孩","女儿"="小孩","孩子"="小孩",
                        "父亲"="爸爸","车子"="消防车","电视机"="电视",
                        #task5
                        "大水"="洪水","女"="小孩","消防员"="战士","发大水"="发洪水",
                        "解放军"="战士","电视机"="电视","电视机"="电视",
                        #task 6 
                        "兔"="兔子","龟"="乌龟","白兔"="兔子",
                        #task 7
                        "孩子"="小孩","农民"="村民","电视机"="电视"
                        ))%>%
  select(subject, normative, group, task, word2)%>%
  mutate(token = 1,
         character = nchar(word2))%>%
  group_by(subject, normative, task)%>%
  summarise(token = sum(token),
            character = sum(character),
            type = n_distinct(word2),
            ttr = type/token,
            c = log(type)/log(token),
            r = type/sqrt(token))%>%
  filter(normative %in% c("1","2","3"))%>%
  group_by(normative, task)%>%
  get_summary_stats(token, type, character, ttr,c,r, type = "mean_sd")%>%
  select(-n)%>%
  gather(stats, value, -(normative:variable))%>%
  mutate(value = round(value, 1))%>%
  unite(temp, variable, stats)%>%
  spread(temp, value)%>%
  select( "task", "normative","character_mean", "character_sd", "type_mean", "type_sd",
          "token_mean", "token_sd", "ttr_mean", "ttr_sd", "c_mean", "c_sd", "r_mean", "r_sd")
   
chinese.TTR.test = df.tokenised%>%
    mutate(word2 = dplyr::recode(word,
                        #task 2
                        "电视机"="电视","窗"="窗户","电视机"="电视",
                        "男孩"="小孩","小朋友"="小孩","足球"="球",
                        #task3
                        "雨伞"="伞","孩子"="小孩","小孩子"="小孩",
                        "母亲"="妈妈","电视机"="电视","电视机"="电视",
                        #task4
                        "女孩"="小孩","女儿"="小孩","孩子"="小孩",
                        "父亲"="爸爸","车子"="消防车","电视机"="电视",
                        #task5
                        "大水"="洪水","女"="小孩","消防员"="战士","发大水"="发洪水",
                        "解放军"="战士","电视机"="电视","电视机"="电视",
                        #task 6 
                        "兔"="兔子","龟"="乌龟","白兔"="兔子",
                        #task 7
                        "孩子"="小孩","农民"="村民","电视机"="电视"
                        ))%>%
  select(subject, normative, group, task, word2)%>%
  mutate(token = 1,
         character = nchar(word2))%>%
  group_by(subject, normative, task)%>%
  summarise(token = sum(token),
            character = sum(character),
            type = n_distinct(word2),
            ttr = type/token,
            c = log(type)/log(token),
            r = type/sqrt(token))%>%
  #filter(normative%in%c("2"))%>%
  #group_by(normative, task)%>%
    gather(measures, values, c("token", "character","type","ttr","c","r"))%>%
    filter(normative %in% c("1","2","3"))%>%
    group_by(measures, task)%>%
    rstatix::wilcox_test(values~ normative)%>%
  mutate(p.adj = round(p.adj,4))%>%
  select(-p)

chinese.TTR%>%
  filter(normative != "4")%>%
  select(-c("ttr_mean","ttr_sd","c_mean","c_sd","r_mean","r_sd"))%>%
  arrange(task)%>%
    flextable()%>%
    set_caption(caption = "Table 3. Number of characters, word types, and tokens for each task and each group.  ")

chinese.TTR.test%>%
    filter(measures %!in% c("c","r","ttr"))%>%
    flextable()%>%
    set_caption(caption = "Table 4 Statistical comparisions of linguistic variables among normative, control and PWA goups.")

提取核心词汇

core.lex.raw = df.tokenised%>%
  filter(normative == "1")%>%
  ## filter some functional words
  # anti_join(fWord)%>%
  #merge some  words
  mutate(word2 = dplyr::recode(word,
                        #task 2
                        "电视机"="电视","窗"="窗户","电视机"="电视",
                        "男孩"="小孩","小朋友"="小孩","足球"="球",
                        #task3
                        "雨伞"="伞","孩子"="小孩","小孩子"="小孩",
                        "母亲"="妈妈","电视机"="电视","电视机"="电视",
                        #task4
                        "女孩"="小孩","女儿"="小孩","孩子"="小孩",
                        "父亲"="爸爸","车子"="消防车","电视机"="电视",
                        #task5
                        "大水"="洪水","女"="小孩","消防员"="战士", "发大水"="发洪水",
                        "解放军"="战士","电视机"="电视","电视机"="电视",
                        #task 6 
                        "兔"="兔子","龟"="乌龟","白兔"="兔子",
                        #task 7
                        "孩子"="小孩","农民"="村民","电视机"="电视",
                        "饭"="米饭"
                        ))%>%
  group_by(subject,task)%>%
  count(word2, sort = TRUE)

core.lex.freq = core.lex.raw%>%
  group_by(task, word2)%>%
  summarise(freq = sum(n))


# number of controls
n.ctr = df.tokenised%>%
  filter(normative == "1")%>%
  distinct(subject)%>%
  nrow()

core.lex.ctrl = core.lex.raw%>%
  mutate(present = 1)%>%
  group_by(task, word2)%>%
  summarise(x1distribute = sum(present)/n.ctr)%>%
  mutate(x1distribute = round(x1distribute, 2)*100)%>%
  arrange(desc(x1distribute))  %>%
  mutate(top.no = 1:n())%>%
  #filter(distribute > 0.5)
  filter(top.no < 31)%>%
  mutate(x2chinese = case_when(
      word2 == "了" ~ "FC1", word2 == "的" ~ "FC2", word2 == "一" ~ "one",
      word2 == "树" ~ "tree", word2 == "上" ~ "up", word2 == "猫" ~ "cat",
      word2 == "在" ~ "in", word2 == "狗" ~ "dog", word2 == "小" ~ "small",
      word2 == "救" ~ "save", word2 == "有" ~ "have", word2 == "下来" ~ "come down",
      word2 == "这个" ~ "this",word2 == "是" ~ "link verb",word2 == "然后" ~ "then",
      word2 == "一个" ~ "classifier (one)",word2 == "一只" ~ "classifier (one)",
      word2 == "不" ~ "negative marker",
      word2 == "把" ~ "FC3", word2 == "来" ~ "come", word2 == "梯子" ~ "ladder",
      word2 == "爬" ~ "climb", word2 == "到" ~ "arrive", word2 == "小孩" ~ "kid",
      word2 == "就" ~ "FC4", word2 == "着" ~ "FC5", word2 == "这" ~ "this",
      word2 == "下" ~ "down", word2 == "想" ~ "think", word2 == "也" ~ "too",
      word2 == "叫" ~ "shout", word2 == "她" ~ "she", word2 == "树枝" ~ "branch",
      word2 == "被" ~ "FC6", word2 == "水" ~ "water", word2 == "吧" ~ "FC7",
      word2 == "就是" ~ "be exactly", word2 == "一" ~ "one", word2 == "发" ~ "flooding",
      word2 == "个" ~ "classifier", word2 == "里" ~ "inside", word2 == "伞" ~ "umbrella",
      word2 == "妈妈" ~ "mum", word2 == "他" ~ "he", word2 == "下雨" ~ "raining",
      word2 == "带" ~ "carry", word2 == "雨" ~ "rain", word2 == "上学" ~ "go to school",
      word2 == "走" ~ "go", word2 == "淋" ~ "get wet (by rain)", word2 == "去" ~ "go",
      word2 == "要" ~ "want", word2 == "时候" ~ "time", word2 == "跑" ~ "run",
      word2 == "没" ~ "none", word2 == "给" ~ "give", word2 == "说" ~ "say",
      word2 == "窗户" ~ "window", word2 == "看" ~ "look", word2 == "玻璃" ~ "glass",
      word2 == "踢" ~ "kick", word2 == "球" ~ "ball", word2 == "人" ~ "man",
      word2 == "电视" ~ "TV", word2 == "那个" ~ "that", word2 == "家" ~ "home",
      word2 == "我" ~ "I", word2 == "火腿肠" ~ "sausage", word2 == "油" ~ "oil",
      word2 == "蛋炒饭" ~ "egg fried rice", word2 == "放" ~ "put", word2 == "先" ~ "first",
      word2 == "锅" ~ "wok", word2 == "鸡蛋" ~ "egg", word2 == "再" ~ "then",
      word2 == "切" ~ "cut", word2 == "倒" ~ "pour", word2 == "米饭" ~ "rice",
      word2 == "可以" ~ "can", word2 == "米饭" ~ "that", word2 == "家" ~ "home",
      word2 == "好" ~ "good", word2 == "做" ~ "do", word2 == "进去" ~ "into",
      word2 == "盐" ~ "salt", word2 == "一下" ~ "one time", word2 == "那个" ~ "that",
      word2 == "狼" ~ "wolf", word2 == "羊" ~ "sheep", word2 == "都" ~ "all",
      word2 == "喊" ~ "shout", word2 == "吃" ~ "eat", word2 == "真的" ~ "real",
       word2 == "次" ~ "(this) time", word2 == "又" ~ "again", word2 == "山" ~ "hill",
       word2 == "兔子" ~ "rabbit", word2 == "乌龟" ~ "tortoise", word2 == "它" ~ "it",
       word2 == "赛跑" ~ "race", word2 == "过" ~ "FC9", word2 == "和" ~ "and",
       word2 == "得" ~ "FC8", word2 == "快" ~ "quick", word2 == "睡" ~ "sleep",
       word2 == "喊" ~ "shout", word2 == "吃" ~ "eat", word2 == "终点" ~ "end",
       word2 == "很" ~ "very", word2 == "森林" ~ "forest", word2 == "比赛" ~ "games",
       word2 == "听" ~ "hear", word2 == "已经" ~ "already",word2 == "开始" ~ "begin",
       word2 == "洪水" ~ "flood", word2 == "炒" ~ "stir fry", word2 == "村民" ~ "villager",
      word2 == "里面" ~ "inside",
      TRUE                      ~ "####"))

core.lex.ctrl.wide = core.lex.ctrl%>%
  ungroup()%>%
  gather(measures, value, c("word2", "x1distribute", "x2chinese"))%>%
  mutate(measures = paste(task, measures, sep = "-"))%>%
  select(-task)%>%
  spread(measures, value)

core.lex.ctrl.wide%>%
    flextable()%>%
    set_caption(caption = "Table 5 Core lexicon for different tasks")

研究结果

描述性图表

### 比较核心词汇分数
core.score.pwa.ctrl = df.tokenised%>%
  #filter(Age > 20 & Age < 65 )%>%
  filter(normative %in% c("2","3"))%>%
  select(subject,group,task,word, AQ, Aphasia_Type, include)%>%
  filter(include == "Y")%>%
  ## filter some functional words
  #anti_join(fWord)%>%
  #merge some  words
  mutate(word2 = dplyr::recode(word,
                        #task 2
                        "电视机"="电视","窗"="窗户","电视机"="电视",
                        "男孩"="小孩","小朋友"="小孩","足球"="球",
                        #task3
                        "雨伞"="伞","孩子"="小孩","小孩子"="小孩",
                        "母亲"="妈妈","电视机"="电视","电视机"="电视",
                        #task4
                        "女孩"="小孩","女儿"="小孩","孩子"="小孩",
                        "父亲"="爸爸","车子"="消防车","电视机"="电视",
                        #task5
                        "大水"="洪水","女"="小孩","消防员"="战士","发大水"="发洪水",
                        "解放军"="战士","电视机"="电视","电视机"="电视",
                        #task 6 
                        "兔"="兔子","龟"="乌龟","白兔"="兔子",
                        #task 7
                        "孩子"="小孩","农民"="村民","电视机"="电视"
  ))%>%
  select(-word)%>%
  distinct()%>%
  inner_join(core.lex.ctrl, by = c("task","word2"))%>%
  mutate(present = 1)%>%
  group_by(subject, group, task)%>%
  filter(task!="@task1" & task != "@task9")%>%
  summarise(score = sum(present))%>%
  mutate(id = paste(subject, group, sep = "_"))


cn.matrix = data.frame(
  expand.grid(task2 = unique(core.score.pwa.ctrl$task), 
              id2 = unique(core.score.pwa.ctrl$id)))%>%
  mutate(unique_id = paste(id2, task2, sep = "_"))

fig.core.score = core.score.pwa.ctrl %>% 
  mutate(unique_id = paste(id, task, sep = "_"))%>%
  right_join(cn.matrix)%>%
  mutate(subject= str_extract(id2, "^\\w*_"),
         subject = str_remove(subject,"_"),
         task = task2,
         group = str_extract(id2, "control|patient"))%>%
  # replace na with 0
  mutate(score = coalesce(score, 0))%>%
  groupwiseMean(score ~ group + task,
                data = .,
                conf = 0.95,
                digits = 3) %>%
  ggplot(.,aes(task, Mean, fill = group))+
  geom_bar(colour = "black",
           stat = "identity", position = position_dodge(.9))+
  geom_errorbar(aes(ymin = Trad.lower,
                    ymax = Trad.upper),
                width = .2, size = 0.7, 
                position = position_dodge(.9))+
  scale_fill_manual(values=c("grey75", "white"),
                    name="Participants",
                    labels=c("Control",
                             "PWA"))+
  labs(y = "Core Lexicon scores",
       x = "Task")+
  theme_bw()

fig.core.score

统计建模

## 统计分析

core.score.pwa.ctrl.df = core.score.pwa.ctrl %>%
  mutate(unique_id = paste(id, task, sep = "_"))%>%
  right_join(cn.matrix)%>%
  mutate(subject= str_extract(id2, "^\\w*_"),
         subject = str_remove(subject,"_"),
         task = task2,
         group = str_extract(id2, "control|patient"))%>%
  # replace na with 0
  mutate(score = coalesce(score, 0))


stat.test.normality = core.score.pwa.ctrl.df  %>%
  group_by(task)%>%
  rstatix::shapiro_test(score)%>% 
  rstatix::add_significance("p")

core.lex.wilcox = core.score.pwa.ctrl.df  %>%
  group_by(task)%>%
  rstatix::wilcox_test(score ~ group)%>% 
  rstatix::add_significance("p")

core.lex.wilcox.effectsize = core.score.pwa.ctrl.df  %>%
  group_by(task)%>%
  wilcox_effsize(score ~ group)

core.lex.wilcox.result = core.lex.wilcox%>%
  select(task, n1, n2, statistic, p, p.signif)%>%
  left_join(core.lex.wilcox.effectsize)%>%
  select(task, n1, n2, statistic, p, p.signif, effsize, magnitude)%>%
  mutate(effsize = round(effsize,2),
         statistic = round(statistic, 0))

core.lex.wilcox.result%>%
    flextable()%>%
    set_caption(caption = "Table 7 Statistical comparisons of core lexicon scores between healthy controls and PWA in each discourse production task. ")

### 核心词汇分数和词汇丰富度相关性分析
### correlation with aphasia severity
score.aq.correlation  = core.score.pwa.ctrl.df %>% 
  left_join(subjects_all)%>%
  filter(group == "patient")%>%
  select(subject, group, task, AQ, score)%>%
  mutate(AQ = as.numeric(AQ),
         task = dplyr::recode(task, "@task2"="Pic-Window","@task3"="Pic-Umbrella",
                       "@task4"="Pic-CatRescue","@task5"="Pic-Flood",
                       "@task6"="S-TortioseHare",
                       "@task7"="S-CryWolf","@task8"="Proc-FriedRice"))%>%
  group_by(task)%>%
  cor_test(AQ, score, method = "spearman")


### linguistic variables
linguistic = df.tokenised%>%
    mutate(word2 = dplyr::recode(word,
                        #task 2
                        "电视机"="电视","窗"="窗户","电视机"="电视",
                        "男孩"="小孩","小朋友"="小孩","足球"="球",
                        #task3
                        "雨伞"="伞","孩子"="小孩","小孩子"="小孩",
                        "母亲"="妈妈","电视机"="电视","电视机"="电视",
                        #task4
                        "女孩"="小孩","女儿"="小孩","孩子"="小孩",
                        "父亲"="爸爸","车子"="消防车","电视机"="电视",
                        #task5
                        "大水"="洪水","女"="小孩","消防员"="战士","发大水"="发洪水",
                        "解放军"="战士","电视机"="电视","电视机"="电视",
                        #task 6 
                        "兔"="兔子","龟"="乌龟","白兔"="兔子",
                        #task 7
                        "孩子"="小孩","农民"="村民","电视机"="电视"
                        ))%>%
  select(subject, normative, group, task, word2)%>%
  mutate(token = 1,
         character = nchar(word2))%>%
  group_by(subject, normative, task)%>%
  summarise(token = sum(token),
            character = sum(character),
            type = n_distinct(word2),
            ttr = type/token,
            c = log(type)/log(token),
            r = type/sqrt(token))%>%
  filter(normative %in% c("2","3"))%>%
  mutate(group = dplyr::recode(normative,
                        "2"="control","3"="patient"))

score.linguistic.correlation.full = core.score.pwa.ctrl.df%>% 
  #filter(group == "patient")%>%
  left_join(linguistic)%>%
  mutate_all(~ifelse(is.na(.), 0, .))%>%
  left_join(subjects_all, by = c("subject", "group"))%>%
  mutate(AQ = as.numeric(AQ))%>%
  group_by(group, task)%>%
  cor_test(token, character, type, ttr, score, c,r,AQ, method = "spearman")

score.linguistic.cor.final = score.linguistic.correlation.full%>%
  mutate(var = paste(var1, var2, sep = "-"),
         statistic = round(statistic, 0),
         p = round(p,4))%>%
  filter(group == "patient")%>%
  filter(var %in% c("score-r"))

score.aq.correlation %>%
    flextable()%>%
    set_caption(caption = "Table 8 Correlations of core lexicon scores with aphasia serverity. ")


chinese.TTR %>%
    select("task","normative","ttr_mean","ttr_sd","c_mean","c_sd","r_mean","r_sd")%>%
    arrange(task)%>%
    flextable()%>%
    set_caption(caption = "Table 9. Lexical diversity measures of each group per task. ")


chinese.TTR.test %>%
    filter(measures %in% c("c","r","ttr"))%>%
    flextable()%>%
    set_caption(caption = "Table 10 Statistical comparisions of lexical diversity measures among normative, control and PWA goups per task. ")

score.linguistic.cor.final %>%
    flextable()%>%
    set_caption(caption = "Table 11. Correlations of core lexicon scores with lexical diversity R.")

研究结论

   核心词汇评分能够有效区分汉语失语症患者与健康对照组的话语产出，并反映话语的词汇多样性和信息丰富度。因此，我们的研究发现具有临床意义：这些核心词汇列表可作为一种免转录的快速评估方法，用于汉语失语症患者的话语产出评估。