Galaxy notebook

Initial theorizing

Basic goal

To learn about the organization of sexual preferences. In a nutshell, what sexual preferences tend to appear together within individuals?

How well does the gay–straight dichotomy fare empirically? What about the gay–straight–bi trichotomy?
Are gay men naturally divided into tops and bottoms?
Are BDSMers naturally divided into tops and bottoms?
Are straight men naturally divided into breast men and buttocks men (and leg men)?
How do various odd fetishes relate to each other?

Finally, while it would be nice to know how orientation identity relates to these things, I'm afraid that asking about it will induce artificial consistency between identity and preferences. This is all going to be self-report, after all, at least to begin with.

What is a sexual preference?

I've already felt a lot of skepticism about whether people have stable underlying situation-independent preferences in an economic sense (see, e.g., Ariely, Loewenstein, & Prelec, 2006). Since sexual affect is characteristically capricious, it stands to reason I should be even more skeptical of the idea of sexual preferences.

Backing up a bit, what are sexual preferences supposed to mean for behavior? How can we construe them as behavior patterns? Well, like all preferences, they should guide decisions, but decisions about what? Three domains come to mind:

Partner choice. "Homosexuality" ought to mean you're more likely to sexually and romantically pursue people of the same gender than the opposite gender.
- A danger here is that we can expect people to have different partner ideals for stable relationships, for one-night stands, and for various kinds of nonsexual relationships.
- Also, we need to be careful to include partner preferences that people have no intention of acting upon; for example, men committed to straightness finding some other men attractive. If we ask about partner preferences in a way that clearly has to do with actual partner choice (e.g., "Would you have sex with this person?"), we're going to miss these kinds of sexual attraction. Which would be bad, because that sort of thing is one of the main potential problems with the lay trichotomy. "Do you find this person sexually attractive?" is from this perspective a better question.
Activity choice. If you like fellatio better than coitus, you'll try to get the former more than the latter. You could certainly aim for partners with whom your preferred activities are more feasible, either because of the partner's anatomy or the partner's preferences, and indeed the main point of many fetish communities is to connect people with matching activity preferences. Usually, however, I don't think people's mate choices are driven by interest in particular activities. However much people argue that men only date women for the sex, they tend not to believe it's for a particular sexual activity. Nobody thinks most men would date men and women indiscriminately if only it weren't that they liked vaginal sex so much. On the contrary, if memory serves, most men prefer fellatio to coitus, and yet we don't see them trolling Grindr.
Pornography choice. When I think about it, it isn't at all clear how people's interest in seeing different things in porn relates to what they actually want to do to whom. Which, of course, makes its importance in the grand scheme of things pretty suspect.

Perhaps, then, I should try to distinguish partner preferences and activity preferences, and I should consider their interrelations as one of the chief empirical questions about sexual preferences.

A unified approach

Now, what is sexual attraction? "Patterns of partner choice" doesn't seem to suffice, because, as mentioned above, I want to allow for the possibility that people have sexual attraction they don't act on. What consequences does such sexual attraction have for behavior, then? Most importantly, in my mind, sexual attraction is what is theorized to underlie effects of sexual stimuli on non-sexual behavior, such as inspecting brassieres making men impatient (Van den Bergh, Dewitte, & Warlop, 2008). But those effects are way too indirect to define sexual attraction.

Here is another idea. Sexual attraction is people's activity-choice patterns in bizarre hypothetical situations in which they are incentivized to choose according to maximum sexual pleasure independently of other considerations, emotional or practical (e.g., "I will torture this kitten until you orgasm; pick your porn"; notice that I'm now construing porn consumption as a kind of activity). Okay, maybe that's the wrong kind of situation, considering that wanting and liking are distinct: we can't expect people to be great affective forecasters for sexual experiences any more than they are for anything else. But, surely there is some situation or combination of situations that would reveal certain activity-choice patterns independently of such other factors as people's desire to see themselves as heterosexual.

Now we can finally sort of begin to unify partner preferences, activity preferences, and porn preferences. For, in a sufficiently concrete hypothetical, people are necessarily choosing between composite stimuli (e.g., crush-fetish porn either includes female or male performers, and every performer has a hairstyle, so hairstyle could be a factor in choosing or not choosing a piece of crush porn). Different dimensions of sexual preference (e.g., hair color) are cashed out in how different dimensions of the stimuli influence choice.

This line of thinking naturally suggests a task of the following form. Subjects are asked how much they would like to do each of a big list of things, with appropriate qualifiers to ensure that subjects discount practical considerations, their wish to maintain a sexual identity, and so on; ideally, only sexual attraction should determine decisions.

Items related to partner preferences are of the form "Have sex with [type of person]"; the person type can be, for example, "a person who's taller than you". It should be emphasized to subjects a priori that the phrase "have sex" includes any sexual activity.
Items related to activity preferences are just a name or description of the activity.
Items related to porn preferences (if we wanted to include porn preferences) are of the form "Watch [pornography type]" or "Masturbate to [pornography type]" or something.

It would be wise to give subjects optional opportunities to mention things that are important to them but we didn't list, including qualifiers (e.g., if we have only one item about group sex, subjects could say they find some kinds of group sex a lot more attractive than others).

Kinds of preferences to consider

very general themes
- the partner's sexual arousal or interest
- dominating or submitting to the partner
- rape
- (surely there are others worth including)
general activity categories (N.B. it is generally necessary to consider asymmetric roles in partnered activities separately)
- coitus
- anal copulation
- oral sex (fellatio, cunnilingus, anilingus)
- masturbation (solo or partnered)
- frottage
- kissing
- hugging
- group sex
- misc. fetish stuff
- sexual talk (might be fruitfully subdivided into, e.g., demeaning talk and compliments)
- nonverbal vocalizations (moaning, etc.)
features of the partner
- (We probably won't have enough detail to precisely relate this stuff to the ev-psych research regarding the details of appearance preferences, such as waist-to-hip ratio. We will not be asking people for ideal measurements.)
- body-part variables (some of which are traditionally associated with romance rather than sex, but presumably they're still related to sexual attraction)
  - relating to genitals
    - vulva appearance
    - penis size
    - pubic hair
  - buttocks shape and size
  - breast size
  - chest muscularity
  - leg hair
  - foot size
  - eye color
  - hairstyle and hair color
- body shapes
  - hourglass shape (waist-to-hip ratio?)
  - weight
  - height
  - muscularity
  - amputation
- demographics
  - gender and sex (including transsexualism and transgenderism)
  - ethnicity
  - age
  - profession
  - paranormality
- vaguer characteristics such as status, personality, etc. (although many of these probably relate more to what people want in a long-term partner than to sexual attraction)
  - Fletcher, Simpson, Thomas, and Giles (1999) present a scale of generic partner ideals
    - But see Lukaszewski and Roney (2010), who showed that the targets of qualities such as kindness matter a lot
  - Figueredo, Sefcek, and Jones (2006), using the Big Five, found the people preferred partners like themselves but somewhat more socially desirable (conscientious, agreeable, etc.)
  - Backus and Mahalik (2011) found that less feministic women were interested in men with a more masculine personality
porn preferences: just include some major categories of porn, but also text (e.g., romance novels)

Instrument outline

Demographics
- gender ("Male", "Female", or "Other")
- age
- race / ethnicity
Preferences
Room for free-response qualifiers or additions?
Externalizing / antisociality (How do rape or other criminal sexual interests relate to the externalizing?)
- drug use <-
- impulsivity <-
- condom use / safe sex <-
Number of sex partners in the past year ("12 months") (split by gender)
Sexual-orientation identity
[say, two repeats from preferences]
"How honest were you able to be?" or so

Subject filtering

bad.s = with(sb, row.names(sb)[
    minutes < 7 |
    honest < 4 |
    (abs(retest.fellatio_to) >= 3 & abs(retest.friend) >= 3)])
bad.s = c(bad.s,
  "s1209")
  # s1209 said "In the very first question I answered the questions
  # as to my own gender incorrectly. I am FEMALE, not Male." I've
  # corrected sb$gender appropriately in data.R, but the subject
  # was still asked the wrong preferences questions.
good.s = setdiff(row.names(sb), bad.s)
ggood.s = intersect(good.s,
    row.names(ss(sb, gender %in% qw(Male, Female))))
prefs.g = ss(prefs, char(s) %in% good.s)
prefwide = prefwide.all[good.s,]
1

	value
	1

c("Total N" = nrow(sb), Included = length(good.s),
  Percent = round(100 * length(good.s)/nrow(sb)))

	value
Total N	1001
Included	936
Percent	94

Basic results

d = aggregate(pref ~ item, prefs.g, function(x) table(factor(x, levels = 1:7)))
d = data.frame(
    median = tapply(prefs.g$pref, prefs.g$item, median),
    d$pref)
d[order(-tapply(prefs.g$pref, prefs.g$item, mean)),]

	median	X1	X2	X3	X4	X5	X6	X7
desired	7	6	2	2	11	22	85	808
pleasure_to	7	4	1	2	22	43	91	773
in_rship	7	7	1	2	23	41	120	742
love	7	2	3	7	30	49	97	748
intimacy	7	6	3	6	38	49	127	707
coitus_m	7	18	3	2	5	10	43	384
fellatio_rec	7	7	4	4	25	21	61	343
coitus_f	7	19	5	5	13	11	49	357
kiss	7	5	5	17	76	94	158	581
mast_rec_f	7	13	5	11	34	32	62	302
persity_oh	7	10	5	14	93	136	205	473
persity_ah	7	15	4	12	103	120	191	491
semen_to_mouth	7	23	7	11	36	37	75	276
semen_to_vag	7	33	16	9	23	34	50	300
persity_nl	6	9	3	14	137	142	212	419
mast_rec_m	6	9	10	11	51	76	89	219
persity_eh	6	12	13	22	132	135	218	404
cunn_rec	7	27	17	17	44	27	49	278
persity_ch	6	12	9	20	149	154	207	385
hug	6	16	37	66	179	104	113	421
bnip_to	6	56	25	26	79	71	104	309
mast_solo_f	6	29	20	23	73	50	74	190
underwear	6	32	22	44	121	94	112	245
porn_visual	6	55	35	43	149	148	182	324
rebel	5	75	34	43	164	167	154	299
porn_video_mf	5	75	44	53	167	154	172	271
woman	7	192	56	23	71	34	62	498
porn_written	5	67	61	62	186	151	128	281
bnip_rec	6	76	57	52	89	47	90	259
roleplay	5	42	29	63	150	114	105	167
mast_solo_m	5	19	19	42	120	93	83	89
rich	5	72	50	65	225	143	129	252
semen_rec_vag	5	81	21	25	65	46	44	177
experienced	5	72	47	100	198	157	147	215
woman_fem	6	232	40	30	72	52	108	402
analpen_to_f	5	68	29	44	58	56	52	158
mast_to_f	6	215	43	35	84	89	106	364
persity_el	4	49	57	97	266	154	121	192
porn_video_ff	5	170	53	70	130	108	128	277
semen_to_anus	5	89	39	29	58	36	64	150
breasts_big	5	222	51	52	107	82	122	300
cunn_to	5	262	40	36	86	83	112	317
friend	4	152	75	90	206	115	118	180
control_rec	4	159	99	97	159	99	126	197
group_sex	4	205	69	82	152	96	107	225
man	5	369	39	22	28	23	47	408
virgin	4	170	84	92	204	82	107	197
voyeur_known	4	190	89	86	156	114	104	197
control_to	4	146	99	122	196	115	103	155
butt_big	4	170	109	113	181	107	83	173
bondage_rec	4	213	86	98	154	103	97	185
bondage_to	4	191	97	89	195	105	97	162
man_mas	4	415	21	25	49	43	97	286
voyeur_secret	4	249	101	90	144	93	98	161
objpen_to	4	279	61	82	162	103	94	155
recent_acq	4	229	105	99	162	121	84	136
breasts_small	4	266	75	78	197	101	93	126
stranger	4	265	90	84	174	100	92	131
exhibit	4	193	59	80	118	68	56	96
mast_to_m	3	381	60	39	94	71	100	191
persity_ol	3	153	149	171	231	107	51	74
persity_cl	4	175	146	140	249	107	57	62
fellatio_to	3	412	44	49	84	72	78	197
butt_small	3	181	117	174	252	94	52	66
penis_big	3	401	39	53	100	78	97	168
objpen_rec	3	362	70	68	127	77	76	156
leather	3	279	137	127	180	88	63	62
feet_small	3	261	109	128	287	73	40	38
anil_rec	2	455	107	62	100	55	62	95
feet_big	2	331	161	147	177	43	39	38
insult_to	2	425	125	96	103	66	56	65
insult_rec	2	435	117	96	108	72	46	62
persity_al	2	380	159	131	120	64	28	54
anil_to_f	1	533	90	59	68	52	50	84
semen_rec_mouth	1	571	54	55	70	28	60	98
persity_nh	2	363	191	163	116	49	24	30
pain_rec	2	451	154	88	95	69	39	40
woman_mas	2	457	129	110	115	55	36	34
semen_swallow	1	575	68	54	64	51	32	92
analpen_rec	1	581	75	53	71	50	36	70
porn_video_mm	1	584	83	53	67	34	41	74
feet	1	492	157	111	79	33	20	44
pain_to	1	515	138	85	104	43	16	35
semen_rec_anus	1	642	66	44	62	36	27	59
woman_trans	1	608	91	52	82	29	32	42
man_fem	1	601	93	64	81	34	29	34
penis_small	1	589	132	99	78	25	7	6
man_trans	1	671	84	40	70	24	24	23
urine_to	1	732	58	40	37	20	26	23
uncon	1	711	84	35	52	21	13	20
analpen_to_m	1	372	26	14	23	8	5	17
anil_to_m	1	755	56	31	28	17	20	29
rape_rec	1	739	57	41	47	20	15	17
urine_rec	1	767	41	31	37	24	15	21
age_70	1	704	106	62	38	12	8	6
rape_to	1	806	57	19	19	12	11	12
incest	1	822	33	27	32	8	7	7
age_14	1	831	38	27	17	7	3	13
age_08	1	906	16	2	6	1	3	2

Mean absolute deviations from the median:

round(d = 1, sort(dec = T, sapply(prefwide, function(v)
    mean(abs(v - median(v, na.rm = T)), na.rm = T))))

	value
man	2.7
man_mas	2.6
mast_to_m	2.3
fellatio_to	2.3
cunn_to	2.2
penis_big	2.2
woman_fem	2.1
breasts_big	2.1
mast_to_f	2.1
objpen_rec	2.1
semen_to_anus	2.0
woman	2.0
semen_rec_vag	2.0
group_sex	1.9
voyeur_secret	1.9
objpen_to	1.9
porn_video_ff	1.9
bondage_rec	1.9
analpen_to_f	1.9
voyeur_known	1.9
bnip_rec	1.9
exhibit	1.9
stranger	1.9
control_rec	1.8
recent_acq	1.8
breasts_small	1.8
virgin	1.8
bondage_to	1.8
butt_big	1.7
anil_rec	1.7
friend	1.7
control_to	1.6
leather	1.6
insult_to	1.6
insult_rec	1.6
porn_written	1.6
rich	1.5
porn_video_mf	1.5
rebel	1.5
experienced	1.5
bnip_to	1.5
mast_solo_f	1.5
anil_to_f	1.5
semen_rec_mouth	1.5
persity_cl	1.5
roleplay	1.4
persity_ol	1.4
underwear	1.4
butt_small	1.4
feet_small	1.4
persity_el	1.4
persity_al	1.4
porn_visual	1.4
hug	1.4
feet_big	1.4
pain_rec	1.4
semen_swallow	1.4
woman_mas	1.4
mast_solo_m	1.3
analpen_rec	1.3
porn_video_mm	1.3
persity_nh	1.2
cunn_rec	1.2
feet	1.2
pain_to	1.2
mast_rec_m	1.1
semen_to_vag	1.1
persity_ch	1.1
persity_eh	1.0
semen_rec_anus	1.0
woman_trans	1.0
semen_to_mouth	1.0
man_fem	1.0
persity_nl	1.0
persity_ah	1.0
persity_oh	1.0
mast_rec_f	0.8
penis_small	0.8
man_trans	0.8
kiss	0.7
urine_to	0.6
uncon	0.6
analpen_to_m	0.6
coitus_f	0.6
anil_to_m	0.6
rape_rec	0.6
fellatio_rec	0.6
urine_rec	0.5
age_70	0.5
coitus_m	0.4
intimacy	0.4
love	0.4
rape_to	0.3
in_rship	0.3
incest	0.3
pleasure_to	0.3
age_14	0.3
desired	0.2
age_08	0.1

#dwide.g = ss(dwide, char(s) %in% good.s)
prefwide.ken = cor(prefwide,
    method = "kendall", use = "pairwise.complete.obs")
prefpairs = data.frame(t(combn(pref.items, 2)))
prefpairs$kendall = sapply(1 : nrow(prefpairs), function(i)
    prefwide.ken[char(prefpairs[i, 1]), char(prefpairs[i, 2])])
# prefpairs$kendall = sapply(1 : nrow(prefpairs), function(i) cor(method = "kendall",
#      prefwide[[char(prefpairs[i, 1])]],
#      prefwide[[char(prefpairs[i, 2])]]))

Greatest-magnitude Kendall correlations:

transform(ss(ordf(prefpairs, -abs(kendall)), abs(kendall) >= .5),
    kendall = round(kendall, 2))

	X1	X2	kendall
3369	semen_rec_mouth	semen_swallow	0.85
4553	man	man_mas	0.82
549	analpen_to_m	man	0.79
4642	woman	woman_fem	0.77
4301	penis_big	man_mas	0.76
763	fellatio_to	mast_to_m	0.76
942	cunn_to	mast_to_f	0.76
4299	penis_big	man	0.75
1591	mast_to_f	woman	0.74
540	analpen_to_m	penis_big	0.73
1424	mast_to_m	man	0.73
613	analpen_rec	semen_rec_anus	0.72
481	analpen_to_m	analpen_rec	0.72
822	fellatio_to	man	0.72
2772	urine_to	urine_rec	0.71
483	analpen_to_m	fellatio_to	0.71
4186	recent_acq	stranger	0.71
522	analpen_to_m	semen_swallow	0.70
490	analpen_to_m	mast_to_m	0.70
1592	mast_to_f	woman_fem	0.69
1003	cunn_to	woman	0.69
813	fellatio_to	penis_big	0.69
530	analpen_to_m	porn_video_mm	0.68
1415	mast_to_m	penis_big	0.68
519	analpen_to_m	semen_rec_mouth	0.67
271	coitus_m	woman	0.67
425	analpen_to_f	semen_to_anus	0.67
792	fellatio_to	semen_rec_mouth	0.67
4366	breasts_big	woman	0.67
1004	cunn_to	woman_fem	0.65
1426	mast_to_m	man_mas	0.65
551	analpen_to_m	man_mas	0.65
795	fellatio_to	semen_swallow	0.65
4367	breasts_big	woman_fem	0.65
824	fellatio_to	man_mas	0.65
362	coitus_f	man	0.64
541	analpen_to_m	penis_small	0.64
4396	breasts_small	woman	0.63
4555	man	woman	-0.62
550	analpen_to_m	man_fem	0.61
521	analpen_to_m	semen_rec_anus	0.61
1580	mast_to_f	breasts_big	0.60
4397	breasts_small	woman_fem	0.60
4600	man_mas	woman	-0.59
1581	mast_to_f	breasts_small	0.59
3082	insult_to	insult_rec	0.58
1394	mast_to_m	semen_rec_mouth	0.58
2301	control_rec	bondage_rec	0.57
3368	semen_rec_mouth	semen_rec_anus	0.57
993	cunn_to	breasts_small	0.57
1397	mast_to_m	semen_swallow	0.57
4624	man_trans	woman_trans	0.57
4149	friend	recent_acq	0.56
3474	semen_rec_anus	semen_swallow	0.56
614	analpen_rec	semen_swallow	0.56
611	analpen_rec	semen_rec_mouth	0.55
1532	mast_to_f	bnip_to	0.55
3771	porn_visual	porn_video_mf	0.55
4556	man	woman_fem	-0.55
992	cunn_to	breasts_big	0.55
2077	intimacy	love	0.55
487	analpen_to_m	anil_to_m	0.55
3387	semen_rec_mouth	penis_big	0.55
3543	semen_swallow	penis_big	0.54
3396	semen_rec_mouth	man	0.54
3885	porn_video_ff	woman	0.54
1567	mast_to_f	porn_video_ff	0.53
979	cunn_to	porn_video_ff	0.53
4150	friend	stranger	0.53
3949	voyeur_known	voyeur_secret	0.53
3552	semen_swallow	man	0.53
1815	objpen_rec	penis_big	0.52
768	fellatio_to	objpen_rec	0.52
575	analpen_rec	fellatio_to	0.52
4601	man_mas	woman_fem	-0.52
1370	mast_to_m	objpen_rec	0.52
1824	objpen_rec	man	0.51
944	cunn_to	bnip_to	0.51
1750	bnip_to	woman	0.51
1667	bnip_rec	man	0.51
1751	bnip_to	woman_fem	0.51
2641	bondage_to	bondage_rec	0.50
587	analpen_rec	objpen_rec	0.50
2506	pain_to	pain_rec	0.50
3886	porn_video_ff	woman_fem	0.50
1794	objpen_rec	semen_rec_mouth	0.50

Biplots

item.biplot = function(gender, sideways = F)
   {pw = prefwide[sb[row.names(prefwide), "gender"] == gender,]
    items = pref.items[unname(sapply(pref.items, function(pi)
        all(!is.na(pw[pi])) &&
        var(pw[pi]) > 0))]
    pw = pw[,items]
    if (sideways)
        pw = t(pw)
    # Remove constant columns
    pw = pw[, apply(pw, 2, var, na.rm = T) != 0]
    pc = prcomp(pw, center = T, scale. = T)
    pc.scores = as.matrix(pw) %*% pc$rotation
    pc1.scores = pc.scores[,"PC1"] / max(abs(pc.scores[,"PC1"])) * max(abs(pc$rotation[,"PC1"]))
    pc2.scores = pc.scores[,"PC2"] / max(abs(pc.scores[,"PC2"])) * max(abs(pc$rotation[,"PC2"]))
    ggplot() + no.gridlines() +
        geom_segment(aes(xend = pc1.scores, yend = pc2.scores),
            x = 0, y = 0, arrow = arrow(), color = "red", alpha = .1) +
        geom_text(aes(pc$rotation[,"PC1"], pc$rotation[,"PC2"],
           label = rownames(pc$rotation)))}
1

	value
	1

item.biplot("Male")

item.biplot("Female")

item.biplot("Male", sideways = T)

item.biplot("Female", sideways = T)

Structure paper

Hierarchical clustering

Men

c(
    "number of subjects" = nrow(hclust.kendall.abs("Male")$dat),
    "number of items" = ncol(hclust.kendall.abs("Male")$dat))

	value
number of subjects	464
number of items	89

plot(hclust.kendall.abs("Male")$tree)

clustertable = function(gender, k, pretty = F)
   {l = hclust.kendall.abs(gender)
    cuts = cutree(l$tree, k = k)
    sapply(1 : max(cuts), function(i)
       {vnames = names(cuts[cuts == i])
        mean.abs.cor = sapply(vnames, function(v)
            mean(1 - as.matrix(l$dists)[v, setdiff(vnames, v)]))
        vnames = vnames[order(-mean.abs.cor)]
        cor.with.v1.is.neg = sapply(vnames, function(v)
            cor(l$dat[[v]], l$dat[[vnames[1]]], method = "kendall") < 0)
        intracluster.cors = 1 - as.dist(as.matrix(l$dists)[vnames, vnames])
        gsub("0.", ".", fixed = T, c(
            sprintf("q %2d, M %.02f, SD %.02f",
                length(vnames),
                mean(intracluster.cors),
                sdn(intracluster.cors)),
            paste0(
                sprintf("%.02f", sort(mean.abs.cor, dec = T)),
                " ",
                ifelse(cor.with.v1.is.neg, "*", ""),
                (if (pretty) pretty.item.names[vnames] else vnames)),
            rep(NA, max(table(cuts)) - sum(cuts == i))))})}
clustertable("Male", 2)

	V1	V2
1	q 80, M .15, SD .13	q 9, M .24, SD .09
2	.23 man	.28 persity_ol
3	.23 analpen_to_m	.26 persity_cl
4	.22 fellatio_to	.24 butt_small
5	.22 semen_swallow	.24 persity_nh
6	.22 mast_to_m	.24 persity_el
7	.22 semen_rec_mouth	.24 feet_big
8	.22 porn_video_mm	.22 persity_al
9	.22 analpen_rec	.22 feet_small
10	.22 penis_big	.21 breasts_small
11	.20 semen_rec_anus
12	.20 man_mas
13	.20 penis_small
14	.19 objpen_rec
15	.19 man_fem
16	.19 *coitus_m
17	.18 anil_to_m
18	.18 voyeur_known
19	.18 voyeur_secret
20	.17 *woman
21	.17 man_trans
22	.17 semen_to_anus
23	.17 *mast_to_f
24	.17 *woman_fem
25	.17 woman_trans
26	.16 recent_acq
27	.16 objpen_to
28	.16 urine_to
29	.16 anil_rec
30	.16 urine_rec
31	.16 rebel
32	.16 group_sex
33	.16 friend
34	.16 pain_to
35	.15 rape_rec
36	.15 *analpen_to_f
37	.15 bondage_to
38	.15 insult_rec
39	.15 *cunn_to
40	.15 porn_video_mf
41	.15 insult_to
42	.15 semen_to_mouth
43	.15 stranger
44	.14 *porn_video_ff
45	.14 persity_eh
46	.14 persity_oh
47	.14 *semen_to_vag
48	.14 control_to
49	.14 *pleasure_to
50	.14 anil_to_f
51	.14 porn_visual
52	.13 porn_written
53	.13 pain_rec
54	.13 leather
55	.13 *love
56	.13 incest
57	.13 control_rec
58	.13 rape_to
59	.13 *breasts_big
60	.13 bondage_rec
61	.13 mast_solo_m
62	.13 rich
63	.12 mast_rec_m
64	.12 experienced
65	.12 uncon
66	.12 *in_rship
67	.12 feet
68	.12 *fellatio_rec
69	.11 *desired
70	.11 *persity_nl
71	.11 *persity_ch
72	.11 *virgin
73	.11 woman_mas
74	.11 age_70
75	.11 *persity_ah
76	.10 age_14
77	.10 butt_big
78	.09 *intimacy
79	.09 *kiss
80	.08 age_08
81	.07 *hug

clustertable("Male", 3)

	V1	V2	V3
1	q 56, M .19, SD .16	q 24, M .22, SD .11	q 9, M .24, SD .09
2	.28 man	.29 mast_to_f	.28 persity_ol
3	.28 analpen_to_m	.28 coitus_m	.26 persity_cl
4	.28 fellatio_to	.27 pleasure_to	.24 butt_small
5	.28 semen_swallow	.27 woman_fem	.24 persity_nh
6	.27 mast_to_m	.25 in_rship	.24 persity_el
7	.27 semen_rec_mouth	.25 woman	.24 feet_big
8	.27 analpen_rec	.25 cunn_to	.22 persity_al
9	.27 porn_video_mm	.24 persity_oh	.22 feet_small
10	.26 penis_big	.24 persity_nl	.21 breasts_small
11	.25 objpen_rec	.23 love
12	.25 semen_rec_anus	.23 persity_eh
13	.24 man_fem	.22 desired
14	.24 man_mas	.22 persity_ch
15	.23 penis_small	.22 persity_ah
16	.22 man_trans	.22 semen_to_vag
17	.22 woman_trans	.21 kiss
18	.22 anil_to_m	.21 intimacy
19	.21 voyeur_secret	.20 mast_rec_m
20	.21 voyeur_known	.19 breasts_big
21	.21 urine_to	.18 fellatio_rec
22	.20 urine_rec	.17 semen_to_mouth
23	.20 anil_rec	.17 porn_video_ff
24	.19 insult_rec	.15 hug
25	.19 semen_to_anus	.13 butt_big
26	.19 rape_rec
27	.19 pain_to
28	.18 bondage_to
29	.18 objpen_to
30	.18 recent_acq
31	.18 insult_to
32	.17 pain_rec
33	.17 friend
34	.17 group_sex
35	.17 leather
36	.17 rebel
37	.17 incest
38	.16 control_to
39	.16 bondage_rec
40	.16 control_rec
41	.16 stranger
42	.16 porn_written
43	.15 *analpen_to_f
44	.15 anil_to_f
45	.15 feet
46	.15 uncon
47	.15 mast_solo_m
48	.14 rape_to
49	.14 age_70
50	.13 porn_visual
51	.13 porn_video_mf
52	.13 woman_mas
53	.12 experienced
54	.12 rich
55	.11 age_14
56	.11 *virgin
57	.08 age_08

clustertable("Male", 4)

	V1	V2	V3	V4
1	q 31, M .21, SD .10	q 24, M .22, SD .11	q 25, M .35, SD .24	q 9, M .24, SD .09
2	.26 voyeur_secret	.29 mast_to_f	.50 man	.28 persity_ol
3	.26 insult_to	.28 coitus_m	.49 semen_rec_mouth	.26 persity_cl
4	.25 voyeur_known	.27 pleasure_to	.48 semen_swallow	.24 butt_small
5	.25 bondage_to	.27 woman_fem	.48 penis_big	.24 persity_nh
6	.25 semen_to_anus	.25 in_rship	.48 fellatio_to	.24 persity_el
7	.25 recent_acq	.25 woman	.47 analpen_to_m	.24 feet_big
8	.24 control_to	.25 cunn_to	.47 analpen_rec	.22 persity_al
9	.23 stranger	.24 persity_oh	.47 mast_to_m	.22 feet_small
10	.23 objpen_to	.24 persity_nl	.46 porn_video_mm	.21 breasts_small
11	.23 friend	.23 love	.44 man_mas
12	.23 insult_rec	.23 persity_eh	.44 semen_rec_anus
13	.23 group_sex	.22 desired	.42 penis_small
14	.22 rebel	.22 persity_ch	.42 man_fem
15	.22 analpen_to_f	.22 persity_ah	.36 man_trans
16	.21 pain_to	.22 semen_to_vag	.36 anil_to_m
17	.21 urine_to	.21 kiss	.36 objpen_rec
18	.21 bondage_rec	.21 intimacy	.32 woman_trans
19	.20 porn_video_mf	.20 mast_rec_m	.25 rape_rec
20	.20 porn_visual	.19 breasts_big	.20 incest
21	.20 porn_written	.18 fellatio_rec	.17 rape_to
22	.20 anil_to_f	.17 semen_to_mouth	.17 age_70
23	.20 pain_rec	.17 porn_video_ff	.16 age_14
24	.20 leather	.15 hug	.15 uncon
25	.19 anil_rec	.13 butt_big	.14 woman_mas
26	.19 control_rec		.10 age_08
27	.18 rich
28	.18 urine_rec
29	.17 experienced
30	.16 mast_solo_m
31	.15 feet
32	.14 virgin

clustertable("Male", 5)

	V1	V2	V3	V4	V5
1	q 31, M .21, SD .10	q 24, M .22, SD .11	q 19, M .50, SD .21	q 6, M .30, SD .09	q 9, M .24, SD .09
2	.26 voyeur_secret	.29 mast_to_f	.62 man	.36 rape_to	.28 persity_ol
3	.26 insult_to	.28 coitus_m	.60 semen_rec_mouth	.34 uncon	.26 persity_cl
4	.25 voyeur_known	.27 pleasure_to	.60 penis_big	.30 age_14	.24 butt_small
5	.25 bondage_to	.27 woman_fem	.60 fellatio_to	.28 rape_rec	.24 persity_nh
6	.25 semen_to_anus	.25 in_rship	.59 semen_swallow	.27 incest	.24 persity_el
7	.25 recent_acq	.25 woman	.58 analpen_to_m	.25 age_08	.24 feet_big
8	.24 control_to	.25 cunn_to	.58 mast_to_m		.22 persity_al
9	.23 stranger	.24 persity_oh	.58 analpen_rec		.22 feet_small
10	.23 objpen_to	.24 persity_nl	.57 porn_video_mm		.21 breasts_small
11	.23 friend	.23 love	.56 man_mas
12	.23 insult_rec	.23 persity_eh	.53 semen_rec_anus
13	.23 group_sex	.22 desired	.52 penis_small
14	.22 rebel	.22 persity_ch	.51 man_fem
15	.22 analpen_to_f	.22 persity_ah	.44 anil_to_m
16	.21 pain_to	.22 semen_to_vag	.44 man_trans
17	.21 urine_to	.21 kiss	.41 objpen_rec
18	.21 bondage_rec	.21 intimacy	.37 woman_trans
19	.20 porn_video_mf	.20 mast_rec_m	.18 age_70
20	.20 porn_visual	.19 breasts_big	.16 woman_mas
21	.20 porn_written	.18 fellatio_rec
22	.20 anil_to_f	.17 semen_to_mouth
23	.20 pain_rec	.17 porn_video_ff
24	.20 leather	.15 hug
25	.19 anil_rec	.13 butt_big
26	.19 control_rec
27	.18 rich
28	.18 urine_rec
29	.17 experienced
30	.16 mast_solo_m
31	.15 feet
32	.14 virgin

Women

c(
    "number of subjects" = nrow(hclust.kendall.abs("Female")$dat),
    "number of items" = ncol(hclust.kendall.abs("Female")$dat))

	value
number of subjects	459
number of items	85

plot(hclust.kendall.abs("Female")$tree)

clustertable("Female", 2)

	V1	V2
1	q 73, M .17, SD .11	q 12, M .26, SD .10
2	.25 cunn_to	.31 in_rship
3	.24 group_sex	.30 intimacy
4	.23 porn_video_ff	.29 love
5	.23 porn_visual	.27 pleasure_to
6	.23 mast_to_f	.27 desired
7	.23 woman	.27 kiss
8	.23 objpen_rec	.27 persity_ah
9	.23 breasts_small	.25 mast_rec_f
10	.23 breasts_big	.24 persity_nl
11	.22 objpen_to	.24 persity_ch
12	.22 voyeur_known	.20 hug
13	.22 woman_fem	.16 cunn_rec
14	.22 stranger
15	.22 woman_trans
16	.21 anil_to_f
17	.21 man_trans
18	.21 recent_acq
19	.20 porn_video_mf
20	.20 woman_mas
21	.20 pain_rec
22	.20 semen_swallow
23	.20 semen_rec_mouth
24	.20 porn_written
25	.20 insult_rec
26	.20 insult_to
27	.19 bondage_rec
28	.19 semen_rec_anus
29	.19 bondage_to
30	.19 voyeur_secret
31	.19 analpen_rec
32	.19 porn_video_mm
33	.19 anil_to_m
34	.19 anil_rec
35	.18 rebel
36	.18 friend
37	.18 pain_to
38	.18 control_rec
39	.18 leather
40	.17 butt_big
41	.17 man_fem
42	.17 experienced
43	.17 fellatio_to
44	.17 mast_solo_f
45	.17 rape_rec
46	.16 persity_oh
47	.15 urine_to
48	.15 persity_cl
49	.14 feet
50	.14 rich
51	.14 control_to
52	.14 penis_big
53	.14 virgin
54	.13 *mast_to_m
55	.13 rape_to
56	.13 butt_small
57	.13 urine_rec
58	.13 persity_nh
59	.13 feet_small
60	.13 persity_eh
61	.12 feet_big
62	.12 uncon
63	.12 semen_rec_vag
64	.12 persity_al
65	.12 *man
66	.12 *coitus_f
67	.11 incest
68	.10 *man_mas
69	.10 age_70
70	.10 age_14
71	.08 *penis_small
72	.07 persity_ol
73	.07 age_08
74	.05 *persity_el

clustertable("Female", 3)

	V1	V2	V3
1	q 61, M .20, SD .12	q 12, M .26, SD .10	q 12, M .18, SD .08
2	.27 cunn_to	.31 in_rship	.22 persity_nh
3	.27 group_sex	.30 intimacy	.22 feet_small
4	.26 porn_video_ff	.29 love	.21 butt_small
5	.26 woman	.27 pleasure_to	.21 persity_ol
6	.26 mast_to_f	.27 desired	.21 persity_cl
7	.26 porn_visual	.27 kiss	.20 feet_big
8	.25 breasts_big	.27 persity_ah	.19 penis_small
9	.25 objpen_rec	.25 mast_rec_f	.18 feet
10	.25 breasts_small	.24 persity_nl	.16 virgin
11	.25 woman_fem	.24 persity_ch	.16 persity_al
12	.24 voyeur_known	.20 hug	.12 age_70
13	.24 objpen_to	.16 cunn_rec	.12 persity_el
14	.24 stranger
15	.24 woman_trans
16	.23 anil_to_f
17	.23 recent_acq
18	.23 porn_video_mf
19	.22 man_trans
20	.22 pain_rec
21	.22 woman_mas
22	.22 insult_rec
23	.22 semen_swallow
24	.22 semen_rec_mouth
25	.22 bondage_rec
26	.22 porn_written
27	.21 semen_rec_anus
28	.21 insult_to
29	.21 bondage_to
30	.21 analpen_rec
31	.20 voyeur_secret
32	.20 friend
33	.20 anil_rec
34	.20 anil_to_m
35	.20 rebel
36	.20 porn_video_mm
37	.20 pain_to
38	.20 control_rec
39	.19 leather
40	.18 fellatio_to
41	.18 rape_rec
42	.18 mast_solo_f
43	.17 experienced
44	.17 persity_oh
45	.17 butt_big
46	.16 urine_to
47	.16 man_fem
48	.16 control_to
49	.16 penis_big
50	.15 rich
51	.15 rape_to
52	.14 urine_rec
53	.14 *mast_to_m
54	.14 persity_eh
55	.13 uncon
56	.13 *man
57	.13 *coitus_f
58	.13 semen_rec_vag
59	.12 incest
60	.12 *man_mas
61	.11 age_14
62	.07 age_08

clustertable("Female", 4)

	V1	V2	V3	V4
1	q 55, M .21, SD .12	q 12, M .26, SD .10	q 6, M .27, SD .11	q 12, M .18, SD .08
2	.29 cunn_to	.31 in_rship	.31 age_14	.22 persity_nh
3	.28 group_sex	.30 intimacy	.30 rape_to	.22 feet_small
4	.28 porn_video_ff	.29 love	.27 incest	.21 butt_small
5	.28 woman	.27 pleasure_to	.27 rape_rec	.21 persity_ol
6	.27 mast_to_f	.27 desired	.23 age_08	.21 persity_cl
7	.27 porn_visual	.27 kiss	.23 uncon	.20 feet_big
8	.27 objpen_rec	.27 persity_ah		.19 penis_small
9	.26 breasts_big	.25 mast_rec_f		.18 feet
10	.26 woman_fem	.24 persity_nl		.16 virgin
11	.26 voyeur_known	.24 persity_ch		.16 persity_al
12	.26 breasts_small	.20 hug		.12 age_70
13	.25 objpen_to	.16 cunn_rec		.12 persity_el
14	.25 anil_to_f
15	.24 stranger
16	.24 woman_trans
17	.24 porn_video_mf
18	.24 recent_acq
19	.23 semen_swallow
20	.23 semen_rec_mouth
21	.23 woman_mas
22	.23 bondage_rec
23	.23 porn_written
24	.23 pain_rec
25	.23 bondage_to
26	.22 insult_rec
27	.22 man_trans
28	.22 semen_rec_anus
29	.22 analpen_rec
30	.22 insult_to
31	.21 anil_rec
32	.21 friend
33	.21 rebel
34	.21 voyeur_secret
35	.21 anil_to_m
36	.21 control_rec
37	.20 porn_video_mm
38	.20 fellatio_to
39	.20 leather
40	.20 pain_to
41	.19 mast_solo_f
42	.19 persity_oh
43	.18 butt_big
44	.18 experienced
45	.17 control_to
46	.17 penis_big
47	.16 man_fem
48	.16 urine_to
49	.16 rich
50	.15 *mast_to_m
51	.15 persity_eh
52	.14 urine_rec
53	.14 *man
54	.14 semen_rec_vag
55	.14 *coitus_f
56	.12 *man_mas

Bass-ackwards factor analysis

Men

go.fa = function(gender, nfactors)
   {nfactors = as.numeric(nfactors)
    k = list("go.fa", gender, nfactors)
    cache(k, cache.dirs = c("Kodi", "projects", "galaxy"), comment = deparse(k), v =
       {pw = ss(prefwide, sb[row.names(prefwide), "gender"] == gender)
        items = pref.items[unname(sapply(pref.items, function(pi)
            all(!is.na(pw[pi])) &&
            var(pw[pi]) > 0))]
        pw = pw[,items]
        result = fa(pw, nfactors = nfactors, rotate = "varimax", fm = "ml",
            cor = "poly")
        punl(pw, result)})}
display.loadings = function(l)
   {m = loadings(l$result)
    assigned.factor = apply(abs(m), 1, which.max)
    ks = 1 : max(assigned.factor)
    round(d = 2, do.call(rbind, lapply(ks, function(fk)
       {items = names(assigned.factor[assigned.factor == fk])
        m[items[order(-abs(m[items, fk]))],]})))[,paste0("ML", ks)]}
factor.score.cors = function(l1, l2)
   round(d = 2, sapply(sort(colnames(l1$result$scores)), function(f1)
       sapply(sort(colnames(l2$result$scores)), function(f2)
           cor(l1$result$scores[,f1], l2$result$scores[,f2]))))
1

	value
	1

l.male2 = go.fa("Male", 2)
zcomb = combn(colnames(l.male2$pw), 2, simplify = F, FUN = function(iv)
    table(l.male2$pw[[iv[1]]], l.male2$pw[[iv[2]]]) == 0)
zero.prop.per.cell = mean(c(recursive = T, zcomb))
zero.prop.per.varpair = mean(sapply(zcomb, any))
round(d = 2, c(zero.prop.per.varpair, zero.prop.per.cell))

	value
	0.96 0.22

display.loadings(go.fa("Male", 2))

	ML1	ML2
man	0.96	-0.03
semen_rec_mouth	0.94	-0.05
fellatio_to	0.94	0.02
penis_big	0.94	-0.09
semen_swallow	0.93	-0.01
porn_video_mm	0.93	-0.06
analpen_to_m	0.93	-0.02
man_mas	0.92	-0.15
mast_to_m	0.92	0.02
analpen_rec	0.91	-0.01
semen_rec_anus	0.89	-0.06
anil_to_m	0.85	-0.18
penis_small	0.82	-0.16
man_fem	0.80	0.02
man_trans	0.74	0.10
objpen_rec	0.73	0.18
woman	-0.68	0.53
coitus_m	-0.65	0.58
woman_trans	0.63	0.27
rape_rec	0.58	0.07
urine_rec	0.55	0.14
urine_to	0.50	0.21
anil_rec	0.48	0.28
age_08	0.48	-0.30
incest	0.45	0.11
age_70	0.41	0.08
rape_to	0.38	0.02
pain_to	0.35	0.26
age_14	0.34	-0.08
pain_rec	0.33	0.24
feet	0.33	0.28
leather	0.32	0.31
love	-0.32	0.25
feet_big	0.32	0.18
woman_mas	0.28	0.27
uncon	0.26	0.18
semen_to_mouth	-0.02	0.67
porn_video_mf	-0.01	0.65
mast_to_f	-0.39	0.64
analpen_to_f	-0.09	0.62
porn_video_ff	-0.24	0.62
recent_acq	0.16	0.60
voyeur_known	0.34	0.60
semen_to_anus	0.22	0.59
voyeur_secret	0.30	0.59
cunn_to	-0.33	0.59
semen_to_vag	-0.38	0.58
woman_fem	-0.49	0.58
group_sex	0.19	0.58
objpen_to	0.18	0.58
rebel	0.15	0.58
friend	0.15	0.58
fellatio_rec	-0.20	0.56
persity_oh	-0.08	0.55
porn_visual	0.02	0.54
stranger	0.14	0.54
persity_eh	-0.04	0.52
mast_rec_m	-0.07	0.51
breasts_small	-0.12	0.51
rich	0.04	0.49
bondage_to	0.19	0.49
pleasure_to	-0.36	0.48
experienced	0.08	0.48
control_to	0.10	0.47
insult_to	0.17	0.47
anil_to_f	0.14	0.47
breasts_big	-0.42	0.46
porn_written	0.18	0.44
virgin	-0.10	0.41
mast_solo_m	0.23	0.40
desired	-0.28	0.39
butt_big	0.03	0.38
persity_el	-0.02	0.37
in_rship	-0.26	0.36
persity_nl	-0.21	0.36
control_rec	0.31	0.36
insult_rec	0.35	0.35
persity_ch	-0.17	0.35
butt_small	0.12	0.34
bondage_rec	0.24	0.34
persity_cl	0.08	0.32
persity_ah	-0.21	0.32
feet_small	0.07	0.29
kiss	-0.15	0.29
persity_al	0.08	0.28
persity_ol	0.01	0.28
intimacy	-0.22	0.25
persity_nh	0.05	0.19
hug	-0.09	0.13

display.loadings(go.fa("Male", 3))

	ML1	ML2	ML3
man	0.97	0.05	-0.05
fellatio_to	0.95	0.09	-0.02
penis_big	0.95	0.00	-0.09
man_mas	0.94	-0.06	-0.11
semen_rec_mouth	0.94	0.06	-0.13
mast_to_m	0.93	0.09	-0.03
porn_video_mm	0.93	0.04	-0.11
semen_swallow	0.92	0.11	-0.14
analpen_to_m	0.91	0.11	-0.16
analpen_rec	0.88	0.13	-0.18
semen_rec_anus	0.84	0.12	-0.28
anil_to_m	0.81	0.03	-0.36
penis_small	0.78	0.01	-0.29
man_fem	0.78	0.12	-0.11
man_trans	0.70	0.22	-0.15
objpen_rec	0.68	0.31	-0.14
woman	-0.67	0.32	0.46
coitus_m	-0.63	0.36	0.49
woman_trans	0.58	0.37	-0.07
woman_fem	-0.49	0.41	0.42
urine_rec	0.45	0.37	-0.36
breasts_big	-0.44	0.36	0.25
anil_rec	0.41	0.40	-0.11
age_70	0.34	0.23	-0.26
feet_big	0.31	0.18	0.05
analpen_to_f	-0.20	0.70	-0.04
semen_to_anus	0.12	0.69	-0.01
voyeur_secret	0.22	0.64	0.05
insult_to	0.04	0.64	-0.20
recent_acq	0.08	0.63	0.07
objpen_to	0.10	0.61	0.09
semen_to_mouth	-0.07	0.61	0.28
stranger	0.05	0.60	0.00
bondage_to	0.10	0.59	-0.07
control_to	-0.01	0.59	-0.10
anil_to_f	0.03	0.58	-0.12
voyeur_known	0.30	0.58	0.22
group_sex	0.14	0.57	0.16
porn_video_mf	-0.04	0.56	0.31
porn_video_ff	-0.29	0.55	0.21
friend	0.11	0.55	0.20
rebel	0.11	0.54	0.23
pain_to	0.21	0.51	-0.39
semen_to_vag	-0.42	0.50	0.25
insult_rec	0.25	0.50	-0.18
mast_to_f	-0.39	0.47	0.43
porn_visual	0.01	0.46	0.30
breasts_small	-0.16	0.46	0.19
cunn_to	-0.34	0.46	0.36
urine_to	0.37	0.45	-0.37
bondage_rec	0.16	0.44	-0.08
pain_rec	0.23	0.43	-0.28
rich	0.03	0.43	0.24
virgin	-0.14	0.41	0.08
experienced	0.06	0.41	0.25
porn_written	0.16	0.41	0.19
leather	0.26	0.40	-0.07
control_rec	0.26	0.39	0.06
feet	0.26	0.38	-0.10
persity_al	0.01	0.37	-0.13
persity_cl	0.03	0.35	0.01
butt_small	0.09	0.34	0.09
mast_solo_m	0.24	0.33	0.25
woman_mas	0.23	0.33	-0.04
feet_small	0.03	0.32	0.01
butt_big	0.03	0.31	0.23
persity_nh	-0.03	0.29	-0.19
persity_ol	0.00	0.24	0.13
age_08	0.35	0.05	-0.77
pleasure_to	-0.27	0.20	0.69
in_rship	-0.15	0.08	0.69
desired	-0.19	0.12	0.66
love	-0.20	-0.04	0.66
intimacy	-0.12	-0.01	0.62
rape_to	0.23	0.34	-0.60
persity_ah	-0.12	0.08	0.58
kiss	-0.05	0.06	0.57
persity_ch	-0.09	0.12	0.56
persity_eh	0.01	0.32	0.55
persity_nl	-0.14	0.14	0.54
age_14	0.23	0.18	-0.53
persity_oh	-0.04	0.37	0.52
uncon	0.12	0.45	-0.48
rape_rec	0.46	0.33	-0.47
mast_rec_m	-0.03	0.34	0.46
fellatio_rec	-0.19	0.40	0.43
incest	0.34	0.34	-0.42
hug	-0.01	-0.04	0.40
persity_el	0.00	0.26	0.31

display.loadings(go.fa("Male", 4))

	ML1	ML2	ML3	ML4
man	0.95	0.10	-0.05	-0.18
semen_rec_mouth	0.94	0.04	-0.13	-0.09
fellatio_to	0.94	0.12	-0.03	-0.15
penis_big	0.92	0.06	-0.09	-0.22
semen_swallow	0.92	0.09	-0.15	-0.09
mast_to_m	0.91	0.13	-0.03	-0.16
analpen_rec	0.90	0.07	-0.19	-0.01
porn_video_mm	0.90	0.10	-0.11	-0.21
man_mas	0.90	0.03	-0.10	-0.30
analpen_to_m	0.89	0.14	-0.17	-0.14
semen_rec_anus	0.87	0.03	-0.29	0.03
man_fem	0.81	0.03	-0.12	0.06
anil_to_m	0.78	0.05	-0.37	-0.20
penis_small	0.78	-0.02	-0.29	-0.11
man_trans	0.76	0.06	-0.16	0.20
objpen_rec	0.74	0.15	-0.17	0.23
woman_trans	0.66	0.15	-0.09	0.37
woman	-0.57	0.13	0.44	0.56
rape_rec	0.49	0.22	-0.49	0.14
urine_rec	0.48	0.24	-0.39	0.18
anil_rec	0.42	0.36	-0.16	0.10
age_70	0.35	0.16	-0.28	0.09
feet	0.30	0.27	-0.14	0.22
feet_big	0.29	0.24	0.03	-0.06
recent_acq	0.06	0.73	0.01	0.05
stranger	0.03	0.68	-0.06	0.05
friend	0.07	0.68	0.14	-0.02
control_to	-0.03	0.65	-0.16	0.05
insult_to	0.04	0.63	-0.27	0.15
voyeur_secret	0.23	0.62	-0.01	0.20
bondage_to	0.09	0.61	-0.13	0.10
semen_to_mouth	-0.05	0.61	0.22	0.22
rebel	0.10	0.60	0.18	0.09
group_sex	0.13	0.60	0.11	0.13
voyeur_known	0.30	0.59	0.17	0.13
semen_to_anus	0.17	0.56	-0.08	0.37
porn_visual	0.00	0.53	0.25	0.06
rich	0.00	0.52	0.20	0.02
insult_rec	0.25	0.50	-0.23	0.08
porn_video_mf	0.01	0.49	0.26	0.33
objpen_to	0.16	0.49	0.04	0.35
pain_to	0.21	0.49	-0.44	0.07
porn_written	0.14	0.47	0.15	0.02
fellatio_rec	-0.19	0.46	0.39	0.11
virgin	-0.16	0.46	0.04	0.08
experienced	0.06	0.43	0.21	0.12
leather	0.25	0.43	-0.11	0.02
persity_al	-0.01	0.40	-0.17	0.03
bondage_rec	0.18	0.39	-0.13	0.15
persity_cl	0.02	0.38	-0.03	0.05
control_rec	0.28	0.37	0.02	0.12
pain_rec	0.25	0.36	-0.32	0.14
mast_solo_m	0.24	0.36	0.22	0.06
butt_small	0.10	0.33	0.05	0.12
persity_el	0.00	0.31	0.28	0.06
persity_nh	-0.03	0.30	-0.22	0.05
butt_big	0.04	0.30	0.20	0.15
persity_ol	-0.01	0.29	0.10	0.01
feet_small	0.05	0.26	-0.02	0.16
age_08	0.38	-0.12	-0.77	0.10
in_rship	-0.12	0.06	0.67	0.18
pleasure_to	-0.25	0.21	0.66	0.19
love	-0.19	-0.02	0.66	0.08
desired	-0.18	0.17	0.64	0.08
rape_to	0.25	0.25	-0.63	0.10
intimacy	-0.10	-0.01	0.61	0.12
persity_ah	-0.12	0.14	0.56	0.03
kiss	-0.03	0.03	0.56	0.15
age_14	0.25	0.06	-0.55	0.11
persity_ch	-0.09	0.18	0.54	0.04
persity_nl	-0.13	0.16	0.53	0.12
uncon	0.14	0.35	-0.52	0.18
persity_eh	0.00	0.41	0.51	0.05
persity_oh	-0.05	0.43	0.48	0.10
incest	0.35	0.26	-0.45	0.12
mast_rec_m	-0.02	0.37	0.42	0.14
urine_to	0.39	0.37	-0.42	0.14
hug	0.01	-0.06	0.39	0.08
cunn_to	-0.22	0.18	0.32	0.66
mast_to_f	-0.29	0.25	0.40	0.61
coitus_m	-0.54	0.18	0.47	0.57
semen_to_vag	-0.32	0.30	0.21	0.57
anil_to_f	0.14	0.31	-0.17	0.57
analpen_to_f	-0.12	0.49	-0.10	0.54
woman_fem	-0.41	0.27	0.39	0.48
porn_video_ff	-0.22	0.41	0.16	0.45
breasts_small	-0.09	0.29	0.15	0.44
breasts_big	-0.38	0.23	0.22	0.40
woman_mas	0.30	0.15	-0.06	0.34

display.loadings(go.fa("Male", 5))

	ML1	ML2	ML3	ML4	ML5
man	0.95	0.10	-0.06	-0.17	0.07
semen_rec_mouth	0.94	0.07	-0.13	-0.08	0.01
fellatio_to	0.94	0.13	-0.03	-0.14	0.07
penis_big	0.92	0.07	-0.09	-0.21	0.03
semen_swallow	0.91	0.13	-0.15	-0.08	0.02
mast_to_m	0.91	0.15	-0.03	-0.16	0.04
man_mas	0.90	0.04	-0.11	-0.28	0.02
porn_video_mm	0.90	0.12	-0.12	-0.20	0.02
analpen_rec	0.90	0.12	-0.19	0.00	-0.01
analpen_to_m	0.89	0.18	-0.17	-0.14	-0.02
semen_rec_anus	0.87	0.08	-0.29	0.04	-0.01
man_fem	0.81	0.05	-0.12	0.07	0.05
penis_small	0.78	-0.01	-0.30	-0.09	0.05
anil_to_m	0.78	0.09	-0.37	-0.18	-0.03
man_trans	0.75	0.07	-0.16	0.21	0.12
objpen_rec	0.72	0.26	-0.16	0.22	-0.09
woman_trans	0.65	0.16	-0.09	0.36	0.16
woman	-0.58	0.11	0.46	0.53	0.10
coitus_m	-0.55	0.15	0.48	0.54	0.15
urine_rec	0.46	0.35	-0.39	0.18	-0.10
breasts_big	-0.39	0.18	0.23	0.37	0.21
age_70	0.35	0.09	-0.29	0.10	0.28
feet	0.28	0.28	-0.13	0.21	0.12
semen_to_anus	0.14	0.65	-0.06	0.31	0.01
control_to	-0.06	0.65	-0.14	-0.01	0.14
insult_to	0.01	0.64	-0.24	0.09	0.15
bondage_to	0.06	0.64	-0.11	0.05	0.08
semen_to_mouth	-0.08	0.63	0.25	0.16	0.10
voyeur_known	0.28	0.62	0.19	0.07	0.08
recent_acq	0.03	0.62	0.03	-0.01	0.42
group_sex	0.11	0.61	0.13	0.07	0.11
voyeur_secret	0.20	0.61	0.01	0.14	0.19
stranger	0.00	0.60	-0.04	-0.01	0.35
analpen_to_f	-0.15	0.59	-0.08	0.49	-0.03
friend	0.05	0.58	0.16	-0.08	0.36
objpen_to	0.13	0.55	0.06	0.30	0.02
porn_visual	-0.03	0.55	0.27	0.01	0.03
rebel	0.08	0.52	0.20	0.03	0.33
insult_rec	0.23	0.51	-0.21	0.04	0.11
pain_to	0.19	0.50	-0.42	0.03	0.12
porn_written	0.12	0.49	0.17	-0.02	0.03
porn_video_mf	-0.02	0.48	0.28	0.28	0.16
anil_rec	0.40	0.47	-0.15	0.07	-0.11
fellatio_rec	-0.21	0.47	0.41	0.06	0.05
urine_to	0.37	0.46	-0.40	0.11	-0.06
leather	0.23	0.45	-0.10	-0.01	0.05
porn_video_ff	-0.25	0.43	0.18	0.40	0.10
bondage_rec	0.16	0.43	-0.11	0.12	0.04
rich	-0.01	0.41	0.21	-0.03	0.35
experienced	0.05	0.39	0.22	0.08	0.21
control_rec	0.26	0.38	0.03	0.09	0.08
virgin	-0.17	0.38	0.05	0.03	0.28
pain_rec	0.23	0.37	-0.31	0.12	0.11
mast_solo_m	0.22	0.35	0.23	0.03	0.09
butt_big	0.03	0.26	0.21	0.12	0.18
age_08	0.38	-0.11	-0.78	0.13	0.09
pleasure_to	-0.26	0.21	0.67	0.16	0.02
in_rship	-0.12	0.05	0.67	0.17	0.01
love	-0.19	-0.03	0.66	0.08	-0.03
desired	-0.19	0.16	0.65	0.06	0.01
rape_to	0.23	0.24	-0.62	0.09	0.16
intimacy	-0.10	0.00	0.61	0.11	-0.08
persity_ah	-0.12	0.05	0.56	0.02	0.20
kiss	-0.03	0.04	0.55	0.14	-0.03
age_14	0.25	0.04	-0.55	0.12	0.15
persity_ch	-0.09	0.08	0.54	0.03	0.24
persity_nl	-0.13	0.07	0.53	0.10	0.22
persity_eh	-0.01	0.33	0.52	0.02	0.22
uncon	0.12	0.32	-0.51	0.16	0.24
persity_oh	-0.06	0.39	0.49	0.06	0.16
rape_rec	0.48	0.21	-0.49	0.13	0.18
incest	0.34	0.22	-0.45	0.11	0.23
mast_rec_m	-0.04	0.36	0.44	0.10	0.07
hug	0.01	-0.08	0.39	0.09	0.01
persity_ol	-0.02	0.07	0.10	-0.02	0.61
persity_cl	0.01	0.19	-0.03	0.02	0.60
persity_nh	-0.04	0.11	-0.23	0.03	0.57
persity_el	-0.01	0.13	0.28	0.03	0.53
persity_al	-0.02	0.25	-0.17	0.00	0.50
feet_big	0.29	0.08	0.02	-0.07	0.46
butt_small	0.09	0.19	0.05	0.10	0.44
breasts_small	-0.10	0.17	0.16	0.43	0.44
feet_small	0.05	0.15	-0.02	0.15	0.39
woman_mas	0.29	0.05	-0.06	0.34	0.38
cunn_to	-0.24	0.23	0.34	0.64	0.03
mast_to_f	-0.31	0.26	0.41	0.57	0.10
anil_to_f	0.11	0.45	-0.16	0.54	-0.12
semen_to_vag	-0.34	0.26	0.22	0.53	0.24
woman_fem	-0.43	0.22	0.40	0.44	0.20

ggplot(melt(go.fa("Male", 5)$result$scores)) +
    geom_density(aes(value)) +
    facet_grid(. ~ Var2)

plot.fscores.vs.scores = function(gender, km)
   {item.clusters = cutree(hclust.kendall.abs(gender)$tree, km)
    cluster.scores = do.call(cbind, lapply(1 : km, function(k)
        rowMeans(hclust.kendall.abs(gender)$dat[,
            names(item.clusters[item.clusters == k])])))
    factor.scores = go.fa(gender, km)$result$scores[,paste0("ML", 1 : km)]
    colnames(factor.scores) = NULL
    # Find the optimal mapping between clusters and factors.
    # We define the optimal mapping as the one that maximizes the sum
    # of sqaured correlations.
    perms = permutations(km)
    perm = perms[which.max(apply(perms, 1, function(perm)
       sum(sapply(1 : km, function(i)
            cor(cluster.scores[,i], factor.scores[,perm[i]])^2)))),]
    # Create the scatterplots.
    print(perm)
    ggplot(
        merge(
           transform(melt(cluster.scores), Var2 = perm[Var2]),
           melt(factor.scores),
           by = c("Var1", "Var2"))) +
        geom_point(aes(value.x, value.y)) +
        facet_grid(. ~ Var2, labeller = as_labeller(function(xs)
            sprintf("f %s, c %s", xs, sapply(xs, function(x) which(perm == x))))) +
        xlab("Cluster scores") + ylab("Factor scores")}
plot.fscores.vs.scores("Male", 5)

Women

l.female2 = go.fa("Female", 2)
zcomb = combn(colnames(l.female2$pw), 2, simplify = F, FUN = function(iv)
    table(l.female2$pw[[iv[1]]], l.female2$pw[[iv[2]]]) == 0)
zero.prop.per.cell = mean(c(recursive = T, zcomb))
zero.prop.per.varpair = mean(sapply(zcomb, any))
round(d = 2, c(zero.prop.per.varpair, zero.prop.per.cell))

	value
	0.94 0.21

display.loadings(go.fa("Female", 2))

	ML1	ML2
cunn_to	0.78	-0.09
porn_video_ff	0.76	0.07
group_sex	0.74	0.07
woman	0.74	-0.11
mast_to_f	0.74	-0.07
breasts_big	0.73	-0.05
woman_fem	0.73	-0.14
anil_to_f	0.71	-0.29
voyeur_known	0.69	0.14
objpen_to	0.69	-0.13
breasts_small	0.69	-0.20
objpen_rec	0.67	0.26
woman_trans	0.67	-0.32
porn_visual	0.67	0.31
woman_mas	0.65	-0.28
man_trans	0.64	-0.26
stranger	0.63	-0.06
recent_acq	0.59	-0.04
pain_rec	0.58	-0.02
anil_to_m	0.58	-0.13
bondage_to	0.58	0.16
insult_rec	0.57	-0.02
anil_rec	0.57	0.02
voyeur_secret	0.57	0.05
insult_to	0.57	-0.13
porn_video_mf	0.57	0.35
friend	0.57	-0.02
porn_video_mm	0.57	-0.13
bondage_rec	0.56	0.28
porn_written	0.55	0.31
semen_swallow	0.54	0.25
semen_rec_anus	0.53	0.02
butt_big	0.53	-0.03
pain_to	0.53	-0.23
semen_rec_mouth	0.53	0.27
analpen_rec	0.52	0.06
leather	0.50	0.09
rebel	0.49	0.32
man_fem	0.48	-0.20
urine_to	0.48	-0.40
control_rec	0.48	0.30
rape_rec	0.47	-0.26
mast_solo_f	0.45	0.36
urine_rec	0.44	-0.44
experienced	0.42	0.22
control_to	0.41	0.11
feet	0.40	-0.18
persity_cl	0.38	-0.02
virgin	0.36	0.00
rich	0.34	0.26
butt_small	0.34	0.05
feet_small	0.33	-0.09
persity_nh	0.33	-0.24
persity_al	0.32	-0.13
feet_big	0.29	0.02
penis_small	0.18	-0.18
persity_ol	0.13	-0.04
desired	-0.05	0.85
man	-0.09	0.74
in_rship	-0.09	0.73
intimacy	-0.19	0.72
coitus_f	0.01	0.72
love	-0.23	0.72
pleasure_to	0.08	0.71
incest	0.38	-0.69
kiss	-0.07	0.64
mast_rec_f	0.20	0.63
rape_to	0.45	-0.61
mast_to_m	0.28	0.53
man_mas	0.01	0.53
persity_eh	0.25	0.52
age_14	0.24	-0.52
persity_nl	-0.07	0.52
persity_ah	-0.04	0.51
age_08	0.13	-0.50
cunn_rec	0.34	0.50
fellatio_to	0.41	0.49
uncon	0.41	-0.49
persity_ch	-0.02	0.49
persity_oh	0.36	0.44
penis_big	0.29	0.44
hug	-0.12	0.41
semen_rec_vag	0.26	0.40
age_70	0.28	-0.39
persity_el	0.03	0.10

display.loadings(go.fa("Female", 3))

	ML1	ML2	ML3
semen_rec_mouth	0.14	0.06	0.70
semen_swallow	0.16	0.05	0.70
fellatio_to	0.04	0.31	0.69
penis_big	-0.07	0.26	0.61
semen_rec_anus	0.17	-0.17	0.61
analpen_rec	0.18	-0.12	0.59
mast_to_m	-0.05	0.37	0.59
control_rec	0.19	0.14	0.57
insult_rec	0.28	-0.18	0.55
semen_rec_vag	-0.03	0.26	0.54
recent_acq	0.29	-0.20	0.53
anil_to_m	0.26	-0.29	0.53
stranger	0.35	-0.21	0.53
bondage_rec	0.32	0.14	0.53
pain_rec	0.31	-0.17	0.52
objpen_rec	0.47	0.14	0.52
rebel	0.24	0.18	0.52
porn_video_mf	0.36	0.23	0.52
insult_to	0.27	-0.28	0.52
porn_written	0.31	0.18	0.50
anil_rec	0.31	-0.13	0.49
rape_rec	0.17	-0.41	0.46
leather	0.25	-0.04	0.46
man_mas	-0.28	0.40	0.45
pain_to	0.25	-0.38	0.43
bondage_to	0.40	0.05	0.43
experienced	0.20	0.11	0.42
voyeur_secret	0.40	-0.05	0.40
rich	0.16	0.15	0.39
control_to	0.22	0.01	0.38
porn_video_mm	0.37	-0.23	0.38
persity_cl	0.16	-0.13	0.36
persity_al	0.09	-0.25	0.35
feet_big	0.07	-0.08	0.34
feet	0.20	-0.29	0.31
butt_small	0.21	-0.02	0.26
feet_small	0.21	-0.16	0.21
persity_ol	-0.03	-0.12	0.19
persity_el	-0.02	0.07	0.07
woman	0.94	-0.05	0.06
mast_to_f	0.93	-0.01	0.07
woman_fem	0.91	-0.08	0.07
cunn_to	0.89	-0.07	0.16
breasts_big	0.83	-0.03	0.19
porn_video_ff	0.82	0.06	0.26
breasts_small	0.79	-0.18	0.10
woman_mas	0.69	-0.28	0.13
woman_trans	0.63	-0.35	0.21
anil_to_f	0.62	-0.35	0.29
objpen_to	0.62	-0.19	0.28
voyeur_known	0.54	0.05	0.43
group_sex	0.54	-0.04	0.52
man_trans	0.51	-0.33	0.30
butt_big	0.50	-0.06	0.21
porn_visual	0.50	0.21	0.49
friend	0.43	-0.10	0.35
man_fem	0.36	-0.26	0.25
mast_solo_f	0.35	0.30	0.34
virgin	0.25	-0.07	0.23
desired	-0.04	0.84	0.15
incest	0.21	-0.78	0.19
love	-0.11	0.77	-0.06
in_rship	0.00	0.75	0.04
intimacy	-0.10	0.75	-0.01
rape_to	0.20	-0.73	0.31
pleasure_to	0.09	0.69	0.18
age_14	0.00	-0.64	0.22
kiss	-0.08	0.62	0.12
uncon	0.18	-0.61	0.28
man	-0.41	0.61	0.50
mast_rec_f	0.19	0.60	0.23
coitus_f	-0.30	0.58	0.53
urine_rec	0.23	-0.54	0.28
age_08	0.06	-0.53	-0.02
persity_nl	-0.04	0.52	0.05
urine_to	0.25	-0.52	0.33
persity_ah	-0.01	0.51	0.05
cunn_rec	0.33	0.47	0.27
persity_ch	-0.01	0.47	0.09
persity_eh	0.14	0.45	0.31
age_70	0.17	-0.44	0.14
hug	-0.13	0.40	0.05
persity_oh	0.24	0.35	0.34
persity_nh	0.11	-0.35	0.30
penis_small	-0.02	-0.27	0.22

display.loadings(go.fa("Female", 4))

	ML1	ML2	ML3	ML4
semen_rec_mouth	0.08	0.06	0.68	0.19
fellatio_to	-0.02	0.29	0.68	0.13
semen_swallow	0.10	0.06	0.67	0.22
penis_big	-0.13	0.19	0.66	-0.03
control_rec	0.14	0.07	0.63	-0.03
coitus_f	-0.35	0.50	0.58	-0.15
bondage_rec	0.27	0.09	0.58	0.03
insult_rec	0.24	-0.23	0.58	0.09
semen_rec_anus	0.12	-0.17	0.58	0.22
group_sex	0.49	-0.09	0.58	0.09
porn_video_mf	0.31	0.18	0.58	0.02
stranger	0.30	-0.27	0.57	0.09
semen_rec_vag	-0.08	0.22	0.56	0.03
analpen_rec	0.13	-0.11	0.56	0.21
recent_acq	0.24	-0.23	0.55	0.13
rebel	0.19	0.15	0.55	0.06
objpen_rec	0.42	0.13	0.55	0.12
mast_to_m	-0.10	0.40	0.55	0.18
man	-0.45	0.53	0.54	-0.16
porn_visual	0.45	0.18	0.54	0.06
pain_rec	0.26	-0.19	0.53	0.14
insult_to	0.23	-0.29	0.50	0.20
man_mas	-0.32	0.32	0.50	-0.13
porn_written	0.26	0.19	0.50	0.17
rape_rec	0.13	-0.44	0.46	0.15
anil_rec	0.27	-0.09	0.45	0.25
anil_to_m	0.21	-0.22	0.44	0.39
leather	0.20	-0.02	0.43	0.22
bondage_to	0.36	0.07	0.43	0.16
voyeur_secret	0.36	-0.06	0.43	0.11
friend	0.39	-0.13	0.40	0.07
rich	0.12	0.15	0.39	0.10
pain_to	0.21	-0.34	0.37	0.30
experienced	0.16	0.16	0.37	0.27
control_to	0.18	0.02	0.36	0.16
mast_solo_f	0.32	0.32	0.34	0.13
woman	0.94	-0.07	0.15	0.00
mast_to_f	0.92	0.00	0.13	0.08
woman_fem	0.90	-0.09	0.15	0.04
cunn_to	0.87	-0.07	0.22	0.10
breasts_big	0.81	-0.06	0.27	0.03
porn_video_ff	0.79	0.02	0.35	0.00
breasts_small	0.78	-0.13	0.11	0.22
woman_mas	0.68	-0.20	0.10	0.30
woman_trans	0.60	-0.25	0.15	0.40
anil_to_f	0.59	-0.29	0.25	0.33
objpen_to	0.59	-0.10	0.23	0.34
voyeur_known	0.50	0.04	0.47	0.12
butt_big	0.47	0.03	0.15	0.33
intimacy	-0.11	0.79	-0.01	-0.05
in_rship	-0.01	0.79	0.05	-0.06
love	-0.10	0.78	-0.04	-0.14
desired	-0.05	0.78	0.24	-0.27
pleasure_to	0.08	0.72	0.19	-0.01
incest	0.19	-0.71	0.09	0.36
rape_to	0.17	-0.68	0.22	0.36
kiss	-0.09	0.66	0.11	0.00
mast_rec_f	0.16	0.62	0.25	0.02
persity_ah	-0.02	0.61	-0.01	0.16
persity_nl	-0.05	0.60	0.02	0.09
age_14	-0.02	-0.56	0.11	0.35
persity_ch	-0.03	0.54	0.06	0.09
uncon	0.15	-0.53	0.19	0.38
hug	-0.14	0.47	-0.01	0.10
persity_eh	0.11	0.47	0.32	0.07
age_08	0.05	-0.44	-0.12	0.32
urine_rec	0.20	-0.44	0.17	0.43
cunn_rec	0.30	0.42	0.35	-0.10
persity_oh	0.21	0.37	0.34	0.10
penis_small	-0.05	-0.09	0.04	0.57
man_fem	0.32	-0.09	0.11	0.55
feet_small	0.17	0.02	0.06	0.53
man_trans	0.48	-0.19	0.19	0.50
feet_big	0.03	0.06	0.20	0.48
persity_nh	0.07	-0.22	0.17	0.47
feet	0.17	-0.16	0.18	0.47
butt_small	0.17	0.12	0.15	0.44
persity_ol	-0.06	0.02	0.04	0.44
urine_to	0.22	-0.42	0.22	0.43
age_70	0.16	-0.32	0.02	0.41
porn_video_mm	0.33	-0.14	0.30	0.39
virgin	0.22	0.06	0.13	0.39
persity_cl	0.12	-0.05	0.28	0.36
persity_el	-0.03	0.21	-0.06	0.36
persity_al	0.05	-0.19	0.27	0.32

ggplot(melt(go.fa("Female", 4)$result$scores)) +
    geom_density(aes(value)) +
    facet_grid(. ~ Var2)

plot.fscores.vs.scores("Female", 4)

Choosing the number of clusters and factors

Below are plots of the eigenvalues of factor analysis (x = 1) and the heights of clusters (x = 2), scaled to the maximum of 1. x-coordinates are jittered to prevent overplotting. I also include tables of the first 10 differences of successive values.

f = function(v) v / max(v)
screeplots = function(gender)
   {d = rbind(
       data.frame(type = 1, y = f(go.fa(gender, 1)$result$e.values)),
       data.frame(type = 2, y = f(hclust.kendall.abs(gender)$tree$height)))
    dodge(type, y, data = d) + no.gridlines()}
screeplots("Male")

rd(abs(rbind(
    factor = diff(f(go.fa("Male", 1)$result$e.values)),
    cluster = diff(rev(f(hclust.kendall.abs("Male")$tree$height))))[,1:10]))

	V1	V2	V3	V4	V5	V6	V7	V8	V9	V10
factor	0.295	0.409	0.124	0.022	0.017	0.028	0.008	0.008	0.013	0.002
cluster	0.009	0.024	0.024	0.001	0.028	0.001	0.006	0.017	0.015	0.010

For men, I see natural gaps after 3 and 6 points for factor analysis, and after 5 points for cluster analysis. So, 5 seems like a reasonable compromise.

screeplots("Female")

rd(abs(rbind(
    factor = diff(f(go.fa("Female", 1)$result$e.values)),
    cluster = diff(rev(f(hclust.kendall.abs("Female")$tree$height))))[,1:10]))

	V1	V2	V3	V4	V5	V6	V7	V8	V9	V10
factor	0.395	0.337	0.081	0.046	0.026	0.014	0.010	0.003	0.006	0.005
cluster	0.027	0.012	0.010	0.023	0.009	0.020	0.006	0.001	0.012	0.013

For women, I see gaps after 2, 4, and 5 factors, and 1, 4, and 6 clusters. So 4 seems a good choice.

Cluster prediction

I want a procedure that can cluster items, then use these clusters to predict unobserved values of the variables in new cases. My strategy (implemented in cluster-prediction.R) is as follows.

The procedure accepts a training set, in which a response is present for every item for every subject.
The procedure uses the training set to partition the items into clusters.
It then, again inside the training set, constructs a simple model predicting each item given the median value of all other (standardized) items in the cluster.
Given a test set, which is similar to the training set but has all new subjects and is missing some responses, the procedure predicts the missing responses using the simple model (re-applying whatever standardizing transformations it used during training).

Now, it's true that when we're trying to apply the models in the test set we in general won't have access to every other item in the cluster other than the DV. But the bigger the cluster and the more similar its items, the more accurately we can estimate the cluster median with only some of the items. Also, the median is robust enough that it should be little affected by a few missing items.

Here's a trial run with fake data.

test.clustering.d = local(
   {set.seed(20)
    n = 100
    ief = rnorm(100)
    t(sapply(1 : n, function(i)
       {f1 = rnorm(1, sd = 5)
        f2 = rnorm(1, sd = 5)
        f3 = rnorm(1, sd = 5)
        f4 = rnorm(1, sd = 5)
        c(
            x.f1.1 = f1 + rnorm(1) + ief[1],
            x.f1.2 = f1 + rnorm(1) + ief[2],
            x.f1.3 = f1 + rnorm(1) + ief[3],
            x.f1.4 = f1 + rnorm(1) + ief[4],
            x.f2.1 = f2 + rnorm(1) + ief[5],
            x.f2.2 = f2 + rnorm(1) + ief[6],
            x.f2.3 = f2 + rnorm(1) + ief[7],
            x.f2.4 = 1.5 * (f2 + rnorm(1) + ief[8]),
            x.f2.5 = 1 + f2 + rnorm(1) + ief[9],
            x.f3.p4.1 = f3 + f4/2 + rnorm(1) + ief[10],
            x.f3.p4.2 = f3 + f4/2 + rnorm(1) + ief[11],
            x.f3.p4.3 = f3 + f4/2 + rnorm(1) + ief[12],
            x.f4.p3.1 = f4 + f3/2 + rnorm(1) + ief[13],
            x.f4.p3.2 = f4 + f3/2 + rnorm(1) + ief[14],
            x.f4.p3.3 = f4 + f3/2 + rnorm(1) + ief[15])}))})
ks = 2:6
results = cached(data.frame(v = sapply(ks, function(k)
   {pred = cv.cluster.prediction(test.clustering.d, k)
    rmsd(pred, test.clustering.d)})))
results = rbind(v = sd(test.clustering.d), results)
rownames(results) = c("SD", paste("k =", ks))
rd(results)

	v
SD	5.748
k = 2	3.554
k = 3	2.226
k = 4	1.263
k = 5	1.844
k = 6	1.990

Notice that the most logical number of clusters, 4, yields the least prediction error.

Now for the real thing. Gentlemen first.

pw.m = as.matrix(remove.na.prefwide.cols(
    ss(prefwide, sb[row.names(prefwide), "gender"] == "Male")))
ks = 1:15
preds = cached(lapply(ks, function(k)
   {message("k = ", k)
    cv.cluster.prediction.prefs(pw.m, k = k)}))

results = data.frame(row.names = paste("k =", ks),
    v = sapply(preds, function(pred)
        mean(
        colMeans(abs(pred - pw.m)))))
results = rbind(
    v = mean(
        mapcols(pw.m, function(v) mean(abs(v - median(v))))),
    results)
rd(d = 2, results)

	v
v	1.10
k = 1	1.13
k = 2	1.09
k = 3	1.04
k = 4	1.03
k = 5	1.01
k = 6	1.00
k = 7	0.99
k = 8	0.98
k = 9	0.97
k = 10	0.98
k = 11	0.97
k = 12	0.97
k = 13	0.97
k = 14	0.97
k = 15	0.96

rd(d = 2, results[which.min.hastie(results$v),, drop = F])

	v
k = 5	1.01

Ladies:

pw.f = as.matrix(remove.trivial.prefwide.cols(
    ss(prefwide, sb[row.names(prefwide), "gender"] == "Female")))
preds.f = cached(lapply(ks, function(k)
   {message("k = ", k)
     cv.cluster.prediction.prefs(pw.f, k = k)}))

results = data.frame(row.names = paste("k =", ks),
    v = sapply(preds.f, function(pred)
        quantile(p = .95,
        colMeans(abs(pred - pw.f)))))
results = rbind(
    v = quantile(p = .95,
        mapcols(pw.f, function(v) mean(abs(v - median(v))))),
    results)
rd(d = 2, results)

	v
v	2.05
k = 1	1.70
k = 2	1.73
k = 3	1.70
k = 4	1.68
k = 5	1.66
k = 6	1.64
k = 7	1.61
k = 8	1.64
k = 9	1.57
k = 10	1.60
k = 11	1.61
k = 12	1.57
k = 13	1.59
k = 14	1.56
k = 15	1.57

rd(d = 2, results[which.min.hastie(results$v),, drop = F])

	v
k = 4	1.68

Criterion variables

Other variables in the dataset we might try to predict using sexual preferences include:

Number of sex partners
Condom use, and for women, pill compliance
Frequencies of perisexual drug use (especially drinking)
Externalizing

table(sb[good.s, "partners_year"])

	count
0	63
1	269
2	47
3	38
4	12
5	8
6	3
7	1
8	3
10	2
12	2
13	1
19	1
100	1

Dichotomized by whether the number of partners is 2 or more.

table(sb[good.s, "partners_year"] >= 2)

	count
FALSE	332
TRUE	119

t(sapply(condom, function(v) table(v, useNA = "always")))

	Never	Rare	Stimes	Usual	Always	NA
condom_fellatio_rec	162	34	23	9	5	267
condom_coitus_m	54	47	44	50	35	270
condom_analpen_to_m	12	3	0	4	13	468
condom_analpen_to_f	46	25	19	15	26	369
condom_coitus_f	79	33	34	40	34	280
condom_fellatio_to	196	19	11	10	7	257
condom_analpen_rec	79	11	17	14	18	361

The same data with all non-Never values collapsed:

t(sapply(condom, function(v) table(v != "Never", useNA = "always")))

	FALSE	TRUE	NA
condom_fellatio_rec	162	71	267
condom_coitus_m	54	176	270
condom_analpen_to_m	12	20	468
condom_analpen_to_f	46	85	369
condom_coitus_f	79	141	280
condom_fellatio_to	196	47	257
condom_analpen_rec	79	60	361

table(dwide$contraceptive_pills, useNA = "always")

	count
?	1
0	25
1	1
2	1
3	4
4	45
N/A	161
NA	262

This item doesn't seem to have any variability of the kind we want.

rbind(
    alcohol = table(sb[good.s, "alcohol_freq"]),
    odrugs = table(sb[good.s, "odrugs_freq"]))

	Never	Rare	Stimes	Usual	Always
alcohol	137	142	140	21	5
odrugs	326	60	38	16	9

ggplot(sb[good.s,]) +
    geom_dotplot(aes(dinhib), binwidth = 1, stackratio = .75) +
    scale_y_continuous(breaks = NULL) +
    scale_x_continuous(breaks = seq(0, 60, 5)) +
    coord_cartesian(xlim = c(-2, 62))

Ridge regression

Here I attempt to predict some of the criterion variables with ridge regression on all of the preferences items.

For the logistic-regression models, NLL2 is the mean negative log-likelihood, base 2 (a proper scoring rule; Buja, Stuetzle, & Shen, 2005).

Drinking

Per gender:

rd(with(ss(sb[good.s,], !is.na(alcohol_freq)),
    predwithpref.bygender.logit(char(s), alcohol_freq != "Never")))

	Accuracy	NLL2
Male baseline	0.696	0.886
Male model	0.700	0.882
Female baseline	0.698	0.884
Female model	0.698	0.893

Model combining both genders:

rd(with(ss(sb[good.s,], !is.na(alcohol_freq)),
    predwithpref.bothgenders.logit(char(s), alcohol_freq != "Never")))

	Accuracy	NLL2
baseline	0.697	0.885
model	0.697	0.881

Failure.

Number of partners in the past year

Per gender:

rd(with(sb[good.s,],
    predwithpref.bygender.logit(char(s), partners_year >= 2)))

	Accuracy	NLL2
Male baseline	0.683	0.902
Male model	0.665	0.871
Female baseline	0.800	0.722
Female model	0.805	0.639

Model combining both genders:

rd(with(sb[good.s,],
    predwithpref.bothgenders.logit(char(s), partners_year >= 2)))

	Accuracy	NLL2
baseline	0.739	0.815
model	0.748	0.740

Not much.

Condom use

condom.ses = intersect(
    with(sb[good.s,], char(s)[
        gender == "Male" & partners_year_f >= 2]),
    row.names(ss(condom, !is.na(condom_coitus_m))))
c("Sample size" = length(condom.ses))

	value
Sample size	65

rd(predwithpref.onegender.logit(
    condom.ses,
    condom[condom.ses, "condom_coitus_m"] >= "Usual",
    "Male"))

	Accuracy	NLL2
Male baseline	0.585	0.979
Male model	0.523	1.041

Failure: the ridge regression overfit, maybe because of the small sample size.

Externalizing

rd(with(sb[good.s,],
    predwithpref.bygender.normal(char(s), sqrt(dinhib), y.min = 0)))

	RMSE
Male baseline	1.260
Male model	1.234
Female baseline	1.380
Female model	1.292

Not much.

Gender differences in preferences

Plots

Instead of point predictions, let's consider prediction intervals. (I'd like tolerance intervals, but how am I going to get tolerance intervals for a rating scale?) Below are 50% HDIs for each gender and item.

local(
   {ses = row.names(ss(sb[good.s,],
        gender %in% qw(Male, Female)))
    gender = sb[ses, "gender"]
    pwu = pwu[ses,]
    f = function(x) data.frame(discrete.hdi(
        as.integer(na.omit(x)), p = .5))
    d = do.call(rbind, lapply(pwu.items, function(pwi) rbind(
         data.frame(item = pwi, gender = "Male", f(pwu[gender == "Male", pwi])),
         data.frame(item = pwi, gender = "Female", f(pwu[gender == "Female", pwi])))))
    d = ordf(
        transform(d, item = factor(item, levels =
            names(sort(sapply(pwu, function(v) mean(v, na.rm = T)))))),
        item, gender)
    ggplot(d) +
        geom_linerange(
           aes(
               #int(item) + ((gender == "Female") - .5)/10,
               item,
               ymin = lo - .1, ymax = hi + .1,
               color = gender),
           size = 1.25,
           position = position_dodge(height = 0, width = .2)) +
        scale_y_continuous(breaks = 1:7) +
        scale_color_manual(values = c(Male = "blue", Female = "red")) +
        theme(
            panel.grid.major.y = element_blank(),
            panel.grid.minor = element_blank()) +
        coord_flip()})

Interesting.

Here's a mosaic plot, which can be especially helpful (vs. the interval graph above) for items with ceiling or floor effects.

d = local(
   {ses = row.names(ss(sb[good.s,],
        gender %in% qw(Male, Female)))
    d = melt(cbind(ses, pwu[ses,]))
    colnames(d) = qw(s, item, v)
    d = ordf(
        transform(d, item = factor(item, levels =
            names(sort(sapply(pwu, function(v) -mean(v, na.rm = T)))))),
        s, item)
    d})
mosaicplot(dir = qw(h, h, v), las = 1, with(d, table(
    item,
    droplevels(sb[char(s), "gender"]),
    v)))

Let's construct HDIs for within-subject differences between items that are in some sense opposite, such as bnip_rec versus bnip_to and virgin versus experienced.

opposites = qw(
    anil_to, anil_rec,
    mast_to, mast_rec,
    objpen_to, objpen_rec,
    control_to, control_rec,
    pain_to, pain_rec,
    bondage_to, bondage_rec,
    urine_to, urine_rec,
    insult_to, insult_rec,
    rape_to, rape_rec,
    porn_visual, porn_written,
    voyeur_known, voyeur_secret,
    voyeur_known, exhibit,
    stranger, in_rship,
    penis_big, penis_small,
    breasts_big, breasts_small,
    butt_big, butt_small,
    feet_big, feet_small,
    man, woman,
    man_mas, man_fem,
    woman_mas, woman_fem,
    man_trans, woman_trans,
    age_14, age_70,
    rich, rebel,
    virgin, experienced,
    persity_el, persity_eh,
    persity_al, persity_ah,
    persity_cl, persity_ch,
    persity_nl, persity_nh,
    persity_ol, persity_oh)
opprefs = do.call(rbind, lapply(seq(1, length(opposites), 2), function(i)
   {p1 = opposites[i]
    p2 = opposites[i + 1]
    minuend = (
        if (p1 == "voyeur_both")
            pmax(pwu$voyeur_known, pwu$voyeur_secret)
        else
            pwu[,p1])
    subtrahend = pwu[,p2]
    data.frame(
       s = row.names(pwu),
       item = paste(p2, "<", p1),
       v = minuend - subtrahend)}))

local(
   {ses = row.names(ss(sb[good.s,],
        gender %in% qw(Male, Female)))
    opprefs = ss(opprefs, char(s) %in% ses)
    f = function(x) data.frame(discrete.hdi(
        as.integer(na.omit(x)), p = .5))
    d = do.call(rbind, lapply(levels(opprefs$item), function(itn) rbind(
         data.frame(item = itn, gender = "Male", f(ss(opprefs, item == itn & sb[s, "gender"] == "Male")$v)),
         data.frame(item = itn, gender = "Female", f(ss(opprefs, item == itn & sb[s, "gender"] == "Female")$v)))))
     d = ordf(
         transform(d, item = factor(item, levels =
             names(sort(with(opprefs, tapply(v, item, function(v) mean(v, na.rm = T))))))),
         item, gender)
    ggplot(d) +
        geom_linerange(
           aes(
               item,
               ymin = lo - .1, ymax = hi + .1,
               color = gender),
           size = 1.25,
           position = position_dodge(height = 0, width = .2)) +
        scale_y_continuous(breaks = seq(-6, 6, 2)) +
        scale_color_manual(values = c(Male = "blue", Female = "red")) +
        theme(
            panel.grid.major.y = element_blank(),
            panel.grid.minor = element_blank()) +
        coord_flip()})

Interpretation

I've grouped the items according to theoretical prediction, although the description of each item here is of the sample rather than the theoretical prediction.

Social distance

love
F somewhat more likely to choose 7

in_rship
similar to love

intimacy
similar to love

stranger
M about uniform, F mode 1

recent_acq
M about uniform, F mode 1

friend
M higher

group_sex
M mode 7, F mode 1

kiss
F more likely to choose 7

hug
F higher

mast_solo
F mode 7, M mode 4

Power

rebel
M slightly higher

rape_rec
F higher

rape_to
M higher

control_rec
F mode 7, M mode 1

control_to
M mode 7, F mode 1 (but close to uniform for both

bondage_rec
F mode 7, M mode 1

bondage_to
F slightly higher

exhibit
both about uniform, but F is more polarized

voyeur_known
M mode 7, F mode 1 (but close to uniform for both)

voyeur_secret
M about uniform, F mode 1

insult_to
M higher

insult_rec
M dislike less

urine_to
M higher

uncon
M higher

urine_rec
M higher

age_70
M higher

incest
M higher

age_14
M higher

age_08
M higher

pain_rec
F dislike less

pain_to
M higher
Signs of reproductive health

experienced
M slightly higher

virgin
M mode 7, F mode 1

feet_small
M higher

feet_big
M slightly higher

butt_big
M mode 7, F mode 1
Written vs. visual porn

porn_written
F higher

porn_visual
M higher
Resources

rich
M slightly higher
Misc. (see below):

desired
M choose 6s (vs. 7s) about twice as often

pleasure_to
F slightly more likely to choose 7
Gender preferences (boring)

woman
M mode 7, F mode 1

woman_fem
F mode 7, M mode 1

breasts_big
M mode 7, F mode 1

breasts_small
M mode 4, F mode 1

penis_small
F higher

penis_big
F mode 7, M mode 1

woman_mas
M dislike less

man
F mode 7, M mode 1

man_mas
F mode 7, M mode

man_fem
F higher

cunn_to
M mode 7, F mode 1

semen_rec_mouth
F dislike less

semen_swallow
F higher

semen_rec_anus
F higher

fellatio_to
F mode 7, M mode 1
No obvious prediction a priori

butt_small
M dislike less

feet
M higher

coitus
M somewhat more likely to choose 7

persity_ah
similar

mast_rec
F more likely to choose 7

persity_oh
M slightly higher

mast_to
M higher

persity_nl
F slightly higher

persity_eh
M slightly higher

persity_ch
F slightly higher

bnip_to
M mode 7, F mode 1

underwear
M slightly higher

bnip_rec
F mode 7, M about uniform

roleplay
M slightly higher

persity_el
M higher

objpen_to
M about uniform, F mode 1

persity_ol
M dislike less

persity_cl
M dislike less

objpen_rec
F mode 7, M mode 1

leather
both about uniform, but F is more polarized

anil_to
M higher

anil_rec
both dislike, but F is more polarized

persity_al
M higher

persity_nh
M dislike less

analpen_rec
F higher

woman_trans
M dislike less

man_trans
F higher

Compromise data analysis

We'll do a (statistically dubious) χ² test on the whole table (treating the interaction of gender and item as a single factor), then provide estimates with a Bayesian categorical model.

local(
   {ses = ggood.s
    d = melt(cbind(ses, pwu[ses, names(unlist(unname(itemgroups)))]))
    colnames(d) = qw(s, item, v)
    xt = with(d, chisq.test(
        droplevels(interaction(item, sb[char(s), "gender"])),
        v))
    c(xt$statistic, xt$parameter, p = xt$p.value)})

	value
X-squared	29115.16
df	486.00
p	0.00

Significant at some very small p (let's say p < .001); no big surprise there.

local(
   {ses = ggood.s
    d = melt(cbind(ses, pwu[ses, names(unlist(unname(itemgroups)))]))
    colnames(d) = qw(s, item, v)
    d = ddply(d, .(item), function(slice)
       {xt = with(slice, chisq.test(
            droplevels(sb[char(s), "gender"]),
            v))
        c(xt$statistic, xt$parameter, p = rd(d = 3, xt$p.value))})
    ordf(d, -p)})

	item	X-squared	df	p
17	bondage_to	5.127628	6	0.528
41	pleasure_to	5.411887	6	0.492
27	age_08	8.665882	6	0.193
30	pain_to	9.041871	6	0.171
11	rebel	11.807334	6	0.066
35	feet_big	12.093654	6	0.060
12	rape_rec	13.302938	6	0.038
26	age_70	15.908568	6	0.014
5	in_rship	17.358862	6	0.008
13	rape_to	19.322632	6	0.004
18	exhibit	21.256323	6	0.002
40	desired	20.934090	6	0.002
19	voyeur_known	22.662430	6	0.001
23	urine_to	22.897185	6	0.001
24	urine_rec	23.142820	6	0.001
1	love	28.031677	6	0.000
2	intimacy	41.230457	6	0.000
3	kiss	44.654504	6	0.000
4	hug	56.160757	6	0.000
6	friend	181.558345	6	0.000
7	recent_acq	188.918032	6	0.000
8	stranger	138.987030	6	0.000
9	group_sex	105.192518	6	0.000
10	mast_solo	68.147727	6	0.000
14	control_rec	62.033867	6	0.000
15	control_to	34.232169	6	0.000
16	bondage_rec	68.609541	6	0.000
20	voyeur_secret	32.822227	6	0.000
21	insult_to	65.515668	6	0.000
22	insult_rec	25.751995	6	0.000
25	uncon	58.606553	6	0.000
28	incest	53.058759	6	0.000
29	pain_rec	28.689436	6	0.000
31	experienced	29.119596	6	0.000
32	virgin	206.483394	6	0.000
33	age_14	65.512431	6	0.000
34	feet_small	98.116940	6	0.000
36	butt_big	162.264495	6	0.000
37	porn_written	36.977414	6	0.000
38	porn_visual	42.790112	6	0.000
39	rich	25.005620	6	0.000

We now model each item and gender as an independent categorical distribution. Each is assigned a flat Dirichlet prior.

categorical.cellprobs(v, prior.α)
   {t = tabulate(v)
    t = c(t, rep(0, length(prior.α) - length(t)))
    α = t + prior.α
      # This is the posterior estimate of α, the parameter
      # of the Dirichlet distribution.
    # Now estimate the cell probabilities with the posterior
    # means. (Why means? By the law of total probability,
    # the marginal probability is the mean of the conditional
    # probabilities.)
    α / sum(α)}

Of course, writing this function only makes me realize that making this Bayesian correction to estimate the cell probabilities consists just of adding 1 to each cell before taking proportions. Works for me.

item.genderdiff.plot(good.s, prior.inc = 1) +
    theme_bw(base_size = 12) +
    theme(panel.border = element_blank())

Paper plans

Introduction
- As in the proposal paper, distinguish sexual orientation from sexual preferences and argue that sexual preferences for things other than gender has received insufficient attention.
- Discuss what theory suggests should distinguish men's and women's (at least American men's and women's) sexual preferences for things other than just gender. (The items for each category are listed above.)
  - Social distance: because of differential parental investment, women should require intimacy and commitment more than men do. Thus, compared to men, they should be more sexually interested in things implying closeness to a single partner and less in things implying distance or a lack of a committed partner.
  - Resources: Women should be sexually interested in the rich, famous, and competent because this provides evidence of being able to support a large family.
  - Power: Men should seek power over women in order to prevent being cuckolded. (Again because of differential parental investment, women don't need men to be faithful as much as men need women to be faithful.) They should also be sexually interested in expressing dominance over women in order to reinforce the general social arrangement of men dominating women (Vandermassen, 2011, describes how feminist and evolutionary theory agree here). Women, conversely, should be sexually interested in expressing submission to men to provide reassurance that they're playing along. It's in their evolutionary interests to be able to cheat when they want to, but the more they can convince a mate they're obedient, the better their chances of being able to cuckold him without him noticing (and thus trick him into raising another man's child).
  - Signs of reproductive health: In women, small feet are associated with nulliparity and large buttocks are associated with youth, so men should be attracted to these whereas women shouldn't care. Virgins are of course (without artifical insemination) nulliparious, so men should prefer virgins, too. Women by contrast may actually prefer men who are sexually experienced because this will increase their sons' sexual success more than it will hurt their own reproductive chances with this man (the sexy-son hypothesis).
  - Written vs. visual porn: Ellis and Symons (1990) argue that written porn is more popular among women and visual porn among men because women care more about emotions and context and men more about raw fertility cues.
  - Misc.
    - pleasure_to: Ogas and Gaddam (2011) p. 57 claim men are particularly concerned that women's expressed sexual pleasure is genuine in order to help ensure her faithfulness.
    - desired: Ogas and Gaddam (2011) p. 40 claim women particularly desire men to sexually interested in them in order to help ensure his faithfulness.
- Brief high-level overview of method
Method
Results
Discussion

References

Ariely, D., Loewenstein, G., & Prelec, D. (2006). Tom Sawyer and the construction of value. Journal of Economic Behavior and Organization, 60, 1–10. doi:10.1016/j.jebo.2004.10.003

Backus, F. R., & Mahalik, J. R. (2011). The masculinity of Mr. Right: Feminist identity and heterosexual women's ideal romantic partners. Psychology of Women Quarterly, 35(2), 318–326. doi:10.1177/0361684310392357

Buja, A., Stuetzle, W., & Shen, Y. (2005, November 3). Loss functions for binary class probability estimation and classification: Structure and applications. Retrieved from http://www.stat.washington.edu/wxs/Learning-papers/paper-proper-scoring.pdf

Ellis, B. J., & Symons, D. (1990). Sex differences in sexual fantasy: An evolutionary psychological approach. Journal of Sex Research, 27(4), 527–555. doi:10.1080/00224499009551579

Figueredo, A. J., Sefcek, J. A., & Jones, D. N. (2006). The ideal romantic partner personality. Personality and Individual Differences, 41(3), 431–441. doi:10.1016/j.paid.2006.02.004

Fletcher, G. J. O., Simpson, J. A., Thomas, G., & Giles, L. (1999). Ideals in intimate relationships. Journal of Personality and Social Psychology, 76(1), 72–89. doi:10.1037/0022-3514.76.1.72

Lukaszewski, A. W., & Roney, J. R. (2010). Kind toward whom? Mate preferences for personality traits are target specific. Evolution and Human Behavior, 31(1), 29–38. doi:10.1016/j.evolhumbehav.2009.06.008

Ogas, O., & Gaddam, S. (2011). A billion wicked thoughts: What the world's largest experiment reveals about human desire. New York, NY: Dutton. ISBN 978-0-525-95209-1.

Van den Bergh, B., Dewitte, S., & Warlop, L. (2008). Bikinis instigate generalized impatience in intertemporal choice. Journal of Consumer Research, 35, 85–97. doi:10.1086/525505

Vandermassen, G. (2011). Evolution and rape: A feminist Darwinian perspective. Sex Roles, 64(9, 10), 732–747. doi:10.1007/s11199-010-9895-y