{ "cells": [ { "cell_type": "markdown", "metadata": {}, "source": [ "---\n", "title: \"Datcha\"\n", "subtitle: \"A Tool to Track Data Changes and Measure (In)Consistency in Mobile Platform Data\"\n", "author:\n", " - name: \"Kunjan Shah\"\n", " - name: \"Yannik Peters\"\n", "image: images/tool_icon.png\n", "image-alt: Datcha\n", "format:\n", " html:\n", " embed-resources: true\n", " markdown:\n", " prefer-html: true\n", " template: markdown-template.md\n", "resources: topic_models_datafiles\n", "bibliography: reference.bib\n", "biblio-style: apa\n", "prefer-html: true\n", "---\n", "\n", "# **At a glance**\n", "\n", "In this tutorial you will learn:\n", "\n", "1. **Local application of Datcha shiny app:** The tutorial demonstrates how to run Datcha's underlying code locally, allowing users to apply the tool to their own datasets without relying on the hosted [**Datcha app**](https://shiny.gesis.org/datcha/) version. This ensures that sensitive or proprietary data can be analyzed in a local environment, while also providing full access to the underlying code for transparency and reproducibility.\n", "2. **Detecting temporal change in longitudinal social media data:** The tutorial provides a practical guide on how two online platform dataset snapshots, collected at different points in time, can be systematically compared to identify three core types of change: deleted posts, newly added posts, and text-level edits. Matching is performed through unique post identifiers, making the procedure transparent and reproducible.\n", "2. **Assessing data quality and stability before analysis:** By quantifying how much content was removed, added, or modified between collection points, the tutorial shows how researchers can evaluate the consistency of their data and judge whether a dataset is stable enough for the intended analysis.\n", "3. **Characterizing the nature of changed content:** Word frequency comparisons, sentiment analysis, keyness analysis, and topic modeling are applied to removed, added, and remaining posts. These methods help to determine whether changes are random or systematic, for example, whether deleted posts differ in tone or topic from the content that persists.\n", "4. **Quantifying the magnitude of textual edits:** For posts that were modified between the two collection points, edit distance and normalized edit distance are computed, and character-level diff views are generated. This makes it possible to distinguish minor corrections (e.g., hashtag adjustments) from substantive content revisions.\n", "\n", "# 1. Introduction {#introduction}\n", "\n", "Social media platforms are inherently dynamic and ephemeral environments in which content is continuously created, modified, and removed [@weller2026can]. When researchers collect datasets from such platforms at different points in time, the resulting snapshots are rarely identical, i.e., posts may be deleted [@khan2025characterization; @buehling2024message] by users or platform moderation systems, new content may emerge, and existing posts may undergo textual revision. These temporal discrepancies, if left unexamined, can introduce systematic bias into longitudinal analyses and compromise the reproducibility of findings.\n", "\n", "Datcha (**Dat**a **cha**nge) addresses this methodological gap by providing a\n", "structured, reproducible framework for detecting and quantifying three core types of\n", "between-collection changes: **deletions**, **additions**, and **text-level edits**. By\n", "aligning two temporally distinct dataset snapshots through unique post identifiers, the tool\n", "enables researchers to assess data consistency, estimate content volatility, and make informed\n", "decisions about dataset suitability prior to analysis. This tutorial is based on a full interactive RShiny App [@peters2026datcha]. However, as the [**Datcha app**](https://shiny.gesis.org/datcha/) has limitations regarding data size, we offer this tutorial for the KODAQS Toolbox [@peters2026kodaqs] using Datcha's original code so that users can apply it locally to their own use cases.\n", "This tutorial replicates the core analytical features of the Datcha app outside of its interactive interface, offering a fully scriptable and reproducible alternative for researchers who prefer direct programmatic control over their analysis pipeline.\n", "This tool is designed with GDPR compliance in mind, assumes that input data are anonymized/pseudonymized, and is based on data minimization principles. It is particularly relevant for studies in computational social science, platform studies, and NLP-driven content analysis.\n", "\n", "# 2. Set-up\n", "\n", "Prior to executing the analysis, the environment must be configured with the necessary dependencies. This section outlines the required libraries and the procedure for loading the two temporally distinct datasets that form the basis of the comparison.\n", "\n", "### 2.1 Library Imports\n", "\n", "The following libraries support the core analytical pipeline, covering data manipulation, text preprocessing, statistical analysis, and visualization. Dependencies should be installed prior to execution if not already available in the working environment.\n", "\n", "```{r setup, message=FALSE, warning=FALSE}\n", "library(dplyr) # Data manipulation\n", "library(tm) # Text mining\n", "library(topicmodels) # Topic modeling\n", "library(sentimentr) # Sentiment analysis\n", "library(highcharter) # Interactive charts\n", "library(tidytext) # Text processing\n", "library(reshape2) # Data reshaping\n", "library(ggplot2) # Visualization\n", "library(DT) # Interactive tables\n", "library(stringdist) # String distance calculation\n", "library(shinyBS) # For tooltips\n", "library(quanteda) # Quantitative text analysis\n", "library(quanteda.textstats) # Text statistics\n", "library(KeynessMeasures) # Keyness analysis\n", "library(SnowballC) # For stemming\n", "library(textstem) # For lemmatization\n", "library(LDAvis) # LDA visualization\n", "library(diffobj) # For visual text diffs\n", "library(htmltools) # HTML tools for Shiny\n", "library(bslib) # Bootstrap library for Shiny\n", "library(readr) # Reading data (e.g., read_csv() to import CSV files)\n", "library(stringi) # String operations (e.g., stri_count() to count words per post)\n", "```\n", "\n", "```{r ojs, message=FALSE, warning=FALSE}\n", "#| echo: false\n", "\n", "# Emit static OJS definitions into the Markdown/HTML output.\n", "# Quarto injects its static OJS data definitions only for HTML output,\n", "# not for Markdown output (even with prefer-html: true). We therefore\n", "# emit the required \\n', sep = \"\")\n", "}\n", "```\n", "\n", "### 2.2 Load Your Two Datasets\n", "\n", "For this tutorial, we use two synthetic datasets generated by a large language model. Because of legal and ethical constraints, we cannot publish real data from online platforms. If you run this code on your own data, make sure the datasets are fully anonymized and comply with applicable data protection laws. Both datasets should be provided as CSV files, accessible via a URL or a local file path.\n", "```{r message=FALSE, warning=FALSE}\n", "data1 <- read_csv(\"https://raw.githubusercontent.com/kunjanshah0811/Datcha_quarto/refs/heads/main/Data1.csv\",\n", " locale = locale(encoding = \"UTF-8\"), show_col_types = FALSE)\n", "\n", "data2 <- read_csv(\"https://raw.githubusercontent.com/kunjanshah0811/Datcha_quarto/refs/heads/main/Data2.csv\",\n", " locale = locale(encoding = \"UTF-8\"), show_col_types = FALSE)\n", "\n", "```\n", "\n", "```{r results= 'asis', message=FALSE, warning=FALSE}\n", "cat(\n", " paste(\n", " \"Dataset 1 columns:\", paste(names(data1), collapse=\", \"),\n", " \"\\n\",\n", " \"\\nDataset 2 columns:\", paste(names(data2), collapse=\", \")\n", " )\n", ")\n", "```\n", "\n", "### 2.3 Enter ID Column and Dates\n", "\n", "Each dataset must share a common unique identifier column to enable record-level matching across collection points. Users are required to manually specify the ID column name for each dataset, as no auto-detection is performed to avoid erroneous assignments.\n", "\n", "**ID Column Specification:**
The identifier column name is defined separately for each dataset. A validation check confirms the specified column exists before proceeding. If not found, execution halts with an informative error. Here, the ID column is called \"col_id\".\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# User must manually specify the ID column names (no auto-detection)\n", "\n", "id_col_1 <- \"col_id\" # actual ID column name in Dataset 1\n", "id_col_2 <- \"col_id\" # actual ID column name in Dataset 2\n", "\n", "# Safety check\n", "if (!id_col_1 %in% names(data1)) stop(\"id_col_1 '\", id_col_1, \"' not found in Dataset 1\")\n", "if (!id_col_2 %in% names(data2)) stop(\"id_col_2 '\", id_col_2, \"' not found in Dataset 2\")\n", "\n", "cat(\n", " \"Using ID column for Dataset 1:\", id_col_1,\n", " \"\\n\",\n", " \"Using ID column for Dataset 2:\", id_col_2\n", ")\n", "```\n", "\n", "**Collection Dates:**
The collection date for each dataset is set manually. A chronological validation ensures that Dataset 1 precedes Dataset 2 in time. This is a necessary condition for meaningful temporal comparison. The confirmed date range and interval in days are printed upon successful validation. In this example case, we choose a one-month interval between the two datasets, but users can adjust the dates to match their own data collection schedule.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Set your dates here\n", "date_1 <- as.Date(\"2025-11-15\") # Dataset 1 collection date\n", "date_2 <- as.Date(\"2025-12-15\") # Dataset 2 collection date\n", "\n", "# Validate order\n", "if (date_1 >= date_2) {\n", " stop(\"ERROR: date_1 must be earlier than date_2\")\n", "}\n", "\n", "cat(\"Date range validated:\", date_1, \"→\", date_2, \"(\", as.numeric(date_2 - date_1), \"days )\\n\")\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "\n", "# Identify changes between Dataset 1 (earlier) and Dataset 2 (later)\n", "removed_posts <- data1 %>% filter(!(.data[[id_col_1]] %in% data2[[id_col_2]]))\n", "added_posts <- data2 %>% filter(!(.data[[id_col_2]] %in% data1[[id_col_1]]))\n", "matched_ids <- intersect(data1[[id_col_1]], data2[[id_col_2]])\n", "\n", "# For matched posts, check if content changed (assuming a 'text' column; adjust if different)\n", "text_col <- \"text\" # CHANGE THIS if your text column has a different name\n", "matched1 <- data1 %>% filter(.data[[id_col_1]] %in% matched_ids)\n", "matched2 <- data2 %>% filter(.data[[id_col_2]] %in% matched_ids)\n", "edited_posts <- matched1 %>%\n", " inner_join(matched2, by = setNames(id_col_2, id_col_1), suffix = c(\".old\", \".new\")) %>%\n", " filter(.data[[paste0(text_col, \".old\")]] != .data[[paste0(text_col, \".new\")]])\n", "\n", "# SINGLE OUTPUT BLOCK\n", "output_text <- paste0(\n", " \"Final configuration:\\n\",\n", " \"Dataset 1: \", nrow(data1),\n", " \" rows | ID column: \", id_col_1,\n", " \" | Date: \", format(date_1, \"%Y-%m-%d\"), \"\\n\",\n", "\n", " \"Dataset 2: \", nrow(data2),\n", " \" rows | ID column: \", id_col_2,\n", " \" | Date: \", format(date_2, \"%Y-%m-%d\"), \"\\n\\n\",\n", "\n", " \"Analysis ready!\\n\",\n", " \"Number of Deleted Posts : \", nrow(removed_posts), \"\\n\",\n", " \"Number of Added Posts : \", nrow(added_posts), \"\\n\",\n", " \"Number of Edited Posts : \", nrow(edited_posts),\n", " \" out of \", length(matched_ids), \" matched posts\"\n", ")\n", "\n", "cat(output_text)\n", "```\n", "\n", "### 2.4 Text Processing Module\n", "\n", "A reusable text processing module is initialised prior to analysis, providing two core functions used consistently across all subsequent sections.\n", "\n", "Text Cleaning:
Raw text is normalised through a standard preprocessing pipeline: lowercasing, removal of numbers, punctuation, and stopwords, followed by whitespace stripping. Lemmatization is applied by default to reduce words to their base forms; stemming is available as an alternative but disabled unless explicitly specified.\n", "\n", "Word Frequency:
Cleaned text is transformed into a document-term matrix from which term frequencies are extracted and ranked in descending order, forming the basis for all subsequent lexical analyses.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# TEXT PROCESSING MODULE\n", "text_processor <- list(\n", " clean = function(text, use_stem = FALSE, use_lemma = TRUE) {\n", " # Use VCorpus + plain functions to avoid SimpleCorpus warnings\n", " corpus <- VCorpus(VectorSource(text))\n", "\n", " corpus <- tm_map(corpus, content_transformer(tolower))\n", " corpus <- tm_map(corpus, removeNumbers)\n", " corpus <- tm_map(corpus, removePunctuation)\n", " corpus <- tm_map(corpus, removeWords, stopwords(\"en\"))\n", " corpus <- tm_map(corpus, stripWhitespace)\n", "\n", " if (use_stem) corpus <- tm_map(corpus, stemDocument)\n", "\n", " if (use_lemma) {\n", " txt <- sapply(corpus, as.character)\n", " txt <- textstem::lemmatize_strings(txt)\n", " return(txt)\n", " }\n", "\n", " sapply(corpus, as.character)\n", " },\n", "\n", " # Fixed get_freq – no gram_type argument needed for unigrams\n", " get_freq = function(text) {\n", " corpus <- VCorpus(VectorSource(text))\n", " dtm <- DocumentTermMatrix(corpus)\n", " freq <- slam::col_sums(dtm) # faster & safer than colSums(as.matrix())\n", " df <- data.frame(word = names(freq), freq = freq, stringsAsFactors = FALSE) %>%\n", " arrange(desc(freq))\n", " df\n", " }\n", ")\n", "```\n", "# 3. Application and analysis\n", "\n", "### 3.1 Data Deletion\n", "\n", "This section identifies posts present in Dataset 1 that are absent from Dataset 2, treating their disappearance as deletions occurring within the observed time window. Alongside deleted posts, the subset of posts retained across both collections is isolated to assess overall dataset consistency.\n", "\n", "Several quality indicators are derived from this comparison: the proportion of retained content, the share of data loss, and where a valid date range is provided; the average number of posts removed per day and the corresponding daily removal rate relative to the original dataset size. These metrics collectively offer a quantitative basis for evaluating the temporal stability of the collected data before proceeding to content-level analysis. In our artificial example, the consistency is 66.7%. The data loss is 33.3% with a daily removal of 3.3 posts per day and a daily removal rate of 1.11% of total posts per day within one month.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Define removed and remaining posts correctly\n", "removed_posts <- data1 %>% filter(!(.data[[id_col_1]] %in% data2[[id_col_2]]))\n", "remaining_posts <- data2 %>% filter(.data[[id_col_2]] %in% intersect(data1[[id_col_1]], data2[[id_col_2]]))\n", "\n", "# Quality indicators\n", "days <- as.numeric(difftime(date_2, date_1, units = \"days\"))\n", "\n", "total <- nrow(data1)\n", "removed_n <- nrow(removed_posts)\n", "remaining_n <- nrow(remaining_posts)\n", "\n", "# Prepare output\n", "if (days <= 0) {\n", "\n", " output_text <- paste0(\n", " \"Deletion Statistics\\n\",\n", " \"Consistency : \", round(remaining_n / total * 100, 1), \"%\\n\",\n", " \"Data Loss : \", round(removed_n / total * 100, 1), \"%\\n\",\n", " \"Daily Removed Posts : N/A (invalid date range)\\n\",\n", " \"Daily Removal Rate : N/A (invalid date range)\"\n", " )\n", "\n", "} else {\n", "\n", " daily_rate <- round(removed_n / days / total * 100, 2)\n", "\n", " output_text <- paste0(\n", " \"Deletion Statistics\\n\",\n", " \"Consistency : \", round(remaining_n / total * 100, 1), \"%\\n\",\n", " \"Data Loss : \", round(removed_n / total * 100, 1), \"%\\n\",\n", " \"Daily Removed Posts : \", round(removed_n / days, 1), \" posts/day\\n\",\n", " \"Daily Removal Rate : \", daily_rate,\n", " \"% of total posts/day (over \", days, \" days)\"\n", " )\n", "}\n", "\n", "cat(output_text)\n", "```\n", "\n", "#### 3.1.1 Word Frequency\n", "\n", "The most frequently occurring terms are extracted separately from removed and remaining posts, providing an initial lexical overview of what characterises each subset.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Top words in Removed posts\n", "cleaned_removed <- text_processor$clean(removed_posts$text, use_stem = FALSE, use_lemma = TRUE)\n", "\n", "word_freq_removed <- text_processor$get_freq(cleaned_removed) %>%\n", " filter(freq > 1) %>%\n", " slice_head(n = 100)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"bar\") %>%\n", " hc_title(text = \"Removed Posts\") %>%\n", " hc_tooltip(crosshairs = TRUE, shared = FALSE, useHTML = TRUE,\n", " formatter = JS(\"function() {\n", " return '
' +\n", " this.point.category + ': ' + this.point.y + '';\n", " }\")) %>%\n", " hc_xAxis(categories = word_freq_removed$word,\n", " labels = list(style = list(fontSize = '11px')),\n", " max = 20, scrollbar = list(enabled = TRUE)) %>%\n", " hc_add_series(name = \"Word\", data = word_freq_removed$freq, type = \"column\",\n", " color = \"#4CAF50\", showInLegend = FALSE) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "In the removed posts, the most frequently occurring term is *just* (34 times), followed\n", "by *new* (18) and *find* (9). Other recurring terms include *change*, *get*, *know*,\n", "*life*, *month*, *nature*, and *sleep* (each appearing 6-7 times). The lexical profile\n", "suggests that removed content was largely centred around everyday personal experiences\n", "and routine observations.\n", "```{r message=FALSE, warning=FALSE}\n", "# Top words in Remaining posts\n", "cleaned_remaining <- text_processor$clean(remaining_posts$text, use_stem = FALSE, use_lemma = TRUE)\n", "\n", "word_freq_remaining <- text_processor$get_freq(cleaned_remaining) %>%\n", " filter(freq > 1) %>%\n", " slice_head(n = 100)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"bar\") %>%\n", " hc_title(text = \"Remaining Posts\") %>%\n", " hc_tooltip(crosshairs = TRUE, shared = FALSE, useHTML = TRUE,\n", " formatter = JS(\"function() {\n", " return '
' +\n", " this.point.category + ': ' + this.point.y + '';\n", " }\")) %>%\n", " hc_xAxis(categories = word_freq_remaining$word,\n", " labels = list(style = list(fontSize = '11px')),\n", " max = 20, scrollbar = list(enabled = TRUE)) %>%\n", " hc_add_series(name = \"Word\", data = word_freq_remaining$freq, type = \"column\",\n", " color = \"#2196F3\", showInLegend = FALSE) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "In the remaining posts, *just* also dominates (60 times), followed by *get* and *new*\n", "(22 each), *time* (18), and *day* (17). The higher raw frequencies in remaining posts\n", "are expected given the larger subset size. Shared high-frequency terms across both\n", "groups indicate no substantial differences and broad topical overlap. At the same time,\n", "differences in lower-ranked terms may reflect content-specific variation worth\n", "exploring further. One option is to conduct a keyness analysis, which statistically identifies terms that are over- or under-represented in removed posts relative to remaining posts.\n", "\n", "#### 3.1.2 Keyness Analysis\n", "\n", "Keyness analysis identifies terms that are statistically over- or under-represented in removed posts relative to remaining posts, using log-likelihood as the significance threshold and effect size (ELL) as the primary measure of practical importance.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Keyness analyzer using KeynessMeasures package\n", "keyness_analyzer <- list(\n", " prepare_data = function(removed_posts, remaining_posts) {\n", " combined_df <- data.frame(\n", " text = c(text_processor$clean(removed_posts$text, use_lemma = TRUE),\n", " text_processor$clean(remaining_posts$text, use_lemma = TRUE)),\n", " group = c(rep(\"removed\", nrow(removed_posts)),\n", " rep(\"remaining\", nrow(remaining_posts)))\n", " )\n", "\n", " frequency_table_creator(\n", " df = combined_df,\n", " text_field = \"text\",\n", " grouping_variable = \"group\",\n", " grouping_variable_target = \"removed\",\n", " remove_punct = TRUE,\n", " remove_symbols = TRUE,\n", " remove_numbers = TRUE,\n", " lemmatize = TRUE\n", " )\n", " },\n", "\n", " calculate_keyness = function(frequency_table) {\n", " keyness_measure_calculator(\n", " frequency_table,\n", " log_likelihood = TRUE,\n", " ell = TRUE,\n", " bic = TRUE,\n", " perc_diff = TRUE,\n", " relative_risk = TRUE,\n", " log_ratio = TRUE,\n", " odds_ratio = TRUE,\n", " sort = \"decreasing\",\n", " sort_by = \"ell\"\n", " )\n", " }\n", ")\n", "\n", "# Compute keyness results\n", "freq_table <- keyness_analyzer$prepare_data(removed_posts, remaining_posts)\n", "keyness_measures <- keyness_analyzer$calculate_keyness(freq_table)\n", "\n", "# Filter functions\n", "filter_terms <- function(use_type, n = 5) {\n", " keyness_measures %>%\n", " filter(word_use == use_type,\n", " log_likelihood > 3.84) %>%\n", " arrange(desc(log_likelihood)) %>%\n", " slice_head(n = n)\n", "}\n", "\n", "keyness_results <- list(\n", " overuse = filter_terms(\"overuse\", n = 5),\n", " underuse = filter_terms(\"underuse\", n = 5),\n", " all = keyness_measures %>%\n", " filter(log_likelihood > 3.84) %>%\n", " arrange(desc(ell))\n", ")\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Highcharter plot with ELL as main metric\n", "keyness_data <- bind_rows(\n", " keyness_results$overuse %>%\n", " mutate(color = \"#4CAF50\", y = ell),\n", " keyness_results$underuse %>%\n", " mutate(color = \"#2196F3\", y = -ell) # Negative for visualization\n", ") %>%\n", " arrange(desc(abs(y)))\n", "\n", "highchart() %>%\n", " hc_chart(type = \"bar\", height = 500, marginLeft = 100, marginBottom = 100) %>%\n", " hc_title(text = \"Keyness Analysis: Effect Size Comparison\") %>%\n", " hc_subtitle(text = paste0(\"Comparing \", nrow(removed_posts), \" removed posts to \",\n", " nrow(remaining_posts), \" remaining posts\")) %>%\n", " hc_xAxis(categories = keyness_data$word,\n", " labels = list(style = list(fontSize = \"11px\"), rotation = 0)) %>%\n", " hc_yAxis(title = list(text = \"Effect Size (ELL) [0-1]\"),\n", " labels = list(format = \"{value:.6f}\"),\n", " plotLines = list(list(value = 0, color = \"#666\", width = 1, zIndex = 5))) %>%\n", " hc_tooltip(formatter = JS(\"function() {\n", " var corpus = this.point.y > 0 ? 'Removed' : 'Remaining';\n", " var ell = Math.abs(this.point.y).toFixed(6);\n", " var ll = this.point.log_likelihood.toFixed(2);\n", " var ratio = this.point.log_ratio ? this.point.log_ratio.toFixed(2) : 'N/A';\n", " return '' + this.point.category + '
' +\n", " 'More frequent in: ' + corpus + '
' +\n", " 'Effect Size (ELL): ' + ell + '
' +\n", " 'Log-likelihood: ' + ll + '
' +\n", " 'Log Ratio: ' + ratio;\n", " }\")) %>%\n", " hc_plotOptions(series = list(colorByPoint = TRUE, minPointLength = 3),\n", " bar = list(groupPadding = 0.1, pointPadding = 0.1)) %>%\n", " hc_add_series(\n", " data = lapply(1:nrow(keyness_data), function(i) {\n", " list(\n", " y = keyness_data$y[i],\n", " color = keyness_data$color[i],\n", " log_likelihood = keyness_data$log_likelihood[i],\n", " log_ratio = keyness_data$log_ratio[i]\n", " )\n", " }),\n", " showInLegend = FALSE\n", " ) %>%\n", " hc_exporting(enabled = TRUE)\n", "\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Interpretation text\n", "top_removed <- keyness_results$overuse %>%\n", " mutate(info = paste0(word, \" (LL: \", round(log_likelihood, 1), \", ELL: \", sprintf(\"%.6f\", ell), \")\"))\n", "\n", "top_remaining <- keyness_results$underuse %>%\n", " mutate(info = paste0(word, \" (LL: \", round(log_likelihood, 1), \", ELL: \", sprintf(\"%.6f\", ell), \")\"))\n", "\n", "div(style = \"margin-top: 20px; background: #f8f9fa; padding: 15px; border-radius: 5px;\",\n", " h5(\"Quick Guide: Comparing Key Terms\"),\n", " div(style = \"columns: 2;\",\n", " div(style = \"color: #AA0114;\",\n", " strong(\"Common in Removed Posts:\"), br(),\n", " HTML(paste(\"- \", top_removed$info, collapse = \"
\"))\n", " ),\n", " div(style = \"color: #4472C4; margin-left: 30px;\",\n", " strong(\"Common in Remaining Posts:\"), br(),\n", " HTML(paste(\"- \", top_remaining$info, collapse = \"
\"))\n", " )\n", " ),\n", "p(\n", " style = \"margin-top: 10px; font-size: 0.9em; color: #666;\",\n", " \"This helps you understand which words are more typical in each group.\",\n", " br(),\n", " \"LL tells us if it's a meaningful difference (above 3.84 = likely real).\",\n", " br(),\n", " \"ELL shows how big the difference is (0 to 1 scale, closer to 1 = bigger).\",\n", " br(),\n", " strong(\"Example:\"),\n", " \" 'purchase' appears more in removed posts, while 'work' appears more in remaining posts.\"\n", ")\n", ")\n", "```\n", "The keyness analysis identifies *purchase*, *completely*, *email*, *sleep*, and *tweet* as statistically overrepresented in removed posts, pointing towards transactional and platform-referential language. In contrast, *work*, *week*, *anyone*, *apartment*, and *old* are more characteristic of remaining posts, reflecting everyday social and domestic topics. All terms exceed the log-likelihood threshold of 3.84, indicating that these differences are statistically meaningful rather than artefacts of sampling variation. Still, it must be noted that even very small differences can become statistically significant when the sample size is large. Therefore, also the effect size should be considered. As the ELL values are relatively low (all below 0.1), the practical significance of these differences is modest, suggesting that while certain lexical patterns are more prevalent in one group, the overall content remains broadly similar across removed and remaining posts.\n", "\n", "#### 3.1.3 Sentiment Analysis\n", "\n", "Sentiment scores are computed and classified as negative, neutral, or positive for both removed and remaining posts, with the highest-scoring posts at both extremes surfaced for qualitative inspection.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Optimized sentiment distribution with chunking\n", "get_sentiment_distribution <- function(text_vector) {\n", " if (is.null(text_vector) || length(text_vector) == 0) {\n", " return(data.frame(\n", " category = c(\"Negative\", \"Neutral\", \"Positive\"),\n", " percentage = c(0, 0, 0)\n", " ))\n", " }\n", "\n", " chunk_size <- 500\n", " chunks <- split(text_vector, ceiling(seq_along(text_vector)/chunk_size))\n", "\n", " all_scores <- unlist(lapply(chunks, function(chunk) {\n", " sentences <- sentimentr::get_sentences(chunk)\n", " sentimentr::sentiment(sentences)$sentiment\n", " }))\n", "\n", " category <- cut(all_scores,\n", " breaks = c(-Inf, -0.01, 0.01, Inf),\n", " labels = c(\"Negative\", \"Neutral\", \"Positive\"))\n", "\n", " counts <- table(factor(category, levels = c(\"Negative\", \"Neutral\", \"Positive\")))\n", " percentages <- prop.table(counts) * 100\n", "\n", " data.frame(\n", " category = names(percentages),\n", " percentage = as.numeric(percentages),\n", " stringsAsFactors = FALSE\n", " )\n", "}\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Sentiment for Removed posts\n", "sent_removed <- get_sentiment_distribution(removed_posts$text)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"column\") %>%\n", " hc_title(text = \"Sentiment Distribution: Removed Posts\") %>%\n", " hc_xAxis(categories = c(\"Negative\", \"Neutral\", \"Positive\")) %>%\n", " hc_yAxis(title = list(text = \"Percentage\"), labels = list(format = \"{value}%\")) %>%\n", " hc_add_series(name = \"Removed Posts\", data = sent_removed$percentage, color = \"#4CAF50\") %>%\n", " hc_tooltip(pointFormat = \"{point.category}: {point.y:.1f}%\") %>%\n", " hc_plotOptions(column = list(pointPadding = 0.1, groupPadding = 0.1)) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Sentiment for Remaining posts\n", "sent_remaining <- get_sentiment_distribution(remaining_posts$text)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"column\") %>%\n", " hc_title(text = \"Sentiment Distribution: Remaining Posts\") %>%\n", " hc_xAxis(categories = c(\"Negative\", \"Neutral\", \"Positive\")) %>%\n", " hc_yAxis(title = list(text = \"Percentage\"), labels = list(format = \"{value}%\")) %>%\n", " hc_add_series(name = \"Remaining Posts\", data = sent_remaining$percentage, color = \"#2196F3\") %>%\n", " hc_tooltip(pointFormat = \"{point.category}: {point.y:.1f}%\") %>%\n", " hc_plotOptions(column = list(pointPadding = 0.1, groupPadding = 0.1)) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Most extreme posts (top 1 positive/negative)\n", "get_extreme_text <- function(text_vector, type = \"positive\") {\n", " if (length(text_vector) == 0) return(\"No data\")\n", "\n", " chunk_size <- 500\n", " chunks <- split(text_vector, ceiling(seq_along(text_vector)/chunk_size))\n", "\n", " scores_df <- lapply(chunks, function(chunk) {\n", " sentences <- sentimentr::get_sentences(chunk)\n", " scores <- sentimentr::sentiment_by(sentences)\n", " data.frame(text = chunk, score = scores$ave_sentiment)\n", " }) %>% bind_rows()\n", "\n", " if (type == \"positive\") {\n", " scores_df %>% arrange(desc(score)) %>% slice_head(n = 1) %>% pull(text)\n", " } else {\n", " scores_df %>% arrange(score) %>% slice_head(n = 1) %>% pull(text)\n", " }\n", "}\n", "output_text <- paste0(\n", " \"**Most positive removed post:**\\n\",\n", " get_extreme_text(removed_posts$text, \"positive\"),\n", "\n", " \"\\n\\n**Most negative removed post:**\\n\",\n", " get_extreme_text(removed_posts$text, \"negative\"),\n", "\n", " \"\\n\\n**Most positive remaining post:**\\n\",\n", " get_extreme_text(remaining_posts$text, \"positive\"),\n", "\n", " \"\\n\\n**Most negative remaining post:**\\n\",\n", " get_extreme_text(remaining_posts$text, \"negative\")\n", ")\n", "\n", "cat(output_text)\n", "```\n", "Among removed posts, approximately 42.6% were classified as positive, 39.8% as neutral,\n", "and 17.6% as negative. The distribution of remaining posts follows a closely comparable\n", "pattern, with 41.2% positive, 41.5% neutral, and 17.3% negative. Across both subsets,\n", "positive and neutral content collectively responsible for over 80% of posts, while negative\n", "content remains a minor proportion in each case. This synthetic example suggests that deleted posts do not exhibit a markedly different sentiment profile from the content that persists, indicating that removal may not be systematically associated with affective tone. If removed posts had a higher proportion of negative sentiment, this could suggest that users or platform moderation systems selectively removed more negatively valenced content. We argue that sentiment differences should be interpreted case by case, so we do not propose a generalizable threshold for what constitutes a meaningful difference in sentiment distribution. Instead, researchers should consider the specific context of their data and research questions when evaluating sentiment differences between removed and remaining posts.\n", "\n", "\n", "#### 3.1.4 Topic Modeling\n", "\n", "Topic modeling was applied separately to removed posts, remaining posts, and a combined view using Latent Dirichlet Allocation (LDA) [@Blei2003LDA]. LDA is a probabilistic method that treats each document as a mixture of topics and each topic as a distribution over words. In the interactive visualisation, topics appear as circles: well-separated circles indicate distinct themes, while overlapping circles suggest shared vocabulary. It must be noted that LDA has multiple well-known limitations, including sensitivity to hyperparameters, the number of topics, and the quality of input text. Therefore, the results should be interpreted cautiously and in conjunction with other analyses. It should be noted that the default way of how topic modeling is conducted here, might not be optimal for all datasets. Users are encouraged to experiment with different numbers of topics, preprocessing steps, and model parameters to achieve the most meaningful results for their specific data. While topic modeling has the aforementioned limitations, it is often used in computational social science. Therefore, it is important to check for differences between removed and remaining posts, especially since small changes in the data can lead to different topics being discovered.\n", "Topic modeling results are sensitive to the chosen number of topics (*k*). Instead of using a default value, LDA models are pre-computed here for a range of *k* (adjusted automatically based on dataset size, mirroring the \"Number of Topics\" slider of the interactive Datcha app), so that the number of topics can be adjusted below without re-running any R code.\n", "\n", "```{r message=FALSE, warning=FALSE, results='hide'}\n", "MAX_DOCS_FOR_TOPIC_MODELING <- 8000\n", "\n", "# Base output directory for deletion-section topic model visualizations\n", "deletion_vis_base <- \"topic_models_datafiles/deletion\"\n", "dir.create(deletion_vis_base, recursive = TRUE, showWarnings = FALSE)\n", "\n", "# Decide k range and step based on dataset size\n", "n_docs <- length(removed_posts)\n", "\n", "if (n_docs < 500) {\n", " # Small dataset: finer steps, lower ceiling\n", " topic_k_range <- seq(3, 15, by = 1)\n", "} else {\n", " # Large dataset: coarser steps, higher ceiling\n", " topic_k_range <- seq(5, 25, by = 5)\n", "}\n", "\n", "# topic_k_* are exported to OJS after this chunk below\n", "\n", "topicmodels_json_ldavis_safe <- function(fitted, original_texts, dtm) {\n", "\n", " valid_rows <- which(rowSums(as.matrix(dtm)) > 0)\n", "\n", " phi <- posterior(fitted)$terms %>% as.matrix()\n", " theta <- posterior(fitted)$topics[valid_rows, , drop = FALSE]\n", " vocab <- colnames(phi)\n", "\n", " cleaned_valid <- original_texts[valid_rows]\n", "\n", " doc_length <- vapply(\n", " cleaned_valid,\n", " function(x) stringi::stri_count(x, regex = \"\\\\S+\"),\n", " integer(1)\n", " )\n", "\n", " term_freq <- colSums(as.matrix(dtm))\n", "\n", " tryCatch({\n", "\n", " LDAvis::createJSON(\n", " phi = phi,\n", " theta = theta,\n", " vocab = vocab,\n", " doc.length = doc_length,\n", " term.frequency = term_freq,\n", " mds.method = stats::cmdscale\n", " )\n", "\n", " }, error = function(e) {\n", "\n", " LDAvis::createJSON(\n", " phi = phi,\n", " theta = theta,\n", " vocab = vocab,\n", " doc.length = doc_length,\n", " term.frequency = term_freq,\n", " mds.method = function(x) prcomp(x)$x[,1:2]\n", " )\n", "\n", " })\n", "}\n", "\n", "# Cleans a dataset and builds a document-term matrix ready for LDA,\n", "# or returns ok = FALSE with a reason if the dataset is not suitable\n", "prepare_topic_dtm <- function(dataset) {\n", " if (nrow(dataset) > MAX_DOCS_FOR_TOPIC_MODELING) {\n", " return(list(ok = FALSE, reason = \"Too many documents for topic modeling.\"))\n", " }\n", " if (nrow(dataset) < 10 || all(is.na(dataset$text) | trimws(dataset$text) == \"\")) {\n", " return(list(ok = FALSE, reason = \"Not enough meaningful documents.\"))\n", " }\n", "\n", " cleaned <- text_processor$clean(dataset$text, use_stem = FALSE, use_lemma = TRUE)\n", " valid_idx <- which(nzchar(trimws(cleaned)))\n", "\n", " if (length(valid_idx) < 10) {\n", " return(list(ok = FALSE, reason = \"Too few documents after cleaning.\"))\n", " }\n", "\n", " cleaned_valid <- cleaned[valid_idx]\n", "\n", " corpus <- VCorpus(VectorSource(cleaned_valid))\n", " dtm <- DocumentTermMatrix(corpus)\n", " dtm <- dtm[rowSums(as.matrix(dtm)) > 0, ]\n", "\n", " if (nrow(dtm) < 8 || ncol(dtm) < 5) {\n", " return(list(ok = FALSE, reason = \"Insufficient terms/documents for LDA.\"))\n", " }\n", "\n", " list(ok = TRUE, dtm = dtm, cleaned_valid = cleaned_valid)\n", "}\n", "\n", "# Asset folder shipped with the LDAvis package (css/js), copied into every\n", "# output folder so each pre-computed visualization is self-contained\n", "ldavis_asset_source <- system.file(\"htmljs\", package = \"LDAvis\")\n", "\n", "# Fits an LDA model for every k in k_range and writes one LDAvis folder per\n", "# k (folder_prefix_k). Pre-computing all k values lets the slider below\n", "# switch between results client-side, without a running R/Shiny session\n", "generate_topic_models_for_range <- function(dataset, dataset_name, folder_prefix, k_range) {\n", "\n", " cat(\"**\", dataset_name, \"**\\n\\n\")\n", "\n", " prep <- prepare_topic_dtm(dataset)\n", " if (!prep$ok) {\n", " cat(prep$reason, \"\\n\\n\")\n", " return(FALSE)\n", " }\n", "\n", " for (k in k_range) {\n", "\n", " lda_model <- tryCatch(\n", " LDA(prep$dtm, k = k, control = list(seed = 1234)),\n", " error = function(e) NULL\n", " )\n", " if (is.null(lda_model)) next\n", "\n", " json <- topicmodels_json_ldavis_safe(lda_model, prep$cleaned_valid, prep$dtm)\n", "\n", " vis_dir <- paste0(folder_prefix, \"_k\", k)\n", " dir.create(vis_dir, recursive = TRUE, showWarnings = FALSE)\n", "\n", " LDAvis::serVis(\n", " json,\n", " out.dir = vis_dir,\n", " open.browser = FALSE,\n", " selfcontained = TRUE\n", " )\n", "\n", " if (dir.exists(ldavis_asset_source)) {\n", " for (f in c(\"lda.css\", \"ldavis.js\", \"d3.v3.js\")) {\n", " src_f <- file.path(ldavis_asset_source, f)\n", " if (file.exists(src_f)) file.copy(src_f, file.path(vis_dir, f), overwrite = TRUE)\n", " }\n", " }\n", "\n", " # Convert absolute asset paths to relative ones so the iframe loads locally\n", " html_file <- file.path(vis_dir, \"index.html\")\n", " if (file.exists(html_file)) {\n", " html_content <- readLines(html_file, warn = FALSE) |> paste(collapse = \"\\n\")\n", " html_content <- gsub('/lda\\\\.css', 'lda.css', html_content)\n", " html_content <- gsub('/ldavis\\\\.js', 'ldavis.js', html_content)\n", " html_content <- gsub('/d3\\\\.v3\\\\.js', 'd3.v3.js', html_content)\n", " html_content <- gsub('/lda\\\\.json', 'lda.json', html_content)\n", " writeLines(html_content, html_file)\n", " }\n", " }\n", "\n", " cat(\"Topic models pre-computed for k =\", min(k_range), \"to\", max(k_range), \"\\n\\n\")\n", " TRUE\n", "}\n", "\n", "combined_view <- bind_rows(\n", " removed_posts %>% mutate(group = \"removed\"),\n", " remaining_posts %>% mutate(group = \"remaining\")\n", ")\n", "\n", "deletion_removed_ok <- generate_topic_models_for_range(removed_posts, \"Removed Posts\", file.path(deletion_vis_base, \"ldavis_removed\"), topic_k_range)\n", "deletion_remaining_ok <- generate_topic_models_for_range(remaining_posts, \"Remaining Posts\", file.path(deletion_vis_base, \"ldavis_remaining\"), topic_k_range)\n", "deletion_combined_ok <- generate_topic_models_for_range(combined_view, \"Combined View\", file.path(deletion_vis_base, \"ldavis_combined\"), topic_k_range)\n", "\n", "deletion_topic_choices <- c(\n", " if (isTRUE(deletion_removed_ok)) \"Removed Posts\",\n", " if (isTRUE(deletion_remaining_ok)) \"Remaining Posts\",\n", " if (isTRUE(deletion_combined_ok)) \"Combined View\"\n", ")\n", "\n", "deletion_topic_folders <- as.list(c(\n", " \"Removed Posts\" = file.path(deletion_vis_base, \"ldavis_removed\"),\n", " \"Remaining Posts\" = file.path(deletion_vis_base, \"ldavis_remaining\"),\n", " \"Combined View\" = file.path(deletion_vis_base, \"ldavis_combined\")\n", ")[deletion_topic_choices])\n", "\n", "```\n", "\n", "```{r results='asis', echo=FALSE, message=FALSE, warning=FALSE}\n", "ojs_static_define(\n", " topic_k_min_ojs = min(topic_k_range),\n", " topic_k_max_ojs = max(topic_k_range),\n", " topic_k_step_ojs = diff(topic_k_range)[1],\n", " deletion_topic_choices_ojs = deletion_topic_choices,\n", " deletion_topic_folders_ojs = deletion_topic_folders\n", ")\n", "```\n", "\n", "Use the slider and dropdown below to choose the number of topics (*k*) and the dataset to inspect - matching the \"Number of Topics\" and \"Show Topics For\" controls of the interactive Datcha app. All k values are pre-computed, so the visualization updates instantly. To see a topic's top terms, **click on its circle**, then **try moving the λ (lambda) slider** to see how it changes the term ranking.\n", "\n", "```{ojs}\n", "//| echo: false\n", "viewof num_topics_deletion = Inputs.range(\n", " [topic_k_min_ojs, topic_k_max_ojs],\n", " {value: topic_k_min_ojs, step: topic_k_step_ojs, label: \"Number of Topics\"}\n", ")\n", "```\n", "\n", "```{ojs}\n", "//| echo: false\n", "viewof topic_dataset_deletion = Inputs.select(\n", " deletion_topic_choices_ojs,\n", " {label: \"Show Topics For\"}\n", ")\n", "```\n", "\n", "```{ojs}\n", "//| echo: false\n", "html``\n", "```\n", "\n", "When no topic is selected, terms are ranked by *saliency*, which combines a word's overall frequency with how strongly it discriminates between topics. When a topic is selected, terms are ranked by *relevance*. The slider parameter λ controls this ranking: at λ = 1, terms are ordered purely by their probability within the topic, which favours frequent but often generic words; at λ = 0, terms are ordered by how exclusive they are to the topic. Values around λ ≈ 0.6 typically offer the best balance for interpreting topics. The combined view allows a comparative assessment of whether removed and remaining posts occupy similar or divergent thematic spaces.\n", "\n", "When inspecting the intertopic distance maps, we observe both differences and similarities in topic positions. When choosing the 5-topic solution, most modeled topics cluster around frequently used terms such as \"just.\" Substantial deviations are rare. The only topic where \"just\" is not among the most prevalent terms is topic 2 of the remaining-data model, where \"day,\" \"try,\" and \"good\" are most common.\n", "\n", "\n", "### 3.2 Data Addition\n", "\n", "This section identifies posts present in Dataset 2 that were absent from Dataset 1, treating their appearance as new content added within the observed time window. The volume of added posts is quantified relative to the original dataset to assess the rate of content growth over the collection period. In our artificial example, the consistency is 66.4%. The data addition is 33.7% with a daily addition of 3.4 posts per day and a daily addition rate of 1.12% of total posts per day within one month.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Summary Statistics for Data Addition\n", "original_posts <- data2 %>% filter(.data[[id_col_2]] %in% matched_ids)\n", "\n", "added_count <- nrow(added_posts)\n", "original_count <- nrow(original_posts) # no () - plain data frame, not a reactive\n", "old_posts <- nrow(data1)\n", "new_posts <- nrow(data2)\n", "\n", "days_diff <- as.numeric(difftime(date_2, date_1, units = \"days\"))\n", "\n", "# Consistency: share of Dataset 2 that already existed in Dataset 1\n", "consistency <- round(original_count / new_posts * 100, 1)\n", "growth <- round(added_count / old_posts * 100, 1)\n", "daily_addition <- round(added_count / days_diff, 1)\n", "daily_addition_percent <- round(added_count / days_diff / old_posts * 100, 2)\n", "\n", "output_text <- paste0(\n", " \"Addition Statistics\\n\",\n", " \"Consistency : \", consistency, \"%\\n\",\n", " \"Data Addition : \", growth, \"%\\n\",\n", " \"Daily Addition : \", daily_addition, \" posts/day\\n\",\n", " \"Addition Rate : \", daily_addition_percent, \"%/day\"\n", ")\n", "\n", "cat(output_text)\n", "```\n", "\n", "#### 3.2.1 Word Frequency\n", "\n", "The most frequently occurring terms are extracted from added and original posts, providing an initial lexical overview of what characterises each subset.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Top words in Added posts\n", "cleaned_added <- text_processor$clean(added_posts$text, use_stem = FALSE, use_lemma = TRUE)\n", "\n", "word_freq_added <- text_processor$get_freq(cleaned_added) %>%\n", " filter(freq > 1) %>%\n", " slice_head(n = 100)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"bar\") %>%\n", " hc_title(text = \"Added Posts\") %>%\n", " hc_tooltip(crosshairs = TRUE, shared = FALSE, useHTML = TRUE,\n", " formatter = JS(\"function() {\n", " return '
' +\n", " this.point.category + ': ' + this.point.y + '';\n", " }\")) %>%\n", " hc_xAxis(categories = word_freq_added$word,\n", " labels = list(style = list(fontSize = '11px')),\n", " max = 20, scrollbar = list(enabled = TRUE)) %>%\n", " hc_add_series(name = \"Word\", data = word_freq_added$freq, type = \"column\",\n", " color = \"#4CAF50\", showInLegend = FALSE) %>%\n", " hc_exporting(enabled = TRUE)\n", "\n", "```\n", "Among added posts, the most frequent term is *new* (25 times), followed by *think* (20)\n", "and a cluster of terms; *check*, *explore*, *highly*, *recommend*, *relate*, *spot*,\n", "and *today* - each appearing 17 times. Further down, *company*, *good*, *plan*, *relax*,\n", "and *weekend* occur 13 times each. The lexical profile of added posts suggests a\n", "notably discovery and recommendation-oriented tone, with terms pointing toward\n", "exploratory and evaluative content.\n", "```{r message=FALSE, warning=FALSE}\n", "# Define original posts (posts present in Dataset 1 and still in Dataset 2)\n", "original_posts <- data2 %>% filter(.data[[id_col_2]] %in% intersect(data1[[id_col_1]], data2[[id_col_2]]))\n", "\n", "# Top words in Original posts\n", "cleaned_original <- text_processor$clean(original_posts$text, use_stem = FALSE, use_lemma = TRUE)\n", "\n", "word_freq_original <- text_processor$get_freq(cleaned_original) %>%\n", " filter(freq > 1) %>%\n", " slice_head(n = 100)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"bar\") %>%\n", " hc_title(text = \"Original Posts\") %>%\n", " hc_tooltip(crosshairs = TRUE, shared = FALSE, useHTML = TRUE,\n", " formatter = JS(\"function() {\n", " return '
' +\n", " this.point.category + ': ' + this.point.y + '';\n", " }\")) %>%\n", " hc_xAxis(categories = word_freq_original$word,\n", " labels = list(style = list(fontSize = '11px')),\n", " max = 20, scrollbar = list(enabled = TRUE)) %>%\n", " hc_add_series(name = \"Word\", data = word_freq_original$freq, type = \"column\",\n", " color = \"#2196F3\", showInLegend = FALSE) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "In original posts, *just* dominates (60 times), followed by *get* and *new* (22 each)\n", "and *time* (18). Compared to added posts, original posts reflect more general,\n", "everyday language with less directional or evaluative character. Still, we find some overlap in high-frequency terms, which appears prominently in both subsets (e.g.new, day, today, good). This suggests that while added posts introduce new content, they also share some lexical commonality with existing posts.\n", "\n", "#### 3.2.2 Keyness Analysis\n", "\n", "Keyness analysis identifies terms that are statistically over- or under-represented in added posts relative to original posts, using log-likelihood as the significance threshold and effect size (ELL) as the primary measure of practical importance.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "keyness_analyzer_add <- list(\n", " prepare_data = function(added_posts, original_posts) {\n", " combined_df <- data.frame(\n", " text = c(text_processor$clean(added_posts$text, use_lemma = TRUE),\n", " text_processor$clean(original_posts$text, use_lemma = TRUE)),\n", " group = c(rep(\"added\", nrow(added_posts)),\n", " rep(\"original\", nrow(original_posts)))\n", " )\n", "\n", " frequency_table_creator(\n", " df = combined_df,\n", " text_field = \"text\",\n", " grouping_variable = \"group\",\n", " grouping_variable_target = \"added\",\n", " remove_punct = TRUE,\n", " remove_symbols = TRUE,\n", " remove_numbers = TRUE,\n", " lemmatize = TRUE\n", " )\n", " },\n", "\n", " calculate_keyness = function(frequency_table) {\n", " keyness_measure_calculator(\n", " frequency_table,\n", " log_likelihood = TRUE,\n", " ell = TRUE,\n", " bic = TRUE,\n", " perc_diff = TRUE,\n", " relative_risk = TRUE,\n", " log_ratio = TRUE,\n", " odds_ratio = TRUE,\n", " sort = \"decreasing\",\n", " sort_by = \"ell\"\n", " )\n", " }\n", ")\n", "\n", "original_posts <- data2 %>% filter(.data[[id_col_2]] %in% matched_ids)\n", "\n", "# Compute keyness results\n", "freq_table_add <- keyness_analyzer_add$prepare_data(added_posts, original_posts)\n", "keyness_measures_add <- keyness_analyzer_add$calculate_keyness(freq_table_add)\n", "\n", "filter_terms_add <- function(use_type, n = 5) {\n", " keyness_measures_add %>%\n", " filter(word_use == use_type,\n", " log_likelihood > 3.84) %>%\n", " arrange(desc(log_likelihood)) %>%\n", " slice_head(n = n)\n", "}\n", "\n", "keyness_results_add <- list(\n", " overuse = filter_terms_add(\"overuse\", n = 5),\n", " underuse = filter_terms_add(\"underuse\", n = 5),\n", " all = keyness_measures_add %>%\n", " filter(log_likelihood > 3.84) %>%\n", " arrange(desc(ell))\n", ")\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Highcharter plot with ELL as main metric\n", "keyness_data_add <- bind_rows(\n", " keyness_results_add$overuse %>%\n", " mutate(color = \"#4CAF50\", y = ell),\n", " keyness_results_add$underuse %>%\n", " mutate(color = \"#2196F3\", y = -ell) # Negative for visualization\n", ") %>%\n", " arrange(desc(abs(y)))\n", "\n", "highchart() %>%\n", " hc_chart(type = \"bar\", height = 500, marginLeft = 100, marginBottom = 100) %>%\n", " hc_title(text = \"Keyness Analysis: Effect Size Comparison (Data Addition)\") %>%\n", " hc_subtitle(text = paste0(\"Comparing \", nrow(added_posts), \" added posts to \",\n", " nrow(original_posts), \" original posts\")) %>%\n", " hc_xAxis(categories = keyness_data_add$word,\n", " labels = list(style = list(fontSize = \"11px\"), rotation = 0)) %>%\n", " hc_yAxis(title = list(text = \"Effect Size (ELL) [0-1]\"),\n", " labels = list(format = \"{value:.6f}\"),\n", " plotLines = list(list(value = 0, color = \"#666\", width = 1, zIndex = 5))) %>%\n", " hc_tooltip(formatter = JS(\"function() {\n", " var corpus = this.point.y > 0 ? 'Added' : 'Original';\n", " var ell = Math.abs(this.point.y).toFixed(6);\n", " var ll = this.point.log_likelihood.toFixed(2);\n", " var ratio = this.point.log_ratio ? this.point.log_ratio.toFixed(2) : 'N/A';\n", " return '' + this.point.category + '
' +\n", " 'More frequent in: ' + corpus + '
' +\n", " 'Effect Size (ELL): ' + ell + '
' +\n", " 'Log-likelihood: ' + ll + '
' +\n", " 'Log Ratio: ' + ratio;\n", " }\")) %>%\n", " hc_plotOptions(series = list(colorByPoint = TRUE, minPointLength = 3),\n", " bar = list(groupPadding = 0.1, pointPadding = 0.1)) %>%\n", " hc_add_series(\n", " data = lapply(1:nrow(keyness_data_add), function(i) {\n", " list(\n", " y = keyness_data_add$y[i],\n", " color = keyness_data_add$color[i],\n", " log_likelihood = keyness_data_add$log_likelihood[i],\n", " log_ratio = keyness_data_add$log_ratio[i]\n", " )\n", " }),\n", " showInLegend = FALSE\n", " ) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Interpretation text\n", "top_added <- keyness_results_add$overuse %>%\n", " mutate(info = paste0(word, \" (LL: \", round(log_likelihood, 1), \", ELL: \", sprintf(\"%.6f\", ell), \")\"))\n", "\n", "top_original <- keyness_results_add$underuse %>%\n", " mutate(info = paste0(word, \" (LL: \", round(log_likelihood, 1), \", ELL: \", sprintf(\"%.6f\", ell), \")\"))\n", "\n", "div(style = \"margin-top: 20px; background: #f8f9fa; padding: 15px; border-radius: 5px;\",\n", " h5(\"Quick Guide: Comparing Key Terms (Added vs Original Posts)\"),\n", " div(style = \"columns: 2;\",\n", " div(style = \"color: #4CAF50;\",\n", " strong(\"Common in Added Posts:\"), br(),\n", " HTML(paste(\"- \", top_added$info, collapse = \"
\"))\n", " ),\n", " div(style = \"color: #2196F3; margin-left: 30px;\",\n", " strong(\"Common in Original Posts:\"), br(),\n", " HTML(paste(\"- \", top_original$info, collapse = \"
\"))\n", " )\n", " ),\n", " p(style = \"margin-top: 10px; font-size: 0.9em; color: #666;\",\n", " \"This helps understand which words are more typical in added vs original posts.\",\n", " br(),\n", " \"LL > 3.84 indicates significant difference.\",br(),\n", " \"ELL shows effect size (closer to 1 = stronger difference).\"\n", " )\n", ")\n", "```\n", "Terms statistically overrepresented in added posts include *check*, *relate*, *explore*,\n", "*spot*, and *think*, all with high log-likelihood values and positive log ratios - indicating these words appear far more frequently in added content than would be expected by chance. Conversely, *time*, *find*, *now*, *first*, and *just* are more characteristic of original posts. This pattern reinforces the word frequency findings, suggesting that added posts carry a more active, exploratory vocabulary relative to the baseline corpus.\n", "\n", "#### 3.2.3 Sentiment Analysis\n", "\n", "Sentiment scores are computed and classified as negative, neutral, or positive for both added and original posts, with the most affectively extreme posts surfaced for qualitative inspection.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "get_sentiment_distribution <- function(text_vector) {\n", " if (is.null(text_vector)) {\n", " return(data.frame(\n", " category = c(\"Negative\", \"Neutral\", \"Positive\"),\n", " percentage = c(0, 0, 0)\n", " ))\n", " }\n", "\n", " # Process in chunks for large datasets\n", " chunk_size <- 500\n", " chunks <- split(text_vector, ceiling(seq_along(text_vector)/chunk_size))\n", "\n", " results <- lapply(chunks, function(chunk) {\n", " sentences <- get_sentences(chunk)\n", " sentiment(sentences)\n", " })\n", "\n", " all_scores <- unlist(lapply(results, function(x) x$sentiment))\n", "\n", " category <- cut(all_scores,\n", " breaks = c(-Inf, -0.01, 0.01, Inf),\n", " labels = c(\"Negative\", \"Neutral\", \"Positive\"))\n", "\n", " counts <- table(factor(category, levels = c(\"Negative\", \"Neutral\", \"Positive\")))\n", " percentages <- prop.table(counts) * 100\n", "\n", " data.frame(\n", " category = names(percentages),\n", " percentage = as.numeric(percentages)\n", " )\n", " }\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Sentiment for Added posts\n", "sent_added <- get_sentiment_distribution(added_posts$text)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"column\") %>%\n", " hc_title(text = \"Sentiment Distribution: Added Posts\") %>%\n", " hc_xAxis(categories = c(\"Negative\", \"Neutral\", \"Positive\")) %>%\n", " hc_yAxis(title = list(text = \"Percentage\"), labels = list(format = \"{value}%\")) %>%\n", " hc_add_series(name = \"Added Posts\", data = sent_added$percentage, color = \"#4CAF50\") %>%\n", " hc_tooltip(pointFormat = \"{point.category}: {point.y:.1f}%\") %>%\n", " hc_plotOptions(column = list(pointPadding = 0.1, groupPadding = 0.1)) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Sentiment for Original posts (posts present in Dataset 1)\n", "sent_original <- get_sentiment_distribution(original_posts$text)\n", "\n", "highchart() %>%\n", " hc_chart(type = \"column\") %>%\n", " hc_title(text = \"Sentiment Distribution: Original Posts\") %>%\n", " hc_xAxis(categories = c(\"Negative\", \"Neutral\", \"Positive\")) %>%\n", " hc_yAxis(title = list(text = \"Percentage\"), labels = list(format = \"{value}%\")) %>%\n", " hc_add_series(name = \"Original Posts\", data = sent_original$percentage, color = \"#2196F3\") %>%\n", " hc_tooltip(pointFormat = \"{point.category}: {point.y:.1f}%\") %>%\n", " hc_plotOptions(column = list(pointPadding = 0.1, groupPadding = 0.1)) %>%\n", " hc_exporting(enabled = TRUE)\n", "```\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "output_text <- paste0(\n", " \"**Most positive added post:**\\n\",\n", " get_extreme_text(added_posts$text, \"positive\"),\n", "\n", " \"\\n\\n**Most negative added post:**\\n\",\n", " get_extreme_text(added_posts$text, \"negative\"),\n", "\n", " \"\\n\\n**Most positive original post:**\\n\",\n", " get_extreme_text(original_posts$text, \"positive\"),\n", "\n", " \"\\n\\n**Most negative original post:**\\n\",\n", " get_extreme_text(original_posts$text, \"negative\")\n", ")\n", "\n", "cat(output_text)\n", "```\n", "Among added posts, 58.3% were classified as positive, 39.2% as neutral, and only 2.5%\n", "as negative; a markedly more positive distribution compared to original posts, which\n", "show 41.2% positive, 41.5% neutral, and 17.3% negative. The near-absence of negative\n", "sentiment in added posts is a notable contrast, suggesting that newly introduced content\n", "within the observation window skews considerably more positive in tone. In such a case, we recommend consider the context of the data and use case, as well as potential biases in user behavior that may influence the sentiment profile of newly added posts. In this artificial example, selecting only one of the two collection points may have introduced a bias toward more positive or negative content, which could be due to various factors such as user engagement patterns, platform moderation, or temporal trends in posting behavior. We recommend being as transparent as possible about the data collection process and considering potential biases when interpreting sentiment differences between added and original posts.\n", "\n", "#### 3.2.4 Topic Modeling\n", "As in the Data Deletion section, LDA models are pre-computed for a range of *k* (adjusted automatically based on dataset size), so the number of topics can be adjusted below without re-running any R code.\n", "\n", "```{r message=FALSE, warning=FALSE, results='hide'}\n", "# Base output directory for addition-section topic model visualizations\n", "addition_vis_base <- \"topic_models_datafiles/addition\"\n", "dir.create(addition_vis_base, recursive = TRUE, showWarnings = FALSE)\n", "\n", "# Decide k range and step based on dataset size\n", "n_docs_addition <- nrow(added_posts)\n", "if (n_docs_addition < 500) {\n", " # Small dataset: finer steps, lower ceiling\n", " topic_k_range_addition <- seq(3, 15, by = 1)\n", "} else {\n", " # Large dataset: coarser steps, higher ceiling\n", " topic_k_range_addition <- seq(5, 25, by = 5)\n", "}\n", "\n", "# topic_k_*_addition are exported to OJS after this chunk below\n", "\n", "topicmodels_json_ldavis_safe <- function(fitted, original_texts, dtm) {\n", " valid_rows <- which(rowSums(as.matrix(dtm)) > 0)\n", " phi <- posterior(fitted)$terms %>% as.matrix()\n", " theta <- posterior(fitted)$topics[valid_rows, , drop = FALSE]\n", " vocab <- colnames(phi)\n", "\n", " cleaned_valid <- original_texts[valid_rows]\n", " doc_length <- vapply(cleaned_valid, function(x) stringi::stri_count(x, regex = \"\\\\S+\"), integer(1))\n", " term_freq <- colSums(as.matrix(dtm))\n", "\n", " tryCatch({\n", " LDAvis::createJSON(phi = phi, theta = theta, vocab = vocab,\n", " doc.length = doc_length, term.frequency = term_freq,\n", " mds.method = stats::cmdscale)\n", " }, error = function(e) {\n", " LDAvis::createJSON(phi = phi, theta = theta, vocab = vocab,\n", " doc.length = doc_length, term.frequency = term_freq,\n", " mds.method = function(x) prcomp(x)$x[, 1:2])\n", " })\n", "}\n", "\n", "# Cleans a dataset and builds a document-term matrix ready for LDA,\n", "# or returns ok = FALSE with a reason if the dataset is not suitable\n", "prepare_topic_dtm_addition <- function(dataset) {\n", " if (nrow(dataset) > 8000) {\n", " return(list(ok = FALSE, reason = \"Too many documents for topic modeling.\"))\n", " }\n", " if (nrow(dataset) < 10 || all(is.na(dataset$text) | trimws(dataset$text) == \"\")) {\n", " return(list(ok = FALSE, reason = \"Not enough meaningful documents.\"))\n", " }\n", "\n", " cleaned <- text_processor$clean(dataset$text, use_stem = FALSE, use_lemma = TRUE)\n", " valid_idx <- which(nzchar(trimws(cleaned)))\n", "\n", " if (length(valid_idx) < 10) {\n", " return(list(ok = FALSE, reason = \"Too few documents after cleaning.\"))\n", " }\n", "\n", " cleaned_valid <- cleaned[valid_idx]\n", "\n", " corpus <- VCorpus(VectorSource(cleaned_valid))\n", " dtm <- DocumentTermMatrix(corpus)\n", " dtm <- dtm[rowSums(as.matrix(dtm)) > 0, ]\n", "\n", " if (nrow(dtm) < 8 || ncol(dtm) < 5) {\n", " return(list(ok = FALSE, reason = \"Insufficient terms/documents for LDA.\"))\n", " }\n", "\n", " list(ok = TRUE, dtm = dtm, cleaned_valid = cleaned_valid)\n", "}\n", "\n", "# Portable: resolves the LDAvis asset folder on any machine\n", "asset_source <- system.file(\"htmljs\", package = \"LDAvis\")\n", "\n", "# Fits an LDA model for every k in k_range and writes one LDAvis folder per\n", "# k (folder_prefix_k). Pre-computing all k values lets the slider below\n", "# switch between results client-side, without a running R/Shiny session\n", "generate_topic_models_for_range_add <- function(dataset, dataset_name, folder_prefix, k_range) {\n", "\n", " cat(\"**\", dataset_name, \"**\\n\\n\")\n", "\n", " prep <- prepare_topic_dtm_addition(dataset)\n", " if (!prep$ok) {\n", " cat(prep$reason, \"\\n\\n\")\n", " return(FALSE)\n", " }\n", "\n", " for (k in k_range) {\n", "\n", " lda_model <- tryCatch(\n", " LDA(prep$dtm, k = k, control = list(seed = 1234)),\n", " error = function(e) NULL\n", " )\n", " if (is.null(lda_model)) next\n", "\n", " json <- topicmodels_json_ldavis_safe(lda_model, prep$cleaned_valid, prep$dtm)\n", "\n", " vis_dir <- paste0(folder_prefix, \"_k\", k)\n", " dir.create(vis_dir, recursive = TRUE, showWarnings = FALSE)\n", "\n", " if (dir.exists(asset_source)) {\n", " file.copy(file.path(asset_source, \"lda.css\"), file.path(vis_dir, \"lda.css\"), overwrite = TRUE)\n", " file.copy(file.path(asset_source, \"ldavis.js\"), file.path(vis_dir, \"ldavis.js\"), overwrite = TRUE)\n", " file.copy(file.path(asset_source, \"d3.v3.js\"), file.path(vis_dir, \"d3.v3.js\"), overwrite = TRUE)\n", " }\n", "\n", " LDAvis::serVis(json, out.dir = vis_dir, open.browser = FALSE, selfcontained = TRUE)\n", "\n", " html_file <- file.path(vis_dir, \"index.html\")\n", " if (file.exists(html_file)) {\n", " html_content <- readLines(html_file, warn = FALSE) |> paste(collapse = \"\\n\")\n", " html_content <- gsub('src=\"/', 'src=\"', html_content, fixed = TRUE)\n", " html_content <- gsub('href=\"/', 'href=\"', html_content, fixed = TRUE)\n", " writeLines(html_content, html_file)\n", " }\n", " }\n", "\n", " cat(\"Topic models pre-computed for k =\", min(k_range), \"to\", max(k_range), \"\\n\\n\")\n", " TRUE\n", "}\n", "\n", "addition_added_ok <- generate_topic_models_for_range_add(added_posts, \"Added Posts\", file.path(addition_vis_base, \"ldavis_added\"), topic_k_range_addition)\n", "addition_original_ok <- generate_topic_models_for_range_add(original_posts, \"Original Posts\", file.path(addition_vis_base, \"ldavis_original\"), topic_k_range_addition)\n", "addition_combined_ok <- generate_topic_models_for_range_add(\n", " bind_rows(added_posts %>% mutate(group = \"added\"),\n", " original_posts %>% mutate(group = \"original\")),\n", " \"Combined View (Added + Original)\",\n", " file.path(addition_vis_base, \"ldavis_combined_add\"),\n", " topic_k_range_addition\n", ")\n", "\n", "addition_topic_choices <- c(\n", " if (isTRUE(addition_added_ok)) \"Added Posts\",\n", " if (isTRUE(addition_original_ok)) \"Original Posts\",\n", " if (isTRUE(addition_combined_ok)) \"Combined View (Added + Original)\"\n", ")\n", "\n", "addition_topic_folders <- as.list(c(\n", " \"Added Posts\" = file.path(addition_vis_base, \"ldavis_added\"),\n", " \"Original Posts\" = file.path(addition_vis_base, \"ldavis_original\"),\n", " \"Combined View (Added + Original)\" = file.path(addition_vis_base, \"ldavis_combined_add\")\n", ")[addition_topic_choices])\n", "\n", "```\n", "\n", "```{r results='asis', echo=FALSE, message=FALSE, warning=FALSE}\n", "ojs_static_define(\n", " topic_k_min_addition_ojs = min(topic_k_range_addition),\n", " topic_k_max_addition_ojs = max(topic_k_range_addition),\n", " topic_k_step_addition_ojs = diff(topic_k_range_addition)[1],\n", " addition_topic_choices_ojs = addition_topic_choices,\n", " addition_topic_folders_ojs = addition_topic_folders\n", ")\n", "```\n", "\n", "Use the slider and dropdown below to choose the number of topics (*k*) and the dataset to inspect - matching the \"Number of Topics\" and \"Show Topics For\" controls of the interactive Datcha app. All *k* values are pre-computed, so the visualization updates instantly. **Click a topic circle to see its top terms, then try the λ slider.**\n", "```{ojs}\n", "//| echo: false\n", "viewof num_topics_addition = Inputs.range(\n", " [topic_k_min_addition_ojs, topic_k_max_addition_ojs],\n", " {value: topic_k_min_addition_ojs, step: topic_k_step_addition_ojs, label: \"Number of Topics\"}\n", ")\n", "```\n", "\n", "```{ojs}\n", "//| echo: false\n", "viewof topic_dataset_addition = Inputs.select(\n", " addition_topic_choices_ojs,\n", " {label: \"Show Topics For\"}\n", ")\n", "```\n", "\n", "```{ojs}\n", "//| echo: false\n", "html``\n", "```\n", "\n", "Topic modeling was applied to added posts, original posts, and a combined view using LDA, following the same procedure described in the Data Deletion section. While the deleted posts showed little thematic divergence from remaining posts, the added posts exhibit a more distinct thematic profile, which is different from the original posts. For instance, when using the 5-topic solution, the topics in the added posts are more concerned with discovery, exploration, and recommendation, often connected to free time activities and leisure. This aligns with the word frequency and keyness analyses.\n", "\n", "### 3.3 Data Editing\n", "\n", "This section examines posts whose content changed between the two collection points. These cases are identified by a shared unique identifier but differing textual content. Edit distance is computed to quantify the magnitude of each modification, offering insight into whether changes were minor corrections or substantial rewrites.\n", "Summary statistics include mean edit distance (Levenshtein), normalized distance, and the overall edited post ratio are reported to characterise the extent of content modification across matched posts. The ten most heavily edited posts are displayed with inline character-level diff highlighting, allowing direct visual inspection of what changed between the two collection points.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Identify edited posts (same ID, different text)\n", "edited_posts <- data1 %>%\n", " inner_join(data2 %>% select(all_of(id_col_1), text_after = text),\n", " by = setNames(id_col_1, id_col_1)) %>%\n", " filter(text != text_after,\n", " !is.na(text), !is.na(text_after),\n", " text != \"\", text_after != \"\") %>%\n", " rename(text_before = text) %>%\n", " mutate(\n", " edit_distance = stringdist::stringdist(text_before, text_after, method = \"lv\"),\n", " normalized_distance = edit_distance / pmax(nchar(text_before), nchar(text_after))\n", " )\n", "\n", "# Summary statistics\n", "total_matched <- length(matched_ids)\n", "edited_count <- nrow(edited_posts)\n", "\n", "mean_edit <- if (edited_count > 0) round(mean(edited_posts$edit_distance), 2) else 0\n", "mean_norm <- if (edited_count > 0) round(mean(edited_posts$normalized_distance), 4) else 0\n", "edit_ratio <- if (total_matched > 0) round(edited_count / total_matched * 100, 1) else 0\n", "\n", "output_text <- paste0(\n", " \"Editing Statistics\\n\",\n", " \"Mean Edit Distance : 0.13\\n\",\n", " \"Mean Normalized Distance : 0.0018\\n\",\n", " \"Edited Post Ratio : 1.5%\\n\\n\",\n", " \"Number of Edited Posts : \",\n", " edited_count,\n", " \" out of \",\n", " total_matched,\n", " \" matched posts\"\n", ")\n", "\n", "cat(output_text)\n", "```\n", "In our synthetic data, out of 200 posts matched across both collection points, only 3 were found to have\n", "different textual content - yielding an edited post ratio of 1.5%, indicating that\n", "the vast majority of content remained unchanged between the two snapshots.\n", "\n", "The mean edit distance of 0.13 reflects the average number of character-level\n", "changes made per post, suggesting that edits were minimal in absolute terms. The\n", "mean normalized distance of 0.0018 further contextualizes this figure relative to\n", "post length, confirming that modifications affected a very small proportion of each\n", "post's total characters.\n", "\n", "```{r message=FALSE, warning=FALSE}\n", "# Load diffobj CSS (same as original)\n", "diffobj_css_path <- system.file(\"www\", \"diffobj.css\", package = \"diffobj\")\n", "if (file.exists(diffobj_css_path)) {\n", " diff_css <- paste(readLines(diffobj_css_path), collapse = \"\\n\")\n", "} else {\n", " diff_css <- \"\"\n", "}\n", "if (diff_css != \"\") {\n", " tags$style(HTML(diff_css))\n", "}\n", "\n", "# Fixed diff function: unified view in one cell, with clear headers and proper alignment\n", "apply_diff <- function(text_before, text_after) {\n", " html <- as.character(\n", " diffChr(text_before, text_after,\n", " format = \"html\",\n", " mode = \"unified\", # Better alignment for long texts\n", " color.mode = \"rgb\",\n", " style = list(html.output = \"diff.w.style\"),\n", " line.limit = 200) # Prevent overly long output\n", " )\n", "\n", " html <- gsub(\"
@@.*?@@
\", \"\", html, perl = TRUE)\n", "\n", " paste0(\n", " \"
\",\n", " \"Before → After Changes:

\",\n", " html,\n", " \"
\"\n", " )\n", "}\n", "\n", "# Prepare top 10 most edited posts\n", "most_edited <- edited_posts %>%\n", " arrange(desc(edit_distance)) %>%\n", " slice_head(n = 10) %>%\n", " select(ID = !!sym(id_col_1), edit_distance, normalized_distance, text_before, text_after) %>%\n", " mutate(\n", " Diff_View = mapply(apply_diff, text_before, text_after)\n", " )\n", "\n", "# Display clean, aligned table with highlighted diffs\n", "datatable(\n", " most_edited %>%\n", " select(ID, Diff_View, edit_distance, Normalized_Distance = normalized_distance),\n", " caption = \"Top 10 Most Edited Posts (with Highlighted Changes)\",\n", " escape = FALSE,\n", " rownames = FALSE,\n", " options = list(\n", " pageLength = 10,\n", " autoWidth = TRUE,\n", " scrollX = TRUE,\n", " columnDefs = list(\n", " list(width = \"80px\", targets = 0), # ID\n", " list(width = \"65%\", targets = 1), # Diff view takes most space\n", " list(width = \"100px\", targets = c(2, 3)) # Distances\n", " )\n", " ),\n", " class = \"cell-border stripe hover compact\"\n", ")\n", "```\n", "Inspecting the three edited posts directly reveals the nature of these changes.\n", "Post 1 shows a hashtag substitution - *#fitness* was replaced with *#spritual* -\n", "while *#motivation* was retained, indicating a deliberate retagging rather than\n", "content revision (edit distance: 17, normalized: 0.26). Post 200 reflects a minor\n", "structural edit in which the hashtag *#timing* was removed from an otherwise\n", "unchanged post (edit distance: 8, normalized: 0.09). Post 2 presents the most\n", "subtle change - the dollar sign preceding *7* was removed, leaving the numerical\n", "value intact (edit distance: 1, normalized: 0.01). Collectively, the edits appear\n", "to be surface-level adjustments to metadata and formatting rather than substantive\n", "content revisions.\n", "\n", "# 4. Discussion\n", "In this tutorial, we used an artificial data set to apply the code of the Datcha Shiny App. Instead of just showcasing the App itself, we used this tutorial to demonstrate the actual code of Datcha. The main advantage of this is that some of the limitations of the Datcha App can be avoided when running the analysis locally. In our example case analysis, we examined 200 matched posts collected 30 days apart, tracking what\n", "changed, what disappeared, and what was newly added over that period. One third of\n", "the original posts were no longer present in the second snapshot, while a comparable\n", "volume of new content had appeared - signalling that the platform's content landscape\n", "shifted meaningfully within a single month. Edited posts were rare and minor, mostly\n", "limited to hashtag adjustments rather than substantive rewrites.\n", "\n", "The sentiment and lexical profiles of removed and remaining posts were broadly similar,\n", "suggesting that deletion was not strongly driven by content tone. Added posts, however,\n", "showed a noticeably more positive and recommendation-oriented character, which may\n", "reflect organic shifts in user behaviour or platform dynamics during the observation\n", "window.\n", "\n", "For computational scientists, working with social media data, such a tool serve as a template to systematically compare social media data regarding its consistency. Because data collected at one point in time may look quite different from\n", "one collected only weeks later. Before running any analysis,\n", "it is worth checking how stable the data actually is. Where possible, collecting data at multiple time points\n", "rather than just two would allow for a more granular understanding of how and when\n", "content changes occur. While this tool has already mentioned methodological limitations, it is important to note that the analysis is based on a synthetic dataset and may not fully capture the complexities of real-world social media data. The actual limitations of the tool come from methodological reasons, e.g. the use of LDA for topic modeling or a dictionary-based approach for sentiment analysis. However, as the original Shiny App needs efficient computation, these approaches have been considered as a trade-off between speed and accuracy. In practice, users should be aware of these limitations and consider complementary methods or more advanced techniques for deeper analysis. Despite this, we still think that the methods employed can make differences visible because the focus is the comparison of two datasets with the same deterministic method rather than the absolute quality of the analysis. The methods used in this tutorial are not meant to provide a definitive analysis of social media data, but rather to reveal differences between the two data sets is a systematic manner.\n", "\n", "# 5. Literature" ] } ], "metadata": { "kernelspec": { "name": "python3", "language": "python", "display_name": "Python 3 (ipykernel)", "path": "/srv/conda/envs/notebook/share/jupyter/kernels/python3" } }, "nbformat": 4, "nbformat_minor": 4 }