One-Forty-One 2024: Lithuanian Parliament Predictions

Author

Richard Martin-Nielsen

Published

October 27, 2024

Introduction

Lithuania’s electoral system is complex with the Parliament (the Seimas) formed in part by a multi-member constituency elected by proportional representation, and by a nearly-equal-sized collection of single-member constituencies which are elected with two-round ballots.

It is proverbially difficult to predict, given little polling, large errors, a low threshold for entry into the multi-member constituency, a large number of active parties, rapid evolution (creation and dissolution) of parties and a short historical trend.

This is nonetheless an attempt to predict the outcomes in the second round of the 2024 parliamentary elections based on the voting patterns in the 2012, 2016 and 2020 parliamentary elections and the voting data from the first round of the 2024 elections. I tried to make a prediction of second round results based on first round results in 2020 and the results weren’t too far off.

Lithuanian Parliamentary Elections

Lithuania uses a mix of a proportional representation and single-member constituencies with a run-off.

Advance polling might allow prediction of the make-up of the multi-member constituency, but polling errors are large compared to the threshold for winning any seats in the multi-member constituency and in 2020 there were surprises in the first round.

Results of the first round may give a heuristic indicator of the eventual outcomes in the run-offs, based on results in 2012, 2016 and 2020.

Past ambitions

In December 2020 I thought I might also look at trying to work from the election district results for the multimember constituency - which may indicate relative preferences which could be used for predicting how votes might redistribute among the top two candidates at the run-off. I also had vague ideas of trying to determine if I could quantify the constituency-by-constituency “lean” of each constituency (or even election district), but the boundaries change from election to election. Even with some investigation of trying to just work at how the different districts names changed from election to election, I eventually dropped these efforts.

Maybe for 2028?

Round I

After the first round of polling, seats are assigned in the multi-member constituency based on proportional representation with a 5% threshold which parties must reach to win any seats. If they pass this threshold, they will get at least 6 seats. These form the “floor” of a party’s eventual representation in Parliament. They cannot have fewer than the seats they get in the multi-member constituency.

A separate ballot in the first round of polling lets Lithuanians choose among candidates for their local constituency MP. If a candidate in a constituency wins more than 40% of the vote, they are elected to their seat. (Up until 2020, I think this threshold was 50%; in 2020 I could see that no one who won 40% of the first round vote lost in the second round, and it may be that this was also recognised and the law and threshold was changed.)

If no candidate gets 40% or more, the top two candidates compete in a run-off Round II, two weeks later.

Round II

Considering Round II, parties now have a “ceiling” on how many seats they can win. This isn’t just the number of seats they placed first in Round I, but also includes those where they were the first runner-up (“challenger”). * Most candidates who win in Round I win in Round II, but not all.

Previous years

In the single-member constituencies, if a candidate wins over 50% in the first round (40% beginning in 2024) they are elected. If no candidate meets this threshold, the top two candidates participate in a run-off election two weeks later.

2012
Candidate	Constituency	Party	Vote Share
VIRGINIJA BALTRAITIENĖ	Kėdainių	Darbo partija	57.4
LEONARD TALMONT	Vilniaus - Šalčininkų	Lietuvos lenkų rinkimų akcija	63.6
ALGIRDAS BUTKEVIČIUS	Vilkaviškio	Lietuvos socialdemokratų partija	68.7

2016
Candidate	Constituency	Party	Vote Share
POVILAS URBŠYS	Vakarinė	Išsikėlė pats	51.3
INGRIDA ŠIMONYTĖ	Antakalnio	Tėvynės sąjunga - Lietuvos krikščionys demokratai	53.3
RIMA BAŠKIENĖ	Kuršėnų-Dainų	Lietuvos valstiečių ir žaliųjų sąjunga	51.6
LEONARD TALMONT	Šalčininkų-Vilniaus	Lietuvos lenkų rinkimų akcija-Krikščioniškų šeimų sąjunga	67.9
ČESLAV OLŠEVSKI	Medininkų	Lietuvos lenkų rinkimų akcija-Krikščioniškų šeimų sąjunga	60.2

2020
Candidate	Constituency	Party	Vote Share
INGRIDA ŠIMONYTĖ	Antakalnio	Tėvynės sąjunga – Lietuvos krikščionys demokratai	62.6
BEATA PETKEVIČ	Šalčininkų–Vilniaus	Lietuvos lenkų rinkimų akcija - Krikščioniškų šeimų sąjunga	62.2
ČESLAV OLŠEVSKI	Medininkų	Lietuvos lenkų rinkimų akcija - Krikščioniškų šeimų sąjunga	55.8

2024
Candidate	Constituency	Party	Vote Share
INGRIDA ŠIMONYTĖ	Antakalnio	Tėvynės sąjunga-Lietuvos krikščionys demokratai	54.8
REMIGIJUS ŽEMAITAITIS	Kelmės–Šilalės	Politinė partija „Nemuno Aušra“	47.8
VIKTORAS FIODOROVAS	Kėdainių	NA	42.7
VAIDA ALEKNAVIČIENĖ	Žiemgalos vakarinė	Lietuvos socialdemokratų partija	41.1
JAROSLAV NARKEVIČ	Šalčininkų–Vilniaus	Lietuvos lenkų rinkimų akcija-Krikščioniškų šeimų sąjunga	48.7
RITA TAMAŠUNIENĖ	Nemenčinės	Lietuvos lenkų rinkimų akcija-Krikščioniškų šeimų sąjunga	44.7
EUGENIJUS SABUTIS	Jonavos	Lietuvos socialdemokratų partija	56.8
ALGIRDAS BUTKEVIČIUS	Vilkaviškio	Demokratų sąjunga „Vardan Lietuvos“	40.8

Code

second_round_results<- aggregate_round_II %>% 
  mutate(party = replace_na(party, "Independent")) %>%
  dplyr::group_by(year, constituency, given_name, family_name, party) 

second_round_subtotals <- second_round_results%>%
  dplyr::group_by(year,constituency) %>%
  dplyr::mutate(total = sum(votes), perc = votes / total)
winner_round_II <-second_round_subtotals %>%
  dplyr::group_by(year,constituency) %>%
  arrange(desc(votes)) %>%
  dplyr::mutate(rank = row_number()) %>%
  pivot_wider(
    id_cols = c(year,constituency),
    names_from = rank,
    values_from = c(Acronym, perc, votes, total, given_name, family_name)
  ) %>%
  dplyr::mutate(separation = perc_1 - perc_2)

Code

##
# Build a wide multi-year table of results of past elections
#
linear_wide_multiyear <- NA

for (thisYear in c(2012, 2016,2020)) {

    first_round_results <- aggregate_round_I %>%
        group_by(year, constituency) %>%
      filter(max(perc)<0.5,year==thisYear) %>%
      arrange(desc(votes)) %>%
      dplyr::mutate(rank = row_number()) #%>%
  
  # Add a new row which contains a fake candidate for each constituency
  # who collects all the votes given to candidates who do not progress
  # to the second round
  ##
  first_round_subtotals <- first_round_results %>%
    ungroup() %>%
    split(.$constituency) %>%
    map(
      ~ add_row(
        .,
        year = thisYear,
        given_name = "An",
        family_name = "Other",
        constituency = unique(.$constituency),
        constituency_number = unique(.$constituency_number),
        party = "Other",
        #eligible_voters = NA,
        votes = sum(.$votes, na.rm = TRUE),
        total = NA,
        perc = NA
      )
    ) %>%
    bind_rows() %>%
    group_by(constituency, constituency_number) %>%
    dplyr::mutate(carry = if_else(rank < 3, votes, 0)) %>%
    dplyr::mutate(carry = if_else(is.na(rank), votes - sum(carry, na.rm =
                                                             TRUE), carry)) %>%
    dplyr::mutate(votes = if_else(is.na(rank), 0, votes))
  
  linear_combined <-
    left_join(
      first_round_subtotals,
  aggregate_round_II,
      by = c("year","given_name", "family_name", "constituency", "constituency_number", "party", "Acronym"),
      suffix = c("_I", "_II")
    )
  
  linear_wide <- linear_combined %>%
    select(-given_name,-family_name) %>%
    filter(carry > 0) %>%
    pivot_wider(
      id_cols = c(year,constituency),
      names_from = rank,
      values_from = c(Acronym, carry, votes_II)
    ) %>%
    #dplyr::select(-party_NA, -votes_II_NA) %>%
    dplyr::rename(final_1 = votes_II_1, final_2 = votes_II_2) %>%
    dplyr::mutate(matchup = paste(Acronym_1, Acronym_2)) %>%
    #dplyr::mutate(Acronym_1 = factor(Acronym_1, levels = ordered_party_list_all_years, ordered = TRUE),
    #              Acronym_2 = factor(Acronym_2, levels = ordered_party_list_all_years, ordered = TRUE)) %>%
        dplyr::mutate(flip = if_else((final_1 < final_2), TRUE, FALSE))
  if ( length(linear_wide_multiyear)== 1) {
    # This used to test against is.na but that stopped working sometime
    # between 2020 and 2024
     linear_wide_multiyear <- linear_wide
   } else {
    linear_wide_multiyear <- 
      bind_rows(linear_wide_multiyear, linear_wide)  
   }
}

Code

if (replotCrossingGraphs) {
  
for (thisYear in c(2012,2016,2020)) {
  thisYearsGraphs <- linear_wide_multiyear %>% filter(year==thisYear) %>%
    # mutate(Acronym_1 = case_when(Acronym_1 == "LS" ~ "LS or LLRA",
    #                              Acronym_1 == "LLRA" ~ "LS or LLRA",
    #                              TRUE ~ Acronym_1)) %>%
  mutate(Acronym_1 = fct_collapse(Acronym_1, "LS or LLRA" = c("LS", "LLRA"))) %>%
    arrange(Acronym_2)
  
  #codes_with_colours <- codes_with_colours %>% dplyr::rename(party_2=Acronym)
  thisYearsGraphs <- left_join(thisYearsGraphs, codes_with_colours,
                               by=c("Acronym_2"="Acronym"))
  thisYearsGraphs %>%
    ggplot(aes()) + theme_minimal() +
    facet_wrap(~Acronym_1, ncol=4) +
    geom_segment(
      aes(
        x = carry_1,
        y = carry_2,
        xend = final_1,
        yend = final_2,
        colour = Acronym_2
      ),
      arrow = arrow(length = unit(0.03, "npc"))
    ) +
    geom_abline(aes(intercept = 0, slope = 1)) +
    #geom_point(data = . %>%filter %>% ("flip"==TRUE), aes(x=carry_1, y=carry_2,colour=black),size=0.6) +
    geom_point(aes(
      x = carry_1,
      y = carry_2,
      colour = Acronym_2,
      shape = flip
    )) +
    labs(
      #title = paste(thisYear, "Seimas Elections: First to Second Round vote shift by first round leader"),
      subtitle = "Arrows crossing the diagonal indicate a change in winner",
      x = "First round winner's vote count",
      y = "First round runner up's vote count",
      colour = "Challenger"
    ) +
    theme(legend.position = "bottom")
  ggsave(paste("Seimas-elections-vote-shifts-", thisYear, ".png", sep=""), width = 8, height = 6)
  ggsave(paste("Seimas-elections-vote-shifts-", thisYear, ".svg", sep=""),device="svg", width = 8, height = 6)
}
}

A First Heuristic - Vote share and Vote lead

Code

# Set the thresholds for the heuristic we'll use - it's here so I can
# refer to it in the body of the text later.
VoteShareThreshold <- 0.4
VoteGapThreshold <- 0.16

Candidates who led with more than 40% of the vote in the first round all won in the second round in 2012 and 2016, and then the law seems to have changed. But many candidates with less than 40% of the vote won in both rounds.

Candidates whose lead over the challenger was more than 16% also all won in the second round. Together these criteria account for around 20 seats in the single member constituencies.

Code

##
# Add in the first round results for 2024
#
  for (thisYear in c(2024)) {
      first_round_results <- aggregate_round_I %>%
        group_by(year, constituency) %>%
      filter(max(perc)<0.4,year==thisYear) %>%
      arrange(desc(votes)) %>%
      dplyr::mutate(rank = row_number()) #%>%
  
  # Add a new row which contains a fake candidate for each constituency
  # who collects all the votes given to candidates who do not progress
  # to the second round
  ##
  first_round_subtotals <- first_round_results %>%
    ungroup() %>%
    split(.$constituency) %>%
    map(
      ~ add_row(
        .,
        year = thisYear,
        given_name = "An",
        family_name = "Other",
        constituency = unique(.$constituency),
        constituency_number = unique(.$constituency_number),
        party = "Other",
        #eligible_voters = NA,
        votes = sum(.$votes, na.rm = TRUE),
        total = NA,
        perc = NA
      )
    ) %>%
    bind_rows() %>%
    group_by(constituency) %>%
    dplyr::mutate(carry = if_else(rank < 3, votes, 0)) %>%
    dplyr::mutate(carry = if_else(is.na(rank), votes - sum(carry, na.rm =
                                                             TRUE), carry)) %>%
    dplyr::mutate(votes = if_else(is.na(rank), 0, votes))
  
  linear_combined <- first_round_subtotals %>%
    rename(votes_I=votes,total_I=total,perc_I=perc) %>%
    mutate(votes_II=NA,total_II=NA, perc_I=NA)

  linear_wide <- linear_combined %>%
    select(-given_name,-family_name) %>%
    filter(carry > 0) %>%
    pivot_wider(
      id_cols = c(year,constituency,constituency_number),
      names_from = rank,
      values_from = c(Acronym, carry, votes_II)
    ) %>%
    #dplyr::select(-party_NA, -votes_II_NA) %>%
    dplyr::rename(final_1 = votes_II_1, final_2 = votes_II_2) %>%
    dplyr::mutate(matchup = paste(Acronym_1, Acronym_2)) %>%
    dplyr::mutate(Acronym_1 = factor(Acronym_1, levels = ordered_party_list_all_years, ordered = TRUE),
                  Acronym_2 = factor(Acronym_2, levels = ordered_party_list_all_years, ordered = TRUE)) %>%
        dplyr::mutate(flip = if_else((final_1 < final_2), TRUE, FALSE))
  # This used to test against is.na but that didn't work
  if (length(linear_wide_multiyear)==1) {
    linear_wide_multiyear <- linear_wide
  } else {
    linear_wide_multiyear <- 
      bind_rows(linear_wide_multiyear, linear_wide)  
  }
  }

Code

party_colours_names <- setNames(party_colours$Colour, party_colours$Acronym)

linear_wide_multiyear %>%
#  filter(constituency_number==2) %>%
  #filter(year < 2024) %>%
  mutate(`Vote Share` = carry_1/(carry_1+carry_2+carry_NA),
         `Vote Gap` = (carry_1-carry_2)/(carry_1+carry_2+carry_NA)) %>%
  rename(Party=Acronym_1, Upset=flip) %>%
  ggplot() +
  facet_wrap(~ year) +
  theme_minimal() +
  geom_point(data = . %>% filter(Upset), aes(x=`Vote Share`, y=`Vote Gap`,
                 color=Party,
                 shape=Upset,
                 alpha=1)) +
  geom_point(data = . %>% filter(!Upset), aes(x=`Vote Share`, y=`Vote Gap`,
                 color=Party,
                 shape=Upset,
                 alpha=0.75)) +
  geom_point(data = . %>% filter(year==2024), aes(x=`Vote Share`, y=`Vote Gap`,
                  color=Party,
                  alpha=1)) +
  scale_colour_manual(values = party_colours_names) +
  guides(alpha=FALSE,
         shape=guide_legend(reverse=TRUE, title="Upset (2012-2020)")) +
  scale_x_continuous(labels=label_percent()) +
  scale_y_continuous(labels=label_percent()) +
  geom_vline(xintercept=VoteShareThreshold) +
  geom_hline(yintercept=VoteGapThreshold)

Code

WithinThresholds <- linear_wide_multiyear %>%
  mutate(`Vote Share` = carry_1/(carry_1+carry_2+carry_NA),
         `Vote Gap` = (carry_1-carry_2)/(carry_1+carry_2+carry_NA)) %>%
  rename(Party=Acronym_1, Upset=flip) %>%
  filter(`Vote Share`<VoteShareThreshold, `Vote Gap`<VoteGapThreshold) %>%
  group_by(year,Upset) %>%
  tally()

Let’s look at the 2024 data a little more closely.

Code

linear_wide_multiyear %>%
  filter(year == 2024) %>%
  mutate(`Vote Share` = carry_1/(carry_1+carry_2+carry_NA),
         `Vote Gap` = (carry_1-carry_2)/(carry_1+carry_2+carry_NA)) %>%
  rename(Party=Acronym_1) %>%
  ggplot() +
  theme_minimal() +
  geom_point(aes(x=`Vote Share`, y=`Vote Gap`,
                 color=Party)) +
  scale_colour_manual(values = party_colours_names) +
  geom_vline(xintercept=VoteShareThreshold) +
  geom_hline(yintercept=VoteGapThreshold) +
  xlim(0.2,0.4) +
  ylim(0.1, 0.25) +
  scale_x_continuous(labels=label_percent()) +
  scale_y_continuous(labels=label_percent())

Because I’m cautious I will push my vote gap threshold to 17%

Code

VoteGapThreshold2024 <- VoteGapThreshold + 0.01

linear_wide_multiyear %>%
  filter(year == 2024) %>%
  mutate(`Vote Share` = carry_1/(carry_1+carry_2+carry_NA),
         `Vote Gap` = (carry_1-carry_2)/(carry_1+carry_2+carry_NA)) %>%
  rename(Party=Acronym_1) %>%
  mutate(LikelyWin = if_else((`Vote Gap`) >= VoteGapThreshold2024, 1, 0.75)) %>%
  ggplot() +
  theme_minimal() +
  geom_point(aes(x=`Vote Share`, y=`Vote Gap`,
                 color=Party, alpha=LikelyWin)) +
  scale_colour_manual(values = party_colours_names) +
  guides(alpha="none") +
  xlim(0.2,0.4) +
  ylim(0.1, 0.25) +
  scale_x_continuous(labels=label_percent()) +
  scale_y_continuous(labels=label_percent()) +
  geom_vline(xintercept=VoteShareThreshold) +
  geom_hline(yintercept=VoteGapThreshold2024)

This assigns three seats to TS-LKD and two seats to the LSDP.

Code

Part_A_Winners_2024 <- linear_wide_multiyear %>% 
  filter(year == 2024) %>%
  mutate(`Vote Share` = carry_1/(carry_1+carry_2+carry_NA),
         `Vote Gap` = (carry_1-carry_2)/(carry_1+carry_2+carry_NA)) %>%
  select(constituency, constituency_number, Acronym_1, Acronym_2, matchup, `Vote Share`, `Vote Gap` ) %>%
  rename(Party=Acronym_1, Challenger=Acronym_2) %>%
  mutate(constituency_number = as.numeric(constituency_number)) %>%
  filter(`Vote Gap` >= VoteGapThreshold2024, `Vote Share`< VoteShareThreshold) %>%
  unique() %>%
  arrange(constituency_number) %>%
  relocate(constituency_number) %>%
  mutate(`Vote Share` = `Vote Share`*100,
         `Vote Gap` = `Vote Gap`*100) %>%
  rename("Constituency Number" = constituency_number,
         Constituency = constituency,
         "Match-up" = matchup)

kable(Part_A_Winners_2024, digits=2)

Constituency Number	Constituency	Party	Challenger	Match-up	Vote Share	Vote Gap
6	Šeškinės–Šnipiškių	TS-LKD	LSDP	TS-LKD LSDP	31.19	18.42
18	Panemunės	TS-LKD	LSDP	TS-LKD LSDP	31.13	17.65
20	Centro–Žaliakalnio	TS-LKD	LS	TS-LKD LS	31.06	19.32
30	Alytaus	LSDP	TS-LKD	LSDP TS-LKD	32.45	17.46
42	Raseinių–Josvainių	LSDP	LVŽS	LSDP LVŽS	39.74	23.32

Success rates

In general, candidates who placed first in the first round win the second round, but the success rates vary from year to year. I refer to the candidate who won the most votes in the first round as the Leader, and the second-placed candidate as the Challenger.

85% of first round winners won the second round in 2012
69% of first round winners won the second round in 2016
84% of first round winners won the second round in 2020
This masks wide variation among parties and between years
- TS-LKD retained their lead in 87.5% times in 2012 but only 40% in 2016

2012
year	Party	Won	Lost	Total	Success Rate (%)
2012	DP	8	4	12	66.67
2012	Independent	2	0	2	100.00
2012	LLRA	2	1	3	66.67
2012	LRLS	3	1	4	75.00
2012	LSDP	18	0	18	100.00
2012	LVŽS	1	0	1	100.00
2012	TS-LKD	21	3	24	87.50
2012	TT	3	1	4	75.00
2012	All	58	10	68	85.29

2016
year	Party	Won	Lost	Total	Success Rate (%)
2016	DP	2	1	3	66.67
2016	Independent	1	2	3	33.33
2016	LLRA	1	0	1	100.00
2016	LRLS	4	0	4	100.00
2016	LS	1	0	1	100.00
2016	LSDP	4	6	10	40.00
2016	LVŽS	20	0	20	100.00
2016	TS-LKD	10	12	22	45.45
2016	TT	3	0	3	100.00
2016	All	46	21	67	68.66

2020
year	Party	Won	Lost	Total	Success Rate (%)
2020	DP	1	0	1	100.00
2020	Independent	3	1	4	75.00
2020	LLRA	1	0	1	100.00
2020	LP	2	0	2	100.00
2020	LRLS	4	1	5	80.00
2020	LSDDP	2	0	2	100.00
2020	LSDP	3	1	4	75.00
2020	LT	1	0	1	100.00
2020	LVŽS	13	0	13	100.00
2020	LŽP	1	0	1	100.00
2020	TS-LKD	26	8	34	76.47
2020	All	57	11	68	83.82

We can look at the success rates of the different parties from year to year, which emphasises how unusual 2016 was compared with 2012 and 2020 (and particularly how bad it was for TS-LKD, LSDP and independent candidates). This does mask how many candidates are being considered at each point.

Code

bind_rows(successRates, summaryRows) %>%
  ggplot() +
  geom_line(aes(x=year, y=`Success Rate (%)`, colour=Party)) +
  #geom_jitter(aes(x=year, y=`Success Rate (%)`, colour=Party), height=0.0, width=0.1) +
  geom_point(aes(x=year, y=`Success Rate (%)`, colour=Party)) +
  theme_minimal() +
  scale_colour_manual(values = party_colours_names) +
  
  #xlim(2011,2021) +
  scale_x_continuous(breaks=c(2012,2016,2020), limits=c(2011,2021)) +
  ylim(0,100) +
  geom_hline(yintercept=200/3)

Code

successRatesPartyToParty <- linear_wide_multiyear %>% 
  filter(year<2024) %>%
  group_by(year,Acronym_1, Acronym_2, flip) %>% tally() %>%
  group_by(year) %>% arrange(year,Acronym_1, Acronym_2) %>%
  pivot_wider(id_cols=c(year, Acronym_1, Acronym_2), names_from=flip,values_from=n) %>%
  rename(Leader=Acronym_1,Challenger=Acronym_2, Won='FALSE',Lost='TRUE') %>%
  select(-'NA') %>%
  replace_na(list(Party="None", Won=0, Lost=0)) %>%
  mutate(Total = Won + Lost, "Success Rate (%)"=Won/Total*100)

Code

PartyFactorList <- intersect( ordered_party_list_all_years,
                              union(unique(successRatesPartyToParty$Leader), unique(successRatesPartyToParty$Challenger)))
PartyFactorList <- to_factor(PartyFactorList, levels=ordered_party_list_all_years)

successRatesPartyToParty %>%
  filter(year==2020) %>%
  select(-Total) %>%
  pivot_longer(cols = Won:Lost, names_to = c("Outcome")) %>%
  mutate(Outcome = to_factor(Outcome, levels = c("Lost", "Won"), ordered=TRUE),
         Leader = to_factor(Leader, levels=ordered_party_list_all_years,ordered =TRUE),
         Challenger = to_factor(Challenger, levels=ordered_party_list_all_years, ordered=TRUE)) %>%
  ggplot(aes(x=Outcome, y=value, fill=Outcome)) +
  facet_grid(Leader ~ Challenger, switch="both") +
    geom_col() +
  labs(
    title = "Success rates for Leaders and Challengers in 2020",
    subtitle = "Results in single-constituency mandates in the second round",
    y="Leader candidate (after 1st round)",
    x="Challenger candidate (after 1st round)",
    caption="Data from VRK.lt | Graph by Richard Martin-Nielsen") +
  theme_linedraw() +
  theme(
    axis.ticks = element_blank()
  )

Code

successRatesPartyToParty %>%
  filter(year==2020) %>%
  select(-Total) %>%
  pivot_longer(cols = Won:Lost, names_to = c("Outcome")) %>%
  mutate(Outcome = to_factor(Outcome, levels = c("Won", "Lost")),
         Leader = to_factor(Leader, levels=PartyFactorList),
         Challenger = to_factor(Challenger, levels=PartyFactorList)) %>%
  group_by(year,Leader,Challenger, Outcome) %>%

  ggplot(aes(values=value, fill=Outcome)) +
  facet_grid(Leader ~ Challenger) +
    geom_waffle() +
  theme_minimal()

Slightly hacky predictions

Let’s have a look and see what we can get from a very basic approach.

Code

# First round data in the single member constituencies
LTU_Elections_2024_Round_I <- read_excel("LTU Elections 2024 Round I.xlsx", 
    skip = 8)
# Data in the multi member constituencies
LTU_Elections_2024_Multimember <- read_excel("LTU Elections 2024 Multimember.xlsx", 
    skip = 7)

# But let's be quick and work from VRK summaries:
First_round_results_2024_10_14_0849_cet_Rezultatai_vrk_lt <- read_excel("First round results 2024-10-14 0849 cet Rezultatai - vrk.lt.xlsx", 
    skip = 8)

Multimember_results_2024_10_14_1830_cet_Rezultatai_vrk_lt <- read_excel("Multimember results 2024-10-14 1830 cet Rezultatai - vrk.lt.xlsx", 
                                                                        sheet="data_lt",
    skip = 11) %>%
  rename(Candidate="Kandidatas", "Electoral Constituency"="Apygarda", "Nominated by"="Partijos, koalicijos pavadinimas")

Code

multimember_party_results <-
  Multimember_results_2024_10_14_1830_cet_Rezultatai_vrk_lt %>%
    filter(`Electoral Constituency`=="Daugiamandatė") %>%
    select(-`Electoral Constituency`) %>%
    left_join(party_names, by=c("Nominated by"="Name"))
MPs_elected_first_round <- Multimember_results_2024_10_14_1830_cet_Rezultatai_vrk_lt %>%
  filter(`Electoral Constituency`!="Daugiamandatė") %>%
    select(-`Electoral Constituency`) %>%
    left_join(party_names, by=c("Nominated by"="Name"))

Code

FirstRoundFractions_2024 <- linear_wide_multiyear %>%
  filter(year == 2024) %>%
  mutate(`Vote Share` = carry_1/(carry_1+carry_2+carry_NA),
         `Vote Gap` = (carry_1-carry_2)/(carry_1+carry_2+carry_NA)) %>%
  rename(Leader=Acronym_1, Challenger=Acronym_2)

WithinThresholds_2024 <- FirstRoundFractions_2024 %>%
  filter(`Vote Share`<VoteShareThreshold, `Vote Gap`<VoteGapThreshold2024) 

LikelyElected_2024 <- FirstRoundFractions_2024 %>%
  filter(`Vote Share`>=VoteShareThreshold || `Vote Gap`>=VoteGapThreshold2024) 
expected_winners_part_A <- LikelyElected_2024

LeaderParties_2024 <- FirstRoundFractions_2024 %>% 
  group_by(Leader) %>%
  tally()

Part_A_Parties_2024 <- Part_A_Winners_2024 %>%
  group_by(Party) %>%
  tally()

Directly elected in the first round

We can build a graph which shows the MPs elected to the Seimas, whether through the multi-member constituency off party lists in the first round, or by passing the threshold in the first round in single-member constituencies (8).

Code

parl_data <- bind_rows(MPs_elected_first_round, multimember_party_results) %>%
  rename(party_long=`Nominated by`, party_short=Acronym) %>%
  group_by(party_long, party_short) %>%
  tally(name="seats") 

first_round_parl_data <- parliament_data(
  election_data = parl_data,
  type="semicircle", party_seats = parl_data$seats,
  parl_rows = 4)

ggplot(first_round_parl_data, aes(x=x, y=y, colour=party_short)) +
  geom_parliament_seats(size=5) +
  theme_ggparliament() +
  scale_colour_manual(values = party_colours_names) +
  guides(colour = guide_legend(title=NULL)) +
  labs( title="MPs elected to the Seimas in the first round 2024")

Directly elected and leading

It’s more useful to have some indication of how this relates. This graph shows both those confirmed as elected and those leading in the first round in single-member constituencies.

I am also adding in the 5 seats where the vote gap is above 17%, counting them as confirmed.

This is somewhat useful and suggests that these seats are uncertain, but doesn’t reflect who the challenger is for each constituency.

Code

parl_data_leaders <-
  FirstRoundFractions_2024 %>%
  mutate("elected"=if_else(`Vote Gap`>VoteGapThreshold2024, TRUE, FALSE)) %>%
  select(party_short=Leader, elected) %>%
  mutate(party_long=party_short) %>%
    group_by(party_long, party_short, elected) %>%
  tally(name="seats")
  
parl_data_with_leaders <- bind_rows(parl_data %>%
    mutate("elected"=TRUE),
  parl_data_leaders) %>%
  mutate(party_short = if_else(is.na(party_short), "Independent", party_short)) %>%
  mutate(party_long = party_short) %>%
  mutate(party_short = factor(party_short,
                                 levels=ordered_party_list_all_years)) %>%
  arrange(party_short,elected)

first_round_parl_data_w_leaders <- parliament_data(
  election_data = parl_data_with_leaders,
  type="semicircle", party_seats = parl_data_with_leaders$seats,
  parl_rows = 4)

ggplot(first_round_parl_data_w_leaders, aes(x=x, y=y, colour=party_short)) +
  geom_parliament_seats(size=5) +
  theme_ggparliament() +
  scale_colour_manual(values = party_colours_names) +
  guides(colour = guide_legend(title=NULL)) +
  geom_emphasize_parliamentarians(elected, size=5) +
  labs( title="MPs elected and leading to the Seimas in the first round 2024")

Choosing success rates for simulation

When we looked at success rates year to year earlier, 2016 looked very odd. A key question for 2024 is whether we think 2016 was an outlier, or whether it reflects a broader range of how Lithuanian parties perform in elections.

In the end, I am going to treat 2016 as an outlier, and base calculations for party-by-party success rates on the data for 2012 and 2020.

Code

adjustedSuccessRates <- linear_wide_multiyear %>%
  filter(year %in% c(2012,2020))%>%
  mutate(VoteGap=(carry_1-carry_2)/(carry_1+carry_2+carry_NA),perc=(carry_1)/(carry_1+carry_2+carry_NA)) %>%
  filter((VoteGap <= VoteGapThreshold) & (perc <= VoteShareThreshold )) %>%
  mutate(-VoteGap,-VoteGapThreshold) %>%
  group_by(Acronym_1,flip) %>% tally() %>%
  arrange(Acronym_1) %>%
  pivot_wider(id_cols=c(Acronym_1), names_from=flip,values_from=n) %>%
  rename(Party=Acronym_1,Won='FALSE',Lost='TRUE') %>%
  select(-'NA') %>%
  replace_na(list(Party="None", Won=0, Lost=0)) %>%
  mutate(Total = Won + Lost, "Success Rate (%)"=Won/Total*100)
kable(adjustedSuccessRates, digits = 2)

Party	Won	Lost	Total	Success Rate (%)
DP	7	4	11	63.64
Independent	3	1	4	75.00
LLRA	1	1	2	50.00
LP	2	0	2	100.00
LRLS	7	2	9	77.78
LSDDP	2	0	2	100.00
LSDP	17	1	18	94.44
LT	1	0	1	100.00
LVŽS	11	0	11	100.00
LŽP	1	0	1	100.00
TS-LKD	31	11	42	73.81
TT	2	1	3	66.67

Code

# Maximum
MaxLeaderSuccess <- 80
# Typical (for where we have no previous data)

# This is what the figure was in the past, it is now being bumped up to 2/3
#AverageLeaderSuccess <- 60
AverageLeaderSuccess <- 2/3*100

We’ll apply a maximum of 80% and assign a typical chance of success of 66.6666667% where we don’t have earlier data. For the Liberalų sąjūdis, I will treat them as a continuation of the LRLS. Note also that the DSVL is not running in any of the second round elections so the figures are irrelevant.

Code

newParties <- tribble(
  ~Party, ~Won, ~Lost, ~Total, ~`Success Rate (%)`,
  # New parties for 2024
  "PPNA", 0, 0, 0, NA,
  "DSVL", 0, 0, 0, NA,
  "LS", 7, 2, 9, 7/9,
  # Old parties from 2020 calculations
  #"LP", 0, 0, 0, NA,
  #"LT", 0, 0, 0, NA,
  #"LSDDP", 0, 0, 0, NA,
  #"LŽP", 0, 0, 0, NA
)

round_II_probability <- bind_rows(adjustedSuccessRates,newParties) %>%
  mutate("Probability"= if_else(Total==0, AverageLeaderSuccess, if_else(`Success Rate (%)`> MaxLeaderSuccess, MaxLeaderSuccess, `Success Rate (%)`)))

Round_II_Parties_2024 <- round_II_probability %>% select(Party)

#kable(slice(round_II_probability, 1:8))
kable(round_II_probability,digits=2)

Party	Won	Lost	Total	Success Rate (%)	Probability
DP	7	4	11	63.64	63.64
Independent	3	1	4	75.00	75.00
LLRA	1	1	2	50.00	50.00
LP	2	0	2	100.00	80.00
LRLS	7	2	9	77.78	77.78
LSDDP	2	0	2	100.00	80.00
LSDP	17	1	18	94.44	80.00
LT	1	0	1	100.00	80.00
LVŽS	11	0	11	100.00	80.00
LŽP	1	0	1	100.00	80.00
TS-LKD	31	11	42	73.81	73.81
TT	2	1	3	66.67	66.67
PPNA	0	0	0	NA	66.67
DSVL	0	0	0	NA	66.67
LS	7	2	9	0.78	0.78

Simulate \(5\times 10^{4}\) times

The second round of the election was simulated \(5\times 10^{4}\) times. Essentially a weighted coin was flipped for each constituency in each simulated election.

The probability of the leader winning is given by the adjusted probabilities we have calculated — if they lose, the challenger wins the seat.

The many simulations were then compiled to see how many seats on average the party will win — the “expected” number of seats.

Monte Carlo isn’t necessary here

I realise that because these are essentially the sum of many independent probability distributions, the calculations could be done without running the Monte Carlo. I have the Monte Carlo code ready and it’s (slightly) faster to rerun it than to put together the calculations which would assemble the expected values given the known independent distributions for each of my variables.

Code

#Join on the probabilities

competitors_part_B <- linear_wide_multiyear %>%
  filter(year==2024, !is.na(constituency_number) ) %>%
  mutate(Acronym_1 = if_else(is.na(Acronym_1), "Independent", Acronym_1),
        Acronym_2 = if_else(is.na(Acronym_2), "Independent", Acronym_2)) %>%
  filter(!(constituency_number %in% expected_winners_part_A$constituency_number )) %>%
  select(constituency_number, constituency,Acronym_1, Acronym_2) %>%
  mutate(Constituency= glue('{formatC(constituency_number,width=2,flag="0")}. {constituency}'))

mc_basis <- left_join(competitors_part_B,
                      round_II_probability %>%
                        select(Party,Probability) %>%
                        mutate(Probability=Probability/100),
                      by=c("Acronym_1"="Party"))

election.sim <- function() {
    mc_basis %>%
    mutate(result = if_else(runif(n=1)<Probability, Acronym_1, Acronym_2)) %>%
    select(-Acronym_1,-Acronym_2,-Probability,-Constituency) %>%
    ungroup()
}

election.tallySeats <- function( x ) {
  left_join(Round_II_Parties_2024,
            x %>% group_by(result) %>%
            tally() %>%
            rename(Party=result), by=c("Party")) %>%
    mutate(Seats=replace_na(n,0)) %>%
    select(-n)
}

election.tallySeatsWide <- function( x ) {
  left_join(Round_II_Parties_2024,
            x %>% group_by(result) %>%
            tally() %>%
            rename(Party=result), by=c("Party")) %>%
            mutate(Seats=replace_na(n,0)) %>%
            select(-n) %>%
            pivot_wider(names_from="Party",values_from="Seats")
}

if (rerunMC) {
  mc.samples_flat <- pbreplicate(runs, election.sim() %>%select(result), simplify = FALSE)
tallies <- mc.samples_flat %>%
  map_dfr(election.tallySeats) %>%
  group_by(Party) %>%
  summarise(ExpectedSeats = sum(Seats)/runs)
TalliedSeats <- mc.samples_flat %>% 
  map_dfr(election.tallySeats)
TalliedSeatsWide <- mc.samples_flat %>%
  map_dfr(election.tallySeatsWide)
  save( "mc.samples_flat","runs","tallies","TalliedSeats","TalliedSeatsWide",
    file="electionsMCruns-2024.Rdata")
} else {
  load("electionsMCruns-2024.Rdata")
}

Expected numbers of seats

Code

Summary_Part_B <- tallies %>%
  mutate(ExpectedSeats = if_else(is.na(ExpectedSeats), 0, ExpectedSeats)) %>%
  mutate(Rounded=round(ExpectedSeats))
  
  
SummarySummaryPartB <- Summary_Part_B %>%
  summarise(Party="All", `ExpectedSeats`=sum(`ExpectedSeats`),`Rounded`=sum(`Rounded`))
  
#kable(bind_rows(Summary_Part_B,SummarySummaryPartB), digits=2)

total_expected <- first_round_parl_data %>% select(-x,-y,-row,-theta) %>% unique() %>%
  full_join(Summary_Part_B, by=c("party_short"="Party")) %>%
  left_join(Part_A_Parties_2024 %>%rename("Expected First Round Winners"=n), by=c("party_short"="Party")) %>%
  replace_na(list(party_long="Unknown", party_short="Independent","Expected First Round Winners"=0,
                         seats=0, ExpectedSeats=0,Rounded=0)) %>%
  relocate("Expected First Round Winners", .before=ExpectedSeats) %>%
  filter(ExpectedSeats > 0 | seats > 0) %>%
  rename("Party (Lithuanian)"=party_long, "Party"="party_short",
         "First Round Seats"="seats", "Second Round Seats (expected)"=ExpectedSeats,
         "Second Round Seats (rounded)" = Rounded) %>%
  mutate(Total = `First Round Seats`+`Expected First Round Winners`+`Second Round Seats (rounded)`) %>%
  mutate(`Party (Lithuanian)` = case_when (
    Party == "LP" ~ "Laisvės partija",
    Party == "LT" ~ "Partija „Laisvė ir teisingumas“",
    .default = Party
  ) 
         ) %>%
  arrange(desc(Total))
kable(total_expected, digits=2)

Party (Lithuanian)	Party	First Round Seats	Expected First Round Winners	Second Round Seats (expected)	Second Round Seats (rounded)	Total
LSDP	LSDP	20	2	18.52	19	41
TS-LKD	TS-LKD	18	3	19.27	19	40
PPNA	PPNA	15	0	5.89	6	21
DSVL	DSVL	8	0	3.05	3	11
LVŽS	LVŽS	6	0	4.80	5	11
LS	LS	8	0	1.28	1	9
Independent	Independent	1	0	2.92	3	4
LLRA	LLRA	2	0	1.03	1	3
Laisvės partija	LP	0	0	0.79	1	1
Partija „Laisvė ir teisingumas“	LT	0	0	0.46	0	0

Plot of expected outcome

Code

parl_data_expected <- total_expected %>%
  rename(party_long=`Party (Lithuanian)`, party_short=Party, seats=Total)


expected_round_parl_data <- parliament_data(
  election_data = parl_data_expected,
  type="semicircle", party_seats = parl_data_expected$seats,
  parl_rows = 5)

ggplot(expected_round_parl_data, aes(x=x, y=y, colour=party_short)) +
  geom_parliament_seats(size=5) +
  theme_ggparliament() +
  scale_colour_manual(values = party_colours_names) +
  guides(colour = guide_legend(title=NULL)) +
  labs( title="Expected outcome of 2024 Seimas elections",
        subtitle="Probabilistic simulation based on past party results",
        caption="Calculations and graph by Richard Martin-Nielsen\nDetails at http://projects.martin-nielsen.ca/OneFortyOne")

Histograms of Seat Allocation

Histograms can show the distribution of the different numbers of seats for each party. The lump being further right means that the party is likely to win more seats. A narrow lump indicates that the party’s chances are limited in a tight range, usually because it is only competing for a limited number of seats in the second-round.

Code

first_round_lookup <- first_round_parl_data %>% select(-x,-y,-row,-theta) %>% unique() %>%select(party_short, seats)

TalliedTotalSeats <- TalliedSeatsWide %>% mutate(MCrun = row_number(), .before=everything()) %>% 
  #head(5) %>%
  pivot_longer(cols=DP:LS,
               names_to="party_short", values_to = "MCseats") %>%
  left_join(first_round_lookup %>%rename(FirstRoundSeats=seats), by=c("party_short")) %>%
  replace_na(list(MCseats=0,FirstRoundSeats=0)) %>%
  mutate(total = MCseats+FirstRoundSeats) %>%
  rename(Party=party_short,Seats=total)

PositiveSeatCounts <- TalliedTotalSeats %>%
  group_by(Party) %>%
  summarise(Seats = sum(Seats)) %>%
  filter(Seats>0)

TalliedTotalSeatsWide <- TalliedTotalSeats %>%
  select(-MCseats, -FirstRoundSeats) %>%
  group_by(MCrun) %>%
  pivot_wider(names_from=Party, values_from = c(Seats)) %>%
  ungroup() %>%
  select(-MCrun)

TalliedTotalSeats %>%
  filter(Party %in% PositiveSeatCounts$Party) %>%
  ggplot(aes(Seats, fill = Party)) + theme_light() +
  facet_wrap(~Party,nrow = 2,ncol=5) +
  geom_bar(aes(y=(..count..)/runs),width=1) +
  scale_fill_manual(values = party_colours_names) +
  guides(colour = guide_legend(title=NULL)) +
  scale_y_continuous(labels=scales::label_percent())

Code

  # geom_histogram(aes(x=Seats),binwidth=1) +
  # scale_y_continuous(labels=percent)

Details

Minimum numbers of seats across all simulations

Code

kable(summarise_each(TalliedTotalSeatsWide,min))

DP	Independent	LLRA	LP	LRLS	LSDDP	LSDP	LT	LVŽS	LŽP	TS-LKD	TT	PPNA	DSVL	LS
0	1	2	0	0	0	29	0	6	0	27	0	16	8	8

Maximum numbers of seats across all simulations

Code

kable(summarise_each(TalliedTotalSeatsWide,max))

DP	Independent	LLRA	LP	LRLS	LSDDP	LSDP	LT	LVŽS	LŽP	TS-LKD	TT	PPNA	DSVL	LS
0	7	5	3	0	0	48	2	15	0	45	0	27	16	14

Top twenty five seat distributions

Code

topTwentyFiveDistributions <- TalliedTotalSeatsWide %>%group_by_all()%>%tally() %>%arrange(desc(n)) %>% ungroup() %>%
  select(-DP, -LRLS, -LSDDP, -"LŽP",-TT) %>%
dplyr::slice_head(n=25)

kable(topTwentyFiveDistributions)

Independent	LLRA	LP	LSDP	LT	LVŽS	TS-LKD	PPNA	DSVL	LS	n
4	3	1	38	0	12	38	20	11	9	8
3	3	1	39	0	10	38	20	13	9	7
4	3	0	39	0	12	37	22	11	8	7
4	3	0	41	0	11	37	22	10	8	7
4	3	1	38	0	10	37	21	12	10	7
4	3	1	38	0	12	36	21	12	9	7
5	3	0	39	0	11	38	20	11	9	7
3	2	0	39	0	11	40	21	11	9	6
3	3	0	38	0	11	39	21	11	10	6
3	3	0	39	0	11	39	22	11	8	6
3	3	0	40	0	11	40	19	11	9	6
3	3	0	41	0	11	38	20	10	10	6
4	2	0	38	0	11	41	20	11	9	6
4	2	0	40	0	11	41	20	10	8	6
4	2	0	41	0	11	40	20	10	8	6
4	3	0	38	0	11	40	22	10	8	6
4	3	0	38	1	11	40	20	10	9	6
4	3	0	39	0	11	39	22	10	8	6
4	3	0	40	0	11	37	21	11	9	6
4	3	0	40	0	11	39	21	10	8	6
4	3	0	41	0	10	39	20	11	8	6
4	3	1	37	1	11	37	21	11	10	6
4	3	1	38	0	12	37	21	11	9	6
4	3	1	39	0	11	37	20	11	10	6
4	3	1	40	0	11	38	20	11	8	6

Possible coalitions

Lithuania’s governments are typically formed as a coalition among several parties, as in many other MMP systems. You can consider a few coalitions. LRT has set out some:

Code

CoalitionCounts <- TalliedTotalSeatsWide %>%
  transmute("CentreRight" = .$"TS-LKD"+.$LP+.$DSVL,
         "Existing" = .$"LS"+.$LP+.$"TS-LKD",
         "CentreLeft" = .$LSDP+.$DSVL+.$"LVŽS",
         "LeftWithNA" = .$LSDP+.$PPNA+.$"LVŽS",
         "Liberals" = .$LS +.$LP, 
         "RedBlue" = .$"TS-LKD" + .$LSDP
         )

CentreRightFreq <- CoalitionCounts %>%
  group_by(CentreRight) %>%
  tally() %>%
  mutate(Coalition="CentreRight", f = n/runs,Seats=CentreRight,LeadParty="TS-LKD")

ExistingFreq <- CoalitionCounts %>%
  group_by(Existing) %>%
  tally() %>%
  mutate(Coalition="Existing", f = n/runs,Seats=Existing,LeadParty="TS-LKD")

CentreLeftFreq <- CoalitionCounts %>%
  group_by(CentreLeft) %>%
  tally() %>%
  mutate(Coalition="CentreLeft", f = n/runs,Seats=CentreLeft,LeadParty="LSDP")

LeftWithNAFreq <- CoalitionCounts %>%
  group_by(LeftWithNA) %>%
  tally() %>%
  mutate(Coalition="LeftWithNA", f = n/runs,Seats=LeftWithNA,LeadParty="LSDP")

LiberalsFreq <- CoalitionCounts %>%
  group_by(Liberals) %>%
  tally() %>%
  mutate(Coalition="Liberals", f = n/runs,Seats=Liberals,LeadParty="LS")

RedBlueFreq <- CoalitionCounts %>%
  group_by(RedBlue) %>%
  tally() %>%
  mutate(Coalition="RedBlue", f = n/runs,Seats=RedBlue,LeadParty="LSDP")

AllFrequencies <- bind_rows(CentreRightFreq,
                            CentreLeftFreq,
                            ExistingFreq,
                            LeftWithNAFreq,
                            LiberalsFreq,
                            RedBlueFreq)
CoalitionDescriptions <- tribble(
  ~`Label`, ~`Parties`, ~`Note`,
  "Centre Right", "TS-LKD, LP and DSVL", "",
  "Existing",     "TS-LKD, LS, LP", "The governing coalition since 2020 elections",
  "Centre Left",  "LSDP, LVŽS and DSVL", "",
  "Left With Nemunas Dawn", "LSDP, PPNA and LVŽS", "Also includes Farmers & Greens",
  "Liberals", "LS and LP", "The two Liberal parties",
  "Red Blue", "TS-LKD and LSDP", "A \"grand coalition\" of the TS-LKD and LSDP"
)
kable(CoalitionDescriptions)

Label	Parties	Note
Centre Right	TS-LKD, LP and DSVL
Existing	TS-LKD, LS, LP	The governing coalition since 2020 elections
Centre Left	LSDP, LVŽS and DSVL
Left With Nemunas Dawn	LSDP, PPNA and LVŽS	Also includes Farmers & Greens
Liberals	LS and LP	The two Liberal parties
Red Blue	TS-LKD and LSDP	A “grand coalition” of the TS-LKD and LSDP

When you look at the seat distributions expected for these possible coalitions individually, it’s quickly clear the Centre-Right is well-shy of the 71 seat margin to form a majority, and doesn’t differ much from the expected seat distribution for the current coalition. The Centre-Left coalition has a very slight chance of passing the 71 seat mark.

With the addition of the Nemunas Dawn (PPNA) and the Farmers and Greens (LVŽS), the LSDP would likely to be able to form a coalition government.

Code

AllFrequencies %>%
  filter(!Coalition == "Liberals") %>%
  ggplot() +
  facet_wrap(vars(Coalition)) +
  geom_col(aes(x=Seats,y=f, colour=Coalition,fill=Coalition),width=1) +
          # position = "dodge2") +
  # geom_line(aes(x=Seats,y=f, colour=Coalition,alpha=0.4)) +
  # geom_jitter(aes(x=Seats,y=f, colour=Coalition,alpha=0.4), width=0.02, height=0) +
  theme_light() +
  scale_y_continuous(labels=scales::percent) +
  scale_x_continuous(limits=c(0,90)) +
   labs(
      #title = paste(thisYear, "Seimas Elections: First to Second Round vote shift by first round leader"),
      #subtitle = "Arrows crossing the diagonal indicate a change in winner",
      x = "Seats",
      y = "Frequency"
    ) +
  scale_fill_manual(
    breaks = c( "CentreRight", "CentreLeft",  "Existing", "LeftWithNA","Liberals", "RedBlue" ),
    values = c( "Blue", "Red", "Grey", "Orange", "Yellow", "Purple")
  )+
    scale_colour_manual(
    breaks = c( "CentreRight", "CentreLeft",  "Existing", "LeftWithNA","Liberals", "RedBlue" ),
    values = c( "Blue", "Red", "Grey", "Orange", "Yellow", "Purple")
  )+
  guides(alpha="none") +
  #theme(legend.position ="none") +
  geom_vline(xintercept=70.5)

Superimposing these graphs doesn’t make the prospects of coalition-building much simpler. If coalition leaders choose not to include the Nemunas Dawn party, it makes it more difficult to pull together a group of MPs numbering 71 or more – which is why I have plotted the numbers for a grand coalition of the LSDP and the TS-LKD.

Code

AllFrequencies %>%
  ggplot() +
  #geom_col(aes(x=Seats,y=f, fill=Coalition,alpha=0.4),width=1,
          # position = "dodge2") +
  geom_line(aes(x=Seats,y=f, colour=Coalition,alpha=0.4)) +
  geom_jitter(aes(x=Seats,y=f, colour=Coalition,alpha=0.4), width=0.02, height=0) +
  theme_light() +
  annotate("text",x=15,y=0.22, label="Liberals") +
  annotate("text",x=49,y=0.02, label="Existing\n(TS-LKD led)") +
  annotate("text",x=46,y=0.2, label="Centre-Right") +
  annotate("text",x=60,y=0.18, label="Centre-Left") +
  annotate("text",x=70,y=0.18, label="LSDP + PPNA\n+ LVŽS") +
  annotate("text",x=86,y=0.10, label="LSDP + TS-LKD\n\"grand coalition\"") +
  scale_y_continuous(labels=scales::percent) +
  scale_x_continuous(limits=c(0,90)) +
   labs(
      #title = paste(thisYear, "Seimas Elections: First to Second Round vote shift by first round leader"),
      #subtitle = "Arrows crossing the diagonal indicate a change in winner",
      x = "Seats",
      y = "Frequency"
    ) +
  scale_fill_manual(
    breaks = c( "CentreRight", "CentreLeft",  "Existing", "LeftWithNA","Liberals", "RedBlue" ),
    values = c( "Blue", "Red", "Grey", "Orange", "Yellow", "Purple")
  )+
    scale_colour_manual(
    breaks = c( "CentreRight", "CentreLeft",  "Existing", "LeftWithNA","Liberals", "RedBlue" ),
    values = c( "Blue", "Red", "Grey", "Orange", "Yellow", "Purple")
  )+
  guides(alpha="none", colour="none") +
  #theme(legend.position ="none") +
  geom_vline(xintercept=70.5)

To be clear, I don’t think a grand coalition of the TS-LKD and the LSDP is likely; I’m not sure it is possible. It is nonetheless likely that the two parties together are likely to have enough seats that they could, if they wished, form a government without any other coalition partners.

Conclusions

It’s still about 24 hours early to conclude that this system will predict the outcome of the second round of the 2024 Parliamentary elections. (I’m writing this shortly after midnight, the morning of 27 October.)

I think this approach is likely to do fairly well again this year.

Four years ago I suggested different ways this system could be improved. Some of these are still open, and in a week we will have data for four elections, at which point it may be worth looking at how the different match-ups influence the chances of an upset in the second-round.

References and credits

Data is from the Central Election Commission of the Republic of Lithuania, particularly their Elections home page (Rinkėjo puslapis) which presents historical electoral data in a consistent and open way.

Hemicycle charts were created using the ggparliament package.

All analysis was done with R, mostly using the tidyverse collection of packages.

Party key

Party	Name
DSVL	Demokratų sąjunga „Vardan Lietuvos“
Independent	Independent
LP	Laisvės partija
LS	Liberalų sąjūdis
LLRA	Lietuvos lenkų rinkimų akcija - Krikščioniškų šeimų sąjunga
LSDP	Lietuvos socialdemokratų partija
LVŽS	Lietuvos valstiečių ir žaliųjų sąjunga
LT	Partija „Laisvė ir teisingumas“
PPNA	Politinė partija „Nemuno Aušra“
TS-LKD	Tėvynės sąjunga - Lietuvos krikščionys demokratai

Independent	LLRA	LP	LSDP	LT	LVŽS	TS-LKD	PPNA	DSVL	LS	n
4	3	1	38	0	12	38	20	11	9	8
3	3	1	39	0	10	38	20	13	9	7
4	3	0	39	0	12	37	22	11	8	7
4	3	0	41	0	11	37	22	10	8	7
4	3	1	38	0	10	37	21	12	10	7
4	3	1	38	0	12	36	21	12	9	7
5	3	0	39	0	11	38	20	11	9	7
3	2	0	39	0	11	40	21	11	9	6
3	3	0	38	0	11	39	21	11	10	6
3	3	0	39	0	11	39	22	11	8	6
3	3	0	40	0	11	40	19	11	9	6
3	3	0	41	0	11	38	20	10	10	6
4	2	0	38	0	11	41	20	11	9	6
4	2	0	40	0	11	41	20	10	8	6
4	2	0	41	0	11	40	20	10	8	6
4	3	0	38	0	11	40	22	10	8	6
4	3	0	38	1	11	40	20	10	9	6
4	3	0	39	0	11	39	22	10	8	6
4	3	0	40	0	11	37	21	11	9	6
4	3	0	40	0	11	39	21	10	8	6
4	3	0	41	0	10	39	20	11	8	6
4	3	1	37	1	11	37	21	11	10	6
4	3	1	38	0	12	37	21	11	9	6
4	3	1	39	0	11	37	20	11	10	6
4	3	1	40	0	11	38	20	11	8	6

Independent	LLRA	LP	LSDP	LT	LVŽS	TS-LKD	PPNA	DSVL	LS	n
4	3	1	38	0	12	38	20	11	9	8
3	3	1	39	0	10	38	20	13	9	7
4	3	0	39	0	12	37	22	11	8	7
4	3	0	41	0	11	37	22	10	8	7
4	3	1	38	0	10	37	21	12	10	7
4	3	1	38	0	12	36	21	12	9	7
5	3	0	39	0	11	38	20	11	9	7
3	2	0	39	0	11	40	21	11	9	6
3	3	0	38	0	11	39	21	11	10	6
3	3	0	39	0	11	39	22	11	8	6
3	3	0	40	0	11	40	19	11	9	6
3	3	0	41	0	11	38	20	10	10	6
4	2	0	38	0	11	41	20	11	9	6
4	2	0	40	0	11	41	20	10	8	6
4	2	0	41	0	11	40	20	10	8	6
4	3	0	38	0	11	40	22	10	8	6
4	3	0	38	1	11	40	20	10	9	6
4	3	0	39	0	11	39	22	10	8	6
4	3	0	40	0	11	37	21	11	9	6
4	3	0	40	0	11	39	21	10	8	6
4	3	0	41	0	10	39	20	11	8	6
4	3	1	37	1	11	37	21	11	10	6
4	3	1	38	0	12	37	21	11	9	6
4	3	1	39	0	11	37	20	11	10	6
4	3	1	40	0	11	38	20	11	8	6

Independent	LLRA	LP	LSDP	LT	LVŽS	TS-LKD	PPNA	DSVL	LS	n
4	3	1	38	0	12	38	20	11	9	8
3	3	1	39	0	10	38	20	13	9	7
4	3	0	39	0	12	37	22	11	8	7
4	3	0	41	0	11	37	22	10	8	7
4	3	1	38	0	10	37	21	12	10	7
4	3	1	38	0	12	36	21	12	9	7
5	3	0	39	0	11	38	20	11	9	7
3	2	0	39	0	11	40	21	11	9	6
3	3	0	38	0	11	39	21	11	10	6
3	3	0	39	0	11	39	22	11	8	6
3	3	0	40	0	11	40	19	11	9	6
3	3	0	41	0	11	38	20	10	10	6
4	2	0	38	0	11	41	20	11	9	6
4	2	0	40	0	11	41	20	10	8	6
4	2	0	41	0	11	40	20	10	8	6
4	3	0	38	0	11	40	22	10	8	6
4	3	0	38	1	11	40	20	10	9	6
4	3	0	39	0	11	39	22	10	8	6
4	3	0	40	0	11	37	21	11	9	6
4	3	0	40	0	11	39	21	10	8	6
4	3	0	41	0	10	39	20	11	8	6
4	3	1	37	1	11	37	21	11	10	6
4	3	1	38	0	12	37	21	11	9	6
4	3	1	39	0	11	37	20	11	10	6
4	3	1	40	0	11	38	20	11	8	6