Анализ PeerMathDial
От открытых диалогов PeerMathDial к социограммам в R
В этом уроке мы пройдём полный воспроизводимый путь: прочитаем открытый JSON Lines непосредственно из GitHub, исследуем вложенную структуру, превратим сессии в таблицу реплик, проведём аудит и построим две социограммы. Первая социограмма — двудольный граф «ученик — сессия», вторая — ориентированный граф «следующий говорящий» для выбранной сессии.
- Исходные данные - https://github.com/Ziyu-Yao-NLP-Lab/PeerMathDial
- PeerMathDial и
- https://raw.githubusercontent.com/Ziyu-Yao-NLP-Lab/PeerMathDial/refs/heads/main/data/conversations.jsonl
Каждая строка файла — отдельный JSON-объект сессии; внутри сессии находится список реплик turns. В публичном описании корпуса указаны 55 диалогов и 6406 реплик.
Результат урока
После выполнения скрипта будут получены:
- длинная таблица
turns_long, где одна строка соответствует одной реплике; - аудит сессий, реплик, учеников и доли реплик учителя;
- таблица границ группы: ядро и эпизодические участники;
student_session_bipartite.dot— двудольный граф «ученик — сессия»;next_speaker_with_teacher.dot— переходы между соседними репликами с учителями;next_speaker_without_teacher.dot— вариант, где учитель удалён из последовательности до вычисления переходов;- варианты тех же графов в обёртке
<graphviz>...</graphviz>для вставки на страницу Поля цифровой дидактики.
0. Параметры исследования
Сначала соберём в одном месте все значения.
Порог ядра равен 5 % всех реплик сессии. Один и тот же edge_min_events применяется к рёбрам всех графов. Толщина ребра линейно переводит число событий [math]\displaystyle{ x }[/math] в диапазон от [math]\displaystyle{ w_{min} }[/math] до [math]\displaystyle{ w_{max} }[/math]:
[math]\displaystyle{ w = w_{min} + \frac{x-x_{min}}{x_{max}-x_{min}}(w_{max}-w_{min}) }[/math].
Если все видимые рёбра имеют одинаковый вес, им назначается середина диапазона.
# ============================================================
data_url <- paste0(
"https://raw.githubusercontent.com/Ziyu-Yao-NLP-Lab/",
"PeerMathDial/refs/heads/main/data/conversations.jsonl"
)
core_share <- 0.05 # ядро: не менее 5 % всех реплик сессии
edge_min_events <- 2L # единый порог включения ребра во все графы
session_number <- 1L # номер сессии в порядке строк JSONL
edge_width_min <- 0.45 # минимальный penwidth
edge_width_max <- 3.80 # максимальный penwidth
arrow_size <- 0.45 # маленькая стрелка ориентированного графа
emoji_font <- "Noto Color Emoji"
output_dir <- "."
# Формула ниже будет применена явно к таблице рёбер каждого графа:
# penwidth = edge_width_min +
# (events - min(events)) / (max(events) - min(events)) *
# (edge_width_max - edge_width_min)
packages <- c("jsonlite", "dplyr", "tidyr", "purrr")
missing_packages <- packages[
!vapply(packages, requireNamespace, logical(1), quietly = TRUE)
]
if (length(missing_packages) > 0) {
install.packages(missing_packages, repos = "https://cloud.r-project.org")
}
invisible(lapply(packages, library, character.only = TRUE))
# ============================================================
# 2. ЗАГРУЗКА JSONL НАПРЯМУЮ ИЗ GITHUB
# ============================================================
json_lines <- readLines(data_url, warn = FALSE, encoding = "UTF-8")
sessions_list <- purrr::map(
json_lines,
jsonlite::fromJSON,
simplifyVector = FALSE
)
length(json_lines)
length(sessions_list)
# Поля верхнего уровня первой сессии
names(sessions_list[[1]])
str(sessions_list[[1]], max.level = 1)
# Где лежат реплики и как устроена одна реплика
length(sessions_list[[1]]$turns)
names(sessions_list[[1]]$turns[[1]])
str(sessions_list[[1]]$turns[[1]], max.level = 2)
# Говорящий и его роль
sessions_list[[1]]$turns[[1]][c("turn_id", "speaker_id", "role")]
# Какие роли действительно встречаются во всём файле
roles_in_file <- sessions_list |>
purrr::map("turns") |>
purrr::flatten() |>
purrr::map_chr("role") |>
unique() |>
sort()
roles_in_file
# ============================================================
# 3. РАЗВОРАЧИВАНИЕ В ДЛИННУЮ ТАБЛИЦУ
# ============================================================
sessions_tbl <- tibble::tibble(
session_order = seq_along(sessions_list),
session = sessions_list
) |>
dplyr::mutate(
session_id = purrr::map_chr(session, "session_id"),
turns = purrr::map(session, "turns")
) |>
dplyr::select(session_order, session_id, turns, session)
sessions_tbl |>
dplyr::select(-session) |>
head(3)
turns_long <- sessions_tbl |>
dplyr::select(session_order, session_id, turns) |>
tidyr::unnest_longer(
turns,
values_to = "turn"
) |>
dplyr::group_by(session_order, session_id) |>
dplyr::mutate(turn_index = dplyr::row_number()) |>
dplyr::ungroup() |>
tidyr::unnest_wider(turn) |>
dplyr::transmute(
session_order,
session_id,
turn_no = as.integer(turn_id),
turn_index = as.integer(turn_index),
speaker_id,
role,
text,
word_count = as.integer(word_count),
action
) |>
dplyr::arrange(session_order, turn_no)
turns_long |> head(10)
dplyr::glimpse(turns_long)
nrow(turns_long)
turns_long |>
dplyr::summarise(
n_turns = dplyr::n(),
index_mismatches = sum(turn_no != turn_index),
missing_speaker = sum(is.na(speaker_id) | speaker_id == ""),
missing_role = sum(is.na(role) | role == "")
)
turns_long |> dplyr::count(role, sort = TRUE)
# ============================================================
# 4. АУДИТ КОРПУСА
# ============================================================
corpus_audit <- tibble::tibble(
n_sessions = dplyr::n_distinct(turns_long$session_id),
n_turns = nrow(turns_long),
n_student_ids = turns_long |>
dplyr::filter(role == "student") |>
dplyr::summarise(n = dplyr::n_distinct(speaker_id)) |>
dplyr::pull(n)
)
corpus_audit
session_audit <- turns_long |>
dplyr::group_by(session_order, session_id) |>
dplyr::summarise(
n_turns = dplyr::n(),
n_student_turns = sum(role == "student"),
n_teacher_turns = sum(role == "teacher"),
n_unknown_turns = sum(role == "unknown"),
n_student_ids = dplyr::n_distinct(speaker_id[role == "student"]),
teacher_share = n_teacher_turns / n_turns,
.groups = "drop"
)
sessions_without_students <- session_audit |>
dplyr::filter(n_student_turns == 0)
session_audit |> head(10)
sessions_without_students
nrow(sessions_without_students)
teacher_share_by_session <- session_audit |>
dplyr::select(session_id, n_turns, n_teacher_turns, teacher_share) |>
dplyr::arrange(dplyr::desc(teacher_share))
teacher_share_by_session |> head(10)
summary(teacher_share_by_session$teacher_share)
speaker_role_conflicts <- turns_long |>
dplyr::distinct(speaker_id, role) |>
dplyr::count(speaker_id, name = "n_roles") |>
dplyr::filter(n_roles > 1)
speaker_role_conflicts
nrow(speaker_role_conflicts)
# ============================================================
# 5. ЯДРО И ЭПИЗОДИЧЕСКОЕ УЧАСТИЕ
# ============================================================
session_sizes <- turns_long |>
dplyr::count(session_id, name = "session_turns")
student_session <- turns_long |>
dplyr::filter(role == "student") |>
dplyr::count(session_id, speaker_id, name = "student_turns") |>
dplyr::left_join(session_sizes, by = "session_id") |>
dplyr::mutate(
turn_share = student_turns / session_turns,
participation_type = dplyr::if_else(
turn_share >= core_share,
"core",
"episodic"
)
) |>
dplyr::arrange(session_id, dplyr::desc(student_turns))
student_session |> head(20)
student_session |> dplyr::count(participation_type)
summary(student_session$turn_share)
# ============================================================
# 6. ГРАФ 1: ДВУДОЛЬНЫЙ «УЧЕНИК — СЕССИЯ»
# ============================================================
bipartite_edges <- student_session |>
dplyr::filter(student_turns >= edge_min_events)
if (nrow(bipartite_edges) > 0) {
bipartite_edges <- bipartite_edges |>
dplyr::mutate(
penwidth = if (max(student_turns) == min(student_turns)) {
(edge_width_min + edge_width_max) / 2
} else {
edge_width_min +
(student_turns - min(student_turns)) /
(max(student_turns) - min(student_turns)) *
(edge_width_max - edge_width_min)
},
edge_style = dplyr::if_else(
participation_type == "core",
"solid",
"dashed"
)
)
}
bipartite_edges |> head(10)
bipartite_edges |> dplyr::count(edge_style)
nrow(bipartite_edges)
Теперь вручную собираем строки DOT. В идентификатор DOT добавляется префикс типа узла, но на рисунке показывается только значок. Настоящий идентификатор помещается в tooltip и появляется при наведении в SVG.
bipartite_student_nodes <- turns_long |>
dplyr::filter(role == "student") |>
dplyr::distinct(speaker_id) |>
dplyr::mutate(
dot_id = paste0("student__", speaker_id),
dot_line = sprintf(
' "%s" [shape=circle, label="👤", tooltip="%s"];',
dot_id, speaker_id
)
)
bipartite_session_nodes <- sessions_tbl |>
dplyr::distinct(session_id) |>
dplyr::mutate(
dot_id = paste0("session__", session_id),
dot_line = sprintf(
' "%s" [shape=square, label="📄", tooltip="%s"];',
dot_id, session_id
)
)
bipartite_edge_lines <- bipartite_edges |>
dplyr::mutate(
from_id = paste0("student__", speaker_id),
to_id = paste0("session__", session_id),
dot_line = sprintf(
paste0(
' "%s" -- "%s" ',
'[weight="%d", penwidth="%.2f", style="%s", ',
'tooltip="%s: %d реплик"];'
),
from_id, to_id, student_turns, penwidth, edge_style,
participation_type, student_turns
)
)
bipartite_dot <- paste(
c(
"graph student_session {",
" layout=fdp;",
" overlap=false;",
" splines=true;",
" outputorder=edgesfirst;",
sprintf(
paste0(
' node [style=filled, fillcolor=white, color=black, ',
'fontcolor=black, fixedsize=true, width=0.46, height=0.46, ',
'fontname="%s"];'
),
emoji_font
),
" edge [color=black];",
bipartite_student_nodes$dot_line,
bipartite_session_nodes$dot_line,
bipartite_edge_lines$dot_line,
"}"
),
collapse = "\n"
)
cat(bipartite_dot)
writeLines(
enc2utf8(bipartite_dot),
file.path(output_dir, "student_session_bipartite.dot"),
useBytes = TRUE
)
# ============================================================
# 7. ГРАФ 2: «СЛЕДУЮЩИЙ ГОВОРЯЩИЙ» С УЧИТЕЛЕМ
# ============================================================
if (session_number < 1 || session_number > nrow(sessions_tbl)) {
stop("session_number выходит за границы таблицы сессий")
}
selected_session_id <- sessions_tbl$session_id[[session_number]]
selected_session_id
selected_turns <- turns_long |>
dplyr::filter(session_id == selected_session_id) |>
dplyr::arrange(turn_no)
selected_turns |>
dplyr::select(turn_no, speaker_id, role, text) |>
head(15)
transition_nodes_with_teacher <- selected_turns |>
dplyr::distinct(speaker_id, role) |>
dplyr::arrange(role, speaker_id)
transitions_with_teacher <- selected_turns |>
dplyr::transmute(
from = speaker_id,
to = dplyr::lead(speaker_id)
) |>
dplyr::filter(!is.na(to)) |>
dplyr::count(from, to, name = "n_events") |>
dplyr::arrange(dplyr::desc(n_events), from, to)
transitions_with_teacher |> head(20)
sum(transitions_with_teacher$n_events)
nrow(selected_turns) - 1L
all_speakers_with_teacher <- transition_nodes_with_teacher$speaker_id
transition_matrix_data <- transitions_with_teacher |>
dplyr::mutate(
from = factor(from, levels = all_speakers_with_teacher),
to = factor(to, levels = all_speakers_with_teacher)
)
transition_matrix_with_teacher <- xtabs(
n_events ~ from + to,
data = transition_matrix_data,
drop.unused.levels = FALSE
)
transition_matrix_with_teacher
mutual_pairs_with_teacher <- transitions_with_teacher |>
dplyr::filter(from != to, n_events >= edge_min_events) |>
dplyr::inner_join(
transitions_with_teacher |>
dplyr::transmute(
from_reverse = to,
to_reverse = from,
n_events_reverse = n_events
),
by = c(
"from" = "from_reverse",
"to" = "to_reverse"
)
) |>
dplyr::filter(
n_events_reverse >= edge_min_events,
from < to
) |>
dplyr::rename(n_events_forward = n_events) |>
dplyr::group_by(from, to) |>
dplyr::summarise(
n_events_forward = max(n_events_forward),
n_events_reverse = max(n_events_reverse),
.groups = "drop"
) |>
dplyr::arrange(dplyr::desc(n_events_forward + n_events_reverse))
mutual_pairs_with_teacher
nrow(mutual_pairs_with_teacher)
transition_edges_with_teacher <- transitions_with_teacher |>
dplyr::filter(n_events >= edge_min_events)
if (nrow(transition_edges_with_teacher) > 0) {
transition_edges_with_teacher <- transition_edges_with_teacher |>
dplyr::mutate(
penwidth = if (max(n_events) == min(n_events)) {
(edge_width_min + edge_width_max) / 2
} else {
edge_width_min +
(n_events - min(n_events)) /
(max(n_events) - min(n_events)) *
(edge_width_max - edge_width_min)
}
)
}
visible_ids_with_teacher <- union(
transition_edges_with_teacher$from,
transition_edges_with_teacher$to
)
isolated_students_with_teacher <- transition_nodes_with_teacher |>
dplyr::filter(
role == "student",
!speaker_id %in% visible_ids_with_teacher
)
transition_edges_with_teacher |> head(20)
isolated_students_with_teacher
nrow(isolated_students_with_teacher)
transition_node_lines_with_teacher <- transition_nodes_with_teacher |>
dplyr::mutate(
dot_id = paste0("person__", speaker_id),
node_shape = dplyr::case_when(
role == "teacher" ~ "doublecircle",
TRUE ~ "circle"
),
dot_line = sprintf(
paste0(
' "%s" [shape=%s, label="👤", ',
'tooltip="%s (%s)"];'
),
dot_id, node_shape, speaker_id, role
)
)
transition_edge_lines_with_teacher <- transition_edges_with_teacher |>
dplyr::mutate(
from_id = paste0("person__", from),
to_id = paste0("person__", to),
dot_line = sprintf(
paste0(
' "%s" -> "%s" ',
'[weight="%d", penwidth="%.2f", style="solid", ',
'arrowsize="%.2f", tooltip="%d переходов"];'
),
from_id, to_id, n_events, penwidth, arrow_size, n_events
)
)
transition_dot_with_teacher <- paste(
c(
"digraph next_speaker_with_teacher {",
" layout=neato;",
" overlap=false;",
" splines=true;",
" outputorder=edgesfirst;",
sprintf(
paste0(
' node [style=filled, fillcolor=white, color=black, ',
'fontcolor=black, fixedsize=true, width=0.52, height=0.52, ',
'fontname="%s"];'
),
emoji_font
),
sprintf(
' edge [color=black, arrowsize="%.2f"];',
arrow_size
),
transition_node_lines_with_teacher$dot_line,
transition_edge_lines_with_teacher$dot_line,
"}"
),
collapse = "\n"
)
cat(transition_dot_with_teacher)
writeLines(
enc2utf8(transition_dot_with_teacher),
file.path(output_dir, "next_speaker_with_teacher.dot"),
useBytes = TRUE
)
# ============================================================
# 8. ВАРИАНТ: УЧИТЕЛЬ УДАЛЁН ДО ПОСТРОЕНИЯ ПЕРЕХОДОВ
# ============================================================
selected_turns_without_teacher <- selected_turns |>
dplyr::filter(role != "teacher") |>
dplyr::arrange(turn_no)
transition_nodes_without_teacher <- selected_turns_without_teacher |>
dplyr::distinct(speaker_id, role) |>
dplyr::arrange(role, speaker_id)
transitions_without_teacher <- selected_turns_without_teacher |>
dplyr::transmute(
from = speaker_id,
to = dplyr::lead(speaker_id)
) |>
dplyr::filter(!is.na(to)) |>
dplyr::count(from, to, name = "n_events") |>
dplyr::arrange(dplyr::desc(n_events), from, to)
transitions_without_teacher |> head(20)
sum(transitions_without_teacher$n_events)
nrow(selected_turns_without_teacher) - 1L
all_speakers_without_teacher <- transition_nodes_without_teacher$speaker_id
transition_matrix_data_without_teacher <- transitions_without_teacher |>
dplyr::mutate(
from = factor(from, levels = all_speakers_without_teacher),
to = factor(to, levels = all_speakers_without_teacher)
)
transition_matrix_without_teacher <- xtabs(
n_events ~ from + to,
data = transition_matrix_data_without_teacher,
drop.unused.levels = FALSE
)
transition_matrix_without_teacher
mutual_pairs_without_teacher <- transitions_without_teacher |>
dplyr::filter(from != to, n_events >= edge_min_events) |>
dplyr::inner_join(
transitions_without_teacher |>
dplyr::transmute(
from_reverse = to,
to_reverse = from,
n_events_reverse = n_events
),
by = c(
"from" = "from_reverse",
"to" = "to_reverse"
)
) |>
dplyr::filter(
n_events_reverse >= edge_min_events,
from < to
) |>
dplyr::rename(n_events_forward = n_events) |>
dplyr::group_by(from, to) |>
dplyr::summarise(
n_events_forward = max(n_events_forward),
n_events_reverse = max(n_events_reverse),
.groups = "drop"
) |>
dplyr::arrange(dplyr::desc(n_events_forward + n_events_reverse))
mutual_pairs_without_teacher
transition_edges_without_teacher <- transitions_without_teacher |>
dplyr::filter(n_events >= edge_min_events)
if (nrow(transition_edges_without_teacher) > 0) {
transition_edges_without_teacher <- transition_edges_without_teacher |>
dplyr::mutate(
penwidth = if (max(n_events) == min(n_events)) {
(edge_width_min + edge_width_max) / 2
} else {
edge_width_min +
(n_events - min(n_events)) /
(max(n_events) - min(n_events)) *
(edge_width_max - edge_width_min)
}
)
}
visible_ids_without_teacher <- union(
transition_edges_without_teacher$from,
transition_edges_without_teacher$to
)
isolated_students_without_teacher <- transition_nodes_without_teacher |>
dplyr::filter(
role == "student",
!speaker_id %in% visible_ids_without_teacher
)
isolated_students_without_teacher
transition_node_lines_without_teacher <- transition_nodes_without_teacher |>
dplyr::mutate(
dot_id = paste0("person__", speaker_id),
node_shape = "circle",
dot_line = sprintf(
paste0(
' "%s" [shape=%s, label="👤", ',
'tooltip="%s (%s)"];'
),
dot_id, node_shape, speaker_id, role
)
)
transition_edge_lines_without_teacher <- transition_edges_without_teacher |>
dplyr::mutate(
from_id = paste0("person__", from),
to_id = paste0("person__", to),
dot_line = sprintf(
paste0(
' "%s" -> "%s" ',
'[weight="%d", penwidth="%.2f", style="solid", ',
'arrowsize="%.2f", tooltip="%d переходов"];'
),
from_id, to_id, n_events, penwidth, arrow_size, n_events
)
)
transition_dot_without_teacher <- paste(
c(
"digraph next_speaker_without_teacher {",
" layout=neato;",
" overlap=false;",
" splines=true;",
" outputorder=edgesfirst;",
sprintf(
paste0(
' node [style=filled, fillcolor=white, color=black, ',
'fontcolor=black, fixedsize=true, width=0.52, height=0.52, ',
'fontname="%s"];'
),
emoji_font
),
sprintf(
' edge [color=black, arrowsize="%.2f"];',
arrow_size
),
transition_node_lines_without_teacher$dot_line,
transition_edge_lines_without_teacher$dot_line,
"}"
),
collapse = "\n"
)
cat(transition_dot_without_teacher)
writeLines(
enc2utf8(transition_dot_without_teacher),
file.path(output_dir, "next_speaker_without_teacher.dot"),
useBytes = TRUE
)
transition_comparison <- tibble::tibble(
variant = c("with_teacher", "without_teacher"),
n_turns = c(
nrow(selected_turns),
nrow(selected_turns_without_teacher)
),
n_raw_transitions = c(
sum(transitions_with_teacher$n_events),
sum(transitions_without_teacher$n_events)
),
n_visible_edges = c(
nrow(transition_edges_with_teacher),
nrow(transition_edges_without_teacher)
),
n_mutual_pairs = c(
nrow(mutual_pairs_with_teacher),
nrow(mutual_pairs_without_teacher)
),
n_isolated_students = c(
nrow(isolated_students_with_teacher),
nrow(isolated_students_without_teacher)
)
)
transition_comparison
# ============================================================
# НЕОБЯЗАТЕЛЬНАЯ ЛОКАЛЬНАЯ ОТРИСОВКА GRAPHVIZ
# ============================================================
if (nzchar(Sys.which("fdp"))) {
system2(
Sys.which("fdp"),
c(
"-Tsvg",
shQuote(file.path(output_dir, "student_session_bipartite.dot")),
"-o",
shQuote(file.path(output_dir, "student_session_bipartite.svg"))
)
)
} else {
message("Команда fdp не найдена: DOT всё равно создан.")
}
if (nzchar(Sys.which("neato"))) {
system2(
Sys.which("neato"),
c(
"-Tsvg",
shQuote(file.path(output_dir, "next_speaker_with_teacher.dot")),
"-o",
shQuote(file.path(output_dir, "next_speaker_with_teacher.svg"))
)
)
system2(
Sys.which("neato"),
c(
"-Tsvg",
shQuote(file.path(output_dir, "next_speaker_without_teacher.dot")),
"-o",
shQuote(file.path(output_dir, "next_speaker_without_teacher.svg"))
)
)
} else {
message("Команда neato не найдена: DOT всё равно создан.")
}
<syntaxhighlight lang="text">
<graphviz>
digraph example {
A -> B;
}
</graphviz>
Если вместо 👤 или 📄 отображается пустой квадрат, это проблема шрифта Graphviz, а не данных. Измените только параметр emoji_font в начале скрипта на шрифт с поддержкой этих символов, доступный на вашей системе, и повторите блоки экспорта.
Как читать два графа
Двудольный граф отвечает на вопрос, какие ученики присутствуют в каких сессиях и насколько интенсивно. Он не показывает порядок реплик. Толстое ребро означает больше реплик ученика в сессии; сплошное ребро — прохождение относительного порога ядра; пунктир — эпизодическое участие.
Граф следующего говорящего отвечает на вопрос, какие идентификаторы часто оказываются соседями в последовательности реплик. Направление важно: A → B и B → A считаются разными переходами. Взаимная пара проходит порог в обоих направлениях, но даже она не доказывает прямой диалог без анализа текста, контекста задания, видео или разметки адресата.
Вариант с учителем сохраняет наблюдаемую хронологию и показывает учительские вмешательства как отдельный тип узла. Вариант без учителя отвечает на другой вопрос: как выглядит последовательность оставшихся говорящих после удаления учительских реплик. Новые связи в нём являются результатом сжатия последовательности и не должны автоматически трактоваться как прямые ответы учеников друг другу.
Упражнения
- Измените
core_shareс 0.05 на 0.10, повторите блоки 5–6 и сравните число сплошных и пунктирных рёбер. Объясните, почему веса рёбер не изменились, а тип некоторых рёбер изменился. - Установите другое значение
session_number, повторите блоки 7–9 и найдите сессию с наибольшим числом видимых переходов при том жеedge_min_events. - Для одной сессии сравните матрицы и социограммы с учителем и без учителя. Найдите хотя бы одну ученическую пару, связь которой появилась или усилилась после удаления учителя, и проверьте исходные номера реплик.
- Обобщите расчёт взаимных пар на все сессии: внутри каждой сессии упорядочьте реплики, постройте соседние пары, агрегируйте направления и посчитайте число взаимных пар при том же пороге. Не смешивайте одинаковые
speaker_idиз разных сессий до этапа группировки поsession_id.
