Fun with narrow sense heritability (part 1)

In chapter 3 of Intelligence, Genes and Success Daniels and others perform a Bayesian meta-analysis of IQ heritability papers and estimate the narrow sense heritability to be "only" 0.34. Such a small number, they claim, invalidates The Bell Curves prediction of a hereditaryelite.

Is this a small number? Let's have some fun and imagine a virus that turns all males with an IQ over 100 impotent, gay, or otherwise reproductively unfit. Also, women mate randomly. It is paradise for the male riders on the short bus and reminds me of high school.

Supposing you start with an average IQ of 100 and and SD of 15. What happens in 22 generations? I ran a simulation with many simple and unreasonable assumptions and found a mean of IQ of 79 and, more importantly, only 0.21% of the population has an IQ over 120. No more smarties! Unless, Gustafason's banana peel just so story is true?


#shortbus party simulation in R assuming stable population and random mating.

heridest_function(mp1,mp2,male,female,narrow){
meanof_((mp1+mp2)/2) + narrow*((male+female)/2 - (mp1+mp2)/2)
}

mcrit_100
male_rnorm(5000,100,15)
female_rnorm(5000,100,15)

narrow_.34
male.mate_sample(male[male"<"mcrit],length(female),replace=t) est_heridest(100,100,male.mate,female,narrow)
male_est+rnorm(length(est),0,sd)
female_est+rnorm(5000,0,sd)
newgen_c(male,female)

for(i in 1:21){
mp1_mean(newgen)
male.mate_sample(male[male"<"mcrit],length(female),replace=T) est_heridest(mp1,mp1,male.mate,female,narrow)
male_est+rnorm(5000,0,sd)
female_est+rnorm(5000,0,sd)
newgen_c(male,female)
print(mean(newgen))
print(sum(newgen>120))
print(i)
}