Simulating party membership

party_join.R

library(tidyverse)
###
nGrp <- 250
grp_ideal_points <- rnorm(nGrp, 0, 1)
grp_sd <- 1
ind_sd <- 1
party_pos <- -1

joinfunc1 <- function(ind_pos, party_pos) {
    ## Probability joining party
    dist_to_party <- abs(ind_pos - party_pos)
    mu_join_party <- -2 -
        dist_to_party
    pr_join_party <- plogis(mu_join_party)
    pr_join_party
}
joinfunc2 <- function(ind_pos) {
    mu_join_party <- -3.35 - ind_pos
    pr_join_party <- plogis(mu_join_party)
    pr_join_party
}

### Let's plot these
png(file = "joinfuncs.png", width = 680, height = 440)
par(mfrow = c(1, 2))
inx <- seq(-3, 3, length.out = 100)
plot(inx, joinfunc1(inx, party_pos = -1),
     type = "l",
     xlab = "Position",
     ylab = "Probability of joining",
     main = "Proximity joining")
plot(inx, joinfunc2(inx),
     type = "l",
     xlab = "Position",
     ylab = "Probability of joining",
     main = "Distal joining")
dev.off()


### What does the pr. joining party look like under each function?
blank_plot <- function(main = "") {
    plot(c(-3, 3), y = c(0, .55),
     xlab = "Position",
     ylab = "Density",
     main = main,
     type = "n")
}

draw_curve <- function(x, y, col = "#99000066") {
    polygon(x = c(min(x),
              min(x),
              x,
              max(x),
              max(x)),
        y = c(0, y[1],
              y,
              y[length(y)],
              0),
        col = col)
}

    
inx <- seq(-3, 3, length.out = 100)
png(file = "ind_and_const.png", width = 680, height = 800)
par(mfrow = c(3, 2))

### Constituency position == 01
### Set up an empty plot
blank_plot("Left-wing seat")
### Draw in a normal distribution for the constituency
outy <- dnorm(inx, mean = -1, sd = 1)
draw_curve(inx, outy)

### Now draw in the membership function
outy <- joinfunc1(inx, party_pos = -1)
draw_curve(inx, outy, col = "#00990066")

### Repeat this for the different joinfunc
blank_plot("Left-wing seat")
### Draw in a normal distribution
outy <- dnorm(inx, mean = -1, sd = 1)
draw_curve(inx, outy)

### Now draw in the membership function
outy <- joinfunc2(inx)
draw_curve(inx, outy, col = "#00990066")


### Constituency position == 0 
### Set up an empty plot
blank_plot("Centrist seat")
### Draw in a normal distribution for the constituency
outy <- dnorm(inx, mean = 0, sd = 1)
draw_curve(inx, outy)

### Now draw in the membership function
outy <- joinfunc1(inx, party_pos = -1)
draw_curve(inx, outy, col = "#00990066")

### Repeat this for the different joinfunc
blank_plot("Centrist seat")
### Draw in a normal distribution
outy <- dnorm(inx, mean = 0, sd = 1)
draw_curve(inx, outy)

### Now draw in the membership function
outy <- joinfunc2(inx)
draw_curve(inx, outy, col = "#00990066")


### Constituency position == 1 
### Set up an empty plot
blank_plot("Right-wing seat")
### Draw in a normal distribution for the constituency
outy <- dnorm(inx, mean = 1, sd = 1)
draw_curve(inx, outy)

### Now draw in the membership function
outy <- joinfunc1(inx, party_pos = -1)
draw_curve(inx, outy, col = "#00990066")

### Repeat this for the different joinfunc
blank_plot("Right-wing seat")
### Draw in a normal distribution
outy <- dnorm(inx, mean = 1, sd = 1)
draw_curve(inx, outy)

### Now draw in the membership function
outy <- joinfunc2(inx)
draw_curve(inx, outy, col = "#00990066")

dev.off()



conjoinfunc1 <- function(inx, party_pos = -1) {
    joinfunc1(inx, party_pos) *
        dnorm(inx)
}
conjoinfunc2 <- function(inx) {
    joinfunc2(inx) *
        dnorm(inx)
}

integrate(f = conjoinfunc1, -100, 100, party_pos = -1)
integrate(f = conjoinfunc2, -100, 100)




### Now plot these two things multiplied together
### What does the pr. joining party look like under each function?
blank_plot <- function(main = "") {
    plot(c(-3, 3), y = c(0, .05),
     xlab = "Position",
     ylab = "Density",
     main = main,
     type = "n")
}

png(file = "conjoin.png", width = 600, height = 800)
par(mfrow = c(3, 2))

### Constituency position == 01
### Set up an empty plot
blank_plot("Left-wing seat")
outy <- dnorm(inx, mean = -1, sd = 1) *
    joinfunc1(inx, party_pos = -1)
draw_curve(inx, outy, col = "#00009966")

blank_plot("Left-wing seat")
outy <- dnorm(inx, mean = -1, sd = 1) *
    joinfunc2(inx)
draw_curve(inx, outy, col = "#00009966")

blank_plot("Centrist seat")
outy <- dnorm(inx, mean = 0, sd = 1) *
    joinfunc1(inx, party_pos = -1)
draw_curve(inx, outy, col = "#00009966")

blank_plot("Centrist seat")
outy <- dnorm(inx, mean = 0, sd = 1) *
    joinfunc2(inx)
draw_curve(inx, outy, col = "#00009966")

blank_plot("Right-wing seat")
outy <- dnorm(inx, mean = 1, sd = 1) *
    joinfunc1(inx, party_pos = -1)
draw_curve(inx, outy, col = "#00009966")

blank_plot("Right-wing seat")
outy <- dnorm(inx, mean = 1, sd = 1) *
    joinfunc2(inx)
draw_curve(inx, outy, col = "#00009966")

dev.off()

### 
## Simulate people
simppl <- function(joinfunc = 1) {
    the_grp <- sample(1:nGrp, 1)
    grp_pos <- grp_ideal_points[the_grp]
    ind_pos <- grp_pos + rnorm(1, 0, ind_sd)
    if (joinfunc == 1) {
        pr_join_party <- joinfunc1(ind_pos, party_pos)
    } else {
        pr_join_party <- joinfunc2(ind_pos)
    }
    
    joins <- rbinom(1, 1, pr = pr_join_party)
    data.frame(grp_pos = grp_pos,
               is_member = joins,
               ind_pos = ind_pos)
}


### First function: proximity to party is what matters
dat <- replicate(100000, simppl(joinfunc = 1), simplify = FALSE)
dat <- do.call("rbind", dat)

### What is the correlation like?
with(dat, cor(grp_pos, ind_pos))
with(subset(dat, is_member == 1) , cor(grp_pos, ind_pos))

### What is the distance like?
with(dat, mean(abs(grp_pos - ind_pos)))
with(subset(dat, is_member == 1) , mean(abs(grp_pos - ind_pos)))

### What is the regression like?
with(dat, lm(ind_pos ~ grp_pos))
with(subset(dat, is_member == 1), lm(ind_pos ~ grp_pos))

### Second function - more left wing people more likely
dat2 <- replicate(100000, simppl(joinfunc = 2), simplify = FALSE)
dat2 <- do.call("rbind", dat2)

### What is the correlation like?
with(dat2, cor(grp_pos, ind_pos))
with(subset(dat2, is_member == 1) , cor(grp_pos, ind_pos))

### What is the distance like?
with(dat2, mean(abs(grp_pos - ind_pos)))
with(subset(dat2, is_member == 1) , mean(abs(grp_pos - ind_pos)))

### What is the regression like?
with(dat2, lm(ind_pos ~ grp_pos))
with(subset(dat2, is_member == 1), lm(ind_pos ~ grp_pos))