1. Setup and Data Loading

Domain: Media / news authenticity detection. Phase 1 asked how fake and real news differ, so this analysis loads both Fake.csv and True.csv and adds a label column. Using the fake file alone would make the Phase 1 comparison questions unanswerable.

fake_path <- file.path(params$data_dir, "Fake.csv")
real_path <- file.path(params$data_dir, "True.csv")
stopifnot("Fake.csv not found - set params$data_dir" = file.exists(fake_path),
          "True.csv not found - set params$data_dir" = file.exists(real_path))

# Read everything as character first; types are fixed explicitly during cleaning
read_news <- function(path, lab) {
  read_csv(path, col_types = cols(.default = col_character()), show_col_types = FALSE) %>%
    mutate(label = lab)
}
raw_df <- bind_rows(read_news(fake_path, "Fake"), read_news(real_path, "Real")) %>%
  mutate(id = row_number(), label = factor(label, levels = c("Fake", "Real")))

cat("Rows:", nrow(raw_df), "| Columns:", ncol(raw_df), "\n")

## Rows: 44898 | Columns: 6

raw_df %>% count(label, name = "articles") %>% knitr::kable(caption = "Articles per file")

Articles per file
label	articles
Fake	23481
Real	21417

# First rows (text truncated for readability)
raw_df %>% mutate(text = str_trunc(text, 100)) %>% head(5) %>% knitr::kable()

title	text	subject	date	label	id
Donald Trump Sends Out Embarrassing New Year’s Eve Message; This is Disturbing	Donald Trump just couldn t wish all Americans a Happy New Year and leave it at that. Instead, he …	News	December 31, 2017	Fake	1
Drunk Bragging Trump Staffer Started Russian Collusion Investigation	House Intelligence Committee Chairman Devin Nunes is going to have a bad day. He s been under the…	News	December 31, 2017	Fake	2
Sheriff David Clarke Becomes An Internet Joke For Threatening To Poke People ‘In The Eye’	On Friday, it was revealed that former Milwaukee Sheriff David Clarke, who was being considered f…	News	December 30, 2017	Fake	3
Trump Is So Obsessed He Even Has Obama’s Name Coded Into His Website (IMAGES)	On Christmas day, Donald Trump announced that he would be back to work the following day, but h…	News	December 29, 2017	Fake	4
Pope Francis Just Called Out Donald Trump During His Christmas Speech	Pope Francis used his annual Christmas Day message to rebuke Donald Trump without even mentioning…	News	December 25, 2017	Fake	5

# Structure and summary
str(raw_df, vec.len = 1, nchar.max = 60)

## tibble [44,898 × 6] (S3: tbl_df/tbl/data.frame)
##  $ title  : chr [1:44898] "Donald Trump Sends Out Embarrassing New Yea"| __truncated__ ...
##  $ text   : chr [1:44898] "Donald Trump just couldn t wish all America"| __truncated__ ...
##  $ subject: chr [1:44898] "News" ...
##  $ date   : chr [1:44898] "December 31, 2017" ...
##  $ label  : Factor w/ 2 levels "Fake","Real": 1 1 ...
##  $ id     : int [1:44898] 1 2 ...

summary(raw_df)

##        title              text            subject             date      
##  Length   :44898   Length   :44898   Length   :44898   Length   :44898  
##  N.unique :38728   N.unique :38639   N.unique :    8   N.unique : 1685  
##  N.blank  :    0   N.blank  :    0   N.blank  :    0   N.blank  :    0  
##  Min.nchar:    8   Min.nchar:    5   Min.nchar:    4   Min.nchar:    9  
##  Max.nchar:  285   Max.nchar:51793   Max.nchar:   15   Max.nchar:  149  
##                    NAs      :  631                                      
##   label             id       
##  Fake:23481   Min.   :    1  
##  Real:21417   1st Qu.:11225  
##               Median :22450  
##               Mean   :22450  
##               3rd Qu.:33674  
##               Max.   :44898

# Subjects per class: note that the two classes use completely different subject labels
raw_df %>% count(label, subject, sort = TRUE) %>% knitr::kable(caption = "Subject categories")

Subject categories
label	subject	n
Real	politicsNews	11272
Real	worldnews	10145
Fake	News	9050
Fake	politics	6841
Fake	left-news	4459
Fake	Government News	1570
Fake	US_News	783
Fake	Middle-east	778

Observation: the two files share no subject categories (fake: News, politics, left-news, …; real: politicsNews, worldnews). Subject is therefore perfectly confounded with class, so subject comparisons below are within-source descriptions, not a fair like-for-like test.

2. Data Cleaning

2.1 Missing values, date parsing and duplicates

# Treat blank strings as missing, then parse dates. The files mix two formats
# ("December 31, 2017" and "19-Feb-18"); a few fake rows contain URLs instead of dates.
df <- raw_df %>%
  mutate(across(c(title, text, subject, date), ~ na_if(str_squish(.x), "")),
         date_parsed = as.Date(parse_date_time(date, orders = c("mdY", "dby"), quiet = TRUE)))

# NA report per column and class (before removal)
df %>% group_by(label) %>%
  summarise(across(c(title, text, subject, date, date_parsed), ~ sum(is.na(.x)))) %>%
  knitr::kable(caption = "Missing values per column (date_parsed counts unparseable dates too)")

Missing values per column (date_parsed counts unparseable dates too)
label	title	text	subject	date	date_parsed
Fake	0	630	0	0	10
Real	0	1	0	0	0

# Remove incomplete rows and exact duplicates, logging rows left after each step
count_lab <- function(d) d %>% count(label, .drop = FALSE) %>% pivot_wider(names_from = label, values_from = n)
steps <- list(bind_cols(step = "Raw rows", count_lab(df)))

df <- df %>% filter(!is.na(text))
steps[[2]] <- bind_cols(step = "Remove empty text", count_lab(df))
df <- df %>% filter(!is.na(title), !is.na(subject))
steps[[3]] <- bind_cols(step = "Remove missing title/subject", count_lab(df))
df <- df %>% filter(!is.na(date_parsed))
steps[[4]] <- bind_cols(step = "Remove missing/unparseable date", count_lab(df))
df <- df %>% distinct(title, text, .keep_all = TRUE)  # keeps first occurrence
steps[[5]] <- bind_cols(step = "Remove duplicate articles", count_lab(df))

removal_log <- bind_rows(steps) %>% mutate(Total = Fake + Real)
knitr::kable(removal_log, caption = "Rows remaining after each cleaning step")

Rows remaining after each cleaning step
step	Fake	Real	Total
Raw rows	23481	21417	44898
Remove empty text	22851	21416	44267
Remove missing title/subject	22851	21416	44267
Remove missing/unparseable date	22841	21416	44257
Remove duplicate articles	17453	21194	38647

rows_removed <- nrow(raw_df) - nrow(df)
cat("Total rows removed:", rows_removed, sprintf("(%.1f%% of the raw data)\n", 100 * rows_removed / nrow(raw_df)))

## Total rows removed: 6251 (13.9% of the raw data)

We remove rather than impute: empty text or an unparseable date cannot be reconstructed meaningfully. Duplicates are removed because repeated articles would over-weight their words and patterns (this affects the fake file far more than the real one).

2.2 Text preprocessing

# Source-leakage check: nearly every genuine article starts with "CITY (Reuters) -".
# That tag would trivially separate the classes, so we strip it from the real text.
df <- df %>%
  mutate(had_dateline = str_detect(text, "^[^()]{0,100}\\(Reuters\\)"),
         text_base    = str_remove(text, "^[^()]{0,100}\\(Reuters\\)\\s*[-\u2013\u2014]?\\s*"))
dateline_share <- df %>% group_by(label) %>% summarise(pct = 100 * mean(had_dateline)) %>% deframe()

# English stopwords (tm) turned into one regular expression
sw <- tm::stopwords("english")
sw_regex <- paste0("\\b(", paste(sw, collapse = "|"), ")\\b")

# Step A: lower-case; drop HTML, URLs, @mentions, numbers and punctuation; squeeze whitespace
clean_basic <- function(x) {
  x %>%
    str_replace_all("[\u2018\u2019\u201B]", "'") %>%      # curly -> straight apostrophe
    str_remove_all("<[^>]+>") %>%                          # HTML tags
    str_remove_all("&[a-zA-Z#0-9]+;") %>%                  # HTML entities
    str_remove_all("(https?://|www\\.|pic\\.twitter\\.com/)\\S+") %>%  # URLs
    str_remove_all("@\\w+") %>%                            # @mentions
    str_to_lower() %>%
    str_remove_all("'s\\b") %>%                            # possessives
    str_replace_all("[^a-z'\\s]", " ") %>%                 # punctuation, digits, symbols
    str_replace_all("'{2,}|\\s'|'\\s", " ") %>%
    str_squish()
}
# Step B: remove stopwords, then leftover apostrophes
clean_nostop <- function(x) x %>% str_remove_all(sw_regex) %>% str_remove_all("'") %>% str_squish()

df <- df %>%
  mutate(title_lc     = clean_basic(title),
         body_lc      = clean_basic(text_base),
         combined_lc  = clean_basic(paste(title, text_base)),  # title + text, stopwords kept (for n-grams)
         combined_ns  = clean_nostop(combined_lc))             # title + text, stopwords removed (for words)

98.5% of real articles carried a Reuters dateline versus 0.01% of fake ones, a clear source artefact that we neutralised.

# Before / after comparison on three random articles
ba_ids <- sample(df$id, 3)
tibble(Before = str_trunc(raw_df$text[match(ba_ids, raw_df$id)], 250),
       After  = str_trunc(df$combined_ns[match(ba_ids, df$id)], 250)) %>%
  knitr::kable(caption = "Raw text vs. cleaned text (title + body, stopwords removed)")

Raw text vs. cleaned text (title + body, stopwords removed)
Before	After
If you wanted to see how low the Trump campaign would go to win, look no further than the stunt they pulled at the second presidential debate. For weeks the Trump campaign had been hinting they would invite Bill Clinton s alleged victims to the …	breaking trump campaign caught paying hillary hating sexual assault victim details wanted see low trump campaign go win look stunt pulled second presidential debate weeks trump campaign hinting invite bill clinton s alleged victims debates teetere…
We all know by now that House Speaker Paul Ryan is a spineless weasel. He is clearly uncomfortable with the idea of a President Trump, and yet he endorsed the great orange one anyway, and no matter how outrageously offensive Trump becomes, no matt…	gary johnson paul ryan trump endorsement mistake man admit video know now house speaker paul ryan spineless weasel clearly uncomfortable idea president trump yet endorsed great orange one anyway matter outrageously offensive trump becomes matter m…
WASHINGTON (Reuters) - The United States and China failed on Wednesday to agree on major new steps to reduce the U.S. trade deficit with China, casting doubt over President Donald Trump’s economic and security relations with Beijing. The annual e…	u s china fail agree trade issues casting doubt issues united states china failed wednesday agree major new steps reduce u s trade deficit china casting doubt president donald trump economic security relations beijing annual economic dialogue sess…

3. Feature Engineering

# All structural features are computed on the (dateline-stripped) text, *before*
# lower-casing, so capitalisation and punctuation are preserved.
df <- df %>%
  mutate(
    # date features
    year  = year(date_parsed),
    month = month(date_parsed, label = TRUE),
    wday  = wday(date_parsed, label = TRUE, week_start = 1),
    # text size
    char_count   = str_length(text_base),
    word_count   = stringi::stri_count_words(text_base),
    avg_word_len = str_count(text_base, "[A-Za-z]") / pmax(word_count, 1),
    # punctuation & emphasis
    punct_count = str_count(text_base, "[[:punct:]]"),
    excl_count  = str_count(text_base, "!"),
    has_excl    = excl_count > 0,
    has_q       = str_detect(text_base, "\\?"),
    upper_ratio = str_count(text_base, "\\b[A-Z]{2,}\\b") / pmax(word_count, 1),  # ALL-CAPS words (incl. acronyms)
    # title features
    title_chars       = str_length(title),
    title_words       = stringi::stri_count_words(title),
    title_has_excl    = str_detect(title, "!"),
    title_upper_ratio = str_count(title, "\\b[A-Z]{2,}\\b") / pmax(title_words, 1)
  ) %>%
  filter(word_count > 0)   # drop articles that became empty after dateline removal

feat_cols <- c("char_count", "word_count", "avg_word_len", "punct_count",
               "excl_count", "upper_ratio", "title_chars", "title_words")

df %>% select(label, all_of(feat_cols)) %>%
  pivot_longer(-label, names_to = "feature") %>%
  group_by(label, feature) %>%
  summarise(mean = mean(value), median = median(value), sd = sd(value),
            min = min(value), max = max(value), .groups = "drop") %>%
  mutate(across(where(is.numeric), ~ round(.x, 3))) %>%
  knitr::kable(caption = "Summary statistics of engineered features")

Summary statistics of engineered features
label	feature	mean	median	sd	min	max
Fake	avg_word_len	4.711	4.701	0.342	2.000	13.471
Fake	char_count	2538.620	2224.000	2189.887	5.000	51493.000
Fake	excl_count	0.742	0.000	2.005	0.000	133.000
Fake	punct_count	59.400	48.000	77.306	0.000	6197.000
Fake	title_chars	90.705	87.000	24.674	15.000	279.000
Fake	title_words	14.618	14.000	4.159	3.000	45.000
Fake	upper_ratio	0.018	0.007	0.053	0.000	1.000
Fake	word_count	431.417	382.000	362.009	1.000	8272.000
Real	avg_word_len	4.948	4.941	0.259	3.373	6.192
Real	char_count	2348.661	2186.500	1677.332	123.000	29755.000
Real	excl_count	0.062	0.000	0.419	0.000	12.000
Real	punct_count	55.427	47.000	44.789	1.000	795.000
Real	title_chars	64.656	64.000	9.159	26.000	133.000
Real	title_words	10.067	10.000	1.705	4.000	20.000
Real	upper_ratio	0.007	0.003	0.011	0.000	0.286
Real	word_count	384.785	359.000	275.841	19.000	5159.000

df %>% group_by(label) %>%
  summarise(`% with "!"` = 100 * mean(has_excl), `% with "?"` = 100 * mean(has_q),
            `% titles with "!"` = 100 * mean(title_has_excl)) %>%
  mutate(across(where(is.numeric), ~ round(.x, 1))) %>%
  knitr::kable(caption = "Presence of exclamation / question marks")

Presence of exclamation / question marks
label	% with “!”	% with “?”	% titles with “!”
Fake	32.1	49.4	11.1
Real	3.8	6.3	0.1

# Token-level analyses (words, n-grams) are run on a stratified random sample to keep
# memory and run-time reasonable; change params$sample_n to use more articles.
set.seed(429)
samp <- df %>% group_by(label) %>% slice_sample(n = min(params$sample_n, min(table(df$label)))) %>% ungroup()
cat("Sample used for token analyses:", nrow(samp), "articles\n")

## Sample used for token analyses: 12000 articles

q99_wc <- quantile(df$word_count, 0.99)   # used to trim extreme tails in plots

4. Exploratory Data Analysis

4.1 Temporal Analysis

# Articles per month by class
monthly <- df %>% mutate(ym = floor_date(date_parsed, "month")) %>% count(ym, label)

p <- ggplot(monthly, aes(ym, n, colour = label)) +
  geom_line(linewidth = 1) + geom_point(size = 1.5) +
  scale_colour_manual(values = pal, name = "Class") +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
  labs(title = "Article frequency over time", x = "Month", y = "Articles published") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
save_plot(p, "01_articles_over_time")

# Day-of-week pattern (share of each class)
dow <- df %>% count(label, wday) %>% group_by(label) %>% mutate(share = n / sum(n))

p <- ggplot(dow, aes(wday, share, fill = label)) +
  geom_col(position = "dodge") +
  scale_fill_manual(values = pal, name = "Class") +
  scale_y_continuous(labels = percent) +
  labs(title = "Publication by day of week", x = "Day of week", y = "Share of the class's articles")
save_plot(p, "02_day_of_week")

# Articles by subject category
subj <- df %>% count(subject, label)

p <- ggplot(subj, aes(reorder(subject, n), n, fill = label)) +
  geom_col() + coord_flip() +
  geom_text(aes(label = comma(n)), hjust = -0.1, size = 3.2) +
  scale_fill_manual(values = pal, name = "Class") +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  labs(title = "Articles by subject category", x = "Subject", y = "Articles")
save_plot(p, "03_articles_by_subject")

# Heatmap: subject x year-month
heat <- df %>% mutate(ym = format(floor_date(date_parsed, "month"), "%Y-%m")) %>% count(subject, ym)

p <- ggplot(heat, aes(ym, subject, fill = n)) +
  geom_tile(colour = "white") +
  scale_fill_viridis_c(option = "magma", direction = -1, trans = "sqrt", name = "Articles") +
  scale_x_discrete(breaks = function(x) x[seq(1, length(x), by = 3)]) +
  labs(title = "Publication pattern: subject vs. month", x = "Month", y = "Subject") +
  theme(axis.text.x = element_text(angle = 60, hjust = 1))
save_plot(p, "04_subject_month_heatmap", h = 5.5)

df %>% group_by(label) %>%
  summarise(first = min(date_parsed), last = max(date_parsed), months = n_distinct(floor_date(date_parsed, "month"))) %>%
  knitr::kable(caption = "Publication window per class")

Publication window per class
label	first	last	months
Fake	2015-03-31	2018-02-19	35
Real	2016-01-13	2017-12-31	24

Interpretation. The two classes cover different time windows, so volume differences over time partly reflect how the datasets were collected, not real publishing behaviour. Weekday patterns and subject activity are best read as descriptions of each source.

4.2 Text Length and Structure

# Word-count histogram + density, and title-length histogram (tails trimmed at the 99th percentile)
p1 <- df %>% filter(word_count <= q99_wc) %>%
  ggplot(aes(word_count, fill = label)) +
  geom_histogram(aes(y = after_stat(density)), bins = 50, alpha = 0.55, position = "identity") +
  geom_density(aes(colour = label), fill = NA, linewidth = 0.9) +
  scale_fill_manual(values = pal, name = "Class") + scale_colour_manual(values = pal, guide = "none") +
  labs(title = "Distribution of word counts", x = "Words per article", y = "Density")

p2 <- ggplot(df, aes(title_words, fill = label)) +
  geom_histogram(aes(y = after_stat(density)), binwidth = 1, alpha = 0.6, position = "identity") +
  scale_fill_manual(values = pal, name = "Class") + coord_cartesian(xlim = c(0, 40)) +
  labs(title = "Distribution of title lengths", x = "Words per title", y = "Density")

g <- gridExtra::arrangeGrob(p1, p2, ncol = 2)
ggsave("figures/05_wordcount_titlelength_hist.png", g, width = 13, height = 5, dpi = 150)
grid::grid.newpage(); grid::grid.draw(g)

# Word count by subject (boxplot, tail trimmed)
p <- ggplot(df, aes(reorder(subject, word_count, median), word_count, fill = label)) +
  geom_boxplot(outlier.alpha = 0.1, outlier.size = 0.6) +
  coord_flip(ylim = c(0, q99_wc)) +
  scale_fill_manual(values = pal, name = "Class") +
  labs(title = "Word count by subject", x = "Subject", y = "Words per article")
save_plot(p, "06_wordcount_by_subject_box")

# Title length vs text length (random subset of points to avoid over-plotting)
set.seed(429)
sc <- df %>% group_by(label) %>% slice_sample(n = 3000) %>% ungroup()

p <- ggplot(sc, aes(title_chars, char_count, colour = label)) +
  geom_point(alpha = 0.25, size = 1) +
  geom_smooth(method = "lm", se = FALSE, linewidth = 1) +
  scale_y_log10(labels = comma) +
  scale_colour_manual(values = pal, name = "Class") +
  labs(title = "Title length vs. text length", x = "Title length (characters)", y = "Text length (characters, log scale)")
save_plot(p, "07_title_vs_text_scatter")

p <- ggplot(df, aes(char_count, fill = label)) +
  geom_density(alpha = 0.5) +
  scale_x_log10(labels = comma) +
  scale_fill_manual(values = pal, name = "Class") +
  labs(title = "Character count distribution", x = "Characters per article (log scale)", y = "Density")
save_plot(p, "08_charcount_density")

Interpretation. Body length overlaps heavily between classes (both are long-form), so length alone is a weak signal. Titles are where the classes visibly diverge (see the title histogram).

4.3 Word Frequency Analysis

# Tokenise the cleaned (stopword-free) combined text of the sample
tokens <- samp %>% select(id, label, subject, combined_ns) %>%
  unnest_tokens(word, combined_ns) %>%
  filter(str_length(word) > 2)

# Top 20 words overall (term frequency)
top20 <- tokens %>% count(word, sort = TRUE) %>% slice_head(n = 20)

p <- ggplot(top20, aes(reorder(word, n), n)) +
  geom_col(fill = "#34495E") + coord_flip() +
  scale_y_continuous(labels = comma) +
  labs(title = "Top 20 most frequent words", x = NULL, y = "Frequency (sampled articles)")
save_plot(p, "09_top20_words")

# Top 10 words within each subject (term frequency)
top_subj <- tokens %>% count(subject, word) %>%
  group_by(subject) %>% slice_max(n, n = 10, with_ties = FALSE) %>% ungroup()

p <- ggplot(top_subj, aes(reorder_within(word, n, subject), n, fill = subject)) +
  geom_col(show.legend = FALSE) + coord_flip() +
  scale_x_reordered() + facet_wrap(~subject, scales = "free", ncol = 2) +
  labs(title = "Top 10 words per subject", x = NULL, y = "Frequency")
save_plot(p, "10_top_words_by_subject", h = 9)

# TF-IDF with each subject treated as one "document": highlights words *specific* to a subject
tfidf <- tokens %>% count(subject, word) %>% bind_tf_idf(word, subject, n)

top_tfidf <- tfidf %>% group_by(subject) %>% slice_max(tf_idf, n = 8, with_ties = FALSE) %>% ungroup()

p <- ggplot(top_tfidf, aes(reorder_within(word, tf_idf, subject), tf_idf, fill = subject)) +
  geom_col(show.legend = FALSE) + coord_flip() +
  scale_x_reordered() + facet_wrap(~subject, scales = "free", ncol = 2) +
  labs(title = "Most distinctive words per subject (TF-IDF)", x = NULL, y = "TF-IDF")
save_plot(p, "11_tfidf_by_subject", h = 9)

# Words that best separate Fake from Real: log2 ratio of relative frequencies
# (add-one smoothing; words with fewer than 50 occurrences are ignored)
word_ratio <- tokens %>% count(word, label) %>%
  pivot_wider(names_from = label, values_from = n, values_fill = 0) %>%
  filter(Fake + Real >= 50) %>%
  mutate(p_fake = (Fake + 1) / (sum(Fake) + 1), p_real = (Real + 1) / (sum(Real) + 1),
         log_ratio = log2(p_fake / p_real))

top_ratio <- bind_rows(slice_max(word_ratio, log_ratio, n = 15, with_ties = FALSE),
                       slice_min(word_ratio, log_ratio, n = 15, with_ties = FALSE)) %>%
  mutate(side = ifelse(log_ratio > 0, "Fake", "Real"))

p <- ggplot(top_ratio, aes(reorder(word, log_ratio), log_ratio, fill = side)) +
  geom_col() + coord_flip() +
  scale_fill_manual(values = pal, name = "More typical of") +
  labs(title = "Words that most distinguish fake from real news",
       x = NULL, y = "log2(relative frequency in Fake / relative frequency in Real)")
save_plot(p, "12_discriminating_words", h = 7)

# Word cloud: overall word frequency
freq <- tokens %>% count(word, sort = TRUE)
dual_plot("13_wordcloud_overall", {
  set.seed(429)
  wordcloud(freq$word, freq$n, max.words = 120, random.order = FALSE,
            colors = brewer.pal(8, "Dark2"), scale = c(4, 0.6))
})

# Comparison cloud: words characteristic of Fake vs Real
mat_label <- tokens %>% count(word, label) %>% reshape2::acast(word ~ label, value.var = "n", fill = 0)
dual_plot("14_comparison_cloud_label", {
  set.seed(429)
  comparison.cloud(mat_label, max.words = 120, colors = pal[colnames(mat_label)],
                   title.size = 1.6, random.order = FALSE)
})

# Comparison cloud across all subjects (words unique to each subject)
mat_subj <- tokens %>% count(word, subject) %>% reshape2::acast(word ~ subject, value.var = "n", fill = 0)
dual_plot("15_comparison_cloud_subject", {
  set.seed(429)
  comparison.cloud(mat_subj, max.words = 150, colors = brewer.pal(max(3, ncol(mat_subj)), "Dark2"),
                   title.size = 1.1, random.order = FALSE)
}, w = 8, h = 8)

Interpretation. Frequent words mostly describe US politics for both classes. The log-ratio chart is more informative: it shows the vocabulary and style markers (e.g. reporting verbs, institutions, colloquial or emotive words) that tilt towards one class.

4.4 Sentiment Analysis

We use the Bing lexicon (included in tidytext, no download needed). The word “trump” is labelled positive in that lexicon, which would be a serious error for a corpus about Donald Trump, so it is removed. The score is (positive words - negative words) / total words, so articles of different lengths are comparable.

bing <- get_sentiments("bing") %>% filter(word != "trump")
pos_words <- bing$word[bing$sentiment == "positive"]
neg_words <- bing$word[bing$sentiment == "negative"]

toks <- stringi::stri_extract_all_words(df$combined_ns)   # one word vector per article
df$n_pos  <- vapply(toks, function(w) sum(w %in% pos_words), integer(1))
df$n_neg  <- vapply(toks, function(w) sum(w %in% neg_words), integer(1))
df$n_toks <- vapply(toks, function(w) sum(!is.na(w)), integer(1))
rm(toks)

df <- df %>%
  mutate(sent_score = (n_pos - n_neg) / pmax(n_toks, 1),
         sent_cat = case_when(sent_score >  0.005 ~ "Positive",   # +/-0.5% net share = neutral band
                              sent_score < -0.005 ~ "Negative",
                              TRUE ~ "Neutral") %>% factor(levels = c("Negative", "Neutral", "Positive")))

df %>% group_by(label) %>%
  summarise(mean = mean(sent_score), median = median(sent_score), sd = sd(sent_score)) %>%
  mutate(across(where(is.numeric), ~ round(.x, 4))) %>% knitr::kable(caption = "Sentiment score by class")

Sentiment score by class
label	mean	median	sd
Fake	-0.0182	-0.0182	0.0434
Real	-0.0112	-0.0099	0.0387

p <- ggplot(df, aes(sent_score, fill = label)) +
  geom_histogram(aes(y = after_stat(density)), bins = 60, alpha = 0.55, position = "identity") +
  scale_fill_manual(values = pal, name = "Class") + coord_cartesian(xlim = c(-0.1, 0.1)) +
  labs(title = "Distribution of sentiment scores", x = "Net sentiment (positive - negative share of words)", y = "Density")
save_plot(p, "16_sentiment_hist")

p <- ggplot(df, aes(reorder(subject, sent_score, median), sent_score, fill = label)) +
  geom_boxplot(outlier.alpha = 0.1, outlier.size = 0.6) + coord_flip(ylim = c(-0.1, 0.1)) +
  scale_fill_manual(values = pal, name = "Class") +
  labs(title = "Sentiment by subject", x = "Subject", y = "Net sentiment score")
save_plot(p, "17_sentiment_by_subject")

p <- df %>% count(label, sent_cat) %>% group_by(label) %>% mutate(share = n / sum(n)) %>%
  ggplot(aes(sent_cat, share, fill = label)) +
  geom_col(position = "dodge") +
  geom_text(aes(label = percent(share, accuracy = 0.1)), position = position_dodge(0.9), vjust = -0.4, size = 3.2) +
  scale_fill_manual(values = pal, name = "Class") + scale_y_continuous(labels = percent, expand = expansion(mult = c(0, 0.12))) +
  labs(title = "Sentiment category counts (share within class)", x = "Sentiment category", y = "Share of articles")
save_plot(p, "18_sentiment_categories")

# Robustness check: compare the lexicon score with sentimentr (sentence-level, handles negation)
# on a small sample. Wrapped in tryCatch so the report still knits if sentimentr fails.
sent_check <- tryCatch({
  set.seed(429)
  s <- df %>% group_by(label) %>% slice_sample(n = 500) %>% ungroup()
  sc <- sentimentr::sentiment_by(sentimentr::get_sentences(s$text_base))
  tibble(bing = s$sent_score, sentimentr = sc$ave_sentiment)
}, error = function(e) { message("sentimentr check skipped: ", conditionMessage(e)); NULL })

if (!is.null(sent_check)) {
  cat("Spearman correlation, Bing score vs sentimentr (n = 1000):",
      round(cor(sent_check$bing, sent_check$sentimentr, method = "spearman"), 3), "\n")
}

## Spearman correlation, Bing score vs sentimentr (n = 1000): 0.733

4.5 N-gram Analysis

# Bigrams from the stopword-retaining text, then drop pairs that contain a stopword
bigrams <- samp %>% select(id, label, combined_lc) %>%
  unnest_tokens(bigram, combined_lc, token = "ngrams", n = 2) %>%
  filter(!is.na(bigram)) %>%
  separate(bigram, c("w1", "w2"), sep = " ", remove = FALSE) %>%
  filter(!w1 %in% sw, !w2 %in% sw, str_length(w1) > 2, str_length(w2) > 2)

top_bi <- bigrams %>% count(bigram, sort = TRUE) %>% slice_head(n = 15)
p <- ggplot(top_bi, aes(reorder(bigram, n), n)) +
  geom_col(fill = "#16A085") + coord_flip() + scale_y_continuous(labels = comma) +
  labs(title = "Top 15 bigrams (all sampled articles)", x = NULL, y = "Frequency")
save_plot(p, "19_top15_bigrams")

top_bi_lab <- bigrams %>% count(label, bigram) %>% group_by(label) %>%
  slice_max(n, n = 15, with_ties = FALSE) %>% ungroup()
p <- ggplot(top_bi_lab, aes(reorder_within(bigram, n, label), n, fill = label)) +
  geom_col(show.legend = FALSE) + coord_flip() + scale_x_reordered() +
  scale_fill_manual(values = pal) + facet_wrap(~label, scales = "free") +
  labs(title = "Top 15 bigrams by class", x = NULL, y = "Frequency")
save_plot(p, "20_top_bigrams_by_class", w = 10, h = 6.5)

# Trigrams: keep only those with no stopword in any position
trigrams <- samp %>% select(id, label, combined_lc) %>%
  unnest_tokens(trigram, combined_lc, token = "ngrams", n = 3) %>%
  filter(!is.na(trigram)) %>%
  separate(trigram, c("w1", "w2", "w3"), sep = " ", remove = FALSE) %>%
  filter(!w1 %in% sw, !w2 %in% sw, !w3 %in% sw, str_length(w1) > 2, str_length(w3) > 2)

top_tri <- trigrams %>% count(label, trigram) %>% group_by(label) %>%
  slice_max(n, n = 15, with_ties = FALSE) %>% ungroup()
p <- ggplot(top_tri, aes(reorder_within(trigram, n, label), n, fill = label)) +
  geom_col(show.legend = FALSE) + coord_flip() + scale_x_reordered() +
  scale_fill_manual(values = pal) + facet_wrap(~label, scales = "free") +
  labs(title = "Top 15 trigrams by class", x = NULL, y = "Frequency")
save_plot(p, "21_top_trigrams_by_class", w = 10, h = 6.5)

4.6 Readability Analysis

Flesch Reading Ease and Flesch-Kincaid Grade are computed from word, sentence and syllable counts. Syllables are approximated by counting vowel groups (minus silent final “e”), which is fast on 40,000+ articles but slightly less accurate than a dictionary method, so compare groups rather than trusting individual scores. Articles under 30 words are excluded (unstable), and extreme values are clipped.

df <- df %>%
  mutate(
    n_sent = pmax(stringi::stri_count_regex(text_base, "[.!?]+(\\s|$)"), 1),
    letters_lc = str_to_lower(str_replace_all(text_base, "[^A-Za-z\\s]", " ")),
    n_syl = stringi::stri_count_regex(letters_lc, "[aeiouy]+") -
            stringi::stri_count_regex(letters_lc, "\\b[a-z]{2,}[^aeiouyl\\s]e\\b"),
    words_per_sent = word_count / n_sent,
    syl_per_word   = pmax(n_syl, 1) / word_count,
    flesch   = 206.835 - 1.015 * words_per_sent - 84.6 * syl_per_word,
    fk_grade = 0.39 * words_per_sent + 11.8 * syl_per_word - 15.59,
    flesch   = ifelse(word_count < 30, NA, pmin(pmax(flesch, -50), 120)),
    fk_grade = ifelse(word_count < 30, NA, pmin(pmax(fk_grade, 0), 30))
  ) %>% select(-letters_lc)

df %>% group_by(label) %>%
  summarise(across(c(flesch, fk_grade), list(mean = ~ mean(.x, na.rm = TRUE), median = ~ median(.x, na.rm = TRUE)))) %>%
  mutate(across(where(is.numeric), ~ round(.x, 2))) %>% knitr::kable(caption = "Readability by class")

Readability by class
label	flesch_mean	flesch_median	fk_grade_mean	fk_grade_median
Fake	41.61	45.07	15.17	14.09
Real	41.99	42.42	13.18	13.02

p1 <- ggplot(df, aes(reorder(subject, flesch, median, na.rm = TRUE), flesch, fill = label)) +
  geom_boxplot(outlier.alpha = 0.1, outlier.size = 0.6, na.rm = TRUE) + coord_flip() +
  scale_fill_manual(values = pal, name = "Class") +
  labs(title = "Flesch Reading Ease by subject", x = "Subject", y = "Flesch Reading Ease (higher = easier)")
save_plot(p1, "22_flesch_by_subject")

p2 <- ggplot(df, aes(reorder(subject, fk_grade, median, na.rm = TRUE), fk_grade, fill = label)) +
  geom_boxplot(outlier.alpha = 0.1, outlier.size = 0.6, na.rm = TRUE) + coord_flip() +
  scale_fill_manual(values = pal, name = "Class") +
  labs(title = "Flesch-Kincaid Grade Level by subject", x = "Subject", y = "US school grade level")
save_plot(p2, "23_fk_grade_by_subject")

set.seed(429)
sc2 <- df %>% filter(!is.na(flesch)) %>% group_by(label) %>% slice_sample(n = 3000) %>% ungroup()
p <- ggplot(sc2, aes(word_count, flesch, colour = label)) +
  geom_point(alpha = 0.25, size = 1) +
  geom_smooth(method = "loess", se = FALSE, linewidth = 1) +
  scale_x_log10(labels = comma) + scale_colour_manual(values = pal, name = "Class") +
  labs(title = "Readability vs. article length", x = "Word count (log scale)", y = "Flesch Reading Ease")
save_plot(p, "24_readability_vs_wordcount")

5. Correlation Analysis

# Spearman correlation (robust to the skewed distributions seen above); is_fake: 1 = fake
cor_vars <- df %>%
  transmute(is_fake = as.integer(label == "Fake"), word_count, title_words, avg_word_len,
            upper_ratio, excl_count, sentiment = sent_score, flesch, fk_grade)
cm <- cor(cor_vars, use = "pairwise.complete.obs", method = "spearman")

cor_long <- as.data.frame(as.table(cm)) %>% rename(r = Freq)
p <- ggplot(cor_long, aes(Var1, Var2, fill = r)) +
  geom_tile(colour = "white") +
  geom_text(aes(label = sprintf("%.2f", r)), size = 3.3) +
  scale_fill_gradient2(low = "#2471A3", mid = "white", high = "#C0392B", limits = c(-1, 1), name = "Spearman r") +
  labs(title = "Correlation heatmap of numerical features", x = NULL, y = NULL) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
save_plot(p, "25_correlation_heatmap", w = 8, h = 6.5)

# Fake vs Real comparison for each feature: medians, Mann-Whitney test, and an effect size
# "prob_fake_higher" = chance that a random fake article scores higher than a random real one
# (0.5 = no difference; with n this large, p-values are always tiny, so judge by the effect size)
effect_vars <- c("word_count", "title_words", "avg_word_len", "upper_ratio",
                 "excl_count", "sent_score", "flesch", "fk_grade")
effect_tbl <- map_dfr(effect_vars, function(v) {
  x <- df[[v]][df$label == "Fake"]; x <- x[!is.na(x)]
  y <- df[[v]][df$label == "Real"]; y <- y[!is.na(y)]
  w <- suppressWarnings(wilcox.test(x, y))
  tibble(feature = v, median_fake = median(x), median_real = median(y),
         p_value = w$p.value, prob_fake_higher = unname(w$statistic) / (length(x) * length(y)))
})
effect_tbl %>% mutate(across(c(median_fake, median_real, prob_fake_higher), ~ round(.x, 3)),
                      p_value = format.pval(p_value, digits = 2)) %>%
  knitr::kable(caption = "Fake vs. Real: medians, Mann-Whitney p-value and effect size")

Fake vs. Real: medians, Mann-Whitney p-value and effect size
feature	median_fake	median_real	p_value	prob_fake_higher
word_count	382.000	359.000	<2e-16	0.548
title_words	14.000	10.000	<2e-16	0.874
avg_word_len	4.701	4.941	<2e-16	0.261
upper_ratio	0.007	0.003	<2e-16	0.646
excl_count	0.000	0.000	<2e-16	0.643
sent_score	-0.018	-0.010	<2e-16	0.442
flesch	45.075	42.418	<2e-16	0.545
fk_grade	14.087	13.016	<2e-16	0.592

6. Key Findings and Insights

6.1 Key findings

Headlines are the strongest stylistic signal. Fake headlines average 14.6 words versus 10.1 for real ones; 11.1% of fake headlines contain “!” (real: 0.08%), and ALL-CAPS words make up 18.5% of fake-headline words versus 1.7% for real.
Emphatic punctuation in the body. 32.1% of fake articles use “!” and 49.4% use “?”, compared with 3.8% and 6.3% of real articles.
Length is a weak discriminator. Median body length is 382 words (fake) versus 359 (real); the distributions overlap heavily.
Vocabulary differs. Words most over-represented in fake news: getty, screenshot, reilly, hilarious, flickr, bundy; in real news: rohingya, catalan, rakhine, myanmar, zuma, spd.
Sentiment: the mean net sentiment is -0.0182 (fake) vs -0.0112 (real), i.e. fake news is slightly lower; 63.6% of fake and 54.9% of real articles are classed negative.
Readability: median Flesch score is 45.1 (fake) vs 42.4 (real); median grade level is 14.1 vs 13.0. Fake news is therefore easier to read by this metric.
Temporal coverage differs by class. Fake articles span Mar 2015 to Feb 2018; real articles span Jan 2016 to Dec 2017. Subject labels do not overlap between classes. Both are data-collection artefacts rather than behavioural findings.
Data quality: 6,251 rows (13.9%) were removed, 5,610 of them duplicates, and 98.5% of real articles carried a “(Reuters)” dateline that had to be stripped to avoid trivial leakage.

6.2 Answers to the Phase 1 research questions

RQ1. What linguistic and structural patterns distinguish fake from real news? Structure rather than length separates the classes: longer and more emphatic headlines (more words, more ALL-CAPS words, far more “!”), and more “!” and “?” inside the body (Sections 3 and 4.2). The effect-size table in Section 5 quantifies this; values far from 0.5 in prob_fake_higher mark the strongest signals.

RQ2. How do publication patterns (frequency, timing, topics) differ? Publication frequency differs mainly because the two datasets cover different periods (Section 4.1). Weekday profiles are described in Figure 02, and topics are source-specific: the fake file is split into News, politics, left-news, Government News, US_News and Middle-east, while real news is politicsNews and worldnews. Because those labels never overlap, subject cannot be treated as an independent predictor.

RQ3. Which textual features (word frequency, sentiment, readability) are characteristic of fake news? The log-ratio word chart (Figure 12) and the n-gram charts (Figures 19-21) show distinctive vocabulary and recurring phrases; sentiment and readability differences are listed in 6.1 and quantified in the effect-size table. Sentiment and readability differences are real but modest relative to headline style, so they work best as supporting features in a model.

6.3 Limitations and recommendations

Source confounding. All real articles come from Reuters and all fake ones from a small set of US political outlets. Differences may reflect outlet style (e.g. wire-service conventions) rather than truthfulness, so conclusions may not generalise to other platforms or to Kenyan social media content, the focus of Phase 1.
Leakage risks. Subject labels, date ranges and the Reuters dateline separate the classes by themselves. We stripped the dateline, but residual cues (e.g. boilerplate phrases) may remain and should be inspected before modelling.
Narrow topic and period. US politics and world news, roughly 2015-2018; language, events and misinformation tactics have since changed.
Lexicon and heuristic limits. Bing sentiment ignores context, sarcasm and negation, and the syllable-based readability formulas are approximations (sentimentr cross-check in 4.4).
Sampling. Word and n-gram results use a stratified sample (params$sample_n per class); rerun with a larger value to check stability.
Duplicates. Removing duplicates keeps the first occurrence, which slightly affects per-subject counts.
Recommendations. Add source-independent data (social-media posts, Kenyan/East African news, other languages including Swahili and Sheng), engagement and network features (shares, account age), and fact-checker labels. Next steps: hold out outlets (not random rows) when evaluating, then fit a simple classifier (logistic regression on the engineered features, then TF-IDF) as planned for Phase 3.

7. Conclusion

After cleaning the combined corpus (duplicates, missing dates and source tags removed), the strongest and most consistent differences between fake and real news were stylistic and concentrated in the headline: length, ALL-CAPS usage and exclamation marks, followed by body punctuation and vocabulary. Article length is similar across classes; sentiment and readability differ only modestly. These engineered features give a sound, interpretable starting point for the predictive modelling phase, provided source and period confounding are controlled for during evaluation. All figures are saved in the figures/ folder.

Appendix: Session Info

sessionInfo()

## R version 4.6.1 (2026-06-24 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=English_United States.utf8 
## [2] LC_CTYPE=English_United States.utf8   
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=C                             
## 
## time zone: Africa/Nairobi
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] scales_1.4.0       wordcloud_2.6      RColorBrewer_1.1-3 tidytext_0.4.3    
##  [5] lubridate_1.9.5    forcats_1.0.1      stringr_1.6.0      dplyr_1.2.1       
##  [9] purrr_1.2.2        readr_2.2.0        tidyr_1.3.2        tibble_3.3.1      
## [13] ggplot2_4.0.3      tidyverse_2.0.0   
## 
## loaded via a namespace (and not attached):
##  [1] textshape_1.7.5     gtable_0.3.6        xfun_0.62          
##  [4] bslib_0.12.0        lattice_0.22-9      tzdb_0.5.0         
##  [7] vctrs_0.7.3         tools_4.6.1         generics_0.1.4     
## [10] parallel_4.6.1      janeaustenr_1.0.0   pkgconfig_2.0.3    
## [13] tokenizers_0.3.0    Matrix_1.7-5        data.table_1.18.6.1
## [16] S7_0.2.2            lifecycle_1.0.5     compiler_4.6.1     
## [19] farver_2.1.2        textshaping_1.0.5   qdapRegex_0.7.10   
## [22] SnowballC_0.7.1     htmltools_0.5.9     sass_0.4.10        
## [25] yaml_2.3.12         pillar_1.11.1       crayon_1.5.3       
## [28] jquerylib_0.1.4     cachem_1.1.0        lexicon_1.3.2      
## [31] nlme_3.1-169        sentimentr_2.9.0    tidyselect_1.2.1   
## [34] digest_0.6.39       stringi_1.8.9       slam_0.1-56        
## [37] reshape2_1.4.5      splines_4.6.1       labeling_0.4.3     
## [40] fastmap_1.2.0       grid_4.6.1          cli_3.6.6          
## [43] magrittr_2.0.5      textclean_0.9.7     withr_3.0.3        
## [46] bit64_4.8.6         timechange_0.4.0    rmarkdown_2.32     
## [49] bit_4.6.0           otel_0.2.0          gridExtra_2.3.1    
## [52] ragg_1.5.2          hms_1.1.4           NLP_0.3-3          
## [55] evaluate_1.0.5      knitr_1.52          viridisLite_0.4.3  
## [58] tm_0.7-20           mgcv_1.9-4          rlang_1.3.0        
## [61] syuzhet_1.0.7       Rcpp_1.1.2          glue_1.8.1         
## [64] xml2_1.6.0          rstudioapi_0.19.0   vroom_1.7.1        
## [67] jsonlite_2.0.0      plyr_1.8.9          R6_2.6.1           
## [70] systemfonts_1.3.2

Fake News Detection: Exploratory Data Analysis

29 October 2026