Hypothesis

We will see a sharp distinction between Republican-appointed and Democratic-appointed Supreme Court Justices.

Data

We utilized data from the Supreme Court Database. This provided us with the voting data per case since 1946. With each case, we got each justice’s name, vote, whether their vote was in favor of the majority, and whether their vote was liberal or conservative.

Initial Analysis

We conduct some initial analysis by looking at the percentage of 9-0, 8-1, etc. votes over time.

load("SCDB_2019_01_caseCentered_Citation.Rdata")
cases <- as_tibble(SCDB_2019_01_caseCentered_Citation)

Plot of majority votes, by term

all_present <- cases %>%
  mutate(totVotes = majVotes + minVotes) %>%
  filter(totVotes == 9)

all_present$majVotes = factor(all_present$majVotes, levels=rev(5:9))

all_present_sum <- all_present %>%
  group_by(term, majVotes, .drop=FALSE) %>%
  summarise(n = n()) %>%
  mutate(percent = 100*n/sum(n))

ggplot(all_present_sum, aes(x=term, y=percent, fill=majVotes)) +
  geom_area() +
  scale_fill_brewer(palette="PuBu", direction=-1)

This stacked area plot seems to show that the percentage of unanimous votes is increasing over time!

# Cumulative
all_present$majVotes = factor(all_present$majVotes, levels=5:9)

all_present_cum <- all_present %>%
  group_by(term, majVotes, .drop=FALSE) %>%
  summarise(n = n()) %>%
  mutate(percent = 100*n/sum(n)) %>%
  mutate(cum_percent = cumsum(percent)) %>%
  droplevels(exclude=9) %>%
  na.omit()

ggplot() +
  geom_area(data=all_present_sum, aes(x=term, y=percent, fill=majVotes)) +
  scale_fill_brewer(palette="PuBu", direction=-1) +
  geom_smooth(data=all_present_cum, aes(x=term, y=cum_percent, color=majVotes)) +
  scale_color_brewer(palette="PuBu") +
  guides(color = guide_legend(reverse=TRUE))

The Loess curves seem to support this.

ggplot(all_present_sum, aes(x=term, y=percent, color=majVotes)) +
  geom_smooth() +
  scale_color_brewer(palette="Dark2", direction=-1)

Plotting the percentages of each majority number (9, 8, 7, 6, 5) we see that the unanimous votes have been increasing, but the number of narrowly-split votes (5-4) have been increasing as well.

PCA

Discussion

When analyzed using PCA, the voting patterns of Congressmen and women are distinctively revealed to rely primarily on one axis: party. We wonder if the same can be said for the Supreme Court, which has judges who are appointed by presidents who represent a party. In order to perform the analysis, however, we will need to make sure that we split by term, since judges may leave the bench. Furthermore, the analysis would not make sense in considering judges that are decades apart, as voting behavior is relative and temporal.

Challenges

Judges leaving and entering the bench poised a challenge for data analysis. Transition term contain lots of missing votes. The first half of the term has missing votes for the new judge and the second half has missing votes for the judge that departed. Since we handle missing votes by dropping cases, this leads to there being little data for transition terms. To fix this, we decided to keep only the senior 9 judges in a term and disregard the new judge.

Furthermore, there was no dataset that we could find that had a list of judges and the party they were appionted by. We had to make this data on our own.

Methodology

Setting Up

First, we load the data.

load("SCDB_2019_01_justiceCentered_Citation.Rdata")

Next, we choose the columns we care about.

justice_centered <- SCDB_2019_01_justiceCentered_Citation %>%
                      dplyr::select(c(caseId, term, issueArea, justice, justiceName, majority))

The data is structured in the tall form where each row represents a judge’s vote in a case. We want to pivot to a wide format for PCA.

wide_justice_centered <- justice_centered %>%
  dplyr::select(caseId, majority, term, justiceName) %>%
  pivot_wider(names_from = caseId, values_from = majority)

Now, we want to run an analysis per term. To do this, we split by group to create smaller dataframes to individually prune out votes where judges reclused or didn’t vote.

term_votes <- wide_justice_centered %>%
  group_split(term)

Data Cleaning

Each dataframe contains all cases, but judges come and go, so we need to clean these columns out.

clean_term_votes <- function(term_vote) {
  term_ <- toString(term_vote$term[2])
  term_vote %>%
    dplyr::select(-justiceName) %>%
    dplyr::select(contains(term_))
}
cleaned_term_votes <- map(term_votes, clean_term_votes)

Our data has some noise. First, we need to deal with years where judges left and entered the court. For our analysis, we’ll keep the older members - even if they left early in the term. In the future, this could be made smarter and the term could be split into two.

clean_judge_number <- function(term_vote) {
  term_vote[c(0:9),]
}
judge_cleaned_votes <- map(cleaned_term_votes, clean_judge_number)

Next, we need to remove votes where not all the judges were present. In the future, this could be improved to better handle missing votes so we don’t have to drop as many cases.

clean_judge_present <- function(term_vote) {
  term_vote %>%
    select_if(~!any(is.na(.)))
}
presence_cleaned_votes <- map(judge_cleaned_votes, clean_judge_present)

Finally, we will change the way votes are represented from the default encoding of votes from 1 (dissenting) and 2 (majority) to 0 (dissenting) and 1 (majority). Also, we’ll remove unanimous votes because they have a variation of 0, as necessary by PCA.

clean_unanimous <- function(term_vote) {
  term_vote %>%
    mutate_all(~ifelse(. == 1, 0, 1)) %>%
    select_if(~!all(. == 1))
}
final_term_votes <- map(presence_cleaned_votes, clean_unanimous)

PCA

Now, we can run PCA on each term.

pca_analysis <- function(term_votes) {
  prcomp(term_votes, scale=TRUE, center=TRUE, rank=2)
}
pcas <- map(final_term_votes, pca_analysis)

Now, we combine it with the names of judges of each term.

populate_justice_names <- function(pca, i) {
  pcx <- pca %>%
         tidy() %>%
         pivot_wider(names_from=PC, values_from=value) %>%
         mutate(id = row_number()-1) %>%
         dplyr::select(-c(`row`))
  if(!("2" %in% names(pcx))) {
    pcx$`2` <- c(0:8) * 0
  }
  justice_names <- term_votes[[i]][c(0:9),c("justiceName","term")]
  justice_names <- mutate(justice_names, id = row_number()-1)
  inner_join(pcx, justice_names, by="id") %>%
    dplyr::select(-id)
}
pca_names <- imap(pcas, populate_justice_names)

Now, we can plot every judge’s first and second principal component.

plot_pc <- function(pca) {
  term_ <- pca$term[1]
  plot <- ggplot(pca, aes(`1`,`2`,label = `justiceName`)) +
    xlim(-20,20) +
    ylim(-20,20) +
    geom_text(alpha=.5) +
    labs(title=term_, x = "PC1", y = "PC2") +
    theme_minimal()
  print(plot)
}
for(pca_ in pca_names[c(0:4)]) {
  plot_pc(pca_)
}

Results

Let’s look at 2018! Here, we see that the party divide is pretty apparent in the first axis.

plot_pc(pca_names[[73]])

Let’s add the party that they were appointed by! Unfortunately, this data isn’t available within the database, so we had to manually create this.

judges_appointed <- read_csv("judges_appointed.csv")

We can even make an animation!

pca_animate <- function(pca) {
  scores = NA
  
  for(score_term in pca) {
    if(is.na(scores)) {
      scores = score_term
    } else {
      scores = rbind(scores, score_term)
    }
  }
  scores <- left_join(scores, judges_appointed, by="justiceName")
  scores$party = factor(scores$party, levels = c("D", "R"))
  colors <- c("blue", "red")
      
  plot <- ggplot(scores, aes(`1`,`2`,label = `justiceName`, color=party)) +
    xlim(-20,20) +
    ylim(-20,20) +
    geom_text(alpha=.8) +
    scale_colour_manual(values=colors) +
    labs(x = "PC1", y = "PC2") +
    theme_minimal() + 
    transition_time(term) +
    labs(title = "Term: {frame_time}")
  
  animate(plot, duration = 75, fps = 1, width = 600, height = 600, renderer = gifski_renderer())
  anim_save("output5.gif")
}

pca_animate(pca_names)

Analysis

There are some interesting stills we can pick out.

pull_still <- function(pca) {
  term_ <- pca$term[1]
  scores <- left_join(pca, judges_appointed, by="justiceName")
  scores$party = factor(scores$party, levels = c("D", "R"))
  colors <- c("blue", "red")
      
  plot <- ggplot(scores, aes(`1`,`2`,label = `justiceName`, color=party)) +
    xlim(-20,20) +
    ylim(-20,20) +
    geom_text(alpha=.8) +
    scale_colour_manual(values=colors) +
    labs(title = term_, x = "PC1", y = "PC2")
  print(plot)
}

Here’s 2017, it’s interesting to see the clear divide in PC1 of party. PCA is picking up on party - but this is mostly a very recent thing. It is interesting to see the very stark clustering of democrats in the positive PC1 direction and Republicans in the negative PC1 direction.

pull_still(pca_names[[72]])

In the 1963 term, you can really see Judge Harlan’s behavior as “The Great Dissenter”. PCA is definitely picking up on his legacy of dissent. He’s very far from the other judges.

pull_still(pca_names[[18]])

pull_still(pca_names[[1]])

Limitations and Future Work

PCA does not do well over time. Axes may flip or completely change in meaning. This is especially obvious between terms where the majority switches - everyone crosses the PC1 axis. Furthermore, the axes meaning does not remain the same throughout the years - so it is difficult to compare between years. In the future, we could utilize something like Multi Dimensional Scaling to be able to perfrom time analysis.

Lastly, we’d like to handle missing votes and transition terms better. Instead of dropping a large amount of cases, it would be good to split the term up so every judge’s vote is accounted for.

PCoA

Discussion

In order to more effectively group case decisions by issue areas and on a liberal-conservative scale, we use Principal Coordinates Analysis. We take a rolling-window snapshot of 100 cases at a time, group them by issue area, and let each justice’s liberal-conservative score on each issue area serve as coordinates in 13-dimensional Euclidean space. We compute pairwise distances between the justices and then apply PCoA in order to effectively visualize the justices’ ideological groupings and differences.

Methodology

First, we load the Supreme Court justice-centered data, and select the columns that we’ll need.

load("SCDB_2019_01_justiceCentered_Citation.Rdata")
justice_votes <- as_tibble(SCDB_2019_01_justiceCentered_Citation) %>%
    dplyr::select(c(caseId, term, issueArea, justiceName, direction))

Because we’d like to group the cases by issue area, we filter out those cases that don’t have an issue area, as well as votes that don’t have a direction assigned.

justice_votes_filtered <- justice_votes %>%
    na.omit(c(issueArea, direction))

The data is currently in a tall format, with each justice’s case vote representing a single row. We pivot to a wider format in which the cases are the columns. We remove cases that don’t have all nine justices voting on them, as we won’t be able to apply MDS to these.

wide_justice_votes <- justice_votes_filtered %>%
    dplyr::select(caseId, issueArea, justiceName, direction) %>%
    group_by(issueArea) %>%
    pivot_wider(names_from = caseId, values_from = direction)
wide_justice_votes_filt <- wide_justice_votes[, (colSums(is.na(wide_justice_votes)) == (nrow(wide_justice_votes)-9)) | (colSums(is.na(wide_justice_votes)) == 0)]

We pivot back to a longer format to create a legend of the issue areas each case is in.

long_justice_votes_filt <- wide_justice_votes_filt %>%
    pivot_longer(-c(issueArea, justiceName), names_to = "caseId", values_to = "direction")

issue_legend <- long_justice_votes_filt %>%
    na.omit() %>%
    dplyr::select(c(caseId, issueArea)) %>%
    distinct()

issue_legend <- issue_legend[order(issue_legend$caseId),]

We separate out the cases based on which issue area they’re classified as (creating a list of dataframes), remove the cases that don’t belong to the issue area, and replace the direction variable (1 as “conservative” and 2 as “liberal”) with 0 as “conservative” and 1 as “liberal.” Finally, we add in the justice names that got deleted and alphabetize the justice names.

votes_by_issue <- group_split(wide_justice_votes_filt) %>%
    lapply(function(x) x[, colSums(is.na(x)) != nrow(x)]) %>%
    lapply(function(x) {
        x <- anchors::replace.value(x, colnames(x)[3:ncol(x)], from=1, to=0)
        x <- anchors::replace.value(x, colnames(x)[3:ncol(x)], from=2, to=1)
    }
    )
justices <- unlist(votes_by_issue[[1]][,2])
votes_by_issue <- votes_by_issue %>%
    lapply(function(x) add_row(x, issueArea = unlist(x[1, 1]), justiceName = justices)) %>%
    lapply(function(x) distinct(x, issueArea, justiceName, .keep_all=TRUE))
votes_by_issue <- lapply(votes_by_issue, function(x) x[order(x$justiceName),])
justices_alph <- votes_by_issue[[1]][,2]
justices_alph <- justices_alph[order(justices_alph$justiceName),]

Going to Python to do more computationally-heavy, iterative work, we import the justices’ votes by issue area and the issue legend.

import math
votes_by_issue = r.votes_by_issue
for i in range(len(votes_by_issue)):
    votes_by_issue[i] = list(map(list, zip(*votes_by_issue[i].values())))
issue_legend = list(map(list, zip(*r.issue_legend.values())))

We will be averaging each justices’ votes on a conservative-to-liberal scale in each of the 13 possible issue areas, over a range of 100 cases at a time.

issue_nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 13, 14]
start_ind = 0
window = 100
just = 38
areas = 13
before_per_issue = [0] * areas
during_per_issue = [0] * areas
for i in range(start_ind, start_ind + window - 1):
    iss_num = issue_legend[i][1]
    iss_ind = issue_nums.index(iss_num)
    during_per_issue[iss_ind] += 1

We do a rolling window from 1946 through the present, looking at only 100 cases at a time. Then, considering a justice’s liberal-to-conservative score in each issue area as a coordinate in 13-dimensional Euclidean space, we compute the pairwise distances between the justices for each snapshot in time.

def distance(just1, just2):
    allnan = True
    dsum = 0
    for i in range(len(just1)):
        if not (math.isnan(just1[i]) or math.isnan(just2[i])):
            allnan = False
            dsum += (just1[i]-just2[i])**2
    if allnan:
        return float('nan')
    return math.sqrt(dsum)

pairwises = [0] * (len(issue_legend) - window + 1)
while start_ind + window <= len(issue_legend):
    # add issue area of new case
    iss_num = issue_legend[start_ind + window - 1][1]
    iss_ind = issue_nums.index(iss_num)
    during_per_issue[iss_ind] += 1
    percents = [0] * just
    for j in range(just):
        percents[j] = [0] * areas
    # find percentage of liberal votes
    for i in range(areas):
        bef = before_per_issue[i]
        dur = during_per_issue[i]
        for j in range(just):
            zeroes = 0
            ones = 0
            for k in range(bef+2,bef+dur+2):
                v = votes_by_issue[i][j][k]
                if v == 0:
                    zeroes += 1
                elif v == 1:
                    ones += 1
            if (ones+zeroes == 0):
                percents[j][i] = float('nan')
            else:
                percents[j][i] = float(ones)/(ones+zeroes)
    # comput pairwise distances
    pairwises[start_ind] = [0] * just
    for j1 in range(just):
        pairwises[start_ind][j1] = [0] * just
        for j2 in range(just):
            pairwises[start_ind][j1][j2] = distance(percents[j1],percents[j2])
    # remove issue area of old case
    iss_num = issue_legend[start_ind][1]
    iss_ind = issue_nums.index(iss_num)
    before_per_issue[iss_ind] += 1
    during_per_issue[iss_ind] -= 1
    start_ind += 1

We load the data back into R from Python and format it.

pairwises = py$pairwises
pairwises <- pairwises %>%
    lapply(function(x) do.call(rbind.data.frame, x))
pairwises <- lapply(pairwises, setNames, nm=justices_alph$justiceName)

We delete the justices with only NaNs throughout. If there’s any NaN’s left, we delete those too.

pairwises <- pairwises %>%
    lapply(function(x)
        x[rowSums(is.na(x)) != ncol(x), colSums(is.na(x)) != nrow(x)]) %>%
    lapply(function(x)
        x[rowSums(is.na(x)) == 0, colSums(is.na(x)) == 0])

We import a CSV file with the party of the president who appointed each justice.

judges_appointed <- read_csv("judges_appointed.csv")

We run Principal Coordinates Analysis on each of the snapshots and combine all of the data.

mds = NA

for (i in 1:length(pairwises)) {
    pairwise <- pairwises[[i]]
    pairdist <- as.dist(pairwise)
    pairmds <- pairdist %>%
        cmdscale() %>%
        as_tibble()
    pairmds <- cbind(pairmds, colnames(pairwise))
    colnames(pairmds) <- c("Dim1", "Dim2", "justiceName")
    pairmds <- left_join(pairmds, judges_appointed, by="justiceName")
    pairmds$party = factor(pairmds$party, levels = c("D", "R"))
    casenum <- rep(c(i), length(pairwise))
    casedf <- data.frame(casenum)
    pairmds <- cbind(pairmds, casedf)
    if(is.na(mds)) {
        mds = pairmds
    } else {
        mds = rbind(mds, pairmds)
    }
}

We set up the plot that we’ll be animating.

colors <- c("blue", "red")

plot <- ggplot(mds, aes(Dim1, Dim2, label=justiceName, color=party)) +
    xlim(-0.5,0.5) +
    ylim(-0.5,0.5) +
    geom_text(alpha=0.5) +
    scale_color_manual(values=colors) +
    labs(x="Dim 1", y="Dim 2") +
    theme_minimal()

anim <- plot + transition_time(casenum)

We create the final animation, showing ideological distances between justices over time.

animate(anim, nframes=6609, fps=100, width=500, height=500, renderer=av_renderer())
anim_save("pcoa.mp4")

Results

Because we’ve labeled the justices by whether they were appointed by a Republican president or a Democratic president, we can see how the composition of the court and the ideologies of the court change relative to time. It seems that there isn’t much polarization in most of modern Supreme Court history, but in recent years (i.e. the Roberts court) there has been more and more polarization between Republican-appointed and Democratic-appointed justices.

Limitations & Future Work

The analysis is limited by the fact that axes may shift, rotate, or even flip over time. Because the point of the visualization is to see how far or close the justices are to each other, orientation is very variable. Controlling for this somehow (perhaps incorporating elements of PCA, or adjusting for justices whose views are unlikely to shift very much over time) would be a step for future work. Another limitation is the instances where justices leave the court and enter the court. Making the analysis less dependent on there being all nine justices on the court could also be the subject of future work.

Do the Votes of Republican-appointed and Democratic-appointed Supreme Court Justices Differ?

Rionna Flynn and Victor Reyes

December 13, 2019

Hypothesis

Data

Initial Analysis

Plot of majority votes, by term

PCA

Discussion

Challenges

Methodology

Setting Up

Data Cleaning

PCA

Results

Analysis

Limitations and Future Work

PCoA

Discussion

Methodology

Results

Limitations & Future Work