Genetic and Environmental Dimensionality of General Intelligence
Jay Lasker
May 5, 2020
Startup
Packages
library(pacman)
p_load(psych, dplyr, kirkegaard, gridExtra, cowplot, meta)Functions
#Congruence coefficient formula because Psych's fa.congruence function is broken
CONGO <- function(F1, F2) {
PHI = sum(F1*F2) / sqrt(sum(F1^2)*sum(F2^2))
return(PHI)}Rationale
There is a lot of work assessing so-called “Jensen effects”, which are correlations between some variable and general intelligence (g). One particular line of research has focused on the relationship between g and the heritability of a given subtest in some battery of cognitive tests. Since no one has done it, I’ll do it here. This analysis is not completed and as such is a work-in-progress which I will continue to add to as time goes on. It is unlikely, however, that the end result will change very much. I’m uploading this for citation purposes, but later on, this will be included as the code repository (alongside an osf entry) for this project, which includes common pathway analyses of many other datasets which have not been analyzed before, and reanalyses with alternative models for ones which have been examined. There will also be an explanation of and simulations for understanding expectations regarding common and independent pathway models for g. I do not agree with the common practice of applying umpteen many corrections since they affirm the consequent, so the eventual meta-analysis will present them as potential maximal effects, not as true effects.
Analysis
Here I plot all of the data including the distributions of correlations between g vectors and heritability (\(h^2\) or A in the ACE model), the common, shared, or between-families environmental component (C), and the unique, unshared, or within-families environmental component (E); the same for the congruence coefficients (Tucker’s \(\phi\)), and finally; the unadjusted meta-regressions. At a later date, I will add moderator tests, more data, perhaps Spearman correlations (though this is basically superfluous), and common pathway models and their associated results.
#GH2 <- read.csv("GeneralHeritability.csv")GHN <- GH2 %>%
group_by(Study) %>%
summarise(
n = n(),
ntot = mean(nt),
age = mean(Age),
country = mean(countrycode),
r = wtd.cors(g.Loading, Heritability),
mean_c = mean(C),
mean_e = mean(E),
mean_te = mean(Total.Environmentality),
mean_g = mean(g.Loading),
mean_h2 = mean(Heritability),
mean_mean = (mean_g + mean_h2)/2,
sd_g = sd(g.Loading),
sd_h2 = sd(Heritability),
sd_c = sd(C),
sd_e = sd(E),
sd_te = sd(Total.Environmentality),
sd_mean = (sd_g + sd_h2)/2,
se = sd_mean/sqrt(n),
r_cor = rangeCorrection(r, sdu = 0.16, sdr = sd_mean, case = 2),
r_corg = rangeCorrection(r, sdu = 0.13, sdr = sd_g, case = 2),
r_corh2 = rangeCorrection(r_corg, sdu = 0.18, sdr = sd_h2, case = 2),
r_corh2a = rangeCorrection(r_corg, sdu = 0.16, sdr = sd_h2, case = 2),
rc = wtd.cors(g.Loading, C),
re = wtd.cors(g.Loading, E),
rte = wtd.cors(g.Loading, Total.Environmentality),
acong = CONGO(g.Loading, Heritability),
ccong = CONGO(g.Loading, C),
econg = CONGO(g.Loading, E),
tecong = CONGO(g.Loading, Total.Environmentality),
sr = cor(g.Loading, Heritability, method = "spearman"),
sc = cor(g.Loading, C, method = "spearman"),
sen = cor(g.Loading, E, method = "spearman"),
ste = cor(g.Loading, Total.Environmentality, method = "spearman"),
invse = se^-1
)
GHNAcor <- metacor(r,
sqrt(ntot),
data = GHN,
studlab = GHN$Study,
sm = "ZCOR",
method.tau = "SJ")
Ccor <- metacor(rc,
sqrt(ntot),
data = GHN,
studlab = GHN$Study,
sm = "ZCOR",
method.tau = "SJ")
Ecor <- metacor(re,
sqrt(ntot),
data = GHN,
studlab = GHN$Study,
sm = "ZCOR",
method.tau = "SJ")
print(paste("Lower = ", Acor$lower.random, "Effect = ", Acor$TE.random, "Upper = ", Acor$upper.random, "SE = ", Acor$seTE.random))## [1] "Lower = 0.36678846326576 Effect = 0.499478986032861 Upper = 0.632169508799962 SE = 0.0677004903221421"print(paste("Lower = ", Ccor$lower.random, "Effect = ", Ccor$TE.random, "Upper = ", Ccor$upper.random, "SE = ", Ccor$seTE.random))## [1] "Lower = -0.0442268727056169 Effect = 0.116287030645666 Upper = 0.276800933996948 SE = 0.0818963535133277"print(paste("Lower = ", Ecor$lower.random, "Effect = ", Ecor$TE.random, "Upper = ", Ecor$upper.random, "SE = ", Ecor$seTE.random))## [1] "Lower = -0.861161390890457 Effect = -0.728549564197554 Upper = -0.595937737504651 SE = 0.0676603385260792"hist1r <- ggplot(GHN, aes(x=r)) + geom_histogram(color = "#999999", fill = "#ED1616", alpha = 0.4, binwidth = 0.1) + theme_classic() + xlab("A") +
theme(
text = element_text(family = "serif", size = 12),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(r)), linetype = "dashed", color = "#637964") + xlim(-1, 1) + ylim(0, 15) +
geom_text(aes(x = 0.433, y = 12, label = 0.43), family = "serif", size = 3, hjust = -0.2) +
geom_vline(aes(xintercept = (0.433)), linetype = "dotted", color = "#637964")
hist2r <- ggplot(GHN, aes(x=rc, na.rm = T)) + geom_histogram(color = "#999999", fill = "#E69F00", alpha = 0.4, binwidth = 0.1) + theme_classic() + xlab("C") +
theme(
text = element_text(size = 12, family = "serif"),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(rc, na.rm = T)), linetype = "dashed", color = "#637964") + xlim(-1, 1) + ylim(0, 15) +
geom_text(aes(x = 0.111, y = 12, label = 0.11), family = "serif", size = 3, hjust = -0.2) +
geom_vline(aes(xintercept = (0.111)), linetype = "dotted", color = "#637964")
hist3r <- ggplot(GHN, aes(x=re, na.rm = T)) + geom_histogram(color = "#999999", fill = "#0FBA1C", alpha = 0.4, binwidth = 0.1) + theme_classic() + xlab("E") +
theme(
text = element_text(size = 12, family = "serif"),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(re, na.rm = T)), linetype = "dashed", color = "#637964") + xlim(-1, 1) + ylim(0, 15) +
geom_text(aes(x = -0.53, y = 12, label = -0.53), family = "serif", size = 3, hjust = 1.2) +
geom_vline(aes(xintercept = (-0.53)), linetype = "dotted", color = "#637964")
hist4r <- ggplot(GHN, aes(x=rte, na.rm = T)) + geom_histogram(color = "#999999", fill = "#2759CF", alpha = 0.4, binwidth = 0.1) + theme_classic() + xlab("T") +
theme(
text = element_text(size = 12, family = "serif"),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(rte, na.rm = T)), linetype = "dashed", color = "#637964") + xlim(-1, 1) + ylim(0, 15) +
geom_text(aes(x = -0.433, y = 12, label = -0.43), family = "serif", size = 3, hjust = 1.2) +
geom_vline(aes(xintercept = (-0.433)), linetype = "dotted", color = "#637964")
hist1c <- ggplot(GHN, aes(x=acong)) + geom_histogram(color = "#999999", fill = "#ED1616", alpha = 0.4, binwidth = 0.02) + theme_classic() + xlab("A") +
theme(
text = element_text(family = "serif", size = 12),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(acong)), linetype = "dashed", color = "#637964") + xlim(0.2, 1) + ylim(0, 20) +
geom_text(aes(x = 0.945, y = 17, label = 0.95), family = "serif", size = 3, hjust = -0.2) + geom_vline(aes(xintercept = (0.945)), linetype = "dotted", color = "#637964")
hist2c <- ggplot(GHN, aes(x=ccong, na.rm = T)) + geom_histogram(color = "#999999", fill = "#E69F00", alpha = 0.4, binwidth = 0.02) + theme_classic() + xlab("C") +
theme(
text = element_text(size = 12, family = "serif"),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(ccong, na.rm = T)), linetype = "dashed", color = "#637964") + xlim(0.2, 1) + ylim(0, 20) +
geom_text(aes(x = 0.78, y = 17, label = 0.78), family = "serif", size = 3, hjust = -0.2) + geom_vline(aes(xintercept = (0.78)), linetype = "dotted", color = "#637964")
hist3c <- ggplot(GHN, aes(x=econg, na.rm = T)) + geom_histogram(color = "#999999", fill = "#0FBA1C", alpha = 0.4, binwidth = 0.02) + theme_classic() + xlab("E") +
theme(
text = element_text(size = 12, family = "serif"),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(econg, na.rm = T)), linetype = "dashed", color = "#637964") + xlim(0.2, 1) + ylim(0, 20) +
geom_text(aes(x = 0.888, y = 17, label = 0.88), family = "serif", size = 3, hjust = 1.2)+ geom_vline(aes(xintercept = (0.888)), linetype = "dotted", color = "#637964")
hist4c <- ggplot(GHN, aes(x=tecong, na.rm = T)) + geom_histogram(color = "#999999", fill = "#2759CF", alpha = 0.4, binwidth = 0.02) + theme_classic() + xlab("T") +
theme(
text = element_text(size = 12, family = "serif"),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.y = element_blank()
) +
geom_vline(data = GHN, aes(xintercept = mean(tecong, na.rm = T)), linetype = "dashed", color = "#637964") + xlim(0.2, 1) + ylim(0, 20) +
geom_text(aes(x = 0.912, y = 17, label = 0.91), family = "serif", size = 3, hjust = 1.2) + geom_vline(aes(xintercept = (0.912)), linetype = "dotted", color = "#637964")
hoz1 <- ggplot(GHN, aes(x=mean_h2, y=mean_g)) +
geom_point(colour = "#797975", alpha = 0.8) +
geom_smooth(method = lm, color = "#797975", fill = "#ED1616", se = T) +
theme_classic() + xlab("Heritability") + theme(text = element_text(size = 12, family = "serif"), axis.line.y = element_blank(), axis.title.y = element_blank(), axis.ticks.y=element_blank(), axis.text.y = element_blank()) + ylim(0.3, 0.85) + annotate("text", x = 0.6, y = 0.3, label = "r = 0.389", parse = F, family = "serif")
hoz2 <- ggplot(GHN, aes(x=mean_c, y=mean_g)) +
geom_point(colour = "#797975", alpha = 0.8) +
geom_smooth(method = lm, color = "#797975", fill = "#E69F00", se = T) +
theme_classic() + xlab("Shared Environment") + theme(axis.title.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), text = element_text(size = 12, family = "serif"), axis.line.y = element_blank()) + ylim(0.3, 0.85) + annotate("text", x = 0.5, y = 0.3, label = "r = -0.169", parse = F, family = "serif")
hoz3 <- ggplot(GHN, aes(x=mean_e, y=mean_g)) +
geom_point(colour = "#797975", alpha = 0.8) +
geom_smooth(method = lm, color = "#797975", fill = "#0FBA1C", se = T) +
theme_classic() + xlab("Nonshared Environment") + theme(axis.title.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), text = element_text(size = 12, family = "serif"), axis.line.y = element_blank()) + ylim(0.3, 0.85) + annotate("text", x = 0.6, y = 0.3, label = "r = -0.326", parse = F, family = "serif")
hoz4 <- ggplot(GHN, aes(x=mean_te, y=mean_g)) +
geom_point(colour = "#797975", alpha = 0.8) +
geom_smooth(method = lm, color = "#797975", fill = "#2759CF", se = T) +
theme_classic() + xlab("Total Environment") + theme(axis.title.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), text = element_text(size = 12, family = "serif"), axis.line.y = element_blank()) + ylim(0.3, 0.85) + annotate("text", x = 0.8, y = 0.3, label = "r = -0.389", parse = F, family = "serif")plot_grid(g1, g2, g3, labels=c("A", "B", "C"), nrow = 3)
In plot sets A (Pearson’s \(r\) distributions), the dashed line is the overall finding and the dotted line is the quality subset. Adjustments for variables like age and g loading method slightly increase the values for A, reduce them for C, and make the E relationships more negative. In terms of standard criteria for understanding values of \(\phi\), the A loadings are congruent with the g loadings, but the C and E loadings are not.
Conclusion
As others have noted, the Jensen effect is robust, and the A component in the typical three-part ACE model is basically a mirror of g, whereas the other components are more multidimensional (C) or associated with specific skills/abilities/group factors rather than g (E). Any theory of intelligence will have to account for this association (as argued by, e.g., Kan, van der Maas & Kievit, 2016). At the moment, a higher-order model with accompanying common pathway clearly accounts for the Jensen effect because all associations are tautologically positive (among other theoretical reasons) and is thus supported by a majority of those who have discussed or investigated this topic (a small group of researchers). However, a bifactor model is also potentially viable and has been tested once so far in an Australian cohort, yielding superior fit to the higher-order common pathway (Wainwright’s work). I have reanalyzed some datasets and found additional support for the bifactor in terms of likelihood, but there are theoretical reasons to reject this model and statistical reasons why it may be preferred in terms of goodness-of-fit even if it’s wrong, so many more empirical tests and theory elaboration will have to follow. It is worth noting that a common pathway is still consistent with genetic sampling as specified by proponents of mutualism.
To-Do
- Lay out meta-analytic protocol and study list.
- Write out quality subsetting protocol.
- Use rater cultural loadings to assess Kan’s explanation.
- Add common pathway novel and reanalyses.
- Explain incongruity between common pathway expectation and observations at the MCV level.
- Add moderator analyses and assess, in particular, heterogeneity by g loading method.
- Use simulations to assess if Gorsuch was correct about PCA/component loadings.
References
Kan, K.-J., Maas, H. L. J. van der, & Kievit, R. A. (2016). Process Overlap Theory: Strengths, Limitations, and Challenges. Psychological Inquiry, 27(3), 220-228. https://doi.org/10.1080/1047840X.2016.1182000