Анализ PeerMathDial

От открытых диалогов PeerMathDial к социограммам в R

В этом уроке мы пройдём полный воспроизводимый путь: прочитаем открытый JSON Lines непосредственно из GitHub, исследуем вложенную структуру, превратим сессии в таблицу реплик, проведём аудит и построим две социограммы. Первая социограмма — двудольный граф «ученик — сессия», вторая — ориентированный граф «следующий говорящий» для выбранной сессии.

Исходные данные

PeerMathDial и

https://raw.githubusercontent.com/Ziyu-Yao-NLP-Lab/PeerMathDial/refs/heads/main/data/conversations.jsonl

аждая строка файла — отдельный JSON-объект сессии; внутри сессии находится список реплик turns. В публичном описании корпуса указаны 55 диалогов и 6406 реплик.

Методологическое ограничение. В корпусе нет надёжно размеченного адресата каждой реплики. Поэтому связь A → B означает только то, что реплика B непосредственно следует за репликой A. Это самый простой и наименее надёжный способ восстановить адресата: B мог отвечать не A, обращаться ко всей группе, продолжать собственную мысль или реагировать на невербальное действие. Такой граф описывает последовательность смены говорящих, а не доказанную коммуникацию «кто к кому обратился».

Результат урока

После выполнения скрипта будут получены:

• длинная таблица 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].

Если все видимые рёбра имеют одинаковый вес, им назначается середина диапазона.

# ============================================================
# 0. ПАРАМЕТРЫ: все настраиваемые величины находятся здесь
# ============================================================

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)

1. Пакеты

Проверяем четыре общеупотребительных пакета и устанавливаем только отсутствующие. igraph и DiagrammeR здесь не нужны: все строки DOT будут собраны открытым кодом через sprintf() и paste().

# ============================================================
# 1. ПРОВЕРКА И ПОДКЛЮЧЕНИЕ ПАКЕТОВ
# ============================================================

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))

Проверьте глазами: missing_packages должен быть пустым после установки. Команда sessionInfo() покажет версии R и подключённых пакетов.

sessionInfo()

2. Загрузка и осмотр JSONL

JSON Lines — это текст, в котором каждая строка содержит самостоятельный JSON-объект. Мы читаем строки прямо по URL, а затем разбираем каждую строку отдельно. Параметр simplifyVector = FALSE сохраняет вложенные объекты как списки: это удобно для первого знакомства со структурой, потому что R не пытается преждевременно превратить всё в плоскую таблицу.

# ============================================================
# 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)

Теперь не угадываем схему, а спрашиваем её у первого объекта. Сначала смотрим поля сессии, затем поля первой реплики и только после этого обращаемся к speaker_id и role.

# Поля верхнего уровня первой сессии
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

Проверьте глазами: у сессии должны быть, среди прочего, поля session_id, speakers и turns. У реплики должны быть turn_id, speaker_id, role, text, word_count и вложенное action. В текущей версии данных роли имеют значения student, teacher и unknown. Не перекодируйте unknown в ученика: это было бы новым предположением, которого нет в данных.

3. Одна строка — одна реплика

Создаём таблицу с одной строкой на сессию и двумя list-column: исходным объектом сессии и списком реплик. Затем unnest_longer() разворачивает список реплик вниз, а unnest_wider() раскрывает поля каждой реплики вправо.

# ============================================================
# 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)

Проверьте глазами: nrow(sessions_tbl) равно числу строк исходного JSONL. Столбец turns пока остаётся списком.

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)

Проверьте глазами: одна строка теперь соответствует одной реплике. turn_no берётся из самого JSON, а turn_index — позиция элемента в списке; следующая проверка должна вернуть ноль несовпадений.

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. Аудит корпуса

Аудит отвечает на четыре вопроса: сколько сессий и реплик, сколько уникальных идентификаторов учеников, есть ли сессии без реплик с ролью student, и какова доля реплик учителя в каждой сессии. Здесь «число учеников» означает число уникальных speaker_id с ролью student именно в conversations.jsonl; оно не обязано совпадать с числом анкетированных или фокусных учеников в других файлах корпуса.

# ============================================================
# 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

Проверьте глазами: для текущей публикации первые два значения должны быть 55 сессий и 6406 реплик. Третье значение — уникальные говорящие с явно указанной ролью student в этом файле.

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)

Проверьте глазами: teacher_share находится между 0 и 1. Сессии в sessions_without_students не удаляются автоматически: они важны для аудита, хотя в двудольном графе у них не будет рёбер к ученикам.

Проверим также, не связан ли один и тот же идентификатор с несколькими ролями. Пустой результат означает, что роли идентификаторов согласованы внутри файла.

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. Граница группы

Для каждого сочетания «ученик — сессия» считаем реплики ученика и делим их на все реплики сессии, включая реплики учителя и неопознанных говорящих. Ученик относится к ядру, если его доля не меньше core_share; иначе участие считается эпизодическим. Выбор знаменателя — содержательное решение: если делить только на ученические реплики, границы ядра изменятся.

# ============================================================
# 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)

Проверьте глазами: для каждой строки student_turns <= session_turns. Изменение единственного параметра core_share при повторном запуске этого и следующих блоков должно менять тип части рёбер, но не исходные числа реплик.

6. Граф 1: ученик — сессия

Строим неориентированный двудольный граф. Ребро означает участие ученика в сессии, его вес равен числу реплик ученика. Ребро попадает на рисунок, только если его вес не меньше общего порога edge_min_events. Ядро показывается сплошной линией, эпизодическое участие — пунктиром.

Все ученики и все сессии сохраняются как узлы, даже если после применения порога у них не осталось рёбер. Поэтому аудит-сессии без учеников и пороговые изоляты не исчезают молча.

# ============================================================
# 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
)

Проверьте глазами: файл начинается с graph, а рёбра записаны оператором --. В строках узлов нет имён в label: ученик обозначен 👤 и кругом, сессия — 📄 и квадратом. Толщина каждого ребра лежит в заданном диапазоне.

7. Граф 2: следующий говорящий

Выбираем сессию по её порядку в исходном JSONL, а не по случайной сортировке идентификаторов. Сначала создаём все переходы между соседними репликами и лишь затем агрегируем одинаковые пары. Самопереходы A → A сохраняются: они означают две соседние реплики одного говорящего и не должны исчезать из последовательности без явного решения исследователя.

# ============================================================
# 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)

Проверьте глазами: turn_no возрастает, а selected_session_id соответствует выбранному session_number.

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

Проверьте глазами: сумма n_events должна быть ровно на единицу меньше числа реплик выбранной сессии. Это контроль того, что каждая соседняя пара учтена один раз.

Матрица переходов

Матрица переходов хранит исходные частоты до пороговой фильтрации: строки — предыдущий говорящий, столбцы — следующий. Факторы с общим набором уровней заставляют R оставить квадратную матрицу и показать нулевые ячейки.

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

Проверьте глазами: сумма всех ячеек матрицы совпадает с nrow(selected_turns) - 1. Диагональ содержит самопереходы.

Взаимные пары

Взаимной считаем неориентированную пару A–B, для которой есть не менее edge_min_events переходов A → B и не менее того же порога B → A. Условие from < to оставляет каждую пару один раз и исключает самопереходы.

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)

Рёбра и изолированные ученики

Видимые рёбра фильтруются тем же edge_min_events, что и двудольный граф. Изолированный ученик — это ученик выбранной сессии, который после применения порога не входит ни в одно видимое ребро. Это пороговая изоляция, а не доказательство отсутствия речи: участник мог иметь редкие переходы, скрытые порогом.

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)

Ручная сборка DOT

Учитель получает shape=doublecircle, ученик — shape=circle; оба обозначены 👤. В данных встречается также роль unknown: такой говорящий остаётся в последовательности как человек с кругом, но его точная роль указана во всплывающей подсказке. Это сохраняет наблюдаемую последовательность, не выдавая неопознанного говорящего за ученика.

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
)

Проверьте глазами: файл начинается с digraph, а рёбра используют ->. Все видимые переходы показаны сплошными линиями; число событий скрыто в tooltip, а не написано поверх социограммы.

8. Вариант без учителя

Важно удалить реплики учителя до вычисления lead(). Тогда две ученические реплики, между которыми раньше стояла реплика учителя, становятся соседними и создают новый прямой переход. Это не то же самое, что удалить учительский узел и его рёбра из уже готового графа.

# ============================================================
# 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

Проверьте глазами: сумма переходов снова на единицу меньше числа оставшихся реплик. Роль unknown не удаляется: этот вариант отвечает именно на вопрос об исключении учителя.

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
)

Проверьте глазами: в этом DOT нет узлов с shape=doublecircle. Идентификаторы по-прежнему находятся только в подсказках.

Сравнение вариантов

Сравним не только рисунки, но и таблицы. После удаления учителя уменьшается число реплик и исчезают переходы с учительскими узлами, однако могут появиться или усилиться связи между оставшимися говорящими, которые раньше были разделены вмешательством учителя.

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

Проверьте глазами: не ожидайте, что вариант без учителя получится простым вычитанием учительских рёбер. Последовательность была сжата, поэтому набор соседних пар пересчитан.

9. Graphviz и MediaWiki

Скрипт уже записал три файла DOT. Если системный Graphviz установлен локально, следующие команды создадут SVG. Для двудольного графа используется движок fdp, для ориентированных графов — neato.

# ============================================================
# 9. НЕОБЯЗАТЕЛЬНАЯ ЛОКАЛЬНАЯ ОТРИСОВКА 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 всё равно создан.")
}

Проверьте глазами: file.exists() должен подтвердить наличие DOT-файлов; SVG появятся только при наличии системных команд Graphviz.

file.exists(file.path(output_dir, "student_session_bipartite.dot"))
file.exists(file.path(output_dir, "next_speaker_with_teacher.dot"))
file.exists(file.path(output_dir, "next_speaker_without_teacher.dot"))

На Поле цифровой дидактики DOT можно вставить между тегами <graphviz> и </graphviz>. Следующий код готовит три текстовых файла, содержимое которых можно целиком скопировать в режим редактирования вики-страницы.

# Файлы, готовые для вставки в MediaWiki с расширением Graphviz
writeLines(
  enc2utf8(c("<graphviz>", bipartite_dot, "</graphviz>")),
  file.path(output_dir, "student_session_bipartite.wiki.txt"),
  useBytes = TRUE
)

writeLines(
  enc2utf8(c(
    "<graphviz>",
    transition_dot_with_teacher,
    "</graphviz>"
  )),
  file.path(output_dir, "next_speaker_with_teacher.wiki.txt"),
  useBytes = TRUE
)

writeLines(
  enc2utf8(c(
    "<graphviz>",
    transition_dot_without_teacher,
    "</graphviz>"
  )),
  file.path(output_dir, "next_speaker_without_teacher.wiki.txt"),
  useBytes = TRUE
)

Минимальная схема вставки выглядит так:

<graphviz>
digraph example {
  A -> B;
}
</graphviz>

Если вместо 👤 или 📄 отображается пустой квадрат, это проблема шрифта Graphviz, а не данных. Измените только параметр emoji_font в начале скрипта на шрифт с поддержкой этих символов, доступный на вашей системе, и повторите блоки экспорта.

10. Как читать два графа

Двудольный граф отвечает на вопрос, какие ученики присутствуют в каких сессиях и насколько интенсивно. Он не показывает порядок реплик. Толстое ребро означает больше реплик ученика в сессии; сплошное ребро — прохождение относительного порога ядра; пунктир — эпизодическое участие.

Граф следующего говорящего отвечает на вопрос, какие идентификаторы часто оказываются соседями в последовательности реплик. Направление важно: A → B и B → A считаются разными переходами. Взаимная пара проходит порог в обоих направлениях, но даже она не доказывает прямой диалог без анализа текста, контекста задания, видео или разметки адресата.

Вариант с учителем сохраняет наблюдаемую хронологию и показывает учительские вмешательства как отдельный тип узла. Вариант без учителя отвечает на другой вопрос: как выглядит последовательность оставшихся говорящих после удаления учительских реплик. Новые связи в нём являются результатом сжатия последовательности и не должны автоматически трактоваться как прямые ответы учеников друг другу.

11. Упражнения

1. Измените core_share с 0.05 на 0.10, повторите блоки 5–6 и сравните число сплошных и пунктирных рёбер. Объясните, почему веса рёбер не изменились, а тип некоторых рёбер изменился.
2. Установите другое значение session_number, повторите блоки 7–9 и найдите сессию с наибольшим числом видимых переходов при том же edge_min_events.
3. Для одной сессии сравните матрицы и социограммы с учителем и без учителя. Найдите хотя бы одну ученическую пару, связь которой появилась или усилилась после удаления учителя, и проверьте исходные номера реплик.
4. Обобщите расчёт взаимных пар на все сессии: внутри каждой сессии упорядочьте реплики, постройте соседние пары, агрегируйте направления и посчитайте число взаимных пар при том же пороге. Не смешивайте одинаковые speaker_id из разных сессий до этапа группировки по session_id.

Источники данных и инструментов

• PeerMathDial: репозиторий и документация схемы
• Описание корпуса PeerMathDial
• Graphviz

---