R function to simulate ranked votes

Hi all you cool cats and kittens,

I'm creating a shiny app for a blog post to illustrate the benefits of ranked-choice voting (RCV). In part of that post, I want to let the user define the choices and number of voters to show results of first past the post voting vs. ranked-choice voting. I've developed a full solution but the sampling makes it unrealistic (all choices get approximately choice/n_choices of the votes). And, usually the outcome is the same as the initial plurality since the runoff data is just noise. I need a way to create uneven sampling that doesn't always result in the candidate with plurality winning. My initial solution was to break the population in half and give arbitrary weights to options for the two different groups... this really didn't help.

Any ideas to create a sample of choices with initial plurality candidate not always becoming favorite?

Here is code as is

# ---- Input Parameters
n_voters     <- 10000                        # number of voters
choice_names <- c("A", "B", "C", "D", "E")   # choice names
n_choices <- length(choice_names)            # number of choices


candidate_df <- matrix(NA,                      # Creating null matrix of choices x voters
                       nrow = n_voters,
                       ncol = n_choices,
                       dimnames = list(paste("Voter", 1:n_voters), choice_names))


# ---- Filling in Data Frame with simulated choices from a given voter base
for(i in 1:nrow(candidate_df)){

  if(i < 0.5*nrow(candidate_df)){ #trying to create uneven distributions with two "different" populations
    choices <- sample(1:n_choices, n_choices, replace = FALSE, prob = c(0.01, 0.04, 0.4, 0.05, 0.5)) 
  } else {
    choices <- sample(1:n_choices, n_choices, replace = FALSE, prob = c(0.4, 0.08, 0.12, 0.3, 0.1)) 
  }
  candidate_df[i,] <- choices     # filling in rows with sampled ranked voting from each voter
}

# -------------------------------------------------------------------------------------------------------------------- #
# ----------------------------------------- #
#
# run of simulation;
#   Rules:
#       1. After 1st choices are tallied, if no one has majority (>= 50%), 
#          then lowest polling candidate is eliminated and their second choice is distributed to that candidaate
#       2. This continues until a given candidate has >=50% rating
#
# ----------------------------------------- #
# -------------------------------------------------------------------------------------------------------------------- #

# store df into new one (so I don't have to run above code not really necessary)
new_df <- candidate_df
polling_check <- prop.table(colSums(new_df == 1))    # begin the simulation by creating a "poll check," which will see if any candidate has >= 50% polling
while(any(polling_check < 0.5)){                     # loop until someone has majority vote

  rank <- colSums(new_df == 1)         # Identify column with least number of "1" rankings
  p_rank <- prop.table(rank)           # finding proportion favoring each candidate as #1
  if(any(p_rank >= 0.5)){              # if there is a cadidate polling above >= 50%, break and print winner
    print(paste("Candidate ", names(p_rank[p_rank >= 0.5]), " is the winner!"))
    break
  } else {                                     # if not... then...
    elim_candidate_index <- which.min(p_rank)  # find candidate polling lowest to delete from df
    new_df <- new_df[,-elim_candidate_index]   # delete that candidate  from above index

    new_df <- t(apply(new_df, 1, rank))        # rank the choices left for everyone (so that if a voters first choice is eliminated, their second choice becomes 1)

    polling_check <- prop.table(colSums(new_df == 1))   # new polling check

    print(paste(polling_check))
    print(paste(names(polling_check)))

  }

}

Notably, this works, but the candidate with plurality ends up winning every time (thus the ranked choice isn't useful to this population). Any suggestion helps!!

-Brennan