Tuesday, October 9, 2012

Optimal Presidential Seeking Behavior


# Imagine that we have a spectrum of voters.  On the left is communist-hippies.  On the fights is fascist-Nazis.

# Zero is perfectly between the two, the "Average voter"

n.voters <- 30000

voter.views <- rnorm(n.voters)

# The command mat.binom will be useful in drawing a matrix of binomial results. I will use a command I programmed in a previous post. (http://www.econometricsbysimulation.com/2012/09/item-response-theory-estimation.html)
mat.binom <- function(n,p) {
  bin.mat <- p*0
  for (i in 1:nrow(p)) {
    for (ii in 1:ncol(p)) {
    # This will draw a random binomial for each of the probabilities.
    bin.mat[i,ii] <- rbinom(1,n,p[i,ii])
  }
  }
 return(bin.mat)
}

# There are two parties in this world.  The probability of being in the left party is based on the normal cdf of your world views.  And the probability of being in the right party is based on 1-cdf of your world views.

# Party discrimination greater than zero means that the parties are more discriminated while less than zero results in less discrimination.
alpha = 1.2

# Party inclination
party.inclination <- cbind(alpha*pnorm(voter.views),alpha*(1-pnorm(voter.views)))
summary(party.inclination)
# NĂ©ed to make sure probabilities max at 1 and bottom at 0
party.inclination[party.inclination<0 0="0" p="p">party.inclination[party.inclination>1] <- 1
summary(party.inclination)

party <- mat.binom(1, party.inclination)

# If the person happens to be in both parties then we will make it so that the person is only in the party for which the person is the most inclined.

party[(party[,1]==party[,2])&(party[,1]==1)&(party.inclination[,1]>party.inclination[,2]),2] <- 0
party[(party[,1]==party[,2])&(party[,1]==1)&(party.inclination[,1]
# Let's generate a graph with three histograms showing the party.
# Par mfrow defines the matrix that the histrograms will be presented as. (3x1) in this case
par(mfrow=c(3,1))

# Now to presenting the histograms
hist(voter.views[party[,2]==1], main="Registered Democrans", xlab="Voter Views", xlim = range(voter.views), col="blue")
hist(voter.views[party[,1]==1], main="Registered Republicats", xlab="Voter Views", xlim = range(voter.views), col="red")
hist(voter.views[party[,2]==0&party[,1]==0], main="Independents", xlab="Voter Views", xlim = range(voter.views), col="purple")



# Generally speaking there should be relatively few independents (when alpha is not small).
length(voter.views[party[,2]==0&party[,1]==0])

party.factor = 0*1:n.voters # 0 is Independent
party.factor[party[,2]==1] = 1 # 1 is Republicrat
party.factor[party[,1]==1] = 2 # 2 is Democran

# Now let us imagine there is a primary for each party.  The candidates must first win the primary before seeking the overall win.

# There are many interesting ways of setting up a dynamic game in which each candidates positions will be based on each other candidates positions.  However, I am going to do a simpler simplification.

# Each candidate chooses two platforms.  1. The Primary Platform, and 2. the Presidential Platform.

# Each candidate will be specified as one of 19 platforms in the primary and presidential in which their positions are drawn from a normal cdf at every 5% interval (starting at 5% and ending at 95%.  Thus we have:

num.pos <- 19
pos.range <- qnorm((1:num.pos)/(num.pos+1))

# Let's see how well each position does relative to all other positions in each of the primaries.

# First let's define a function that will take two positions and a vector and return a 1 or 0.  1 if the first position wins the most points, zero otherwise.

pos.evaluate <- function(pos1,pos2,voters) {
  # The number who vote for candidate 1 because the distance pos1-voters position is smaller than the distance between that and the alterantive position
  nvote1 <- sum(abs(pos1-voters)-abs(pos2-voters)<0 p="p">  nvote2 <- sum(abs(pos1-voters)-abs(pos2-voters)>=0)
  # Finally, let us return 1 if the number of votes for position 1 is greater than position 2.
  return(nvote1>nvote2)
}

# Let's sample the code.
pos.evaluate(1,5, 1:11)
# Someone with a 1 does not win the vote on a uniform range from 1 to 11.
pos.evaluate(6,5, 1:11)
# Someone with a 6 does win the vote. That is because 6 gets votes 6 through 11 while 5 gets 1 through 5.

# Number of wins initially starts at zero.
num.win <- data.frame(position = pos.range, democrans = 0*1:num.pos, republicrats=0*1:num.pos,presidential=0*1:num.pos)

# Now let's see which strategy garnishes the most votes in each primary.
for (i in 1:num.pos) {
  for (ii in 1:num.pos) {
    num.win$democrans[i] <- num.win$democrans[i] + pos.evaluate(pos.range[i],pos.range[ii], voter.views[party.factor==1])
    num.win$republicrats[i] <- num.win$republicrats[i] + pos.evaluate(pos.range[i],pos.range[ii], voter.views[party.factor==2])
    num.win$presidential[i] <- num.win$presidential[i] + pos.evaluate(pos.range[i],pos.range[ii], voter.views)
  }
}

num.win
# By looking to the highest number of wins we can see that in each primary, the dominant strategy is to appear much more liberal for democrans and much more conservative for republicrats while both parties want to be solidly in the center during the presidential election.

par(mfrow=c(1,1))
plot(num.win$position, num.win$democrans, type="l", col="red", ylab="# of wins", xlab="Position", main="Results of Position Strategies")
lines(num.win$position, num.win$republicrats, col="blue")
lines(num.win$position, num.win$presidential)


# Thus, not just the fringe people on either end of the position spectrum will always feel disappointed by the position taken by candidates when they are attempting to win the national vote.  Because even if the candidates claim to be very liberal or very conservative in the primary they tend towards center when trying to win the total vote.

No comments:

Post a Comment