identifying_countries_by_height_thought_experiment_computational_analysis.R

## Concerns thought experiment in 
## Common sequence variants affect molecular function more than rare variants?
## https://www.nature.com/articles/s41598-017-01054-2.pdf
## page 8, first section of discussion
## Doesn't seem right.

rm(list=ls())
set.seed(123)
library(caret)

test.sample <- c(10^(1:7))
n.levels <- length(test.sample)
overall.accuracy <- numeric()
n.iter <- 1e5

mean.germany <- 178 # cm
mean.greece <- 176 # cm
pop.germany <- 82000000
pop.greece <- 11000000

for(j in 1:length(test.sample)){
  
print(j)
germany <- rnorm(pop.germany, mean.germany, 10)
greece <- rnorm(pop.greece, mean.greece, 10)

n.per.sample <- test.sample[j]
results <- matrix(NA, nrow=n.iter, ncol=2)
colnames(results) <- c('country.true', 'country.guess')

  for(i in 1:n.iter){
    coin.flip <- rbinom(1, 1, 0.5)
    country <- ifelse(coin.flip==0, 'germany', 'greece')
    sample.data <- ifelse(country=='germany', 
                          sample(germany, size=n.per.sample),
                          sample(greece, size=n.per.sample))
    diff.from.germany <- abs(mean(sample.data) - mean.germany)
    diff.from.greece <- abs(mean(sample.data) - mean.greece)
    guess <- which.min(c(diff.from.germany, diff.from.greece))
    country.guess <- ifelse(guess==1, "germany", 'greece')
    results[i, c(1,2)] <- c(country, country.guess)
    }

ref <- factor(results[,'country.true'], levels=c('greece','germany'))
preds <- factor(results[,'country.guess'], levels=c('greece','germany'))

confmat <- confusionMatrix(preds, ref)
overall.accuracy[j] <- confmat$overall[1]
}

plot(test.sample, overall.accuracy, type="b")