require(tibble)
require(purrr)

.emulate_coding <- function(ground_truth, Q = 1) {
    if (runif(1) > Q) {
        return(sample(c(1,0), 1))
    } else {
        return(ground_truth)
    }
}

##irr::kripp.alpha(matrix(c(obs_x, obs_x2), nrow = 2, byrow = TRUE), method = "nominal")
### Which is very close to
## cor(obs_x, obs_x2)

.sim <- function(N = 100, P = 0.5, Q = 0.8) {
    real_x <- rbinom(N, 1, P)
    obs_x <- purrr::map_dbl(real_x, .emulate_coding, Q = Q)
### then learn w from obs_x and k
    obs_x2 <- purrr::map_dbl(real_x, .emulate_coding, Q = Q)
    ra <- sum(diag(table(obs_x, obs_x2))) / N ## raw agreement
    rr <- cor(obs_x, obs_x2)
    irr <- irr::kripp.alpha(matrix(c(obs_x, obs_x2), nrow = 2, byrow = TRUE), method = "nominal")$value
    return(data.frame(N, P, Q, ra, rr, irr))
}

N <- c(50, 100, 300)
P <- c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9)
Q <- c(0.5, 0.6, 0.7, 0.8, 0.9, 1)
conditions <- tibble::tibble(expand.grid(N, P, Q))
colnames(conditions) <- c("N", "P", "Q")
res <- list()

for (i in seq_len(nrow(conditions))) {
    print(i)
    res[[i]] <- purrr::map_dfr(rep(NA, 100), ~ .sim(conditions$N[i], conditions$P[i], conditions$Q[i]))
}

conditions$res <- res

require(dplyr)

conditions %>% mutate(mra = purrr::map_dbl(res, ~mean(.$ra, na.rm = TRUE)), mrr = purrr::map_dbl(res, ~mean(.$rr, na.rm = TRUE)), mirr = purrr::map_dbl(res, ~mean(.$irr, na.rm = TRUE))) %>% lm(mirr~0+P+poly(Q, 2), data =.) %>% summary