Привет всем вам, классные кошки и котята,
Я создаю блестящее приложение для поста в блоге, чтобы проиллюстрировать преимущества голосования по рейтингу (RCV). В этой части я хочу, чтобы пользователь определил выбор и количество избирателей, которые будут показывать результаты первого голосования после голосования по сравнению с выбором по рейтингу. Я разработал полное решение, но выборка делает его нереальным c (все варианты получают примерно выбор / n_choices голосов). И, как правило, результат совпадает с исходным множеством, поскольку данные стока являются просто шумом. Мне нужен способ создать неравномерную выборку, которая не всегда приводит к победе кандидата во множественном числе. Мое первоначальное решение состояло в том, чтобы разделить население пополам и дать произвольный вес опциям для двух разных групп ... это действительно не помогло.
Любые идеи для создания выборки вариантов с первоначальным кандидатом в множественное число, не всегда становящимся любимым?
Вот код как
# ---- 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)))
}
}
Примечательно , это работает, но кандидат с множеством заканчивается победой каждый раз (таким образом, ранжированный выбор не полезен для этой группы населения). Любое предложение помогает !!
-Бреннан
РЕДАКТИРОВАТЬ: Я РЕШЕН ЭТО: Для всех, кто просматривает это позже, решение было создать матрицу "предпочтений избирателей "(что в итоге означает вероятность голосования 2-го, 3-го, 4-го и т. д. c.)
Вот краткая версия:
# --------------------------- #
# ---- Input Parameters
# --------------------------- #
n_voters <- voter_number # number of voters
choice_names <- c("A", "B", "C", "D", "E") # choice names
choice_total <- length(choice_names)
# ------------------------------------ #
# ---- Voter Preference/Choice Frames
# ------------------------------------ #
# create voter preference matrix
preference.mat <- matrix(0,
nrow = choice_total,
ncol = choice_total,
dimnames = list(choice_names, choice_names))
# filling in matrix
# A B C D E
preference.mat["A", ] <- c(0.00, 0.40, 0.50, 0.05, 0.05) # filling in preferences (of course, I could have just put this in initial matrix... but if this will be more flexible in the future, should probably remain like this)
preference.mat["B", ] <- c(0.30, 0.00, 0.59, 0.10, 0.01) # could make them all flexible... but that would be a lot
preference.mat["C", ] <- c(0.38, 0.42, 0.00, 0.10, 0.10)
preference.mat["D", ] <- c(0.08, 0.02, 0.05, 0.00, 0.85)
preference.mat["E", ] <- c(0.08, 0.02, 0.05, 0.55, 0.00)
candidate_df <- matrix(NA, # Creating null matrix of rank x voters; a voter first choice in column 1 and so on
nrow = n_voters,
ncol = choice_total,
dimnames = list(paste("Voter", 1:n_voters), 1:choice_total))
# -- Assign first vote by probability within a population (these could be felxible)
candidate_df[,1] <- sample(choice_names, n_voters, replace = TRUE, prob = distributions) # populating with initial distribution of favorites (column 1 - voter' first choice)
new_df <- candidate_df
v <- 1
for(v in 1:n_voters){
first_choice <- new_df[v,1] # exclude this candidate from further options for this voter
count <- 1 # Beginning the count (to go up to = total choices)
exclusions <- c(first_choice) # Beginning the vector of exclusions to pick from in loop
loop.preferences <- preference.mat # reassigning preference.mat to loop.preferences each time (since I mutilate it in the while loop). Could've done this a different way (assign probability as a vector from the beginning)
while(count < choice_total){
probability <- loop.preferences[first_choice, ][which(loop.preferences[first_choice, ] != 0)] # extracting non-zero probabilities from preferences matrix (pref matrix updated each loop)
exclusion_index <- choice_names %in% exclusions # Which indeces contain choices to exclude (T/F vec)
new_df[v,(count+1)] <- sample(choice_names[!exclusion_index], 1, prob = probability) # filling in second row of candidate df with second choice
# update while loop parameters
loop.preferences[first_choice, new_df[v,(count+1)]] <- 0 # making the probability of picking this choice on the next run 0
exclusions <- c(exclusions, new_df[v,(count+1)]) # putting the next choice in the exclusions vector
count <- count + 1 # update count
}
}