バイラルな世論調査は代表的な世論調査ではない

バイラルな世論調査は代表的な世論調査ではない

選挙まであと1週間足らずとなり、人々は何が起こるかを知りたがっています。これはいつものように、多くの世論調査と多くの熱狂的な憶測につながります。しかし、これには問題があります。多くの人々はニュースの受動的な消費者であるということです。彼らは自分のフィードに偶然流れてきたものを読み、そのため、彼らが見るものはバイラルになったものの関数となります。この問題点は、最もバイラルになった世論調査が、最も代表的な世論調査ではないということです。私は以前Twitterでこれを調査しましたが、今、改めて取り上げる価値があると思いました。

Muskが学術利用のためにTwitter APIを完全に破壊してしまったため、代わりにBlueskyで何が起こっているかに頼らざるを得ませんでした。Blueskyは、明確な左派的傾斜があることで知られており、同時に「ベテランミレニアル世代の引退後の投稿先」（https://bsky.app/profile/rincewind.run/post/3kvuqkz3pkh25）でもあります。したがって、これは世論調査でバイラルになったものの代表的なサンプルとは言えませんが、私が長い間Twitterを見て発見したことと一致しています。要するに、私は@usapolling.bsky.social（Blueskyで最も活発な「世論調査配布」アカウントと思われる）の過去90日間の投稿をスクレイピングしました。その後、LLMと過度に複雑なプロンプト（下記参照）を使用して、各投稿の情報を抽出しました。次に、各レースの（民主党-共和党の）差を計算し、最終的に各レースの平均差を計算しました。さらに単純化するために、この分析は単一の一般選挙の世論調査を含む投稿のみに焦点を当てています。完璧なものはありませんが、私はおそらく執筆可能な研究や講義に時間を費やすべきでしょう。

図1は、各レースの平均差からの乖離度別に、各世論調査投稿のリポスト数を示しています。X軸に沿って右に進むほど、そのレースの他の世論調査よりも民主党に有利な世論調査であることを意味します。私は複数の世論調査が投稿されたレースのみを含めるようにフィルタリングしました。黒い線は最良適合線を示しており、世論調査が民主党にとって「より良い」（そのレースの平均世論調査からより離れている）ほど、より多くリポストされる傾向があることを示しています。

コード

library(tidyverse)
library(lme4)
library(broom.mixed)
library(huxtable)
library(ggeffects)

df <- read_csv(here::here("blog/data/election_polling.csv"))

df <- df |
  mutate(Date = as.Date(time)) |
  mutate(
    ID = as.factor(ID),
    Seat = as.factor(Seat),
    Date_Numeric = as.numeric(Date) - min(as.numeric(Date))
  ) |
  mutate(
    ID = case_when(
      ID == "Generic" & Seat == "GenericCongress" ~ "Generic-Congress",
      .default = paste0(ID, "-", Seat)
    )
  ) |
  filter(!(ID == "TX" & Seat == "GenericCongress"))


df |
  filter(N > 1) |
  ggplot(aes(x = Margin_Diff, y = reposts, color = Date)) +
  geom_point() +
  scale_y_log10() +
  geom_smooth(method = "lm", color = "black") +
  theme_minimal() +
  theme(legend.position = "bottom") +
  scale_color_viridis_c(trans = "date") +
  labs(
    x = "Difference from Average Margin",
    y = "Number of Reposts\n(Logged)"
  )

［画像: 図1］

図1: 平均差からの乖離度別リポスト数

レースレベルの変動を見ることも可能です。図2では、レースごと（および一般連邦議会世論調査のみの1つ）に分割した同じスタイルのプロットを示しています。私は10件以上の世論調査があるレースのみを含めました（それ以外は圧倒的すぎてしまいます）。ほとんどのレースで同じパターンが見られます。最もバイラルな投稿は、平均的な投稿よりも民主党を支持するものです（NC上院選レースが何らかの理由で例外です）。

コード

df |
  group_by(
    ID
  ) |
  filter(N > 10) |
  ggplot(aes(x = Margin_Diff, y = reposts, color = Date)) +
  geom_point() +
  scale_y_log10() +
  geom_smooth(method = "lm", color = "black") +
  facet_wrap(~ID) +
  scale_color_viridis_c(trans = "date") +
  labs(
    x = "Difference from Average Margin",
    y = "Number of Reposts\n(Logged)"
  ) +
  theme_minimal() +
  theme(legend.position = "bottom")

［画像: 図2］

図2: レース別 - 平均差からの乖離度別リポスト数

さらに一歩進んで、民主党-共和党の差、投稿の差（平均差から）、および投稿された日付に基づいてリポスト数を予測するモデルを推定できます。多くのレースを混ぜ合わせているという事実を考慮するために、各レースのランダム切片を持つモデルを推定します（一般連邦議会レースを除外し、5件以上の投稿があるレースのみを含めます）。平均差からの乖離度と差の値全体にわたるリポスト数の予測値は、図3に表示されています。ここでも、投稿のバイラル性が決定されるのは平均差からの乖離度であり、差自体は比較的無関係であることが示されています。

コード

mod <- lmer(
  log(reposts) ~ Margin_Diff + Margin + Date_Numeric + (1 | ID),
  data = df,
  subset = reposts > 0 & N > 5 & N < 50
)


ggpredict(mod, terms = c("Margin_Diff [-10:10] ")) |
  plot(show_title = FALSE) +
  scale_y_continuous(limits = c(0, 20)) +
  labs(
    x = "Difference from Average Margin",
    y = "Number of Reposts"
  )
ggpredict(mod, terms = c("Margin[-20:20]")) |
  plot(show_title = FALSE) +
  scale_y_continuous(limits = c(0, 20)) +
  labs(
    x = "Dem-Rep Margin",
    y = "Number of Reposts"
  )

#huxreg(mod)

［画像: 図3(a)］

（a）平均差からの乖離度に基づく予測リポスト数

［画像: 図3(b)］

（b）差に基づく予測リポスト数

図3: ランダム切片モデルからの予測

ランダム傾きも追加すると、どのレースが現在最もバイラルになりやすいかについて興味深いことがわかります。図4では、ランダム傾きとランダム切片を持つモデルのランダム効果を示しています。これは、各レースが他のレースとどのように異なるかを示すものとして読むことができます。例えば、TX上院選レースは一般的にリシェアが多くなる可能性があり、さらに、民主党が優勢であることを示す投稿は特にうまくいくだろうということです。対照的に、ペンシルベニア州知事選レースには誰も関心がありません（これはBlueskyがジョシュ・シャピロに対して抱いている感情に関係しているかもしれません）。

コード

mod <- lmer(
  log(reposts) ~ Margin_Diff + Margin + Date_Numeric + (1 + Margin_Diff | ID),
  data = df,
  subset = reposts > 0 & N > 5 & N < 50
)


sjPlot::get_model_data(mod, type = "re", sort.est = "Margin_Diff") |
  mutate(facet = ifelse(facet == "ID (Intercept)", "Intercept", "Slope")) |
  ggplot(aes(
    x = estimate,
    xmin = conf.low,
    xmax = conf.high,
    y = reorder(term, reihe)
  )) +
  geom_pointrange() +
  facet_wrap(~facet, scales = "free_x") +
  theme_minimal() +
  labs(y = "Estimate", x = "")

［画像: 図4］

図4: ランダム効果推定値

NoteAIの使用

Pythonコード（下記）は、OpenRouterのAuto Routerを使用して書かれました。これはLLMリクエストをモデルにルーティングします。OpenRouterが実行する分類モデルに基づいて異なるモデルにリクエストをルーティングし、品質を最大化しながらコストを最小限に抑えることを目指しています。私は、Zero Data Retentionモデルのみを使用するように設定しており（それはともかく）、コストは「高」のティアに設定しています。Rコードと文章は手書きで、文章のタイプミスや文法的な問題の特定のためにLLMを一度実行しました。