PolitiFact - 10+ Years of Fact Checking

1.1 Truth-O-Meter vs. Flip-O-Meter

On its site, PolitiFact evaluates statements using either its Truth-O-Meter or its Flip-O-Meter system. In short, the Truth-O-Meter is used to evaluate statements for their accuracy (did the speaker say the truth, a falsehood, or something in between?), while the Flip-O-Meter is used to evaluate an official’s consistency on an issue (did they maintain their position, or partly/completely change their stance on a topic?).

#Number and Proportions for total statements in Truth-O-Meter and Flip-O-Meter
temp <- politifact_orig %>% 
  group_by(Type) %>% 
  summarise(Subtotal = n()) %>%
  mutate(Proportion = round((Subtotal / sum(Subtotal)) * 100, 1),
         Subtotal = comma_format()(Subtotal))

V_Flip_O_Meter_n <- temp %>% 
  filter(Type == "Flip-O-Meter") %>% 
  select(Subtotal)
V_Flip_O_Meter_prop <- temp %>% 
  filter(Type == "Flip-O-Meter") %>% 
  select(Proportion)

V_Truth_O_Meter_n <- temp %>% 
  filter(Type == "Truth-O-Meter") %>% 
  select(Subtotal)
V_Truth_O_Meter_prop <- temp %>% 
  filter(Type == "Truth-O-Meter") %>% 
  select(Proportion)

From here on, my analysis will focus only on those statements evaluated by the Truth-O-Meter since they are much more numerous. There are 13,950 (98.4%) Truth-O-Meter Ratings and 231 (1.6%) Flip-O-Meter Ratings.

PolitiFact assigns statements one of six possible ratings to Truth-O-Meter Ratings:

• TRUE - The statement is accurate and there’s nothing significant missing.

• MOSTLY TRUE - The statement is accurate but needs clarification or additional information.

• HALF TRUE - The statement is partially accurate but leaves out important details or takes things out of context.

• MOSTLY FALSE - The statement contains an element of truth but ignores critical facts that would give a different impression.

• FALSE - The statement is not accurate.

• PANTS ON FIRE - The statement is not accurate and makes a ridiculous claim.

For more information on how PolitiFact selects and evaluates statements, see here.

2.1 Rating Issuer

#The locations/editions of PolitiFact summary stats
locations <- politifact %>%
  group_by(source) %>% 
  mutate(Founded = min(year(date))) %>%
  group_by(source, Founded, politifact_location) %>%
  summarise(Total_Ratings = n()) %>% 
  arrange(-Total_Ratings) %>%
  ungroup() %>%
  mutate(`Percentage of Total Ratings` = percent_format()(Total_Ratings / sum(Total_Ratings))) %>%
  rename(Issuer = source, Type = politifact_location)

locations <- locations %>%
  add_column(Rank = 1:nrow(locations)) %>%
  select(Rank, everything())

#Merging in the electoral votes for each state, from https://state.1keydata.com/state-electoral-votes.php
#don't forget Washington DC
electoral_votes <- tribble(
~US_State,  ~`Electoral Votes`, 
"Alabama", 9,
"Montana", 3,
"Alaska", 3,
"Nebraska", 5,
"Arizona", 11,
"Nevada", 6,
"Arkansas", 6,
"New Hampshire", 4,
"California", 55,
"New Jersey", 14,
"Colorado", 9,
"New Mexico", 5,
"Connecticut", 7,
"New York", 29,
"Delaware", 3,
"North Carolina", 15,
"Florida", 29,
"North Dakota", 3,
"Georgia", 16,
"Ohio", 18,
"Hawaii", 4,
"Oklahoma", 7,
"Idaho", 4,
"Oregon", 7,
"Illinois", 20,
"Pennsylvania", 20,
"Indiana", 11,
"Rhode Island", 4,
"Iowa", 6,
"South Carolina", 9,
"Kansas", 6,
"South Dakota", 3,
"Kentucky", 8,
"Tennessee", 11,
"Louisiana", 8,
"Texas", 38,
"Maine", 4,
"Utah", 6,
"Maryland", 10,
"Vermont", 3,
"Massachusetts", 11,
"Virginia", 13,
"Michigan", 16,
"Washington", 12,
"Minnesota", 10,
"West Virginia", 5,
"Mississippi", 6,
"Wisconsin", 10,
"Missouri", 10,
"Wyoming", 3,
"Washington D.C.", 3)

locations <- 
  locations %>% 
  separate(Issuer, c("A", "State"), sep = 11, remove = FALSE)

locations <- left_join(locations, electoral_votes, by = c("State" = "US_State"))%>%
  select(-A, -State) %>%
  mutate(Total_Ratings = comma_format()(Total_Ratings)) %>%
  rename(`Total Ratings` = Total_Ratings) %>%
  select(everything(), `Electoral Votes`)

#Most important Editions
top_x_issuers <- locations %>% 
  filter(`Percentage of Total Ratings` >= 1) %>% #Only takes those with individually more than 1% of the ratings
  mutate(Cumulative_Sum = percent_format()(cumsum(
    as.numeric(
      str_replace_all(`Percentage of Total Ratings`, "[[:punct:]]", "")) / 1000)))

values <- tibble(rating = levels(politifact$rating)[1:6], value = seq(-3, 2, 1)) %>%
  mutate(rating = as_factor(rating),
         rating = fct_relevel(rating, levels(politifact$rating)))

locations_rating <- politifact %>%
  group_by(source, rating) %>% 
  summarise(Total_Ratings = n()) 

locations_rating <- left_join(locations_rating, values, by = "rating") %>%
  mutate(score = Total_Ratings * value) %>%
  summarise(Score = round((sum(score) / sum(Total_Ratings)), 3))

one_percent_issuers <- left_join(top_x_issuers, locations_rating, by = c("Issuer" = "source")) %>%
  mutate(Issuer = factor(Issuer), 
         Issuer = fct_reorder(Issuer, Score)) %>%
  arrange(Score)

one_percent_issuers <- one_percent_issuers %>%
  mutate(cut = cut_interval(one_percent_issuers$Score, 12)) 

PolitiFact is made up of various “Editions” that focus on different sources for the statements that they will rate. There are a total of 25 editions, which I have grouped into two main categories: “State” Editions that focus on statements made by officials or people in a certain U.S. state (21 such editions) and “Non-State” Editions that do not focus on a a single state (the remaining 4 editions). These 21 State Editions cover states with a total of 345 electoral votes, equal to 64.1% of the total electoral votes available for presidential elections.

As we see from this table, PolitiFact National was the source for over one-third of the total statements evaluated. This is likely due in part to the fact that it was the earliest edition founded. The other “Not State” editions include PunditFact, which evaluates statements made by political pundits, PolitiFact Global News Service, which evaluates statements made about Health and Development, and PolitiFact NBC, which is a partnership between PolitiFact and NBC.

#Kable is Rmarkdown's way of making a table look good
kable(locations, align = c("l", "l", "r", "r", "r", "r", "r"), 
      caption = "The Various PolitiFact Editions")

Given that only a subset of all of the PolitiFact Editions are responsible for the vast majority of the statement ratings, I am going to focus on those Editions which individually were responsible for more than 1% of the Truth-O-Meter ratings. These top 12 PolitiFact Editions were cumulatively responsible for 94.0% of the total statements rated.

Looking at the most important PolitiFact Editions, I have set up a metric to measure the average truthfulness of the statements that they have rated. Any statement that is rated as True, I have assigned a Truthfulness Score of +2. Likewise, any statement that PolitiFact has rated False, I have assigned a Truthfulness value of -2. Mostly True, Half-True, and Mostly False statements thus correspond to scores of +1, 0, and -1 respectively. Pants on Fire! claims are “False” statements that are especially ridiculous, so I have given them a Truthfulness Score of -3 (see Table below).

#I came up with this metric myself
kable(values %>% 
        rename(`Statement Rating` = rating, `Truthfulness Score` = value) %>%
        arrange(desc(`Truthfulness Score`)), 
      caption = "Truthfulness Score per Statement Rating")

Using then the top 12 PolitiFact Editions, I have generated a Mean Truthfulness Score for all of the statements PolitiFact has examined. This number takes the total number of statements by rating (e.g. True, Mostly True, etc.), the Truthfulness Score I have assigned each rating, and then divides the sum of those Truthfulness values by the total number of ratings that each Edition has made. In other words, this metric says “What is the average truthfulness of a statement evaluated by each PolitiFact Edition?”.

As we see from the graph below, PunditFact has the lowest average Truthfulness score at -1.148, which means that the average statement that PunditFact rates is Mostly False. Rounding out the top three, PolitiFact Wisconsin and PolitiFact National were the next Editions with the lowest average Truthfulness Scores. On the other end of the spectrum PolitiFact Georgia and PolitiFact Ohio were the only Editions who had a positive truthfulness rating, meaning that the average statement they rated was at least Half-True.

ggplot(one_percent_issuers, aes(x = Issuer, y = Score, fill = cut)) +
  labs(x = "PolitiFact Edition (i.e. who rated the statement?)", 
       y = "Average Truthfulness Rating", 
       title = "Mean Truthfulness Score by PolitiFact Edition") +
  geom_col(color = "black", size = 1) +
  geom_label(label = one_percent_issuers$Score) +
  scale_x_discrete(labels = c(
    "PolitiFact Wisconsin" = "PolitiFact\n Wisconsin", 
    "PolitiFact National" = "PolitiFact\n National",
    "PolitiFact Rhode Island" = "PolitiFact\n Rhode Island",
    "PolitiFact New Hampshire" = "PolitiFact\n New Hampshire",
    "PolitiFact Virginia" = "PolitiFact\n Virginia",
    "PolitiFact Texas" = "PolitiFact\n Texas",
    "PolitiFact Florida" = "PolitiFact\n Florida",
    "PolitiFact Oregon" = "PolitiFact\n Oregon",
    "PolitiFact New Jersey" = "PolitiFact\n New Jersey",
    "PolitiFact Ohio" = "PolitiFact\n Ohio",
    "PolitiFact Georgia" = "PolitiFact\n Georgia")) +
  scale_fill_manual(values = c("#E40602", "#D0240D", "#BD4318", "#AA6223", "#97812E", "#84A039", "#71BF44")) +
  theme(legend.position = "none")

2.2 Ratings Over Time

Given that PolitiFact provides the date that it has rated each statement, it may be interesting to explore if the relative truthfulness of the statements rated has changed over time. Since mid-2010, PolitiFact has generally issued about 3-4 statement ratings per day. In the below graph, I have taken the Mean Truthfulness Score for all of the statements that PolitiFact has evaluated each month (excluding months where PolitiFact rated fewer than 30 statements) and a smooth line to estimate the average Mean Truthfulness Score over time.

Some interesting trends present themselves.

avg_score_all <- politifact %>%
  group_by(rating) %>%
  summarise(n = n())

avg_score_all <- left_join(avg_score_all, values, by = c("rating" = "rating")) %>%
  mutate(score = value * n) %>%
  summarise(avg_value = sum(score) / sum(n)) #The average score for PolitiFact Truth-O-Meter's history

1. The Mean Truthfulness Score for each month is generally negative (the overall rating for all statements PolitiFact has rated was -0.33). There were only two occasions where the Mean Truthfulness Score was notably positive for a few months in a row: September and October of 2007 (early in PolitiFact’s rating history) and around December 2012 / January 2013. To a smaller extent, this same positive blip also occurred in December 2014 / January 2015. Maybe the PolitiFact staff around the holiday season join in the spirit of giving by becoming more generous with their ratings?
   
2. I had thought that the presidential campaign season, which for the sake of argument I have set as one-year prior to the presidential election, would have seen several months with particularly low Mean Truthfulness Scores. My thinking was that close to the presidential election, politicians would be less truthful in order to capture undecided voters at the last minute. At least from this graph, these factors appear to be uncorrelated though that may be due to the fact that there are not many presidential candidates per election and the number of them decreases as the election date approaches which in turn generates fewer statements for PolitiFact to rate.

year_score_all_pre_na <- politifact %>% 
  mutate(revised_date = date) 
day(year_score_all_pre_na$revised_date) <- 1 #Setting all the days to day = 1 so that way they're grouped by month

year_score_all_pre_na <- year_score_all_pre_na %>%
  group_by(revised_date, rating) %>%
  summarise(n = n())

year_score_all_pre_na <- left_join(year_score_all_pre_na, values, by = c("rating" = "rating")) %>%
  ungroup() %>%
  mutate(Score = n * value) %>%
  group_by(revised_date) %>%
  summarise(Score = round((sum(Score) / sum(n)), 3),
            Total_Ratings = sum(n))

year_score_all <- year_score_all_pre_na %>%
  mutate(Score = ifelse(Total_Ratings < 30, NA, Score)) %>% #Only dealing with those with more than 30+ ratings a month
  separate(revised_date, into = c("Year", "Month", "Junk"), remove = FALSE) %>%
  mutate(Month = str_replace_all(Month, c("01" = "Jan", "02" = "Feb", "03" = "Mar",
                                          "04" = "Apr", "05" = "May", "06" = "Jun",
                                          "07" = "Jul", "08" = "Aug", "09" = "Sep",
                                          "10" = "Oct", "11" = "Nov", "12" = "Dec"))) %>%
  unite(Label, Month, Year, sep = " ") %>%
  select(-Junk)

lowest_score_ever <- min(year_score_all$Score, na.rm = TRUE)
worst_month <- year_score_all %>% 
  filter(Score == lowest_score_ever) %>%
  mutate(Label = str_replace_all(Label, c("Jan" = "January", "Feb" = "February", "Mar" = "March",
                           "Apr" = "April", "May" = "May", "Jun" = "June", "Jul" = "July",
                           "Aug" = "August","Sep" = "September", "Oct" = "October", 
                           "Nov" = "November", "Dec" = "December")))

3. The Mean Truthfulness Score for each month has become remarkably negative since April 2017, with the record low in December 2017 at -1.359 as you can see in the graph below. Each month since April (except October) has broken the previously low record set in August 2009. Why is this so? Some possible ideas may be:
   1. Increased political polarization whereby politics has gotten to the point where candidates will say anything to win
      
   2. An artefact of the post-truth era some pundits think we have entered into?
      
   3. Donald Trump and his notoriety for telling falsehoods
      
   4. Or is there some other explanation?

ggplot(year_score_all %>% slice(5:nrow(year_score_all)), #Lop off the first 4 rows because they're NA
       aes(x = revised_date + 15, y = Score, fill = Score)) + #Add 15 days to each month so they align better
  geom_rect(xmin = ymd("2016-Nov-8") - 365, xmax = ymd("2016-Nov-8"),
            ymin = -3, ymax = 2, fill = "gray75", color = "black", linetype = "dashed", size = .8) +
  geom_rect(xmin = ymd("2012-Nov-6") - 365, xmax = ymd("2012-Nov-6"),
            ymin = -3, ymax = 2, fill = "gray75", color = "black", linetype = "dashed", size = .8) +
  geom_rect(xmin = ymd("2008-Nov-4") - 365, xmax = ymd("2008-Nov-4"),
            ymin = -3, ymax = 2, fill = "gray75", color = "black", linetype = "dashed", size = .8) +
  geom_col(color = "black", size = 1) +
  geom_smooth(size = 1.7, color = "royalblue4", se = FALSE) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  scale_y_continuous(breaks = seq(-1.5, 0.5, 0.25)) +
  scale_fill_continuous(low =  "#E40602", high = "#71BF44") +
  theme(legend.position = "none",
        axis.text.x = element_text(size = 12), 
        axis.text.y = element_text(size = 10)) +
  labs(x = "", 
       title = "PolitiFact Mean Truthfulness Score per Month",
       subtitle = "Only months with 30 or more ratings are included. Shaded areas indicate the 12 months prior to a U.S. presidential election") +
  geom_point(data = worst_month, aes(x = revised_date + 15, y = Score - .10),
             size = 5, color = "black", fill = "red", shape = 24, stroke = 2,
             inherit.aes = FALSE) +
  geom_text(data = worst_month, aes(x = revised_date + 15, y = Score - .2),
            label = "Minimum", inherit.aes = FALSE, color = "black", fontface = "bold")

### 2.3 Recent Ratings Seeing as how quickly PolitiFact’s monthly Mean Truthfulness Score becomes very negative after the 2016 presidenital election, I decided to separate the ratings into three mutually exclusive categories to figure out why:

1. I flagged as Website any rating of a statement made by an entity ending in .com, .net, .org, .us, .edu, .site, .gov or that had the word email, facebook, blog, tweet, or image in its name.
   
2. I flagged as Trump any rating of a statement made by Donald Trump.
   
3. I flagged all other ratings as Other.

I took the subtotal Mean Truthfulness values for these three statement categories and divided by the total number of ratings issued each month by PolitiFact. These steps allows me to determine what each of the three categories contributed to PolitiFact’s total Mean Truthfulness Score for each month.

trump_web_other <- politifact %>% 
  mutate(analysis = NA)
trump_web_other <- politifact %>% 
  mutate(analysis = ifelse(website == TRUE, "Website", NA), 
         analysis = ifelse(name == "Donald Trump", "Trump", analysis),
         analysis = ifelse(is.na(analysis), "Other", analysis))

trump_web_analysis <- trump_web_other %>% 
  mutate(revised_date = date) 
day(trump_web_analysis$revised_date) <- 1 #Setting all the days to day = 1 so that way they're grouped by month

trump_web_analysis <- trump_web_analysis %>%
  group_by(revised_date, rating, analysis) %>%
  summarise(n = n()) 

trump_web_analysis <- left_join(trump_web_analysis, values, by = c("rating" = "rating")) %>%
  ungroup() %>%
  mutate(Score = n * value) %>%
  group_by(revised_date, analysis) %>%
  summarise(subtotal = sum(Score),
            Subtotal_Ratings = sum(n))

trump_web_analysis <- left_join(trump_web_analysis, year_score_all_pre_na) %>%
  mutate(Sub_Score = round(subtotal / Total_Ratings, 3)) 
trump_web_analysis <- trump_web_analysis[c(1:4, 7, 5:6)] #Reordering columns

trump_web_analysis <- trump_web_analysis %>%
  mutate(Score = ifelse(Total_Ratings < 5, NA, Score)) %>% #Only dealing with those with more than 30+ ratings a month
  separate(revised_date, into = c("Year", "Month", "Junk"), remove = FALSE) %>%
  mutate(Month = str_replace_all(Month, c("01" = "Jan", "02" = "Feb", "03" = "Mar",
                                          "04" = "Apr", "05" = "May", "06" = "Jun",
                                          "07" = "Jul", "08" = "Aug", "09" = "Sep",
                                          "10" = "Oct", "11" = "Nov", "12" = "Dec"))) %>%
  unite(Label, Month, Year, sep = " ") %>%
  select(-Junk)

website_contribution_worst <- trump_web_analysis %>% 
  filter(revised_date %in% worst_month$revised_date, 
         analysis == "Website") %>%
  mutate(percentage = Sub_Score / Score)
trump_contribution_worst <- trump_web_analysis %>% 
  filter(revised_date %in% worst_month$revised_date, 
         analysis == "Trump") %>%
  mutate(percentage = Sub_Score / Score)
other_contribution_worst <- trump_web_analysis %>% 
  filter(revised_date %in% worst_month$revised_date, 
         analysis == "Other") %>%
  mutate(percentage = Sub_Score / Score)

For example, in December 2017 for all of PolitiFact there were 78 total statements rated with a Mean Truthfulness Score of -1.359. This value correlates to the average statement being at least Mostly False, and this month has the lowest Mean Truthfulness Score since PolitiFact was founded as you can again see in the graph below. Of that -1.359 Mean Truthfulness Score:

• With 15 statements rated, Websites contributed -0.5 to this month’s Mean Truthfulness Score, equal to 36.8% of it
  
• With 7 statements rated, Donald Trump contributed -0.115 to this month’s Mean Truthfulness Score, equal to 8.46% of it
  
• And the remaining 56 statements rated contributed -0.744 to this month’s Mean Truthfulness Score, equal to the remaining 54.7% of it

#When was the first website rating issued. I'm only taking the averages since that point.
first_website <- politifact %>% 
  filter(website == TRUE) %>% 
  filter(date == min(date))

websites_by_month <- trump_web_analysis %>% 
  filter(analysis == "Website", 
         revised_date >= first_website$date[[1]]) %>% 
  mutate(pre_dec_2016 = ifelse(revised_date < "2016-12-01", "PRE", "POST")) %>% 
  group_by(pre_dec_2016) %>% 
  summarise(avg_per_month = round(sum(Subtotal_Ratings) / n(), 1), 
            months = n(), 
            avg_rating = round(sum(subtotal) / sum(Subtotal_Ratings), 3))

Since December 2016, ratings of statements made by websites have been the single largest contributor to the highly negative Mean Truthfulness Scores of late. This coincides with the founding of PolitiFact’s partnership with Facebook to fact-check claims made on the social media site, and likely represents a push overall to rate the accuracy of more claims made online. [^2] Since December 2016, PolitiFact has rated an average of 18 statements made online per month and these statements have an average rating of -2.766, which is closest to Pants on Fire!. Prior to December 2016, PolitiFact only rated an average of 4.2 statements from websites per month, and with an average rating of -1.782 these ratings were closer to False.

ggplot(trump_web_analysis %>% filter(revised_date >= mdy("January 1, 2014"), 
                                     Total_Ratings >= 30), 
       aes(x = revised_date + 15, y = Sub_Score, fill = analysis, 
           color = analysis, group = analysis)) + #Add 15 days to each month so they align better
  geom_rect(xmin = ymd("2016-Nov-8") - 365, xmax = ymd("2016-Nov-8"),
            ymin = -3, ymax = 2, fill = "gray75", color = "black", linetype = "dashed", size = .8) +
  geom_col(color = "black", size = 1) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  scale_fill_manual("", values = c("Website" = "#c118ec", "Trump" = "#ffb00a", "Other" = "#808080"),
                    position = "bottom") +
  scale_y_continuous(breaks = seq(-1.25, 0.5, 0.25)) +
  labs(title = "PolitiFact Mean Truthfulness Score per Month, 2014 - Present",
       x = "", y = "Monthly Average", 
       subtitle = "Shaded area indicates 12 months prior to the November 8, 2016 presidential election. Mean Truthfulness Scores are additive for Donald Trump, Websites, and Other.\nOnly months with 30 or more total ratings are shown.") +
  theme(legend.position = "bottom", 
        legend.box.margin = margin(t = -20), 
        axis.text.x = element_text(size = 12), 
        axis.text.y = element_text(size = 10)) +
  guides(fill = guide_legend(reverse = TRUE)) +
  geom_point(data = worst_month, aes(x = revised_date + 15, y = Score - .10),
             size = 5, color = "black", fill = "red", shape = 24, stroke = 2,
             inherit.aes = FALSE) +
  geom_text(data = worst_month, aes(x = revised_date + 15, y = Score - .2),
            label = "Minimum", inherit.aes = FALSE, color = "black", fontface = "bold")

4.1 Overall Party Mean Truthfulness Score

politifact <- politifact %>% 
  mutate(name = str_replace_all(name, "  ", " ")) %>%
  mutate(rating = fct_drop(rating))

politifact <- left_join(politifact, values, by = "rating")

party_statistical_test <- inner_join(politifact, 
                                      verified_people_speakers %>% 
                                        filter(!duplicated(name)) %>%
                                        select(name, Party), 
                                      by = c("name" = "name"))
  
democrats <- party_statistical_test %>%
  filter(Party == "Democratic") 
republicans <- party_statistical_test %>%
  filter(Party == "Republican")

The final part of my analysis includes grouping all of the major U.S. politicians who have received ratings from PolitiFact by party. This may be an accurate reflection of which party is more “truthful” or it may reflect selection-bias by me or by PolitiFact. Nonetheless, after performing a z-test on statements by major U.S. politicians from the Democratic and Republican party, I can say with greater than 99% confidence that the Mean Truthfulness Score for statements made by major U.S. Democratic politicians is statistically higher than that for major U.S. Republican politicians. [^5]

party_politicians <- verified_people_speakers %>%
  group_by(Party, rating) %>%
  summarise(`Total Statements` = sum(n))

party_politicians <- left_join(party_politicians, values, by = c("rating" = "rating")) %>%
  mutate(score = value * `Total Statements`) %>%
  group_by(Party) %>%
  summarise(Total_Statements = sum(`Total Statements`),
            Score = sum(score)) %>%
  mutate(Final_Ratings = Score / Total_Statements)

added_row <- tibble(Party = "Average Major U.S. Politician", 
                    Total_Statements = sum(party_politicians$Total_Statements), 
                    Score = sum(party_politicians$Score), 
                    Final_Ratings = Score / Total_Statements)

party_politicians <- party_politicians %>%
  bind_rows(added_row) %>%
  mutate(Party = as_factor(Party),
         Party = fct_relevel(Party, "Average Major U.S. Politician", after = 2))

ggplot(party_politicians, aes(x = Party, y = Final_Ratings, fill = Party, 
                              label = round(Final_Ratings, 3))) +
  geom_col(size = 1, color = "black") +
  scale_fill_manual(values = c("Democratic" = "#1A80C4", "Republican" = "#CC3D3D", "Average Major U.S. Politician" = "#735F81"), guide = "none") +
  labs(x = "", y = "", 
       title = "Mean Truthfulness Score for Major Politicians' Statements by Party",
       subtitle = str_c("Includes ", 
                        comma_format()(sum(party_politicians %>% 
                                             filter(Party == c("Democratic", "Republican")) %>% 
                                             select(Total_Statements))), 
                        " statements rated by PolitiFact from ", 
                        nrow(verified_people_speakers %>% 
                               group_by(name) %>% 
                               summarise(n = n())), 
                        " current and recent major U.S. politicians, including:\nPresidents, Vice-Presidents, Presidential Candidates, Senators, Representatives, and Governors.")) +
  geom_hline(yintercept = 0, size = 1.5, linetype = "twodash") +
  geom_vline(xintercept = 2.5, size = 1.5, linetype = "solid") +
  theme(axis.text = element_text(size = 12),
        axis.text.x = element_text(color = c("#1A80C4", "#CC3D3D", "#735F81"), face = "bold"),
        panel.grid.major.x = element_blank()) +
  geom_label()

Footnotes

[^1] Not until I had done a lot data wrangling did I realize that PolitiFact seems to be missing from its site any ratings issued in November 2008. While it has ratings through October 31, 2008 and beginning again on December 1, 2008, there are no ratings at all for November 2008. Visit this page and nearby ones to verify (http://www.politifact.com/truth-o-meter/statements/?page=669)

[^2] It appears that PolitiFact’s efforts to fact-check claims appearing on Facebook do not appear in its Truth-O-Meter ratings, which puts them beyond the scope of my analysis. When I discuss PolitiFact’s ratings of statements made by websites, I only analyze those that appear in PolitiFact’s Truth-O-Meter ratings.

[^3] Not all subjects listed on PolitiFact’s subjects page are actual issues. While subjects such as Abortion and Islam capture statements that refer to Abortion or Islam, the subject “This Week - ABC News” captures statements instead made by politicians and pundits while actually on that television show.

[^4] PolitiFact has rated statements by 3,666 different entities. In my analysis of statements by major politicians by their political party, I used the following lists:

1. U.S. Senators and Representatives from the 109th to the 115th Congressional Sessions, available here. I included all of the sessions that have overlapped with PolitiFact’s existence, which began in 2007.
2. Current U.S. State Governors, available here
3. Currently living former U.S. State Governors, available here
4. 2008, 2012, and 2016 presidential candidates
5. The eight Presidents and Vice-Presidents from 1993 to Present (PolitiFact has not yet rated any statements by presidents prior to Bill Clinton).

When I refer to ‘Democrats’ and ‘Republicans’ in my analysis, I am referring to politicians from the above lists who I have been successfully able to match to individuals who have had statements rated by PolitiFact. Because the matching process is difficult, I cannot guarantee that every individual who falls into the following categories has been accounted for but this should include enough politicians to make my conclusions and analysis valid. I furthermore sought to ensure that every valid U.S. politician who has had at least 10 statements rated by PolitiFact was included. The political party designation used comes from the above mentioned sources.

The remaining entities whose individual records I have intentionally not chosen to analyze include:

• Organizations, civic initiatives, PACs, campaigns, party committees and the like
• Websites
  
• Pundits such as Rush Limbaugh, Sean Hannity, Rachel Maddow, etc.
  
• And Politicians whose only positions thus far are:
  • At the state level
    
  • In a non-elected appointment (i.e. to the cabinet level, ambassadorship, or the Supreme Court)
    
  • Unsuccessful campaigns for a political seat (other than U.S. president)
    
  • Not-yet assumed office (i.e. Governor-elect, Senator-elect, etc., but I do include Presidents-elect)
  • Or not clearly associated with either the Democratic or Republican parties (e.g. I have excluded Gary Johnson, Ralph Nader, and Jesse Ventura, but not Bernie Sanders or Joe Lieberman).

Keep in mind that many politicians who did fit my criteria may at some point have held a position on the above list.

final_test <- z.test(x = democrats$value, y = republicans$value, alternative = "two.sided", 
                     sigma.x = sd(democrats$value), sigma.y = sd(republicans$value), conf.level = 0.99)

[^5] A z-test is used when the population variance and standard-deviation are known. Because I am considering the population only to be the statements that PolitiFact has rated (rather than all statements all politicians have made), I believe a z-test is more appropriate than a t-test. For Democrats, the standard deviation of their Mean Truthfulness Score is 1.388 and for Republicans it is 1.519 (all numbers in this footnote are rounded to three digits). In the z-test, the null hypothesis is that the true difference between the Mean Truthfulness Score of Democrats and Republicans is equal to zero; currently the difference between those means is 0.637. With 99 percent confidence, the true difference between these means is estimated to be between 0.543 and 0.731.

save.image("D:/Everything/R/Politifact Investigation/Final_Final_Workspace.Rdata") #Save the workspace so I can use it in the 'Analysis' page without having to re-run all this code