gwern comments on The average North Korean mathematician

[gwern]

To noodle a bit more about tails coming apart: asymptotically, no matter how large r, the probability of a ‘double max’ (a country being the top/​max on variable A correlated r with variable B also being top/​max on B) decreases to 1/​n. The decay is actually quite rapid, even with small samples you need r>0.9 to get anywhere.

A concrete example here: you can’t get 100%, but let’s say we only want a 50% chance of a double-max. And we’re considering just a small sample like 192 (roughly the number of countries in the world, depending on how you count). What sort of r do we need? We turn out to need r ~ 0.93! There are not many correlations like that in the social sciences (not even when you are taking multiple measurements of the same construct).

---

Some R code to Monte Carlo estimates of the necessary r for n = 1-193 & top-p = 50%:

p_max_bivariate_montecarlo <- function(n,r,iters=60000) {
    library(MASS) # for 'mvrnorm'
    mean(replicate(iters, {
                sample <- mvrnorm(n, mu=c(0,0), Sigma=matrix(c(1, r, r, 1), nrow=2))
                which.max(sample[,1])==which.max(sample[,2])
                })) }

find_r_for_topp <- function(n, topp_target=0.5) {
  r_solver <- function(r) {
     topp <- p_max_bivariate_montecarlo(n, r)
     return(abs(topp_target - topp))
   }
  optim(0.925, r_solver, method="Brent", lower=0, upper=1)$par
  }
library(parallel); library(plyr) # parallelism
rs <- ldply(mclapply(2:193, find_r_for_topp))$V1
# c(0.0204794413, 0.4175067131, 0.5690806174, 0.6098019663, 0.6994770020, 0.7302042200, 0.7517989571, 0.7652371794, 0.7824824776, 0.7928299227, 0.7911903664, 0.8068905240, 0.8177673342, 0.8260679686, 0.8301939461, 0.8258472869, 0.8314810573, 0.8457114147, 0.8477265340, 0.8599239760, 0.8541010795, 0.8539345369, 0.8578597015, 0.8581440013, 0.8584451493, 0.8612079626, 0.8640382310, 0.8693895810, 0.8681881832, 0.8540880634, 0.8688769562, 0.8734774025, 0.8762371597, 0.8737293740, 0.8791205385, 0.8798232797, 0.8780001174, 0.8813006544, 0.8795942424, 0.8809224752, 0.8789012597, 0.8826072026, 0.8820106235, 0.8833360963, 0.8880434608, 0.8865534542, 0.8860206658, 0.8909726985, 0.8918581133, 0.8896068426, 0.8931125753, 0.8915826504, 0.8881211032, 0.8860882133, 0.8857084275, 0.8962766690, 0.8921903730, 0.8942188090, 0.8969666799, 0.8926138586, 0.8971690171, 0.8946804108, 0.8973194094, 0.8942509678, 0.8999695035, 0.8965944860, 0.8961380935, 0.8940129777, 0.9032449177, 0.9008863181, 0.9032217868, 0.9005629127, 0.9020274591, 0.8959058553, 0.9021526115, 0.9039115040, 0.9011588080, 0.9035249155, 0.9017018519, 0.9055311291, 0.9050712304, 0.9090986369, 0.9102189075, 0.9058648333, 0.9062347968, 0.9036232208, 0.9098300563, 0.9104166481, 0.9082378601, 0.9097509415, 0.9072401723, 0.9110669707, 0.9097015650, 0.9095392911, 0.9104547321, 0.9109965730, 0.9105344751, 0.9113974777, 0.9098016391, 0.9108745395, 0.9096074058, 0.9101558716, 0.9114150600, 0.9098197705, 0.9140866653, 0.9110598057, 0.9098305291, 0.9126945140, 0.9116794250, 0.9098304525, 0.9162597410, 0.9138880049, 0.9166744242, 0.9115174937, 0.9098300563, 0.9137427958, 0.9154025570, 0.9098300563, 0.9153743094, 0.9121638454, 0.9098300563, 0.9124202538, 0.9150891460, 0.9155692284, 0.9154097048, 0.9148239514, 0.9135391377, 0.9134265701, 0.9184868581, 0.9155030511, 0.9160840080, 0.9156142020, 0.9180363741, 0.9133847724, 0.9178412895, 0.9164848154, 0.9185051043, 0.9186443572, 0.9163631983, 0.9067252079, 0.9171935358, 0.9068669658, 0.9172083988, 0.9216221015, 0.9173032657, 0.9161656322, 0.9193769687, 0.9196134184, 0.9189703040, 0.9168335043, 0.9208238293, 0.9176496818, 0.9177692888, 0.9193447026, 0.9083813817, 0.9171593478, 0.9207227165, 0.9215861226, 0.9094130225, 0.9197835707, 0.9175185705, 0.9207226893, 0.9213173454, 0.9211625233, 0.9187349438, 0.9094856342, 0.9218536229, 0.9213765908, 0.9216097564, 0.9215764567, 0.9098389885, 0.9098265564, 0.9217230988, 0.9219802481, 0.9226050491, 0.9174997507, 0.9098423672, 0.9208316851, 0.9219666398, 0.9213117029, 0.9227359249, 0.9107645063, 0.9217438628, 0.9225905693, 0.9220370631, 0.9259721234, 0.9225535447, 0.9249239773, 0.9256348191, 0.9232228035, 0.9101015711, 0.9253350470)
library(ggplot2)
qplot(1:192, rs) + coord_cartesian(ylim=c(0,1)) + ylab("Necessary bivariate correlation (Pearson's r)") + xlab("Population size") + ggtitle("Necessary correlation strength for ~50% chance of double-max on 2 correlated variables (Monte Carlo)") + theme_linedraw(base_size = 24) + geom_point(size=4)

https://​​i.imgur.com/​​Yzz2VYA.png