An Example R Markdown Document

In stevetemplates: Steve's R Markdown Templates

knitr::opts_chunk$set(cache=TRUE)
knitr::opts_chunk$set(fig.path='figs/')
knitr::opts_chunk$set(cache.path='cache/')

knitr::opts_chunk$set(
                  fig.process = function(x) {
                      x2 = sub('-\\d+([.][a-z]+)$', '\\1', x)
                      if (file.rename(x, x2)) x2 else x
                      }
                  )
library(tidyverse)
library(stevemisc)

Pop Songs and Political Science

Sheena Easton and Game Theory

Sheena Easton describes the following scenario for her baby:

1. Takes the morning train
2. Works from nine 'til five
3. Takes another train home again
4. Finds Sheena Easton waiting for him

A Total Conflict Game Between Sheena Easton and Her Baby

\begin{table}[h!] \centering \begin{tabular}{lcc} \hline & Sheena Easton & Sheena Easton \ & Stays Home & Goes to Baby's Work\ \hline {\bf Baby Home Again} & -100, {\bf 100} & {\bf 100}, 0 \ {\bf Baby Stays at Work} & {\bf 50}, 0 & -100, {\bf 100} \ \hline \end{tabular} \end{table}

Sheena Easton and her baby are playing a zero-sum (total conflict) game.

• Akin to Holmes-Moriarty game (see: von Neumann and Morgenstern)
• Solution: mixed strategy

Rick Astley's Re-election Platform

Rick Astley's campaign promises:

• Never gonna give you up.
• Never gonna let you down.
• Never gonna run around and desert you.
• Never gonna make you cry.
• Never gonna say goodbye.
• Never gonna tell a lie and hurt you.

Are these promises (if credible) sufficient to secure re-election?

df <- data.frame(x = rnorm(1000))
x <- df$x

ggplot(df, aes(x)) + 
  theme_steve_web() +
  stat_function(fun = dnorm, colour = "black") +
  scale_x_continuous(limits = c(-4, 4), 
                     breaks = c(-4,  0,  4),
                     labels = c("Complete\nEmotional\nNeglect", 
                                "Never Gonna Give You Up\nLet You Down\nRun Around and Desert You\n(Preference of Median Voter)",
                                "Maximum\nEmotional\nSupport")) +
  geom_vline(xintercept = 0) +
  geom_vline(xintercept = 1, linetype="dashed") +
  geom_vline(xintercept = -2, linetype = "dashed") +
  geom_vline(xintercept = -.5, linetype = "dotted") +
  scale_y_continuous(limits = c(0, .5), breaks = NULL, label=NULL) +
  xlab("A Unidimensional Continuum of the Policy Space of Emotional Support") +
  ylab("") +
  stat_function(fun = dnorm, 
                xlim = c(-4,-2),
                size=0,
                geom = "area", fill="#f8766d", alpha=1) +
  stat_function(fun = dnorm, 
                xlim = c(1, 4),
                size=0,
                geom = "area", fill="#619cff", alpha=1)  +
  stat_function(fun = dnorm, 
                xlim = c(-.5, 1),
                size=0,
                geom = "area", fill="#619cff", alpha=.4) +
  stat_function(fun = dnorm, 
                xlim = c(-2, -.5),
                size=0,
                geom = "area", fill="#f8766d", alpha=.4) +
  annotate("text", label="Astley's rival is promising\nfar less in the (public?) good\nof emotional support",
           size = 3.5, family="Open Sans",
           x = -2.1, y = .4,
           hjust = 1) +
  annotate("text", 
           label="Congressman Astley is pledging\nmore emotional support\n(i.e. never gonna make you cry/say goodbye/tell a lie/hurt you)\nthan most his constituents want",
           size = 3.5, family="Open Sans",
           x = 1.1, y = .4,
           hjust = 0) +
  annotate("text", 
           label="Preferences\ncloser to\nAstley's\nrival",
           size = 3.5, family="Open Sans",
           x = -1.2, y = .45,
           hjust = .5) +
  annotate("text", 
           label="Preferences\ncloser to\nCongressman\nAstley",
           size = 3.5, family="Open Sans",
           x = .5, y = .45,
           hjust = .5) +
  labs(title = "Median Voter Theorem Suggests Congressman Astley Secures Re-election Against His Rival",
       subtitle = "Assuming a unidimensional policy space and single-peaked preferences, Congressman Astley is closer to the median voter than his rival and wins the election.") +
  geom_hline(yintercept = 0) +
  geom_vline(xintercept = -4)

Rick Astley and Median Voter Theorem

Whereas these pledges conform to the preferences of the median voter, we expect Congressman Astley to secure re-election.

Caribbean Queen and Operation Urgent Fury

Billy Ocean released "Caribbean Queen" in 1984.

• Emphasized sharing the same dream
• Hearts beating as one

"Caribbean Queen" is about the poor execution of Operation Urgent Fury.

• Echoed JCS chairman David Jones' frustrations with military establishment.

Billy Ocean is advocating for what became the Goldwater-Nichols Act.

• Wanted to take advantage of economies of scale, resolve coordination problems in U.S. military.

The Good Day Hypothesis

We know the following about Ice Cube's day.

1. The Lakers beat the Supersonics.
2. No helicopter looked for a murder.
3. Consumed Fatburger at 2 a.m.
4. Goodyear blimp: "Ice Cube's a pimp."

The Good Day Hypothesis

This leads to two different hypotheses:

• $H_0$: Ice Cube's day is statistically indistinguishable from a typical day.
• $H_1$: Ice Cube is having a good (i.e. greater than average) day.

These hypotheses are tested using archival data of Ice Cube's life.

interval1 <- -qnorm((1-0.9)/2)  # 90% multiplier
interval2 <- -qnorm((1-0.95)/2) # 95% multiplier

tribble(
  ~variable, ~est, ~se,
  "Latent Estimate of\nIce Cube's Day", 1.6, .231
) %>%
  ggplot(.) + 
    theme_steve_web() +
  geom_hline(yintercept = .5, color = "red", lty=2) +
  geom_linerange(aes(x = variable, ymin = est - se*interval1,
                                ymax = est + se*interval1),
                            lwd = 1, position = position_dodge(width = 1/2)) +
  geom_pointrange(aes(x = variable, y = est, ymin = est - se*interval2,
                                 ymax = est + se*interval2),
                             lwd = 1/2, position = position_dodge(width = 1/2),
                             fill = "WHITE") +
  coord_flip() + xlab("") + ylab("Latent Estimate") +
  labs(title = "Latent Estimates from Ice Cube's Archives Lend Support to the 'Good Day' Hypothesis",
       subtitle = "Latent estimates are drawn from an item response model of indicators of the quality of Ice Cube's days. These include whether he had to use his A.K.",
       caption = "Data: Ice Cube's Archives, obviously fictional. Red value of .5 indicate likelihood of 'good day.'")

stevetemplates documentation built on Feb. 16, 2023, 6:17 p.m.