Exclusion

Reasons for Exclusion

The following reasons for exclusion apply:

• missing data (not finishing the initial survey)
• not female
• homosexuality
• currently in a homosexual relationship
• older than 50
• menopausal
• pregnant
• breastfeeding
• participants, who do not want to avoid pregnancy
• participants, who ‘took a chance’ on getting pregnant
• participants, who used no contraception for ‘other reasons’
• use of one of the following contraceptive methods: morning-after pill, breastfeeding, I am infertile, my partner is infertile, I am sterilized, my partner is sterilized, other
• incongruent information about current contraceptive method and method used in the last three months
• use of medication including sex hormones in the last three months.

Data and Functions

source("0_helpers.R")
load("data/cleaned.rdata")
# opts_chunk$set(warning = F, message = F, error = T)

library(knitr)
opts_chunk$set(fig.width = 9, fig.height = 7, cache = T, warning = F, message = F, cache = F, error = T)

# function to seperate the reasons for exclusion variable for upsetr
comma_separated_to_columns = function(df, col) {
  colname = deparse(substitute(col))
  df$splitcol = df %>% pull(colname)
  separate_rows(df, splitcol, convert = TRUE, sep = ", ") %>% 
    mutate(splitcol = if_else(is.na(splitcol), "no", 
                        if_else(splitcol == "" | 
                                  splitcol %in% c(), "included", as.character(splitcol)))) %>% 
    mutate(#splitcol = stringr::str_c(colname, "_", splitcol), 
           value = 1) %>% 
    spread(splitcol, value, fill = 0) %>% 
    select(-colname)
}

all_survey_length = nrow(all_surveys)
diary_length = nrow(diary)
diary_social_length = nrow(diary_social)

Exclusion Steps

all_surveys$reasons_for_exclusion = "" #insert new variable reasons_for_exclusion to list all exclusion criteria
all_surveys$reasons_for_exclusion_contraception = "" #insert new variable reasons_for_exclusion_contraception to list different contraceptions that lead to exclusion

Missing data (not finishing the initial survey)

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(is.na(ended_initial), "didnt_finish_initial, ", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "didnt_finish_initial"))

Var1	Freq
FALSE	1411
TRUE	249

Not female

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(gender != 1 & !is.na(gender), "not_female, ", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "not_female"))

Var1	Freq
FALSE	1657
TRUE	3

Homosexuality

Not primarily heterosexual. This excludes women who reported being equally interested in men and women, women who reported being asexual or aromantic, and participants who did not identify as female gender.

all_surveys = all_surveys %>%
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(sex_orientation >= 4 | gender != 1,
                                               "not_heterosexual_female, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "not_heterosexual_female"))

Var1	Freq
FALSE	1634
TRUE	26

Currently in a non-heterosexual relationship

all_surveys = all_surveys %>%
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(partner_gender == 1,
                                               "non_heterosexual_relationship, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "non_heterosexual_relationship"))

Var1	Freq
FALSE	1651
TRUE	9

Older than 50

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                            if_else(age >= 50, "older_than_50, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "older_than_50"))

Var1	Freq
FALSE	1625
TRUE	35

Menopausal

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(menopause_yes == 1 | menopause_yes == 2,
                                               "menopausal, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "menopausal"))

Var1	Freq
FALSE	1619
TRUE	41

Pregnant

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(pregnant == 1, "pregnant, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "pregnant"))

Var1	Freq
FALSE	1637
TRUE	23

Breastfeeding

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                            if_else(breast_feeding == 1, "breast_feeding, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "breast_feeding"))

Var1	Freq
FALSE	1632
TRUE	28

Participants, who do not want to avoid pregnancy

all_surveys = all_surveys %>%
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(pregnant_trying >= 4,
                                               "pregnant_trying, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "pregnant_trying"))

Var1	Freq
FALSE	1599
TRUE	61

Participants, who ‘took a chance’ on getting pregnant

all_surveys = all_surveys %>%
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(contraception_at_all == 4,
                                               "pregnant_chance, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "pregnant_chance"))

Var1	Freq
FALSE	1619
TRUE	41

Participants, who used no contraception for ‘other reasons’

all_surveys = all_surveys %>%
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(contraception_at_all == 6,
                                               "no_contraception, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "no_contraception"))

Var1	Freq
FALSE	1605
TRUE	55

Conraceptive Method

Use of one of the following contraceptive methods

Morning-after pill

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "hormonal_morning_after_pill",
            "contraception_hormonal_morning_after_pill, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_hormonal_morning_after_pill"))

Var1	Freq
FALSE	1648
TRUE	12

Breastfeeding

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "breast_feeding",
            "contraception_breast_feeding, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_breast_feeding"))

Var1	Freq
FALSE	1659
TRUE	1

I am infertile

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "infertile" &
              !(contraception_method %contains% "partner_infertile"),
            "contraception_infertile, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_infertile"))

Var1	Freq
FALSE	1658
TRUE	2

My partner is infertile

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "partner_infertile",
            "contraception_partner_infertile, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_partner_infertile"))

Var1	Freq
FALSE	1658
TRUE	2

I am sterilized

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "sterilised" &
              !(contraception_method %contains% "partner_sterilised"),
            "contraception_sterilised, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_sterilised"))

Var1	Freq
FALSE	1658
TRUE	2

My partner is sterilized

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "partner_sterilised",
            "contraception_partner_sterilised, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_partner_sterilised"))

Var1	Freq
FALSE	1653
TRUE	7

Other

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion_contraception = str_c(
    reasons_for_exclusion_contraception,
    if_else(contraception_method %contains% "not_listed",
            "contraception_not_listed, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion_contraception %contains% "contraception_not_listed"))

Var1	Freq
FALSE	1651
TRUE	9

Summary

All participants that will be excluded based on their choice of contraception

all_surveys = all_surveys %>%
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(reasons_for_exclusion_contraception != "",
                                       "contraceptive_method, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "contraceptive_method"))

Var1	Freq
FALSE	1626
TRUE	34

Incongruent information about current contraceptive method and method used in the last three months

all_surveys = all_surveys %>%
  mutate(incongruent_information_about_hormonal_contraception =
           ifelse((hormonal_contraception_last3m == 0 & hormonal_contraception == T), 1, 0),
         reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(incongruent_information_about_hormonal_contraception == 1,
                                               "incongruent_information_about_hormonal_contraception, ",
                                               "", "")))


kable(table(all_surveys$reasons_for_exclusion %contains% "incongruent_information_about_hormonal_contraception"))

Var1	Freq
FALSE	1621
TRUE	39

Use of medication including sex hormones in the last three months.

Taking sex hormones (other than the pill)

all_surveys = all_surveys %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                       if_else(medication_name %contains% "Cycloprognova" |
                                                 medication_name %contains% "Cyproderm" |
                                                 medication_name %contains% "DHEA" |
                                                 medication_name %contains% "Hormone" |
                                                 medication_name %contains% "Cyclo-Progynova" |
                                                 medication_name %contains% "Femoston" |
                                                 medication_name %contains% "Gynokadin",
                                               "sex_hormones, ", "", "")))

kable(table(all_surveys$reasons_for_exclusion %contains% "sex_hormones"))

Var1	Freq
FALSE	1653
TRUE	7

Total number of excluded participants

kable(table(all_surveys$reasons_for_exclusion == ""))

Var1	Freq
FALSE	481
TRUE	1179

In total 481 participants were excluded, leaving 1179 subjects which were included in the analysis.

Reasons for exclusion

How to read this plot: The horizontal green bars show for how many women this reason for exclusion applies. The blue bars show how many women are excluded for multiple reasons (e.g., they’re menopausal and not heterosexual).

Table

exclusion_reasons = all_surveys %>% 
  mutate(reasons_for_exclusion = str_sub(reasons_for_exclusion, 1, -3)) %>% 
  select(session, reasons_for_exclusion) %>% 
  comma_separated_to_columns(reasons_for_exclusion) %>% 
  select(-session) 

exclusion_reasons %>% 
  summarise_all(sum) %>%
  sort() %>% 
  gather(reason, n) %>% 
  left_join(all_surveys %>% mutate(reason = str_sub(reasons_for_exclusion, 1, -3)) %>%
              group_by(reason) %>%
              summarise(unique = n())) %>% 
  mutate(unique = if_else(is.na(unique), 0L, unique)) %>% 
  knitr::kable()

reason	n	unique
not_female	3	0
sex_hormones	7	5
non_heterosexual_relationship	9	6
pregnant	23	13
not_heterosexual_female	26	14
breast_feeding	28	13
contraceptive_method	34	21
older_than_50	35	1
incongruent_information_about_hormonal_contraception	39	22
menopausal	41	5
pregnant_chance	41	13
no_contraception	55	15
pregnant_trying	61	17
didnt_finish_initial	249	205
included	1179	0

Figure 3: Exclusion criteria and most common combinations of exclusion criteria.

The horizontal green bars show for how many women this exclusion criteria applies. The blue bars show how many women are excluded for multiple reasons (e.g., not finishing the initial survey and being pregnant). Only the 20 most common overlaps are displayed. See Figure S1 in the supplementary materials for all combinations.

upset1 = exclusion_reasons %>% 
  rename(`Breastfeeding` = breast_feeding, 
         `Choice of Contraceptive Methode` = contraceptive_method,
         `Missing Data` = didnt_finish_initial,
         `Incongruent Information about Contraceptive Method` =
           incongruent_information_about_hormonal_contraception,
         `(Post-)Menopausal` = menopausal,
         `Using no Contraceptive Methods for Other Reasons` = no_contraception,
         `Not Female` = not_female,
         `Not Predominantly Heterosexual` = not_heterosexual_female,
         `Older than 50` = older_than_50,
         `Pregnant` = pregnant,
         `“Taking a Chance” of Becoming Pregnant` = pregnant_chance,
         `Trying to Become Pregnant` = pregnant_trying,
         `Medication Including Sex Hormones` = sex_hormones,
         `Currently in a Homosexual Relationship` = non_heterosexual_relationship) %>%
  filter(included == 0) %>% 
  select(-included) %>% 
  as.data.frame() %>%
  {
  upset(., ncol(.),
        20,
        order.by = "freq",
      main.bar.color = "#6E8691",
      matrix.color = "#6E8691",
      sets.bar.color = "#53AC9B",
      text.scale = 1.2)
  }
upset1

jpeg('Exclusion criteria and most common combinations of exclusion criteria.jpg', 
     width = 900, height = 470, quality = 1000)
upset1
dev.off()

## png 
##   2

Figure S1: Exclusion criteria and all combinations of exclusion criteria.

The horizontal green bars show for how many women this exclusion criteria applies. The blue bars show how many women are excluded for multiple reasons (e.g., not finishing the initial survey and being pregnant). All 52 combinations of exclusion criteria are displayed.

upset2 = exclusion_reasons %>% 
  rename(`Breastfeeding` = breast_feeding, 
         `Choice of Contraceptive Methode` = contraceptive_method,
         `Missing Data` = didnt_finish_initial,
         `Incongruent Information about Contraceptive Method` =
           incongruent_information_about_hormonal_contraception,
         `(Post-)Menopausal` = menopausal,
         `Using no Contraceptive Methods for Other Reasons` = no_contraception,
         `Not Female` = not_female,
         `Not Predominantly Heterosexual` = not_heterosexual_female,
         `Older than 50` = older_than_50,
         `Pregnant` = pregnant,
         `“Taking a Chance” of Becoming Pregnant` = pregnant_chance,
         `Trying to Become Pregnant` = pregnant_trying,
         `Medication Including Sex Hormones` = sex_hormones,
         `Currently in a Homosexual Relationship` = non_heterosexual_relationship) %>%
  filter(included == 0) %>% 
  select(-included) %>% 
  as.data.frame() %>% 
  {
  upset(., ncol(.), 80, order.by = "freq",
      main.bar.color = "#6E8691",
      matrix.color = "#6E8691",
      sets.bar.color = "#53AC9B",
      text.scale = 1.2)
  }
upset2

jpeg('Exclusion criteria and all combinations of exclusion criteria.jpg', 
     width = 900, height = 500, quality = 1000)
upset2
dev.off()

## png 
##   2

Exlusion Steps Diary

To calculate Libido and Sexual Frequency we need Information from the diary. Therefore, two additional exlusion reasons for the diary apply:

• Skipping a diary day
• Dishonest answers on that day

diary = diary %>% left_join(all_surveys %>% select(session, reasons_for_exclusion), by = 'session')

Skipped this diary day (days after dropping out not included)

diary = diary %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                            if_else(is.na(ended_diary) & is.na(modified_diary),
                                                    "skipped_diary_entry, ", "")))

table(diary$reasons_for_exclusion %contains% "skipped_diary_entry")

## 
## FALSE  TRUE 
## 62043  1103

Disclosed that they responded dishonestly on that day.

diary = diary %>% 
  mutate(reasons_for_exclusion = str_c(reasons_for_exclusion,
                                            if_else(dishonest_discard == 1,
                                                    "dishonest_answer, ", "", "")))

table(diary$reasons_for_exclusion %contains% "dishonest_answer")

## 
## FALSE  TRUE 
## 62996   150

Create included variable

all_surveys = all_surveys %>%
  mutate(included = if_else(reasons_for_exclusion == "", TRUE, FALSE))

diary = diary %>%
  mutate(included = if_else(reasons_for_exclusion == "", TRUE, FALSE))

Save

library(testthat)
expect_equal(nrow(diary), diary_length)
expect_equal(nrow(all_surveys), all_survey_length)

save(diary, all_surveys, file = "data/cleaned_selected.rdata")