Galaxy notebook

Created 3 Oct 2013 • Last modified 26 Nov 2017

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)
  • 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")

biplot-male.png

item.biplot("Female")

biplot-female.png

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

biplot-sideways-male.png

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

biplot-sideways-female.png

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)

hier-tree-m.png

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)

hier-tree-f.png

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)

factor-distribs-m.png

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)

fscores-vs-cscores-m.png

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)

factor-distribs-f.png

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

fscores-vs-cscores-f.png

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 # 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")

scree-m.png

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")

scree-f.png

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))

dinhib-dotplot.png

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()})

genderdiff-intervals.png

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)))

genderdiff-mosaic.png

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()})

genderoppdiff-intervals.png

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) χ2 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())

genderdiff-grouped.png

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