Keyness

Техническая информация и библиотеки

rm(list = ls())
date()
## [1] "Mon Feb 10 23:05:32 2025"
sessionInfo()
## R version 4.4.2 (2024-10-31)
## Platform: x86_64-apple-darwin20
## Running under: macOS Ventura 13.7.3
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Europe/Moscow
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices datasets  utils     methods   base     
## 
## loaded via a namespace (and not attached):
##  [1] digest_0.6.36     R6_2.5.1          fastmap_1.2.0     xfun_0.49        
##  [5] cachem_1.1.0      knitr_1.49        htmltools_0.5.8.1 rmarkdown_2.27   
##  [9] lifecycle_1.0.4   cli_3.6.3         sass_0.4.9        renv_1.0.11      
## [13] jquerylib_0.1.4   compiler_4.4.2    rstudioapi_0.16.0 tools_4.4.2      
## [17] evaluate_1.0.1    bslib_0.7.0       yaml_2.3.10       jsonlite_1.8.8   
## [21] rlang_1.1.4
options(scipen = 999) # Убирает научную запись чисел

Библиотеки

library(quanteda)
library(quanteda.textstats)
library(quanteda.textplots)
# library(stm)
library(knitr)
# #library(topicmodels)
# library(ldatuning)
# library(stringr)
 library(tidyr)
# library(wordcloud)
 library(dplyr)
# library(ggplot2)

Загрузка объектов

load(file = "Dictionary.RData")
load(file = "Tokens_S3.Rdata")
load(file = "Tokens_S.Rdata")

Odds Ratio Отноошение шансов

Таблица с частотами по группам. frequency - общая частота с учетом повторов слова внутри одного текста rank - Ранжирование слов по общей частоте. При одинаковых частотах берется средний ранг. docfreq - частота документов с этим словом. То есть количество людей, которые его использовали. OddRatio - Отношение шансов. Отношение шансов — это показатель, который сравнивает вероятность успеха между двумя группами относительно шанса на неудачу. Это более мощный и интерпретируемый инструмент, особенно когда исходная частота успехов низкая.

Формула

Шансы рассчитываются как:

\[ \text{OR} = \frac{\text{Odds}_1}{\text{Odds}_2} = \frac{p_1/(1-p_1)}{p_2(1-p_2)} \]

Слово “девушка” В клинической группе появилось в 16 текстах (респондентов) из 25, в контрольной - в 27 из 30.

\[ \text{OR} = \frac{\text{Odds}_{\text{Clin}}}{\text{Odds}_{\text{Cont}}} = \frac{16/(25-16)}{27(30-27)} = \frac {1,78}{9} = 0.198 \] Шанс получается шанс 16 к 9 в клинической. 16/9 = 1,78 Шанс 27 к 3 в контрольной. 27/3 = 9 Таким образом шанс встретить это слово в текстах клинической группы примерно в 5 раз меньше, чем в контрольной.

Чтобы корректно учитывать случаи, где OddRatio становится равным 0 или бесконечности, используется аддитивное сглаживание. Добавляется небольшое число (0.1) к числителям и знаменателям при расчете отношения шансов (odds ratio), что помогает избежать деления на ноль и уменьшает влияние крайних значений.

\[ \text{OR} = \frac{\text{Odds}_1}{\text{Odds}_2} = \frac{p_1+0,1/(1-p_1+0,1)}{p_2+0,1(1-p_2+0,1)} \]

Таблицы отсортированы по Отошению шансов. две таблицы по 50 самых больших различий. Чаще в клинической и чаще в контрольной группах. Приведены только те слова, которые использовались хотя бы три раза на обе группы. Таблица по объединенным трём текстам.

Freq <- Tokens_S3 |>
   dfm() |> 
   textstat_frequency(groups = Sample, ties_method = "average") |>
   rename(Lemma = feature) |> 
   as.data.frame() |> # Почему не работает на исходном объекте select?
    pivot_wider(
    names_from = group,         # Название группы становится колонкой
    values_from = c(frequency, rank, docfreq), # Данные из этих колонок будут заполнять новые колонки
    values_fill = list(frequency = 0, rank = NA, docfreq = 0)
    ) |>
  mutate(OddRatio = (
      ((docfreq_Clinical) / (25 - docfreq_Clinical)) / 
      ((docfreq_Control) / (30 - docfreq_Control))
    )
      ,OddRatio_0.1 = (
      ((docfreq_Clinical) / (25 - docfreq_Clinical + 0.1)) / 
      ((docfreq_Control + 0.1) / (30 - docfreq_Control + 0.1))
    ))
    
# Таблицы отсортированы по Отошению шансов. две таблицы по 50 самых больших различий. Чаще в клинической и чаще в контрольной группах. Приведены только те слова, которые использовались хотя бы три раза на обе группы. 
#Таблица по объединенным трём текстам.


# Freq |>
#   filter(docfreq_Clinical + docfreq_Control > 3) |>
#   arrange(desc(OddRatio_0.1)) |>
#   head(50)|>
#   mutate(
#     # Округляем до 3 знаков после запятой
#     OddRatio = sprintf("%.4f", OddRatio),
#     OddRatio_0.1 = sprintf("%.4f", OddRatio_0.1)
#     ) |>
#   kable(caption = "Чаще в клинической")
# 
# 
# Freq |>
#   filter(docfreq_Clinical + docfreq_Control > 3) |>
#   arrange(OddRatio_0.1) |>
#   head(50)|>
#   mutate(
#     # Округляем до 3 знаков после запятой
#     OddRatio = sprintf("%.4f", OddRatio),
#     OddRatio_0.1 = sprintf("%.4f", OddRatio_0.1)
#     ) |>
#   kable(caption = "Чаще в контрольной")

Точный критерий Фишера

Вычисление вручную по функции fisher.test(). Fisher’s Exact Test for Count Data Таблица 2х2 по кличеству людий использовавших и не использовавших определённое слово из двух выборок.

# Параметры групп
nClinical <- 25
nControl <- 30

# Функция для выполнения fisher.test и извлечения результатов
calculate_fisher <- function(docfreq_Clinical, docfreq_Control, nClinical, nControl) {
  m <- matrix(
    c(
      docfreq_Clinical, nClinical - docfreq_Clinical,
      docfreq_Control, nControl - docfreq_Control
    ),
    nrow = 2
  )
  test <- fisher.test(m)
  data.frame(
    p_value = test$p.value,
    odds_ratio = unname(test$estimate),
    conf_low = test$conf.int[1],
    conf_high = test$conf.int[2]
  )
}

Вычисление различий по сумме трёх текстов В таблице представлены значения при p<0,1 то есть значимые и близкие к значимым

Lemma - слово
frequency_Clinical - общее количество раз употребления слова
frequency_Control -//-
rank_Clinical - Ранг слова по частоте использования rank_Control -//-
docfreq_Clinical - Количество людей, которые использовали слово
docfreq_Control -//-
OddRatio - Вычесленное отношение шансов (см. формулу)
OddRatio_0.1 - Отношение шансов с поправкой
p_value - достоверность различий
odds_ratio - оценка отношения шансов из теста Фишера
conf_low - Доверительный интервал
conf_high -//-

Freq |>
  rowwise() |>
  mutate(
    fisher_results = list(calculate_fisher(docfreq_Clinical, docfreq_Control, nClinical, nControl))
  ) |>
  unnest_wider(fisher_results) |>
  filter(p_value < 0.1) |>
  arrange(desc(OddRatio_0.1)) |>
  mutate(
    # Округляем до 3 знаков после запятой
    OddRatio = sprintf("%.3f", OddRatio),
    OddRatio_0.1 = sprintf("%.3f", OddRatio_0.1),
    p_value = sprintf("%.3f", p_value),
    odds_ratio = sprintf("%.3f", odds_ratio),
    conf_low = sprintf("%.3f", conf_low),
    conf_high = sprintf("%.3f", conf_high),
    Significance = case_when(
      p_value <= 0.001 ~ "***",
      p_value <= 0.01 ~ "**",
      p_value <= 0.05 ~ "*",
      TRUE ~ "")
  ) |> 
  select(
    Lemma,     
    OR = odds_ratio,
    Sig = Significance,
    p_value, 
    КлинТекст = docfreq_Clinical,
    КонтрТекст = docfreq_Control,
    everything()                         
  ) |>
  kable()

Lemma	OR	Sig	p_value	КлинТекст	КонтрТекст	frequency_Clinical	frequency_Control	rank_Clinical	rank_Control	OddRatio	OddRatio_0.1	conf_low	conf_high
будто_conj	Inf	**	0.006	6	0	8	0	111.0	NA	Inf	94.555	1.613	Inf
курить_v	Inf	*	0.015	5	0	5	0	159.0	NA	Inf	74.876	1.207	Inf
поддерживать_v	Inf	*	0.037	4	0	4	0	190.5	NA	Inf	57.062	0.840	Inf
измена_s	Inf		0.088	3	0	4	0	190.5	NA	Inf	40.860	0.511	Inf
столик_s	Inf		0.088	3	0	4	0	190.5	NA	Inf	40.860	0.511	Inf
сдерживать_v	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
общаться_v	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
без_pr	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
отстранять_v	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
чтоб_conj	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
застукивать_v	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
книжка_s	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
вставать_v	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
отдавать_v	Inf		0.088	3	0	3	0	251.0	NA	Inf	40.860	0.511	Inf
брат_s	7.013		0.082	5	1	5	1	159.0	1123.0	7.250	6.581	0.708	353.746
познакомиться_v	5.797	*	0.012	10	3	11	3	87.0	424.5	6.000	5.789	1.240	37.871
тут_advpro	4.479	*	0.019	12	5	17	7	60.5	212.5	4.615	4.508	1.161	20.001
дочь_s	4.213	*	0.032	10	4	30	13	28.5	122.5	4.333	4.216	0.997	21.759
жена_s	4.123		0.088	8	3	16	10	63.0	156.0	4.235	4.090	0.840	27.485
сестра_s	3.258		0.071	10	5	12	7	79.0	212.5	3.333	3.259	0.823	14.652
происходить_v	0.347		0.099	7	16	9	25	101.0	78.0	0.340	0.339	0.093	1.196
просто_part	0.344		0.061	11	21	15	47	66.0	43.0	0.337	0.336	0.096	1.166
бы_part	0.340		0.061	10	20	23	40	41.0	48.0	0.333	0.333	0.096	1.143
мочь_v	0.325		0.080	14	24	29	72	31.0	27.5	0.318	0.319	0.080	1.211
скоро_adv	0.321		0.058	8	18	15	60	66.0	32.5	0.314	0.313	0.088	1.085
няня_s	0.292		0.075	4	12	12	28	79.0	67.5	0.286	0.284	0.058	1.187
сделать_v	0.292		0.075	4	12	6	18	136.0	97.0	0.286	0.284	0.058	1.187
наверное_adv	0.292		0.075	4	12	4	32	190.5	57.5	0.286	0.284	0.058	1.187
какой-то_apro	0.288	*	0.048	12	23	33	109	24.0	15.0	0.281	0.282	0.075	1.021
заниматься_v	0.283	*	0.032	6	16	8	23	111.0	82.5	0.276	0.275	0.071	1.006
ситуация_s	0.279	*	0.031	8	19	9	55	101.0	37.0	0.272	0.272	0.076	0.951
все_spro	0.261	*	0.038	14	25	26	85	33.5	23.0	0.255	0.256	0.058	1.019
диалог_s	0.245		0.092	2	8	2	19	363.0	91.0	0.239	0.236	0.023	1.419
ожидать_v	0.245		0.092	2	8	2	8	363.0	188.5	0.239	0.236	0.023	1.419
когда_conj	0.245		0.092	2	8	2	8	363.0	188.5	0.239	0.236	0.023	1.419
слушать_v	0.242		0.061	3	11	5	16	159.0	106.0	0.236	0.234	0.038	1.100
продолжать_v	0.242		0.061	3	11	4	16	190.5	106.0	0.236	0.234	0.038	1.100
момент_s	0.242		0.061	3	11	4	18	190.5	97.0	0.236	0.234	0.038	1.100
уже_adv	0.242		0.061	3	11	3	21	251.0	86.5	0.236	0.234	0.038	1.100
свой_apro	0.237	*	0.032	15	26	29	75	31.0	26.0	0.231	0.233	0.046	1.003
но_conj	0.238	*	0.022	12	24	26	68	33.5	29.0	0.231	0.232	0.058	0.871
как-то_advpro	0.225	*	0.014	5	16	8	38	111.0	51.0	0.219	0.218	0.052	0.837
как_advpro	0.211	**	0.007	9	22	36	60	20.0	32.5	0.205	0.205	0.055	0.738
время_s	0.210	*	0.032	3	12	3	16	251.0	106.0	0.205	0.203	0.033	0.945
девушка_s	0.204	*	0.026	16	27	35	104	21.5	17.0	0.198	0.201	0.031	0.971
к_pr	0.204	*	0.026	16	27	24	59	37.5	34.0	0.198	0.201	0.031	0.971
что-то_spro	0.202	*	0.016	14	26	25	72	35.5	27.5	0.196	0.198	0.039	0.842
же_part	0.197	*	0.011	4	15	6	29	136.0	64.0	0.190	0.190	0.039	0.781
молодой_a	0.197	*	0.011	4	15	6	27	136.0	71.5	0.190	0.190	0.039	0.781
хотеть_v	0.189		0.064	18	28	38	90	19.0	20.0	0.184	0.189	0.017	1.144
даже_part	0.184	*	0.016	3	13	6	18	136.0	97.0	0.178	0.177	0.029	0.819
еще_adv	0.184	*	0.016	3	13	3	24	251.0	81.0	0.178	0.177	0.029	0.819
для_pr	0.179	*	0.046	2	10	3	11	251.0	139.0	0.174	0.172	0.017	0.987
вообще_adv	0.179	*	0.046	2	10	2	18	363.0	97.0	0.174	0.172	0.017	0.987
думать_v	0.163	**	0.004	11	25	32	85	25.5	23.0	0.157	0.159	0.036	0.626
говорить_v	0.164	**	0.003	6	20	9	29	101.0	64.0	0.158	0.158	0.040	0.593
сторона_s	0.155	*	0.023	2	11	2	15	363.0	113.5	0.150	0.149	0.015	0.841
так_advpro	0.148	**	0.003	12	26	20	82	53.5	25.0	0.142	0.144	0.029	0.606
вы_spro	0.141		0.059	1	7	2	11	363.0	139.0	0.137	0.135	0.003	1.238
работа_s	0.141		0.059	1	7	1	16	712.0	106.0	0.137	0.135	0.003	1.238
сильно_adv	0.141		0.059	1	7	1	9	712.0	171.5	0.137	0.135	0.003	1.238
только_part	0.118	*	0.031	1	8	1	8	712.0	188.5	0.115	0.113	0.002	1.003
выходить_v	0.118	*	0.031	1	8	1	10	712.0	156.0	0.115	0.113	0.002	1.003
себя_spro	0.104	**	0.002	2	14	3	21	251.0	86.5	0.099	0.099	0.010	0.546
дело_s	0.100	***	0.000	4	20	7	33	122.0	55.5	0.095	0.095	0.019	0.404
куда-то_advpro	0.087	**	0.008	1	10	1	19	712.0	91.0	0.083	0.083	0.002	0.701
этот_apro	0.054	***	0.001	15	29	30	115	28.5	13.5	0.052	0.056	0.001	0.445
рядом_adv	0.057	***	0.001	1	13	2	13	363.0	122.5	0.054	0.054	0.001	0.446
домой_adv	0.000	*	0.012	0	7	0	10	NA	156.0	0.000	0.000	0.000	0.733
пока_conj	0.000	*	0.027	0	6	0	9	NA	171.5	0.000	0.000	0.000	0.928
хотеться_v	0.000	*	0.012	0	7	0	7	NA	212.5	0.000	0.000	0.000	0.733
повод_s	0.000		0.056	0	5	0	7	NA	212.5	0.000	0.000	0.000	1.229
находить_v	0.000		0.056	0	5	0	7	NA	212.5	0.000	0.000	0.000	1.229
куда_advpro	0.000	*	0.027	0	6	0	6	NA	244.0	0.000	0.000	0.000	0.928
принимать_v	0.000		0.056	0	5	0	6	NA	244.0	0.000	0.000	0.000	1.229
где_advpro	0.000		0.056	0	5	0	6	NA	244.0	0.000	0.000	0.000	1.229
родитель_s	0.000		0.056	0	5	0	6	NA	244.0	0.000	0.000	0.000	1.229
небольшой_a	0.000		0.056	0	5	0	5	NA	281.0	0.000	0.000	0.000	1.229
разрешать_v	0.000		0.056	0	5	0	5	NA	281.0	0.000	0.000	0.000	1.229
один_anum	0.000		0.056	0	5	0	5	NA	281.0	0.000	0.000	0.000	1.229
наконец_adv	0.000		0.056	0	5	0	5	NA	281.0	0.000	0.000	0.000	1.229

Картинка 1

Только существительные, прилагательные, глаголы и наречия

Tokens_S |>
  tokens_subset(Image == "picture_1") |>
  tokens_keep(pattern = c("*_S", "*_A", "*_V", "*_ADV"), valuetype = "glob") |>
  dfm() |>
  textstat_frequency(groups = Sample, ties_method = "average") |>
  pivot_wider(
    names_from = group,
    # Название группы становится колонкой
    values_from = c(frequency, rank, docfreq),
    # Данные из этих колонок будут заполнять новые колонки
    values_fill = list(
      frequency = 0,
      rank = NA,
      docfreq = 0
    )
  ) |>
  filter(docfreq_Clinical + docfreq_Control > 2) |>
  # Убираю лишние данные, чтобы быстрее работало
  mutate(OddRatio_0.1 = (((docfreq_Clinical) / (25 - docfreq_Clinical + 0.1)
  ) / (
    (docfreq_Control + 0.1) / (30 - docfreq_Control + 0.1)
  )
  )) |>
  rowwise() |>
  mutate(
    fisher_results = list(calculate_fisher(docfreq_Clinical, docfreq_Control, nClinical, nControl))
  ) |>
  unnest_wider(fisher_results) |>
  # Разбирает Лист из одной колонки по нескольким
  filter(p_value < 0.1) |>
  # Оставляю только значимые и близкие к значимости данные
   arrange(desc(OddRatio_0.1)) |>
  mutate(
    # Округляем до 3 знаков после запятой
    OddRatio_0.1 = sprintf("%.3f", OddRatio_0.1),
    p_value = sprintf("%.3f", p_value),
    odds_ratio = sprintf("%.3f", odds_ratio),
    conf_low = sprintf("%.3f", conf_low),
    conf_high = sprintf("%.3f", conf_high),
    Significance = case_when(
      p_value <= 0.001 ~ "***",
      p_value <= 0.01 ~ "**",
      p_value <= 0.05 ~ "*",
      TRUE ~ ""
    )
  ) |>
  select(
    Lemma = feature,     
    OR = odds_ratio,
    Sig = Significance,
    p_value, 
    КлинТекст = docfreq_Clinical,
    КонтрТекст = docfreq_Control,
    everything()                         
  ) |>
  kable()

Lemma	OR	Sig	p_value	КлинТекст	КонтрТекст	frequency_Clinical	frequency_Control	rank_Clinical	rank_Control	OddRatio_0.1	conf_low	conf_high
злой_a	Inf	*	0.037	4	0	5	0	23.5	NA	57.062	0.840	Inf
возможный_a	Inf	*	0.037	4	0	5	0	23.5	NA	57.062	0.840	Inf
сдерживать_v	Inf		0.088	3	0	3	0	51.0	NA	40.860	0.511	Inf
застукивать_v	Inf		0.088	3	0	3	0	51.0	NA	40.860	0.511	Inf
происходить_v	0.292		0.075	4	12	5	14	23.5	16.0	0.284	0.058	1.187
мужчина_s	0.280		0.062	16	26	33	65	2.0	1.0	0.276	0.054	1.210
думать_v	0.283	*	0.032	6	16	8	31	13.0	5.5	0.275	0.071	1.006
хотеть_v	0.246	*	0.025	11	23	15	46	6.0	3.0	0.240	0.063	0.871
пойти_v	0.242		0.061	3	11	3	19	51.0	12.0	0.234	0.038	1.100
понимать_v	0.208		0.051	2	9	2	12	94.5	18.5	0.201	0.020	1.173
наверное_adv	0.141		0.059	1	7	1	11	256.5	21.5	0.135	0.003	1.238
уже_adv	0.141		0.059	1	7	1	11	256.5	21.5	0.135	0.003	1.238
делать_v	0.118	*	0.031	1	8	1	8	256.5	36.5	0.113	0.002	1.003
ситуация_s	0.118	**	0.005	2	13	2	21	94.5	10.0	0.113	0.011	0.627
сделать_v	0.101	*	0.015	1	9	1	9	256.5	31.0	0.096	0.002	0.832
скоро_adv	0.075	**	0.004	1	11	1	15	256.5	14.5	0.071	0.002	0.598
еще_adv	0.000	*	0.012	0	7	0	10	NA	26.5	0.000	0.000	0.733
например_adv	0.000		0.056	0	5	0	7	NA	45.0	0.000	0.000	1.229
идти_v	0.000	*	0.027	0	6	0	7	NA	45.0	0.000	0.000	0.928
домой_adv	0.000		0.056	0	5	0	6	NA	54.5	0.000	0.000	1.229
выходить_v	0.000		0.056	0	5	0	5	NA	65.5	0.000	0.000	1.229

Картинка 2

Tokens_S |>
  tokens_subset(Image == "picture_2") |>
    tokens_keep(pattern = c("*_S", "*_A", "*_V", "*_ADV"), valuetype = "glob") |>
  dfm() |>
  textstat_frequency(groups = Sample, ties_method = "average") |>
  pivot_wider(
    names_from = group,
    # Название группы становится колонкой
    values_from = c(frequency, rank, docfreq),
    # Данные из этих колонок будут заполнять новые колонки
    values_fill = list(
      frequency = 0,
      rank = NA,
      docfreq = 0
    )
  ) |>
  filter(docfreq_Clinical + docfreq_Control > 2) |>
  # Убираю лишние данные, чтобы быстрее работало
  mutate(OddRatio_0.1 = (((docfreq_Clinical) / (25 - docfreq_Clinical + 0.1)
  ) / (
    (docfreq_Control + 0.1) / (30 - docfreq_Control + 0.1)
  )
  )) |>
  rowwise() |>
  mutate(
    fisher_results = list(calculate_fisher(docfreq_Clinical, docfreq_Control, nClinical, nControl))
  ) |>
  unnest_wider(fisher_results) |>
  # Разбирает Лист из одной колонки по нескольким
  filter(p_value < 0.1) |>
  # Оставляю только значимые и близкие к значимости данные
   arrange(desc(OddRatio_0.1)) |>
  mutate(
    # Округляем до 3 знаков после запятой
    OddRatio_0.1 = sprintf("%.3f", OddRatio_0.1),
    p_value = sprintf("%.3f", p_value),
    odds_ratio = sprintf("%.3f", odds_ratio),
    conf_low = sprintf("%.3f", conf_low),
    conf_high = sprintf("%.3f", conf_high),
    Significance = case_when(
      p_value <= 0.001 ~ "***",
      p_value <= 0.01 ~ "**",
      p_value <= 0.05 ~ "*",
      TRUE ~ ""
    )
  ) |>
  select(
    Lemma = feature,     
    OR = odds_ratio,
    Sig = Significance,
    p_value, 
    КлинТекст = docfreq_Clinical,
    КонтрТекст = docfreq_Control,
    everything()                         
  ) |>
  kable()

Lemma	OR	Sig	p_value	КлинТекст	КонтрТекст	frequency_Clinical	frequency_Control	rank_Clinical	rank_Control	OddRatio_0.1	conf_low	conf_high
курить_v	Inf	*	0.015	5	0	5	0	26.0	NA	74.876	1.207	Inf
муж_s	Inf		0.088	3	0	4	0	36.5	NA	40.860	0.511	Inf
столик_s	Inf		0.088	3	0	4	0	36.5	NA	40.860	0.511	Inf
общаться_v	Inf		0.088	3	0	3	0	55.0	NA	40.860	0.511	Inf
рука_s	Inf		0.088	3	0	3	0	55.0	NA	40.860	0.511	Inf
вставать_v	Inf		0.088	3	0	3	0	55.0	NA	40.860	0.511	Inf
выход_s	Inf		0.088	3	0	3	0	55.0	NA	40.860	0.511	Inf
познакомиться_v	5.797	*	0.012	10	3	10	3	10.5	97.5	5.789	1.240	37.871
девушка_s	0.343		0.094	12	22	20	53	4.0	2.0	0.336	0.093	1.185
заниматься_v	0.245		0.092	2	8	3	12	55.0	15.5	0.236	0.023	1.419
дело_s	0.104	**	0.002	2	14	3	20	55.0	10.5	0.099	0.010	0.546
старый_a	0.000		0.056	0	5	0	5	NA	48.0	0.000	0.000	1.229

Картинка 3

Tokens_S |>
  tokens_subset(Image == "picture_3") |>
    tokens_keep(pattern = c("*_S", "*_A", "*_V", "*_ADV"), valuetype = "glob") |>
  dfm() |>
  textstat_frequency(groups = Sample, ties_method = "average") |>
  pivot_wider(
    names_from = group,
    # Название группы становится колонкой
    values_from = c(frequency, rank, docfreq),
    # Данные из этих колонок будут заполнять новые колонки
    values_fill = list(
      frequency = 0,
      rank = NA,
      docfreq = 0
    )
  ) |>
  filter(docfreq_Clinical + docfreq_Control > 2) |>
  # Убираю лишние данные, чтобы быстрее работало
  mutate(OddRatio_0.1 = (((docfreq_Clinical) / (25 - docfreq_Clinical + 0.1)
  ) / (
    (docfreq_Control + 0.1) / (30 - docfreq_Control + 0.1)
  )
  )) |>
  rowwise() |>
  mutate(
    fisher_results = list(calculate_fisher(docfreq_Clinical, docfreq_Control, nClinical, nControl))
  ) |>
  unnest_wider(fisher_results) |>
  # Разбирает Лист из одной колонки по нескольким
  filter(p_value < 0.1) |>
  # Оставляю только значимые и близкие к значимости данные
   arrange(desc(OddRatio_0.1)) |>
  mutate(
    # Округляем до 3 знаков после запятой
    OddRatio_0.1 = sprintf("%.3f", OddRatio_0.1),
    p_value = sprintf("%.3f", p_value),
    odds_ratio = sprintf("%.3f", odds_ratio),
    conf_low = sprintf("%.3f", conf_low),
    conf_high = sprintf("%.3f", conf_high),
    Significance = case_when(
      p_value <= 0.001 ~ "***",
      p_value <= 0.01 ~ "**",
      p_value <= 0.05 ~ "*",
      TRUE ~ ""
    )
  ) |>
  select(
    Lemma = feature,     
    OR = odds_ratio,
    Sig = Significance,
    p_value, 
    КлинТекст = docfreq_Clinical,
    КонтрТекст = docfreq_Control,
    everything()                         
  ) |>
  kable()

Lemma	OR	Sig	p_value	КлинТекст	КонтрТекст	frequency_Clinical	frequency_Control	rank_Clinical	rank_Control	OddRatio_0.1	conf_low	conf_high
отстранять_v	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
равный_a	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
кажется_adv	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
книжка_s	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
все_adv	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
отдавать_v	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
поддерживать_v	Inf		0.088	3	0	3	0	69.5	NA	40.860	0.511	Inf
брат_s	7.013		0.082	5	1	5	1	37.0	389.5	6.581	0.708	353.746
дочь_s	4.213	*	0.032	10	4	30	13	5.0	23.0	4.216	0.997	21.759
сестра_s	3.258		0.071	10	5	12	7	13.5	50.5	3.259	0.823	14.652
няня_s	0.292		0.075	4	12	12	27	13.5	7.0	0.284	0.058	1.187
видеть_v	0.245		0.092	2	8	3	9	69.5	39.0	0.236	0.023	1.419
ситуация_s	0.245		0.092	2	8	2	15	110.0	20.0	0.236	0.023	1.419
изображать_v	0.208		0.051	2	9	2	10	110.0	32.5	0.201	0.020	1.173
думать_v	0.201	**	0.007	7	20	12	31	13.5	6.0	0.194	0.052	0.705
девушка_s	0.179	*	0.046	2	10	6	22	31.5	13.0	0.172	0.017	0.987
сторона_s	0.141		0.059	1	7	1	9	255.5	39.0	0.135	0.003	1.238
сидеть_v	0.132	***	0.001	4	18	7	22	27.5	13.0	0.127	0.026	0.527
рядом_adv	0.101	*	0.015	1	9	1	9	255.5	39.0	0.096	0.002	0.832
наверное_adv	0.101	*	0.015	1	9	1	13	255.5	23.0	0.096	0.002	0.832
время_s	0.000	*	0.027	0	6	0	8	NA	45.5	0.000	0.000	0.928
хотеться_v	0.000	*	0.012	0	7	0	7	NA	50.5	0.000	0.000	0.733
родитель_s	0.000		0.056	0	5	0	6	NA	59.5	0.000	0.000	1.229

Likelihood Ratio

Здесь подсчет не по отдельным испытуемым, а по всему массиву

Likelihood Ratio (LR) — это метод, который оценивает, насколько сильно различаются вероятности появления слова в двух группах текстов. Он позволяет понять, насколько больше вероятность того, что слово встречается в одной группе по сравнению с другой, и помогает выявить слова, которые могут быть характерны для каждой из групп. Чем выше значение LR, тем больше различие в частотах появления слова между группами, что может свидетельствовать о значимой разнице в контексте этих групп.

Поиск ключевых слов по алгоритму встроенному в пакет Quanteda.

Три текста вместе

В табилце отфильтрованы только значимые < 0,05 На гафик выведено 10 самых контрастных

target_Clin3 <- docvars(Tokens_S3, "Sample") == "Clinical"

Tokens_S3 |>
  dfm() |>
  #dfm_weight(scheme = "boolean") |> 
  textstat_keyness(target = target_Clin3,  measure = "lr") |>
  filter(p < 0.05) |>
  print() |>
  textplot_keyness(n = 10)

##            feature         G2              p n_target n_reference
## 1           дочь_s  24.909481 0.000000600862       30          13
## 2       будто_part  16.730660 0.000043079150       39          30
## 3        женщина_s  14.836463 0.000117246576       83          96
## 4       тут_advpro  14.697772 0.000126195539       17           7
## 5           лицо_s  13.578054 0.000228845359       23          14
## 6       будто_conj  13.481504 0.000240926554        8           0
## 7  познакомиться_v  10.574149 0.001146800549       11           3
## 8           жена_s   9.140322 0.002500370598       16          10
## 9     потом_advpro   8.741253 0.003110907148       12           6
## 10          мать_s   8.268466 0.004033957515       21          17
## 11       будущее_s   7.797348 0.005232298665       19          15
## 12   недовольный_a   7.550754 0.005998496244        8           2
## 13        сестра_s   7.434944 0.006396935061       12           7
## 14        курить_v   7.238311 0.007136409652        5           0
## 15         то_conj   6.332170 0.011856718501       22          21
## 16     нравиться_v   6.141173 0.013206968883       11           7
## 17       держать_v   5.555013 0.018427833292       19          18
## 18      далеко_adv   5.335901 0.020890543487       12           9
## 19   абсолютно_adv   5.231195 0.022185279465        4           0
## 20        измена_s   5.231195 0.022185279465        4           0
## 21    настроение_s   5.231195 0.022185279465        4           0
## 22  поддерживать_v   5.231195 0.022185279465        4           0
## 23      прислуга_s   5.231195 0.022185279465        4           0
## 24        столик_s   5.231195 0.022185279465        4           0
## 25           за_pr   5.132585 0.023480733240       22          23
## 26          быть_v   4.998238 0.025373143758       87         132
## 27      пытаться_v   4.884079 0.027105493746       34          42
## 28            с_pr   4.712602 0.029942296789       71         105
## 29          мама_s   4.569448 0.032547047295       31          38
## 30          брат_s   4.529135 0.033322464148        5           1
## 31          злой_a   4.529135 0.033322464148        5           1
## 32      изменять_v   4.529135 0.033322464148        5           1
## 33     кажется_adv   4.529135 0.033322464148        5           1
## 34     возможный_a   4.495487 0.033984440204        8           4
## 35         дочка_s   4.489191 0.034109812715       12          10
## 36         знать_v   4.390147 0.036147198021       25          29
## 37       пока_conj  -3.963902 0.046485832196        0           9
## 38      просто_adv  -3.963902 0.046485832196        0           9
## 39           раз_s  -3.963902 0.046485832196        0           9
## 40       сторона_s  -4.002574 0.045430826855        2          15
## 41         же_part  -4.263539 0.038938715208        6          29
## 42        все_spro  -4.526624 0.033371388493       26          85
## 43          дело_s  -4.634706 0.031331515473        7          33
## 44       домой_adv  -4.644741 0.031148832595        0          10
## 45       себя_spro  -5.210150 0.022455395338        3          21
## 46         уже_adv  -5.210150 0.022455395338        3          21
## 47   как-то_advpro  -5.414792 0.019966835783        8          38
## 48      вообще_adv  -5.682516 0.017134777889        2          18
## 49       скоро_adv  -5.921705 0.014955481889       15          60
## 50   какой-то_apro  -6.046207 0.013936203562       33         109
## 51        диалог_s  -6.266661 0.012303078285        2          19
## 52         еще_adv  -6.827060 0.008978695769        3          24
## 53        работа_s  -7.259632 0.007052174310        1          16
## 54      так_advpro  -8.607516 0.003347785731       20          82
## 55    наверное_adv  -9.107348 0.002545847171        4          32
## 56  куда-то_advpro  -9.294141 0.002298879132        1          19
## 57       этот_apro -10.212034 0.001395271968       30         115
## 58      ситуация_s -11.618396 0.000653026911        9          55
## 59        вот_part -18.061908 0.000021383702       23         115

picture_1

TargetClin <- 
  tokens_subset(Tokens_S, Image == "picture_1" )$Sample == "Clinical"

  Tokens_S |>
     tokens_subset(Image == "picture_1" ) |>
    dfm() |>
    #dfm_weight(scheme = "boolean") |> 
    textstat_keyness(target = TargetClin,  measure = "lr") |>
    filter(p < 0.05) |>
    print() |>
    textplot_keyness(  )

##          feature        G2            p n_target n_reference
## 1      женщина_s 12.782676 0.0003498442       46          50
## 2           с_pr 12.431496 0.0004221537       23          17
## 3   потом_advpro  9.955445 0.0016037437        6           0
## 4     пытаться_v  9.304118 0.0022863936       24          22
## 5         лицо_s  8.353057 0.0038503902        8           2
## 6    возможный_a  7.775242 0.0052967117        5           0
## 7         злой_a  7.775242 0.0052967117        5           0
## 8  абсолютно_adv  5.641380 0.0175413946        4           0
## 9     будто_conj  5.641380 0.0175413946        4           0
## 10        жена_s  5.426144 0.0198374385       12          10
## 11    изменять_v  5.007544 0.0252370848        5           1
## 12    будто_part  4.808467 0.0283202315       10           8
## 13     будущее_s  4.360255 0.0367868059        9           6
## 14       еще_adv -4.164293 0.0412846302        0          10
## 15     скоро_adv -4.205506 0.0402929444        1          15
## 16      или_conj -4.386076 0.0362336166        3          21
## 17    ситуация_s -6.519521 0.0106696759        2          21

picture_2

TargetClin <- 
  tokens_subset(Tokens_S, Image == "picture_2" )$Sample == "Clinical"

  Tokens_S |>
     tokens_subset(Image == "picture_2" ) |>
    dfm() |>
    #dfm_weight(scheme = "boolean") |> 
    textstat_keyness(target = TargetClin,  measure = "lr") |>
    filter(p < 0.05) |>
    print() |>
    textplot_keyness(  )

##            feature        G2           p n_target n_reference
## 1       будто_part 10.362378 0.001286094       16           9
## 2  познакомиться_v  8.942474 0.002786151       10           3
## 3        женщина_s  8.085397 0.004462336       26          24
## 4           друг_s  7.290525 0.006931921       10           4
## 5         курить_v  7.240456 0.007127887        5           0
## 6           жена_s  5.231797 0.022177613        4           0
## 7            муж_s  5.231797 0.022177613        4           0
## 8     настроение_s  5.231797 0.022177613        4           0
## 9         столик_s  5.231797 0.022177613        4           0
## 10           по_pr  4.926923 0.026441356       10           7
## 11      тут_advpro  4.499992 0.033895010        8           4
## 12     нравиться_v  4.373860 0.036494238        6           2
## 13       свой_apro -3.873991 0.049039767        7          31
## 14       этот_apro -3.892150 0.048512281        8          34
## 15        вот_part -4.713233 0.029931306        6          30
## 16          дело_s -4.713660 0.029923876        3          20
## 17   какой-то_apro -8.418225 0.003714782        9          48

picture_3

TargetClin <- 
  tokens_subset(Tokens_S, Image == "picture_3" )$Sample == "Clinical"

  Tokens_S |>
     tokens_subset(Image == "picture_3" ) |>
    dfm() |>
    #dfm_weight(scheme = "boolean") |> 
    textstat_keyness(target = TargetClin,  measure = "lr") |>
    filter(p < 0.05) |>
    print() |>
    textplot_keyness(  )

##          feature         G2              p n_target n_reference
## 1         дочь_s  22.233507 0.000002414237       30          13
## 2         мать_s   6.817970 0.009024509138       21          17
## 3        знать_v   6.814548 0.009041819211        8           2
## 4  недовольный_a   6.814548 0.009041819211        8           2
## 5       сестра_s   6.439642 0.011160110726       12           7
## 6     прислуга_s   4.845708 0.027715010261        4           0
## 7         брат_s   4.085304 0.043257672165        5           1
## 8     тут_advpro   4.085304 0.043257672165        5           1
## 9         быть_v   3.922803 0.047635394338       33          39
## 10  наверное_adv  -4.272627 0.038731004650        1          13
## 11    ситуация_s  -4.678888 0.030535512444        2          15
## 12     очень_adv  -5.326116 0.021008151840        5          26
## 13    так_advpro  -9.673201 0.001869752268        5          34
## 14      вот_part -13.513359 0.000236871145        6          44

N-Grams 2

Freq_2n <- Tokens_S3 |>
  tokens_replace(Dictionary$Word_POS, Dictionary$Word, valuetype = "fixed") |>
  tokens_ngrams(n = 2L) |>
  dfm() |>
  textstat_frequency(groups = Sample, ties_method = "average") |>
  rename(Lemma = feature) |>
  as.data.frame() |> # Почему не работает на исходном объекте select?
  pivot_wider(
    names_from = group, # Название группы становится колонкой
    values_from = c(frequency, rank, docfreq), # Данные из этих колонок будут заполнять новые колонки
    values_fill = list(frequency = 0, rank = NA, docfreq = 0)
  ) |>
  mutate(
    OddRatio = (
      ((docfreq_Clinical) / (25 - docfreq_Clinical)) /
        ((docfreq_Control) / (30 - docfreq_Control))
    ),
    OddRatio_0.1 = (
      ((docfreq_Clinical) / (25 - docfreq_Clinical + 0.1)) /
        ((docfreq_Control + 0.1) / (30 - docfreq_Control + 0.1))
    )
  )

Freq_2n |>
  rowwise() |>
  mutate(
    fisher_results = list(calculate_fisher(docfreq_Clinical, docfreq_Control, nClinical, nControl))
  ) |>
  unnest_wider(fisher_results) |>
  filter(p_value < 0.1) |>
  arrange(desc(OddRatio_0.1)) |>
  mutate(
    # Округляем до 3 знаков после запятой
    OddRatio = sprintf("%.3f", OddRatio),
    OddRatio_0.1 = sprintf("%.3f", OddRatio_0.1),
    p_value = sprintf("%.3f", p_value),
    odds_ratio = sprintf("%.3f", odds_ratio),
    conf_low = sprintf("%.3f", conf_low),
    conf_high = sprintf("%.3f", conf_high),
    Significance = case_when(
      p_value <= 0.001 ~ "***",
      p_value <= 0.01 ~ "**",
      p_value <= 0.05 ~ "*",
      TRUE ~ "")
  ) |> 
  select(
    Lemma,     
    OR = odds_ratio,
    Sig = Significance,
    p_value, 
    КлинТекст = docfreq_Clinical,
    КонтрТекст = docfreq_Control,
    everything()                         
  ) |>
  kable()

Lemma	OR	Sig	p_value	КлинТекст	КонтрТекст	frequency_Clinical	frequency_Control	rank_Clinical	rank_Control	OddRatio	OddRatio_0.1	conf_low	conf_high
мочь_сказать	Inf	*	0.015	5	0	7	0	37.0	NA	Inf	74.876	1.207	Inf
дочь_и	Inf	*	0.015	5	0	5	0	63.0	NA	Inf	74.876	1.207	Inf
она_будто	Inf	*	0.037	4	0	5	0	63.0	NA	Inf	57.062	0.840	Inf
познакомиться_с	Inf	*	0.037	4	0	4	0	99.5	NA	Inf	57.062	0.840	Inf
пытаться_уходить	Inf	*	0.037	4	0	4	0	99.5	NA	Inf	57.062	0.840	Inf
жена_и	Inf		0.088	3	0	4	0	99.5	NA	Inf	40.860	0.511	Inf
с_женщина	Inf		0.088	3	0	4	0	99.5	NA	Inf	40.860	0.511	Inf
в_голова	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
и_мама	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
к_мужчина	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
он_знать	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
читать_книга	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
не_обращать	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
будущее_девочка	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
вставать_и	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
девочка_пойти	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
ситуация_на	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
сидеть_женщина	Inf		0.088	3	0	3	0	171.5	NA	Inf	40.860	0.511	Inf
у_они	0.334		0.087	5	13	5	22	63.0	16.0	0.327	0.325	0.077	1.257
скоро_все	0.257	*	0.027	5	15	9	42	24.0	2.5	0.250	0.249	0.059	0.955
на_она	0.255	*	0.041	4	13	5	15	63.0	25.5	0.249	0.247	0.051	1.027
что_она	0.246	*	0.025	11	23	15	44	6.5	1.0	0.239	0.240	0.063	0.871
с_он	0.245		0.092	2	8	3	11	171.5	46.0	0.239	0.236	0.023	1.419
что_мужчина	0.245		0.092	2	8	2	10	384.5	54.0	0.239	0.236	0.023	1.419
не_понимать	0.245		0.092	2	8	2	10	384.5	54.0	0.239	0.236	0.023	1.419
думать_что	0.225	*	0.014	5	16	6	42	45.5	2.5	0.219	0.218	0.052	0.837
она_и	0.208		0.051	2	9	2	11	384.5	46.0	0.203	0.201	0.020	1.173
вот_и	0.208		0.051	2	9	2	17	384.5	21.5	0.203	0.201	0.020	1.173
заниматься_свой	0.179	*	0.046	2	10	3	12	171.5	38.5	0.174	0.172	0.017	0.987
я_думать	0.142	**	0.004	3	15	7	40	37.0	4.0	0.136	0.136	0.022	0.623
не_так	0.141		0.059	1	7	2	8	384.5	75.5	0.137	0.135	0.003	1.238
свой_дело	0.118	**	0.005	2	13	4	17	99.5	21.5	0.114	0.113	0.011	0.627
она_быть	0.118	**	0.005	2	13	2	17	384.5	21.5	0.114	0.113	0.011	0.627
в_какой-то	0.101	*	0.015	1	9	1	13	2062.0	33.0	0.097	0.096	0.002	0.832
она_хотеть	0.087	**	0.008	1	10	1	14	2062.0	29.0	0.083	0.083	0.002	0.701
она_что-то	0.087	**	0.008	1	10	1	12	2062.0	38.5	0.083	0.083	0.002	0.701
молодой_девушка	0.000	**	0.006	0	8	0	9	NA	61.5	0.000	0.000	0.000	0.597
то_чтобы	0.000		0.056	0	5	0	8	NA	75.5	0.000	0.000	0.000	1.229
и_я	0.000	*	0.027	0	6	0	8	NA	75.5	0.000	0.000	0.000	0.928
этот_картина	0.000		0.056	0	5	0	8	NA	75.5	0.000	0.000	0.000	1.229
этот_мужчина	0.000	*	0.012	0	7	0	8	NA	75.5	0.000	0.000	0.000	0.733
так_ну	0.000		0.056	0	5	0	7	NA	101.5	0.000	0.000	0.000	1.229
это_все	0.000	*	0.027	0	6	0	7	NA	101.5	0.000	0.000	0.000	0.928
рядом_с	0.000	*	0.012	0	7	0	7	NA	101.5	0.000	0.000	0.000	0.733
по_повод	0.000		0.056	0	5	0	7	NA	101.5	0.000	0.000	0.000	1.229
просто_сидеть	0.000	*	0.027	0	6	0	6	NA	134.5	0.000	0.000	0.000	0.928
какой-то_свой	0.000		0.056	0	5	0	6	NA	134.5	0.000	0.000	0.000	1.229
вообще_не	0.000		0.056	0	5	0	6	NA	134.5	0.000	0.000	0.000	1.229
подходить_к	0.000		0.056	0	5	0	5	NA	188.0	0.000	0.000	0.000	1.229
как_у	0.000		0.056	0	5	0	5	NA	188.0	0.000	0.000	0.000	1.229
но_не	0.000		0.056	0	5	0	5	NA	188.0	0.000	0.000	0.000	1.229
держать_в	0.000		0.056	0	5	0	5	NA	188.0	0.000	0.000	0.000	1.229
ситуация_и	0.000		0.056	0	5	0	5	NA	188.0	0.000	0.000	0.000	1.229
еще_один	0.000		0.056	0	5	0	5	NA	188.0	0.000	0.000	0.000	1.229

N-Grams 3

Freq_2n <- Tokens_S3 |>
  tokens_replace(Dictionary$Word_POS, Dictionary$Word, valuetype = "fixed") |>
  tokens_ngrams(n = 3L) |>
  dfm() |>
  textstat_frequency(groups = Sample, ties_method = "average") |>
  rename(Lemma = feature) |>
  as.data.frame() |> # Почему не работает на исходном объекте select?
  pivot_wider(
    names_from = group, # Название группы становится колонкой
    values_from = c(frequency, rank, docfreq), # Данные из этих колонок будут заполнять новые колонки
    values_fill = list(frequency = 0, rank = NA, docfreq = 0)
  ) |>
  mutate(
    OddRatio = (
      ((docfreq_Clinical) / (25 - docfreq_Clinical)) /
        ((docfreq_Control) / (30 - docfreq_Control))
    ),
    OddRatio_0.1 = (
      ((docfreq_Clinical) / (25 - docfreq_Clinical + 0.1)) /
        ((docfreq_Control + 0.1) / (30 - docfreq_Control + 0.1))
    )
  )

Freq_2n |>
  rowwise() |>
  mutate(
    fisher_results = list(calculate_fisher(docfreq_Clinical, docfreq_Control, nClinical, nControl))
  ) |>
  unnest_wider(fisher_results) |>
  filter(p_value < 0.1) |>
  arrange(desc(OddRatio_0.1)) |>
  mutate(
    # Округляем до 3 знаков после запятой
    OddRatio = sprintf("%.3f", OddRatio),
    OddRatio_0.1 = sprintf("%.3f", OddRatio_0.1),
    p_value = sprintf("%.3f", p_value),
    odds_ratio = sprintf("%.3f", odds_ratio),
    conf_low = sprintf("%.3f", conf_low),
    conf_high = sprintf("%.3f", conf_high),
    Significance = case_when(
      p_value <= 0.001 ~ "***",
      p_value <= 0.01 ~ "**",
      p_value <= 0.05 ~ "*",
      TRUE ~ "")
  ) |> 
  select(
    Lemma,     
    OR = odds_ratio,
    Sig = Significance,
    p_value, 
    КлинТекст = docfreq_Clinical,
    КонтрТекст = docfreq_Control,
    everything()                         
  ) |>
  kable()

Lemma	OR	Sig	p_value	КлинТекст	КонтрТекст	frequency_Clinical	frequency_Control	rank_Clinical	rank_Control	OddRatio	OddRatio_0.1	conf_low	conf_high
не_мочь_сказать	Inf	*	0.037	4	0	6	0	2.0	NA	Inf	57.062	0.840	Inf
мочь_сказать_что	Inf		0.088	3	0	3	0	24.5	NA	Inf	40.860	0.511	Inf
как_будто_бы	0.245		0.092	2	8	8	9	1.0	5.0	0.239	0.236	0.023	1.419
заниматься_свой_дело	0.208		0.051	2	9	3	11	24.5	2.5	0.203	0.201	0.020	1.173
я_думать_что	0.057	***	0.001	1	13	1	32	2359.0	1.0	0.054	0.054	0.001	0.446
на_этот_картина	0.000		0.056	0	5	0	8	NA	7.0	0.000	0.000	0.000	1.229
рядом_с_она	0.000	*	0.027	0	6	0	6	NA	11.0	0.000	0.000	0.000	0.928
сидеть_на_диван	0.000		0.056	0	5	0	5	NA	20.0	0.000	0.000	0.000	1.229
держать_в_рука	0.000		0.056	0	5	0	5	NA	20.0	0.000	0.000	0.000	1.229

Будто

Без разделения на части речи Три текста:

Tokens_S3 |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
   dfm() |>
  textstat_frequency(groups = Sample)

##      feature frequency rank docfreq    group
## 1 будто_part        39    1      11 Clinical
## 2 будто_conj         8    2       6 Clinical
## 3 будто_part        30    1      16  Control

Tokens_S3 |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
  tokens_replace(pattern = c("будто_CONJ", "будто_PART"), replacement = c("будто", "будто"))|>
   dfm() |>
  textstat_frequency(groups = Sample)

##   feature frequency rank docfreq    group
## 1   будто        47    1      15 Clinical
## 2   будто        30    1      16  Control

Точный тест Фишера

fisher.test(matrix(c(
  15, 25-15, 
  16, 30-16
  ), nrow = 2, byrow = TRUE))

## 
##  Fisher's Exact Test for Count Data
## 
## data:  matrix(c(15, 25 - 15, 16, 30 - 16), nrow = 2, byrow = TRUE)
## p-value = 0.7855
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.3946347 4.4159547
## sample estimates:
## odds ratio 
##   1.306006

Picture 1

  Tokens_S |>
   tokens_subset(Image == "picture_1") |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
   dfm() |>
  textstat_frequency(groups = Sample)

##      feature frequency rank docfreq    group
## 1 будто_part        10    1       5 Clinical
## 2 будто_conj         4    2       3 Clinical
## 3 будто_part         8    1       8  Control

Tokens_S |>
   tokens_subset(Image == "picture_1") |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
  tokens_replace(pattern = c("будто_CONJ", "будто_PART"), replacement = c("будто", "будто"))|>
   dfm() |>
  textstat_frequency(groups = Sample)

##   feature frequency rank docfreq    group
## 1   будто        14    1       8 Clinical
## 2   будто         8    1       8  Control

Точный тест Фишера

fisher.test(matrix(c(
  8, 25-8, 
  8, 30-8
  ), nrow = 2, byrow = TRUE))

## 
##  Fisher's Exact Test for Count Data
## 
## data:  matrix(c(8, 25 - 8, 8, 30 - 8), nrow = 2, byrow = TRUE)
## p-value = 0.7688
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.3419581 4.8748929
## sample estimates:
## odds ratio 
##   1.288014

Picture 2

  Tokens_S |>
   tokens_subset(Image == "picture_2") |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
   dfm() |>
  textstat_frequency(groups = Sample)

##      feature frequency rank docfreq    group
## 1 будто_part        16    1       7 Clinical
## 2 будто_conj         3    2       3 Clinical
## 3 будто_part         9    1       8  Control

Tokens_S |>
   tokens_subset(Image == "picture_2") |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
  tokens_replace(pattern = c("будто_CONJ", "будто_PART"), replacement = c("будто", "будто"))|>
   dfm() |>
  textstat_frequency(groups = Sample)

##   feature frequency rank docfreq    group
## 1   будто        19    1       9 Clinical
## 2   будто         9    1       8  Control

Точный тест Фишера

fisher.test(matrix(c(
  9, 25-9, 
  8, 30-8
  ), nrow = 2, byrow = TRUE))

## 
##  Fisher's Exact Test for Count Data
## 
## data:  matrix(c(9, 25 - 9, 8, 30 - 8), nrow = 2, byrow = TRUE)
## p-value = 0.5616
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.4203664 5.7220775
## sample estimates:
## odds ratio 
##   1.534467

Picture 3

  Tokens_S |>
   tokens_subset(Image == "picture_3") |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
   dfm() |>
  textstat_frequency(groups = Sample)

##      feature frequency rank docfreq    group
## 1 будто_part        13    1       8 Clinical
## 2 будто_conj         1    2       1 Clinical
## 3 будто_part        13    1       8  Control

Tokens_S |>
   tokens_subset(Image == "picture_3") |>
  tokens_select(c("будто_CONJ", "будто_PART")) |>
  tokens_replace(pattern = c("будто_CONJ", "будто_PART"), replacement = c("будто", "будто"))|>
   dfm() |>
  textstat_frequency(groups = Sample)

##   feature frequency rank docfreq    group
## 1   будто        14    1       9 Clinical
## 2   будто        13    1       8  Control

Точный тест Фишера

fisher.test(matrix(c(
  9, 25-9, 
  8, 30-8
  ), nrow = 2, byrow = TRUE))

## 
##  Fisher's Exact Test for Count Data
## 
## data:  matrix(c(9, 25 - 9, 8, 30 - 8), nrow = 2, byrow = TRUE)
## p-value = 0.5616
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.4203664 5.7220775
## sample estimates:
## odds ratio 
##   1.534467

…