Robustness checks of ovulatory changes

Cycling women (not on hormonal birth control)

Women on hormonal birth control

Load data

# cd /usr/users/rarslan/relationship_dynamics/ && bsub -q mpi -W 48:00 -n 20 -R span[hosts=1] R -e "filebase = '3_fertility_robustness'; x = rmarkdown::render(paste0('3_fertility_robustness','.Rmd'), run_pandoc = FALSE, clean = FALSE); save(x, file = 'rob.rda'); cat(readLines(paste0(filebase,'.utf8.md')), sep = '\n')"
library(knitr)
opts_chunk$set(fig.width = 8, fig.height = 8, cache = T, warning = T, message = F, cache = F)
source("0_helpers.R")
load("full_data.rdata")
diary = diary %>% 
  mutate(
  included = included_all,
  fertile = if_else(is.na(prc_stirn_b_squished), prc_stirn_b_backward_inferred, prc_stirn_b_squished),
  contraceptive_methods = factor(contraceptive_method, levels = 
  c("barrier_or_abstinence", "fertility_awareness", "none",  "hormonal")),
  relationship_status_clean = factor(relationship_status_clean),
  cohabitation = factor(cohabitation),
  certainty_menstruation = as.numeric(as.character(certainty_menstruation)),
  partner_st_vs_lt = partner_attractiveness_shortterm - partner_attractiveness_longterm
)  %>% group_by(person) %>% 
  mutate(
      fertile_mean = mean(fertile, na.rm = T)
  )
opts_chunk$set(warning = F)
library(Cairo)
opts_chunk$set(dev = "CairoPNG")

diary$age_group = cut(diary$age,c(18,20,25,30,35,70), include.lowest = T)
models = list()

do_model = function(model, diary) {
  outcome = names(model@frame)[1]
  outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")
  model = calculate_effects(model)
  options = list(fig.path = paste0(knitr::opts_chunk$get("fig.path"), outcome, "-"), 
                                 cache.path = paste0(knitr::opts_chunk$get("cache.path"), outcome, "-"))
    asis_knit_child("_robustness_model.Rmd", options = options)
}
do_moderators = function(model, diary) {
  asis_knit_child("_moderators.Rmd")
}
models$extra_pair = lmer(extra_pair ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$desirability_1 = lmer(desirability_1 ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$extra_pair_intimacy = glmer(extra_pair_intimacy ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$extra_pair_sex = glmer(extra_pair_sex ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$in_pair_desire = lmer(in_pair_desire ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$had_petting = glmer(had_petting ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$had_sexual_intercourse = glmer(had_sexual_intercourse ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$partner_initiated_sexual_intercourse = glmer(partner_initiated_sexual_intercourse ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$sexual_intercourse_satisfaction = lmer(sexual_intercourse_satisfaction ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$spent_night_with_partner = glmer(spent_night_with_partner ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$partner_mate_retention = lmer(partner_mate_retention ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$female_mate_retention = lmer(female_mate_retention ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$sexy_clothes = lmer(sexy_clothes ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$showy_clothes = lmer(showy_clothes ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$male_attention_1 = lmer(male_attention_1 ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$in_pair_public_intimacy = glmer(in_pair_public_intimacy ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit"))
models$NARQ_admiration = lmer(NARQ_admiration ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$NARQ_rivalry = lmer(NARQ_rivalry ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$self_esteem_1 = lmer(self_esteem_1 ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$female_jealousy = lmer(female_jealousy ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$relationship_satisfaction_1 = lmer(relationship_satisfaction_1 ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
models$communication_partner_1 = lmer(communication_partner_1 ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary)
model_summaries = parallel::mclapply(models, FUN = do_model, diary = diary, mc.cores = 20)

Extra-pair

model_summaries$extra_pair

Model summary

Model summary

model %>% 
  print_summary()
Linear mixed model fit by REML 
t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
Formula: extra_pair ~ included * (menstruation + fertile) + fertile_mean +      (1 | person)
   Data: diary

REML criterion at convergence: 48549

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.286 -0.557 -0.148  0.405  8.007 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.311    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                      Estimate Std. Error         df t value   Pr(>|t|)    
(Intercept)                             1.8341     0.0470  1311.0000   39.06    < 2e-16 ***
includedhorm_contra                    -0.1181     0.0386  1259.0000   -3.06     0.0022 ** 
menstruationpre                        -0.0905     0.0173 25899.0000   -5.23 0.00000017 ***
menstruationyes                        -0.0713     0.0163 25993.0000   -4.37 0.00001240 ***
fertile                                 0.1730     0.0349 25894.0000    4.96 0.00000072 ***
fertile_mean                           -0.0558     0.2140  1421.0000   -0.26     0.7945    
includedhorm_contra:menstruationpre     0.0691     0.0222 25895.0000    3.11     0.0019 ** 
includedhorm_contra:menstruationyes     0.0858     0.0214 25974.0000    4.02 0.00005958 ***
includedhorm_contra:fertile            -0.1742     0.0442 25999.0000   -3.94 0.00008279 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.474                                                               
menstrutnpr             -0.140  0.179                                                        
menstrutnys             -0.138  0.173  0.398                                                 
fertile                 -0.135  0.222  0.467    0.385                                        
fertile_men             -0.772 -0.024 -0.008   -0.005   -0.059                               
inclddhrm_cntr:mnstrtnp  0.116 -0.224 -0.779   -0.310   -0.363 -0.003                        
inclddhrm_cntr:mnstrtny  0.110 -0.212 -0.304   -0.763   -0.293 -0.003  0.384                 
inclddhrm_cntr:f         0.135 -0.280 -0.368   -0.303   -0.787  0.010  0.467                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.382                 

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.31 [0.18;0.43].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ included + menstruation + fertile + fertile_mean +  
    (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

REML criterion at convergence: 48206

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.748 -0.550 -0.137  0.390  7.911 

Random effects:
 Groups   Name            Variance Std.Dev. Corr             
 person   (Intercept)     0.3328   0.577                     
          fertile         0.2900   0.538    -0.18            
          menstruationpre 0.0442   0.210    -0.29  0.43      
          menstruationyes 0.0672   0.259    -0.26  0.57  0.77
 Residual                 0.3029   0.550                     
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error t value
(Intercept)                           1.8464     0.0479    38.6
includedhorm_contra                  -0.1239     0.0399    -3.1
menstruationpre                      -0.0992     0.0208    -4.8
menstruationyes                      -0.0770     0.0216    -3.6
fertile                               0.1619     0.0459     3.5
fertile_mean                         -0.0983     0.2175    -0.5
includedhorm_contra:menstruationpre   0.0786     0.0267     2.9
includedhorm_contra:menstruationyes   0.0938     0.0281     3.3
includedhorm_contra:fertile          -0.1620     0.0583    -2.8

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.481                                                               
menstrutnpr             -0.214  0.258                                                        
menstrutnys             -0.204  0.251  0.530                                                 
fertile                 -0.164  0.257  0.443    0.458                                        
fertile_men             -0.764 -0.025 -0.001   -0.007   -0.064                               
inclddhrm_cntr:mnstrtnp  0.173 -0.327 -0.779   -0.412   -0.344 -0.007                        
inclddhrm_cntr:mnstrtny  0.164 -0.314 -0.407   -0.769   -0.352 -0.004  0.520                 
inclddhrm_cntr:f         0.159 -0.325 -0.348   -0.360   -0.784  0.011  0.443                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.455                 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
object 11 48522 48612 -24250 48500 NA NA NA
..1 20 48199 48362 -24079 48159 341.2 9 4.584e-68
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Linear mixed model fit by REML ['lmerMod']

REML criterion at convergence: 43998

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.439 -0.556 -0.143  0.402  8.138 

Random effects:
 Groups   Name                                   Variance Std.Dev.
 person   (Intercept)                            0.3144   0.561   
 Xr.2     s(days_filled_out):includedhorm_contra 0.0722   0.269   
 Xr.1     s(days_filled_out):includedcycling     0.0159   0.126   
 Xr.0     s(day_number):includedhorm_contra      0.0013   0.036   
 Xr       s(day_number):includedcycling          0.0000   0.000   
 Residual                                        0.3124   0.559   
Number of obs: 24377, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error t value
X(Intercept)                                 1.8261     0.0473    38.6
Xincludedhorm_contra                        -0.1081     0.0391    -2.8
Xmenstruationpre                            -0.0925     0.0179    -5.2
Xmenstruationyes                            -0.0678     0.0172    -4.0
Xfertile                                     0.1764     0.0368     4.8
Xfertile_mean                               -0.0893     0.2147    -0.4
Xincludedhorm_contra:menstruationpre         0.0748     0.0229     3.3
Xincludedhorm_contra:menstruationyes         0.0865     0.0225     3.9
Xincludedhorm_contra:fertile                -0.1772     0.0466    -3.8
Xs(day_number):includedcyclingFx1            0.0683     0.0297     2.3
Xs(day_number):includedhorm_contraFx1        0.0694     0.0306     2.3
Xs(days_filled_out):includedcyclingFx1      -0.1257     0.0474    -2.7
Xs(days_filled_out):includedhorm_contraFx1  -0.2013     0.0612    -3.3

Family: gaussian 
Link function: identity 

Formula:
extra_pair ~ included + menstruation + fertile + fertile_mean + 
    s(day_number, by = included) + s(days_filled_out, by = included) + 
    included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error t value   Pr(>|t|)    
(Intercept)                           1.8261     0.0473   38.59    < 2e-16 ***
includedhorm_contra                  -0.1081     0.0391   -2.76    0.00573 ** 
menstruationpre                      -0.0925     0.0179   -5.18 0.00000022 ***
menstruationyes                      -0.0678     0.0172   -3.95 0.00007773 ***
fertile                               0.1764     0.0368    4.80 0.00000163 ***
fertile_mean                         -0.0893     0.2147   -0.42    0.67753    
includedhorm_contra:menstruationpre   0.0748     0.0229    3.26    0.00110 ** 
includedhorm_contra:menstruationyes   0.0865     0.0225    3.85    0.00012 ***
includedhorm_contra:fertile          -0.1772     0.0466   -3.80    0.00014 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df    F p-value   
s(day_number):includedcycling          1.00   1.00 5.28  0.0216 * 
s(day_number):includedhorm_contra      1.38   1.38 5.84  0.0162 * 
s(days_filled_out):includedcycling     3.48   3.48 2.97  0.0150 * 
s(days_filled_out):includedhorm_contra 5.44   5.44 3.18  0.0036 **
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

R-sq.(adj) =  0.00548   
lmer.REML =  43998  Scale est. = 0.31242   n = 24377

Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  46934 47033 -23455

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.5537    0.576

Correlation Structure: ARMA(1,0)
 Formula: ~day_number | person 
 Parameter estimate(s):
  Phi1 
0.3069 
Fixed effects: extra_pair ~ included * (menstruation + fertile) + fertile_mean 
                                      Value Std.Error    DF t-value p-value
(Intercept)                          1.8428   0.04799 25620   38.40  0.0000
includedhorm_contra                 -0.1181   0.03956  1051   -2.99  0.0029
menstruationpre                     -0.0883   0.02017 25620   -4.38  0.0000
menstruationyes                     -0.0684   0.01883 25620   -3.63  0.0003
fertile                              0.1774   0.04304 25620    4.12  0.0000
fertile_mean                        -0.0722   0.21899  1051   -0.33  0.7417
includedhorm_contra:menstruationpre  0.0726   0.02591 25620    2.80  0.0051
includedhorm_contra:menstruationyes  0.0843   0.02454 25620    3.43  0.0006
includedhorm_contra:fertile         -0.1731   0.05447 25620   -3.18  0.0015
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.477                                                               
menstruationpre                     -0.159  0.200                                                        
menstruationyes                     -0.156  0.195  0.404                                                 
fertile                             -0.153  0.255  0.425    0.360                                        
fertile_mean                        -0.769 -0.024 -0.008   -0.006   -0.073                               
includedhorm_contra:menstruationpre  0.130 -0.249 -0.778   -0.314   -0.330 -0.003                        
includedhorm_contra:menstruationyes  0.125 -0.238 -0.310   -0.767   -0.275 -0.002  0.389                 
includedhorm_contra:fertile          0.155 -0.322 -0.335   -0.284   -0.787  0.013  0.424                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.353                 

Standardized Within-Group Residuals:
    Min      Q1     Med      Q3     Max 
-4.2860 -0.5602 -0.1651  0.3831  7.8217 

Number of Observations: 26680
Number of Groups: 1054 
Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  46632 46739 -23303

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.5397    0.587

Correlation Structure: ARMA(1,1)
 Formula: ~day_number | person 
 Parameter estimate(s):
   Phi1  Theta1 
 0.7473 -0.4957 
Fixed effects: extra_pair ~ included * (menstruation + fertile) + fertile_mean 
                                      Value Std.Error    DF t-value p-value
(Intercept)                          1.8380   0.04804 25620   38.26  0.0000
includedhorm_contra                 -0.1123   0.03956  1051   -2.84  0.0046
menstruationpre                     -0.0769   0.02024 25620   -3.80  0.0001
menstruationyes                     -0.0622   0.01928 25620   -3.23  0.0013
fertile                              0.1790   0.04556 25620    3.93  0.0001
fertile_mean                        -0.0607   0.21991  1051   -0.28  0.7827
includedhorm_contra:menstruationpre  0.0606   0.02603 25620    2.33  0.0200
includedhorm_contra:menstruationyes  0.0702   0.02501 25620    2.81  0.0050
includedhorm_contra:fertile         -0.1853   0.05757 25620   -3.22  0.0013
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.475                                                               
menstruationpre                     -0.156  0.193                                                        
menstruationyes                     -0.160  0.199  0.435                                                 
fertile                             -0.151  0.258  0.353    0.337                                        
fertile_mean                        -0.769 -0.027 -0.003   -0.005   -0.079                               
includedhorm_contra:menstruationpre  0.126 -0.240 -0.778   -0.338   -0.274 -0.003                        
includedhorm_contra:menstruationyes  0.128 -0.243 -0.335   -0.771   -0.260 -0.002  0.423                 
includedhorm_contra:fertile          0.156 -0.326 -0.279   -0.267   -0.788  0.014  0.352                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.331                 

Standardized Within-Group Residuals:
    Min      Q1     Med      Q3     Max 
-4.0438 -0.5614 -0.1852  0.3752  7.7061 

Number of Observations: 26680
Number of Groups: 1054 

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

REML criterion at convergence: 30418

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.348 -0.557 -0.148  0.408  8.097 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.320    0.566   
 Residual             0.313    0.560   
Number of obs: 17026, groups:  person, 513

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                               1.909422   0.106971   17.85
fertile_mean                                             -0.111294   0.522029   -0.21
contraceptive_methodsfertility_awareness                 -0.100940   0.137287   -0.74
contraceptive_methodsnone                                -0.224004   0.145421   -1.54
contraceptive_methodshormonal                            -0.168364   0.069287   -2.43
fertile                                                   0.053678   0.062481    0.86
menstruationpre                                          -0.085755   0.030170   -2.84
menstruationyes                                          -0.038498   0.028824   -1.34
contraceptive_methodsfertility_awareness:fertile          0.246743   0.141881    1.74
contraceptive_methodsnone:fertile                         0.102445   0.153584    0.67
contraceptive_methodshormonal:fertile                    -0.063479   0.069805   -0.91
contraceptive_methodsfertility_awareness:menstruationpre  0.034951   0.066824    0.52
contraceptive_methodsnone:menstruationpre                 0.136851   0.069882    1.96
contraceptive_methodshormonal:menstruationpre             0.065769   0.033986    1.94
contraceptive_methodsfertility_awareness:menstruationyes  0.052088   0.067166    0.78
contraceptive_methodsnone:menstruationyes                -0.000944   0.073064   -0.01
contraceptive_methodshormonal:menstruationyes             0.058055   0.032875    1.77

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 13 30386 30486 -15180 30360 NA NA NA
by_method 19 30390 30537 -15176 30352 7.983 6 0.2393

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 19 48529 48685 -24246 48491 NA NA NA
with_mod 27 48538 48759 -24242 48484 7.088 8 0.5271

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + age_group +  
    included + fertile + menstruation:included + age_group:included +  
    age_group:fertile + included:fertile + age_group:included:fertile
   Data: diary

REML criterion at convergence: 48582

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.291 -0.558 -0.150  0.403  8.014 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.312    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                   1.93884    0.09945   19.50
menstruationpre                              -0.09068    0.01730   -5.24
menstruationyes                              -0.07085    0.01632   -4.34
fertile_mean                                 -0.06982    0.21501   -0.32
age_group(20,25]                             -0.06427    0.10683   -0.60
age_group(25,30]                             -0.11225    0.10994   -1.02
age_group(30,35]                             -0.16170    0.12618   -1.28
age_group(35,70]                             -0.16834    0.11428   -1.47
includedhorm_contra                          -0.16358    0.10693   -1.53
fertile                                       0.11427    0.09980    1.14
menstruationpre:includedhorm_contra           0.06902    0.02221    3.11
menstruationyes:includedhorm_contra           0.08532    0.02139    3.99
age_group(20,25]:includedhorm_contra         -0.00928    0.12193   -0.08
age_group(25,30]:includedhorm_contra          0.00784    0.13421    0.06
age_group(30,35]:includedhorm_contra          0.27792    0.17496    1.59
age_group(35,70]:includedhorm_contra         -0.04939    0.19007   -0.26
age_group(20,25]:fertile                      0.08241    0.11058    0.75
age_group(25,30]:fertile                      0.08950    0.11397    0.79
age_group(30,35]:fertile                      0.09521    0.13203    0.72
age_group(35,70]:fertile                     -0.01630    0.11912   -0.14
includedhorm_contra:fertile                  -0.13051    0.11070   -1.18
age_group(20,25]:includedhorm_contra:fertile -0.04290    0.12387   -0.35
age_group(25,30]:includedhorm_contra:fertile -0.06894    0.13727   -0.50
age_group(30,35]:includedhorm_contra:fertile -0.30204    0.17720   -1.70
age_group(35,70]:includedhorm_contra:fertile  0.04258    0.20127    0.21

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48521 48627 -24247 48495 NA NA NA
with_mod 15 48522 48645 -24246 48492 2.498 2 0.2868

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + weekend +  
    included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

REML criterion at convergence: 48564

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.281 -0.558 -0.147  0.403  8.015 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.311    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error t value
(Intercept)                              1.83014    0.04737    38.6
menstruationpre                         -0.09047    0.01730    -5.2
menstruationyes                         -0.07133    0.01630    -4.4
fertile_mean                            -0.05361    0.21407    -0.3
weekendTRUE                              0.00853    0.01506     0.6
includedhorm_contra                     -0.11819    0.03936    -3.0
fertile                                  0.19329    0.04245     4.6
menstruationpre:includedhorm_contra      0.06887    0.02221     3.1
menstruationyes:includedhorm_contra      0.08598    0.02137     4.0
weekendTRUE:includedhorm_contra          0.00138    0.01939     0.1
weekendTRUE:fertile                     -0.04901    0.05842    -0.8
includedhorm_contra:fertile             -0.22048    0.05396    -4.1
weekendTRUE:includedhorm_contra:fertile  0.11050    0.07431     1.5

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 23 48449 48637 -24201 48403 NA NA NA
with_mod 35 48463 48750 -24196 48393 9.71 12 0.6414

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + weekday +  
    included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

REML criterion at convergence: 48559

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.271 -0.556 -0.146  0.401  8.109 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.311    0.558   
 Residual             0.319    0.565   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                   1.78818    0.05011    35.7
menstruationpre                              -0.09011    0.01727    -5.2
menstruationyes                              -0.07092    0.01628    -4.4
fertile_mean                                 -0.04487    0.21399    -0.2
weekdayTuesday                                0.05583    0.02691     2.1
weekdayWednesday                              0.04687    0.02687     1.7
weekdayThursday                               0.05778    0.02717     2.1
weekdayFriday                                 0.09984    0.02763     3.6
weekdaySaturday                               0.03339    0.02791     1.2
weekdaySunday                                 0.01445    0.02697     0.5
includedhorm_contra                          -0.12066    0.04459    -2.7
fertile                                       0.16868    0.07581     2.2
menstruationpre:includedhorm_contra           0.06754    0.02217     3.0
menstruationyes:includedhorm_contra           0.08425    0.02134     3.9
weekdayTuesday:includedhorm_contra           -0.03651    0.03457    -1.1
weekdayWednesday:includedhorm_contra          0.01248    0.03469     0.4
weekdayThursday:includedhorm_contra           0.04092    0.03502     1.2
weekdayFriday:includedhorm_contra            -0.01177    0.03550    -0.3
weekdaySaturday:includedhorm_contra           0.02035    0.03591     0.6
weekdaySunday:includedhorm_contra             0.00398    0.03481     0.1
weekdayTuesday:fertile                       -0.04163    0.10435    -0.4
weekdayWednesday:fertile                      0.06512    0.10483     0.6
weekdayThursday:fertile                       0.08043    0.10634     0.8
weekdayFriday:fertile                        -0.06118    0.10651    -0.6
weekdaySaturday:fertile                       0.07491    0.10793     0.7
weekdaySunday:fertile                        -0.08792    0.10489    -0.8
includedhorm_contra:fertile                  -0.25876    0.09698    -2.7
weekdayTuesday:includedhorm_contra:fertile    0.15258    0.13318     1.1
weekdayWednesday:includedhorm_contra:fertile -0.01241    0.13423    -0.1
weekdayThursday:includedhorm_contra:fertile  -0.00634    0.13533     0.0
weekdayFriday:includedhorm_contra:fertile     0.15357    0.13573     1.1
weekdaySaturday:includedhorm_contra:fertile   0.03271    0.13768     0.2
weekdaySunday:includedhorm_contra:fertile     0.25461    0.13398     1.9

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 48521 48661 -24244 48487 NA NA NA
with_mod 23 48520 48708 -24237 48474 13.28 6 0.03882

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + included_levels +  
    included + fertile + menstruation:included + included_levels:included +  
    included_levels:fertile + included:fertile + included_levels:included:fertile
   Data: diary

REML criterion at convergence: 48564

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.295 -0.557 -0.149  0.405  7.997 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.309    0.556   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error t value
(Intercept)                                               1.8208     0.0520    35.0
menstruationpre                                          -0.0929     0.0173    -5.4
menstruationyes                                          -0.0726     0.0163    -4.5
fertile_mean                                             -0.1052     0.2150    -0.5
included_levelslax                                        0.2646     0.1091     2.4
included_levelsconservative                               0.0033     0.0851     0.0
included_levelsstrict                                    -0.0132     0.0838    -0.2
includedhorm_contra                                      -0.1287     0.0537    -2.4
fertile                                                   0.2588     0.0441     5.9
menstruationpre:includedhorm_contra                       0.0707     0.0222     3.2
menstruationyes:includedhorm_contra                       0.0863     0.0214     4.0
included_levelslax:includedhorm_contra                   -0.0887     0.1326    -0.7
included_levelsconservative:includedhorm_contra           0.0177     0.1061     0.2
included_levelsstrict:includedhorm_contra                 0.0245     0.1027     0.2
included_levelslax:fertile                               -0.0720     0.1077    -0.7
included_levelsconservative:fertile                      -0.1942     0.0804    -2.4
included_levelsstrict:fertile                            -0.2427     0.0805    -3.0
includedhorm_contra:fertile                              -0.2152     0.0675    -3.2
included_levelslax:includedhorm_contra:fertile            0.0124     0.1315     0.1
included_levelsconservative:includedhorm_contra:fertile   0.1526     0.1047     1.5
included_levelsstrict:includedhorm_contra:fertile         0.1712     0.1031     1.7

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 48523 48662 -24245 48489 NA NA NA
with_mod 23 48529 48717 -24241 48483 6.535 6 0.366

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + cycle_length_groups +  
    included + fertile + menstruation:included + cycle_length_groups:included +  
    cycle_length_groups:fertile + included:fertile + cycle_length_groups:included:fertile
   Data: diary

REML criterion at convergence: 48565

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.315 -0.557 -0.147  0.405  8.013 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.31     0.557   
 Residual             0.32     0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                       Estimate Std. Error t value
(Intercept)                                              2.0444     0.0905   22.58
menstruationpre                                         -0.0898     0.0173   -5.18
menstruationyes                                         -0.0704     0.0164   -4.29
fertile_mean                                            -0.0900     0.2163   -0.42
cycle_length_groups(25,30]                              -0.2172     0.0892   -2.43
cycle_length_groups(30,35]                              -0.3113     0.1075   -2.90
cycle_length_groups(35,41]                              -0.1933     0.1522   -1.27
includedhorm_contra                                     -0.3802     0.1013   -3.75
fertile                                                  0.1292     0.0922    1.40
menstruationpre:includedhorm_contra                      0.0692     0.0222    3.11
menstruationyes:includedhorm_contra                      0.0859     0.0215    3.99
cycle_length_groups(25,30]:includedhorm_contra           0.2873     0.1102    2.61
cycle_length_groups(30,35]:includedhorm_contra           0.3122     0.1696    1.84
cycle_length_groups(35,41]:includedhorm_contra           0.2863     0.2165    1.32
cycle_length_groups(25,30]:fertile                       0.0698     0.0989    0.71
cycle_length_groups(30,35]:fertile                      -0.0060     0.1171   -0.05
cycle_length_groups(35,41]:fertile                      -0.0317     0.1654   -0.19
includedhorm_contra:fertile                             -0.1215     0.1088   -1.12
cycle_length_groups(25,30]:includedhorm_contra:fertile  -0.0625     0.1172   -0.53
cycle_length_groups(30,35]:includedhorm_contra:fertile  -0.2281     0.1843   -1.24
cycle_length_groups(35,41]:includedhorm_contra:fertile  -0.1442     0.2177   -0.66

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48526 48632 -24250 48500 NA NA NA
with_mod 15 48526 48649 -24248 48496 3.154 2 0.2066

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + certainty_menstruation +  
    included + fertile + menstruation:included + certainty_menstruation:included +  
    certainty_menstruation:fertile + included:fertile + certainty_menstruation:included:fertile
   Data: diary

REML criterion at convergence: 48567

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.283 -0.557 -0.149  0.405  8.005 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.312    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error t value
(Intercept)                                         1.91365    0.13419   14.26
menstruationpre                                    -0.08973    0.01731   -5.18
menstruationyes                                    -0.07006    0.01633   -4.29
fertile_mean                                       -0.04686    0.21453   -0.22
certainty_menstruation                             -0.01977    0.03060   -0.65
includedhorm_contra                                -0.13841    0.17044   -0.81
fertile                                            -0.01189    0.13743   -0.09
menstruationpre:includedhorm_contra                 0.06836    0.02221    3.08
menstruationyes:includedhorm_contra                 0.08506    0.02140    3.98
certainty_menstruation:includedhorm_contra          0.00547    0.03972    0.14
certainty_menstruation:fertile                      0.04479    0.03220    1.39
includedhorm_contra:fertile                        -0.11161    0.17865   -0.62
certainty_menstruation:includedhorm_contra:fertile -0.01628    0.04129   -0.39

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 48529 48652 -24250 48499 NA NA NA
with_mod 19 48535 48691 -24249 48497 1.985 4 0.7385

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + cycle_regularity +  
    included + fertile + menstruation:included + cycle_regularity:included +  
    cycle_regularity:fertile + included:fertile + cycle_regularity:included:fertile
   Data: diary

REML criterion at convergence: 48574

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.286 -0.557 -0.148  0.405  8.010 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.313    0.559   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                                  Estimate Std. Error t value
(Intercept)                                                                        1.81624    0.05568    32.6
menstruationpre                                                                   -0.08972    0.01731    -5.2
menstruationyes                                                                   -0.07072    0.01631    -4.3
fertile_mean                                                                      -0.05723    0.21551    -0.3
cycle_regularityslightly irregular,\nup to 5 days off                              0.04439    0.06549     0.7
cycle_regularityirregular,\nmore than 5 days off                                   0.01462    0.07676     0.2
includedhorm_contra                                                               -0.10276    0.05096    -2.0
fertile                                                                            0.21712    0.04834     4.5
menstruationpre:includedhorm_contra                                                0.06826    0.02222     3.1
menstruationyes:includedhorm_contra                                                0.08518    0.02139     4.0
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra         -0.03353    0.09903    -0.3
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra               0.00369    0.11691     0.0
cycle_regularityslightly irregular,\nup to 5 days off:fertile                     -0.06645    0.06670    -1.0
cycle_regularityirregular,\nmore than 5 days off:fertile                          -0.10303    0.08205    -1.3
includedhorm_contra:fertile                                                       -0.21766    0.05665    -3.8
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile  0.05207    0.09901     0.5
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile       0.11767    0.12247     1.0

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 48518 48641 -24244 48488 NA NA NA
with_mod 19 48513 48668 -24237 48475 13.7 4 0.008322

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + cohabitation +  
    included + fertile + menstruation:included + cohabitation:included +  
    cohabitation:fertile + included:fertile + cohabitation:included:fertile
   Data: diary

REML criterion at convergence: 48554

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.283 -0.559 -0.148  0.401  8.003 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.309    0.556   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                                 1.7652     0.0537    32.9
menstruationpre                                            -0.0911     0.0173    -5.3
menstruationyes                                            -0.0726     0.0163    -4.5
fertile_mean                                               -0.0594     0.2138    -0.3
cohabitationLive in same city                               0.1739     0.0739     2.4
cohabitationLong-distance                                   0.1390     0.0696     2.0
includedhorm_contra                                        -0.1164     0.0581    -2.0
fertile                                                     0.1797     0.0436     4.1
menstruationpre:includedhorm_contra                         0.0694     0.0222     3.1
menstruationyes:includedhorm_contra                         0.0868     0.0214     4.1
cohabitationLive in same city:includedhorm_contra          -0.0730     0.0944    -0.8
cohabitationLong-distance:includedhorm_contra              -0.0424     0.0903    -0.5
cohabitationLive in same city:fertile                      -0.2051     0.0798    -2.6
cohabitationLong-distance:fertile                           0.1220     0.0718     1.7
includedhorm_contra:fertile                                -0.1976     0.0638    -3.1
cohabitationLive in same city:includedhorm_contra:fertile   0.2510     0.0997     2.5
cohabitationLong-distance:includedhorm_contra:fertile      -0.1201     0.0925    -1.3

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 48526 48649 -24248 48496 NA NA NA
with_mod 19 48532 48688 -24247 48494 2.144 4 0.7094

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + relationship_status_clean +  
    included + fertile + menstruation:included + relationship_status_clean:included +  
    relationship_status_clean:fertile + included:fertile + relationship_status_clean:included:fertile
   Data: diary

REML criterion at convergence: 48564

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.286 -0.557 -0.148  0.404  8.007 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.311    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                 Estimate Std. Error t value
(Intercept)                                                       1.85781    0.05042    36.8
menstruationpre                                                  -0.09044    0.01730    -5.2
menstruationyes                                                  -0.07123    0.01631    -4.4
fertile_mean                                                     -0.06836    0.21431    -0.3
relationship_status_cleanVerheiratet                             -0.06524    0.06768    -1.0
relationship_status_cleanVerlobt                                 -0.11395    0.13136    -0.9
includedhorm_contra                                              -0.13205    0.04333    -3.0
fertile                                                           0.18451    0.03998     4.6
menstruationpre:includedhorm_contra                               0.06911    0.02221     3.1
menstruationyes:includedhorm_contra                               0.08593    0.02138     4.0
relationship_status_cleanVerheiratet:includedhorm_contra          0.01591    0.13060     0.1
relationship_status_cleanVerlobt:includedhorm_contra             -0.07588    0.19324    -0.4
relationship_status_cleanVerheiratet:fertile                     -0.04634    0.07039    -0.7
relationship_status_cleanVerlobt:fertile                         -0.00095    0.13203     0.0
includedhorm_contra:fertile                                      -0.18286    0.04875    -3.8
relationship_status_cleanVerheiratet:includedhorm_contra:fertile -0.07167    0.13255    -0.5
relationship_status_cleanVerlobt:includedhorm_contra:fertile      0.11659    0.20500     0.6
do_moderators(models$extra_pair, diary)

Moderators

Partner’s physical attractiveness

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) when partner’s physical attractiveness is low.

model %>%
  test_moderator("partner_attractiveness_physical", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48494 48601 -24234 48468 NA NA NA
with_mod 15 48494 48617 -24232 48464 4.093 2 0.1292

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_physical +  
    included + fertile + menstruation:included + partner_attractiveness_physical:included +  
    partner_attractiveness_physical:fertile + included:fertile +  
    partner_attractiveness_physical:included:fertile
   Data: diary

REML criterion at convergence: 48539

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.283 -0.556 -0.148  0.406  8.003 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.303    0.550   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                            Estimate Std. Error t value
(Intercept)                                                   2.4697     0.1448   17.06
menstruationpre                                              -0.0903     0.0173   -5.22
menstruationyes                                              -0.0714     0.0163   -4.38
fertile_mean                                                 -0.0379     0.2117   -0.18
partner_attractiveness_physical                              -0.0807     0.0174   -4.65
includedhorm_contra                                          -0.4750     0.1897   -2.50
fertile                                                       0.4299     0.1524    2.82
menstruationpre:includedhorm_contra                           0.0691     0.0222    3.11
menstruationyes:includedhorm_contra                           0.0861     0.0214    4.03
partner_attractiveness_physical:includedhorm_contra           0.0462     0.0231    2.00
partner_attractiveness_physical:fertile                      -0.0323     0.0187   -1.73
includedhorm_contra:fertile                                  -0.2947     0.2016   -1.46
partner_attractiveness_physical:includedhorm_contra:fertile   0.0158     0.0244    0.65

Partner’s short-term attractiveness

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) when partner’s short-term attractiveness is low.

model %>%
  test_moderator("partner_attractiveness_shortterm", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48499 48606 -24237 48473 NA NA NA
with_mod 15 48499 48622 -24235 48469 4.184 2 0.1234

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_shortterm +  
    included + fertile + menstruation:included + partner_attractiveness_shortterm:included +  
    partner_attractiveness_shortterm:fertile + included:fertile +  
    partner_attractiveness_shortterm:included:fertile
   Data: diary

REML criterion at convergence: 48540

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.286 -0.556 -0.148  0.404  8.006 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.305    0.552   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                             Estimate Std. Error t value
(Intercept)                                                    1.8176     0.0467    38.9
menstruationpre                                               -0.0905     0.0173    -5.2
menstruationyes                                               -0.0715     0.0163    -4.4
fertile_mean                                                  -0.0393     0.2123    -0.2
partner_attractiveness_shortterm                              -0.1135     0.0274    -4.1
includedhorm_contra                                           -0.0987     0.0384    -2.6
fertile                                                        0.1676     0.0350     4.8
menstruationpre:includedhorm_contra                            0.0692     0.0222     3.1
menstruationyes:includedhorm_contra                            0.0862     0.0214     4.0
partner_attractiveness_shortterm:includedhorm_contra           0.0578     0.0369     1.6
partner_attractiveness_shortterm:fertile                      -0.0567     0.0293    -1.9
includedhorm_contra:fertile                                   -0.1662     0.0445    -3.7
partner_attractiveness_shortterm:includedhorm_contra:fertile   0.0402     0.0384     1.0

Partner’s short-term vs. long-term attractiveness

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) top-right (high LT, low ST), then top-left (low LT, low ST), then bottom-left (low LT, high ST), then bottom-right (high LT/ST).

add_main = update.formula(formula(model), new = as.formula(paste0(". ~ . + partner_attractiveness_longterm * included + partner_attractiveness_shortterm * included + partner_attractiveness_longterm * partner_attractiveness_shortterm"))) # reorder so that the triptych looks nice
add_mod_formula = update.formula(update.formula(formula(model), new = . ~ . - included * fertile), new = as.formula(paste0(". ~ . + partner_attractiveness_longterm * fertile * partner_attractiveness_shortterm * included"))) # reorder so that the triptych looks nice

update(model, formula = add_main) -> with_main
update(model, formula = add_mod_formula) -> with_mod
cat(pander(anova(with_main, with_mod)))

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 48448 48579 -24208 48416 NA NA NA
with_mod 23 48446 48634 -24200 48400 15.96 7 0.02553
effs = allEffects(with_mod)
effs = data.frame(effs$`partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:included`) %>% 
  filter(partner_attractiveness_longterm %in% c(-2,0),partner_attractiveness_shortterm %in% c(-2,0))
ggplot(effs, aes(fertile, fit, ymin = lower, ymax = upper, color = included)) + 
  facet_grid(partner_attractiveness_shortterm ~ partner_attractiveness_longterm) +
  geom_smooth(stat='identity') +
  scale_color_manual(values = c("cycling" = 'red', 'horm_contra' = 'black'), guide = F) +
  scale_fill_manual(values = c("cycling" = 'red', 'horm_contra' = 'black'), guide = F) +
  ggtitle("Moderation", "top-to-bottom: short-term,\nleft-to-right: long-term attractiveness of the partner")+
  ylab(names(model@frame)[1])

print_summary(with_mod)
Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_longterm +  
    fertile + partner_attractiveness_shortterm + included + menstruation:included +  
    partner_attractiveness_longterm:fertile + partner_attractiveness_longterm:partner_attractiveness_shortterm +  
    fertile:partner_attractiveness_shortterm + partner_attractiveness_longterm:included +  
    fertile:included + partner_attractiveness_shortterm:included +  
    partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm +  
    partner_attractiveness_longterm:fertile:included + partner_attractiveness_longterm:partner_attractiveness_shortterm:included +  
    fertile:partner_attractiveness_shortterm:included + partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:included
   Data: diary

REML criterion at convergence: 48514

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.285 -0.557 -0.148  0.403  7.987 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.289    0.537   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                                             Estimate
(Intercept)                                                                                   1.81689
menstruationpre                                                                              -0.08939
menstruationyes                                                                              -0.06950
fertile_mean                                                                                 -0.08072
partner_attractiveness_longterm                                                              -0.13238
fertile                                                                                       0.16947
partner_attractiveness_shortterm                                                             -0.04705
includedhorm_contra                                                                          -0.09586
menstruationpre:includedhorm_contra                                                           0.06851
menstruationyes:includedhorm_contra                                                           0.08475
partner_attractiveness_longterm:fertile                                                       0.06901
partner_attractiveness_longterm:partner_attractiveness_shortterm                              0.03371
fertile:partner_attractiveness_shortterm                                                     -0.08784
partner_attractiveness_longterm:includedhorm_contra                                          -0.02470
fertile:includedhorm_contra                                                                  -0.17245
partner_attractiveness_shortterm:includedhorm_contra                                          0.02739
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm                     -0.01932
partner_attractiveness_longterm:fertile:includedhorm_contra                                  -0.00301
partner_attractiveness_longterm:partner_attractiveness_shortterm:includedhorm_contra          0.00761
fertile:partner_attractiveness_shortterm:includedhorm_contra                                  0.05629
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:includedhorm_contra  0.02688
                                                                                             Std. Error
(Intercept)                                                                                     0.04690
menstruationpre                                                                                 0.01729
menstruationyes                                                                                 0.01632
fertile_mean                                                                                    0.20816
partner_attractiveness_longterm                                                                 0.03233
fertile                                                                                         0.03654
partner_attractiveness_shortterm                                                                0.02979
includedhorm_contra                                                                             0.03937
menstruationpre:includedhorm_contra                                                             0.02220
menstruationyes:includedhorm_contra                                                             0.02138
partner_attractiveness_longterm:fertile                                                         0.03534
partner_attractiveness_longterm:partner_attractiveness_shortterm                                0.02380
fertile:partner_attractiveness_shortterm                                                        0.03203
partner_attractiveness_longterm:includedhorm_contra                                             0.04123
fertile:includedhorm_contra                                                                     0.04607
partner_attractiveness_shortterm:includedhorm_contra                                            0.03886
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm                        0.02617
partner_attractiveness_longterm:fertile:includedhorm_contra                                     0.04481
partner_attractiveness_longterm:partner_attractiveness_shortterm:includedhorm_contra            0.03716
fertile:partner_attractiveness_shortterm:includedhorm_contra                                    0.04106
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:includedhorm_contra    0.04051
                                                                                             t value
(Intercept)                                                                                     38.7
menstruationpre                                                                                 -5.2
menstruationyes                                                                                 -4.3
fertile_mean                                                                                    -0.4
partner_attractiveness_longterm                                                                 -4.1
fertile                                                                                          4.6
partner_attractiveness_shortterm                                                                -1.6
includedhorm_contra                                                                             -2.4
menstruationpre:includedhorm_contra                                                              3.1
menstruationyes:includedhorm_contra                                                              4.0
partner_attractiveness_longterm:fertile                                                          2.0
partner_attractiveness_longterm:partner_attractiveness_shortterm                                 1.4
fertile:partner_attractiveness_shortterm                                                        -2.7
partner_attractiveness_longterm:includedhorm_contra                                             -0.6
fertile:includedhorm_contra                                                                     -3.7
partner_attractiveness_shortterm:includedhorm_contra                                             0.7
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm                        -0.7
partner_attractiveness_longterm:fertile:includedhorm_contra                                     -0.1
partner_attractiveness_longterm:partner_attractiveness_shortterm:includedhorm_contra             0.2
fertile:partner_attractiveness_shortterm:includedhorm_contra                                     1.4
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:includedhorm_contra     0.7

Relative attractiveness to self

whole MV and MV_P scale

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) when partner’s relative attractiveness is low.

three item subsets of the MV/MV_P scale
model %>%
  test_moderator("partner_attractiveness_rel_to_self_MV_short", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48525 48632 -24250 48499 NA NA NA
with_mod 15 48528 48651 -24249 48498 1.305 2 0.5207

Linear mixed model fit by REML ['lmerMod']
Formula: 
extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_rel_to_self_MV_short +  
    included + fertile + menstruation:included + partner_attractiveness_rel_to_self_MV_short:included +  
    partner_attractiveness_rel_to_self_MV_short:fertile + included:fertile +  
    partner_attractiveness_rel_to_self_MV_short:included:fertile
   Data: diary

REML criterion at convergence: 48567

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.291 -0.557 -0.149  0.404  8.014 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.312    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                        Estimate Std. Error t value
(Intercept)                                                               1.8428     0.0529    34.8
menstruationpre                                                          -0.0905     0.0173    -5.2
menstruationyes                                                          -0.0709     0.0163    -4.3
fertile_mean                                                             -0.0579     0.2143    -0.3
partner_attractiveness_rel_to_self_MV_short                               0.0243     0.0678     0.4
includedhorm_contra                                                      -0.1229     0.0454    -2.7
fertile                                                                   0.1950     0.0415     4.7
menstruationpre:includedhorm_contra                                       0.0690     0.0222     3.1
menstruationyes:includedhorm_contra                                       0.0852     0.0214     4.0
partner_attractiveness_rel_to_self_MV_short:includedhorm_contra          -0.0368     0.0705    -0.5
partner_attractiveness_rel_to_self_MV_short:fertile                       0.0659     0.0675     1.0
includedhorm_contra:fertile                                              -0.1996     0.0500    -4.0
partner_attractiveness_rel_to_self_MV_short:includedhorm_contra:fertile  -0.0547     0.0701    -0.8
model %>%
  test_moderator("partner_attractiveness_rel_to_self", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48525 48632 -24250 48499 NA NA NA
with_mod 15 48528 48651 -24249 48498 0.9981 2 0.6071

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_rel_to_self +  
    included + fertile + menstruation:included + partner_attractiveness_rel_to_self:included +  
    partner_attractiveness_rel_to_self:fertile + included:fertile +  
    partner_attractiveness_rel_to_self:included:fertile
   Data: diary

REML criterion at convergence: 48567

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.290 -0.557 -0.149  0.405  8.013 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.312    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                               Estimate Std. Error t value
(Intercept)                                                     1.82982    0.05305    34.5
menstruationpre                                                -0.09049    0.01730    -5.2
menstruationyes                                                -0.07093    0.01631    -4.3
fertile_mean                                                   -0.05483    0.21424    -0.3
partner_attractiveness_rel_to_self                             -0.01187    0.06952    -0.2
includedhorm_contra                                            -0.10889    0.04558    -2.4
fertile                                                         0.19331    0.04179     4.6
menstruationpre:includedhorm_contra                             0.06900    0.02221     3.1
menstruationyes:includedhorm_contra                             0.08526    0.02138     4.0
partner_attractiveness_rel_to_self:includedhorm_contra         -0.00588    0.07215    -0.1
partner_attractiveness_rel_to_self:fertile                      0.06158    0.06986     0.9
includedhorm_contra:fertile                                    -0.19728    0.05021    -3.9
partner_attractiveness_rel_to_self:includedhorm_contra:fertile -0.05269    0.07237    -0.7

Partner’s shortterm attractiveness, alternative specification

model %>%
  test_moderator("partner_attractiveness_shortterm_v2", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48502 48609 -24238 48476 NA NA NA
with_mod 15 48504 48627 -24237 48474 2.683 2 0.2614

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_shortterm_v2 +  
    included + fertile + menstruation:included + partner_attractiveness_shortterm_v2:included +  
    partner_attractiveness_shortterm_v2:fertile + included:fertile +  
    partner_attractiveness_shortterm_v2:included:fertile
   Data: diary

REML criterion at convergence: 48545

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.284 -0.556 -0.149  0.405  8.004 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.305    0.552   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                Estimate Std. Error t value
(Intercept)                                                       1.8219     0.0466    39.1
menstruationpre                                                  -0.0901     0.0173    -5.2
menstruationyes                                                  -0.0710     0.0163    -4.4
fertile_mean                                                     -0.0279     0.2124    -0.1
partner_attractiveness_shortterm_v2                              -0.1173     0.0276    -4.3
includedhorm_contra                                              -0.1095     0.0383    -2.9
fertile                                                           0.1719     0.0349     4.9
menstruationpre:includedhorm_contra                               0.0689     0.0222     3.1
menstruationyes:includedhorm_contra                               0.0857     0.0214     4.0
partner_attractiveness_shortterm_v2:includedhorm_contra           0.0833     0.0366     2.3
partner_attractiveness_shortterm_v2:fertile                      -0.0431     0.0292    -1.5
includedhorm_contra:fertile                                      -0.1717     0.0443    -3.9
partner_attractiveness_shortterm_v2:includedhorm_contra:fertile   0.0257     0.0380     0.7

Partner’s global attractiveness

model %>%
  test_moderator("partner_attractiveness_global", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48522 48629 -24248 48496 NA NA NA
with_mod 15 48525 48648 -24248 48495 1.031 2 0.5971

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_global +  
    included + fertile + menstruation:included + partner_attractiveness_global:included +  
    partner_attractiveness_global:fertile + included:fertile +  
    partner_attractiveness_global:included:fertile
   Data: diary

REML criterion at convergence: 48567

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.287 -0.556 -0.149  0.405  8.009 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.311    0.557   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                                1.83307    0.04693    39.1
menstruationpre                                           -0.09042    0.01730    -5.2
menstruationyes                                           -0.07115    0.01631    -4.4
fertile_mean                                              -0.04867    0.21402    -0.2
partner_attractiveness_global                             -0.04613    0.02807    -1.6
includedhorm_contra                                       -0.11812    0.03852    -3.1
fertile                                                    0.17329    0.03491     5.0
menstruationpre:includedhorm_contra                        0.06921    0.02221     3.1
menstruationyes:includedhorm_contra                        0.08578    0.02138     4.0
partner_attractiveness_global:includedhorm_contra          0.06838    0.03686     1.9
partner_attractiveness_global:fertile                     -0.00137    0.02895     0.0
includedhorm_contra:fertile                               -0.17460    0.04425    -3.9
partner_attractiveness_global:includedhorm_contra:fertile -0.02232    0.03720    -0.6

Partner’s longterm attractiveness

model %>%
  test_moderator("partner_attractiveness_longterm", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48452 48559 -24213 48426 NA NA NA
with_mod 15 48449 48572 -24210 48419 6.762 2 0.03401

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_longterm +  
    included + fertile + menstruation:included + partner_attractiveness_longterm:included +  
    partner_attractiveness_longterm:fertile + included:fertile +  
    partner_attractiveness_longterm:included:fertile
   Data: diary

REML criterion at convergence: 48490

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.298 -0.557 -0.148  0.403  7.997 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.29     0.538   
 Residual             0.32     0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                            Estimate Std. Error t value
(Intercept)                                                  1.84183    0.04562    40.4
menstruationpre                                             -0.08964    0.01729    -5.2
menstruationyes                                             -0.06976    0.01632    -4.3
fertile_mean                                                -0.11011    0.20832    -0.5
partner_attractiveness_longterm                             -0.17146    0.02766    -6.2
includedhorm_contra                                         -0.10852    0.03744    -2.9
fertile                                                      0.17152    0.03491     4.9
menstruationpre:includedhorm_contra                          0.06863    0.02220     3.1
menstruationyes:includedhorm_contra                          0.08497    0.02138     4.0
partner_attractiveness_longterm:includedhorm_contra          0.00807    0.03718     0.2
partner_attractiveness_longterm:fertile                      0.04400    0.03095     1.4
includedhorm_contra:fertile                                 -0.17694    0.04429    -4.0
partner_attractiveness_longterm:includedhorm_contra:fertile  0.01433    0.04094     0.3

Partner’s short-term vs. long-term attractiveness

We also test this specification of the short-term vs. long-term moderator prediction, but we think this is a suboptimal way to test it.

model %>%
  test_moderator("partner_st_vs_lt", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48516 48622 -24245 48490 NA NA NA
with_mod 15 48506 48629 -24238 48476 13.93 2 0.000946

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_st_vs_lt +  
    included + fertile + menstruation:included + partner_st_vs_lt:included +  
    partner_st_vs_lt:fertile + included:fertile + partner_st_vs_lt:included:fertile
   Data: diary

REML criterion at convergence: 48548

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.268 -0.557 -0.148  0.405  7.979 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.309    0.556   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                    1.8414     0.0470    39.2
menstruationpre                               -0.0901     0.0173    -5.2
menstruationyes                               -0.0704     0.0163    -4.3
fertile_mean                                  -0.0675     0.2136    -0.3
partner_st_vs_lt                               0.0418     0.0260     1.6
includedhorm_contra                           -0.1276     0.0385    -3.3
fertile                                        0.1620     0.0351     4.6
menstruationpre:includedhorm_contra            0.0690     0.0222     3.1
menstruationyes:includedhorm_contra            0.0851     0.0214     4.0
partner_st_vs_lt:includedhorm_contra           0.0257     0.0331     0.8
partner_st_vs_lt:fertile                      -0.0803     0.0270    -3.0
includedhorm_contra:fertile                   -0.1602     0.0444    -3.6
partner_st_vs_lt:includedhorm_contra:fertile   0.0333     0.0341     1.0

Partner’s mate value

long scale
model %>%
  test_moderator("MV_P", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48523 48629 -24248 48497 NA NA NA
with_mod 15 48526 48649 -24248 48496 0.2159 2 0.8977

Error: Error in plot.eff(x[[(i - 1) * cols + j]], row = i, col = j, nrow = rows, : x.var = ‘fertile’ is not in the effect.

short scale
model %>%
  test_moderator("MV_P_short", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48524 48631 -24249 48498 NA NA NA
with_mod 15 48527 48650 -24248 48497 1.837 2 0.3991

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + MV_P_short +  
    included + fertile + menstruation:included + MV_P_short:included +  
    MV_P_short:fertile + included:fertile + MV_P_short:included:fertile
   Data: diary

REML criterion at convergence: 48566

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.284 -0.556 -0.149  0.405  8.007 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.311    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                       Estimate Std. Error t value
(Intercept)                              1.8801     0.1246   15.09
menstruationpre                         -0.0908     0.0173   -5.25
menstruationyes                         -0.0715     0.0163   -4.38
fertile_mean                            -0.0566     0.2141   -0.26
MV_P_short                              -0.0135     0.0343   -0.39
includedhorm_contra                     -0.2651     0.1583   -1.67
fertile                                  0.3326     0.1264    2.63
menstruationpre:includedhorm_contra      0.0694     0.0222    3.12
menstruationyes:includedhorm_contra      0.0860     0.0214    4.02
MV_P_short:includedhorm_contra           0.0438     0.0457    0.96
MV_P_short:fertile                      -0.0475     0.0361   -1.31
includedhorm_contra:fertile             -0.3007     0.1632   -1.84
MV_P_short:includedhorm_contra:fertile   0.0375     0.0469    0.80

Partner’s job and income

model %>%
  test_moderator("partner_attractiveness_money", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 48525 48632 -24250 48499 NA NA NA
with_mod 15 48529 48652 -24250 48499 0.2694 2 0.874

Linear mixed model fit by REML ['lmerMod']
Formula: extra_pair ~ menstruation + fertile_mean + (1 | person) + partner_attractiveness_money +  
    included + fertile + menstruation:included + partner_attractiveness_money:included +  
    partner_attractiveness_money:fertile + included:fertile +  
    partner_attractiveness_money:included:fertile
   Data: diary

REML criterion at convergence: 48569

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.286 -0.557 -0.150  0.405  8.004 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.312    0.558   
 Residual             0.320    0.566   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                         Estimate Std. Error t value
(Intercept)                                               1.77559    0.11217   15.83
menstruationpre                                          -0.09049    0.01730   -5.23
menstruationyes                                          -0.07127    0.01631   -4.37
fertile_mean                                             -0.04849    0.21436   -0.23
partner_attractiveness_money                              0.01813    0.03199    0.57
includedhorm_contra                                      -0.03243    0.14080   -0.23
fertile                                                   0.15176    0.11108    1.37
menstruationpre:includedhorm_contra                       0.06905    0.02221    3.11
menstruationyes:includedhorm_contra                       0.08576    0.02138    4.01
partner_attractiveness_money:includedhorm_contra         -0.02762    0.04395   -0.63
partner_attractiveness_money:fertile                      0.00672    0.03324    0.20
includedhorm_contra:fertile                              -0.10970    0.14578   -0.75
partner_attractiveness_money:includedhorm_contra:fertile -0.02125    0.04504   -0.47

Specific robustness analyses for extra-pair effects

Just libido?

Does the effect on extra-pair desire remain after adjusting for the effect on in-pair desire and vice versa?

Yes, if anything they suppress one another’s effects, because they are negatively associated, but both positively associated with fertility. However, we unfortunately did not measure non-directed “libido” (e.g. irrespective of potential partner/solo), precluding any strong conclusions about the independence of these effects (see also here).

Models
lmer(extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean + menstruation + (1 | person), data = diary) %->%
  m_extra_not_adjusted_for_in  %>% 
  print_summary()  %>% 
  plot_all_effects()
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean +  
##     menstruation + (1 | person)
##    Data: diary
## 
## REML criterion at convergence: 52397
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.866 -0.494 -0.129  0.331  7.409 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.421    0.649   
##  Residual             0.368    0.607   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                       Estimate Std. Error         df t value       Pr(>|t|)    
## (Intercept)                             1.8236     0.0538  1263.0000   33.88        < 2e-16 ***
## includedhorm_contra                    -0.2181     0.0443  1211.0000   -4.93 0.000000944176 ***
## fertile                                 0.2494     0.0374 25853.0000    6.66 0.000000000027 ***
## menstruationpre                        -0.1125     0.0185 25855.0000   -6.06 0.000000001341 ***
## menstruationyes                        -0.0778     0.0175 25944.0000   -4.45 0.000008585201 ***
## fertile_mean                           -0.2660     0.2447  1365.0000   -1.09         0.2772    
## includedhorm_contra:fertile            -0.2383     0.0474 25950.0000   -5.02 0.000000513140 ***
## includedhorm_contra:menstruationpre     0.0750     0.0238 25851.0000    3.15         0.0016 ** 
## includedhorm_contra:menstruationyes     0.0893     0.0229 25926.0000    3.90 0.000097428845 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) incld_ fertil mnstrtnp mnstrtny frtl_m inclddhrm_cntr:f
## inclddhrm_c             -0.475                                                        
## fertile                 -0.126  0.207                                                 
## menstrutnpr             -0.131  0.167  0.467                                          
## menstrutnys             -0.128  0.161  0.385  0.398                                   
## fertile_men             -0.771 -0.023 -0.056 -0.008   -0.005                          
## inclddhrm_cntr:f         0.126 -0.262 -0.787 -0.368   -0.304    0.009                 
## inclddhrm_cntr:mnstrtnp  0.108 -0.209 -0.363 -0.779   -0.310   -0.002  0.467          
## inclddhrm_cntr:mnstrtny  0.103 -0.198 -0.293 -0.304   -0.763   -0.002  0.382          
##                         inclddhrm_cntr:mnstrtnp
## inclddhrm_c                                    
## fertile                                        
## menstrutnpr                                    
## menstrutnys                                    
## fertile_men                                    
## inclddhrm_cntr:f                               
## inclddhrm_cntr:mnstrtnp                        
## inclddhrm_cntr:mnstrtny  0.384                 
## 
## ```

lmer(extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean + in_pair_desire + (1 | person), data = diary) %->%
  m_extra_adjusted_for_in %>% 
  print_summary()  %>% 
  plot_all_effects()
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean +  
##     in_pair_desire + (1 | person)
##    Data: diary
## 
## REML criterion at convergence: 52299
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.814 -0.497 -0.133  0.338  7.392 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.411    0.641   
##  Residual             0.367    0.606   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                        Estimate  Std. Error          df t value Pr(>|t|)    
## (Intercept)                             1.94705     0.05461  1390.00000   35.66  < 2e-16 ***
## includedhorm_contra                    -0.20752     0.04382  1214.00000   -4.74  2.4e-06 ***
## fertile                                 0.25859     0.03737 25855.00000    6.92  4.6e-12 ***
## menstruationpre                        -0.11498     0.01851 25857.00000   -6.21  5.4e-10 ***
## menstruationyes                        -0.08455     0.01747 25949.00000   -4.84  1.3e-06 ***
## fertile_mean                           -0.26463     0.24239  1367.00000   -1.09   0.2751    
## in_pair_desire                         -0.03564     0.00343 26489.00000  -10.39  < 2e-16 ***
## includedhorm_contra:fertile            -0.25512     0.04739 25954.00000   -5.38  7.4e-08 ***
## includedhorm_contra:menstruationpre     0.07499     0.02377 25852.00000    3.16   0.0016 ** 
## includedhorm_contra:menstruationyes     0.09070     0.02288 25928.00000    3.96  7.4e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) incld_ fertil mnstrtnp mnstrtny frtl_m in_pr_ inclddhrm_cntr:f
## inclddhrm_c             -0.458                                                               
## fertile                 -0.119  0.209                                                        
## menstrutnpr             -0.132  0.168  0.467                                                 
## menstrutnys             -0.134  0.162  0.384  0.398                                          
## fertile_men             -0.753 -0.023 -0.056 -0.008   -0.005                                 
## in_pair_dsr             -0.218 -0.023 -0.024  0.013    0.037    0.000                        
## inclddhrm_cntr:f         0.117 -0.264 -0.787 -0.368   -0.302    0.009  0.034                 
## inclddhrm_cntr:mnstrtnp  0.107 -0.210 -0.363 -0.779   -0.310   -0.002  0.000  0.467          
## inclddhrm_cntr:mnstrtny  0.102 -0.200 -0.293 -0.304   -0.763   -0.002 -0.006  0.381          
##                         inclddhrm_cntr:mnstrtnp
## inclddhrm_c                                    
## fertile                                        
## menstrutnpr                                    
## menstrutnys                                    
## fertile_men                                    
## in_pair_dsr                                    
## inclddhrm_cntr:f                               
## inclddhrm_cntr:mnstrtnp                        
## inclddhrm_cntr:mnstrtny  0.384                 
## 
## ```

lmer(extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean + scale(in_pair_desire) * included * fertile + fertile_mean + menstruation + (1 | person), data = diary) %->%
  m_extra_mod_by_in %>% 
  print_summary()  %>% 
  plot_triptych(x.var = "fertile", xlevels = 2)
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean +  
##     scale(in_pair_desire) * included * fertile + fertile_mean +      menstruation + (1 | person)
##    Data: diary
## 
## REML criterion at convergence: 52316
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.812 -0.498 -0.133  0.337  7.394 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.411    0.641   
##  Residual             0.367    0.606   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                                      Estimate  Std. Error          df t value Pr(>|t|)    
## (Intercept)                                           1.81837     0.05330  1265.00000   34.12  < 2e-16 ***
## includedhorm_contra                                  -0.20746     0.04382  1214.00000   -4.73  2.5e-06 ***
## fertile                                               0.25893     0.03739 25852.00000    6.92  4.5e-12 ***
## menstruationpre                                      -0.11508     0.01852 25855.00000   -6.21  5.2e-10 ***
## menstruationyes                                      -0.08472     0.01749 25949.00000   -4.84  1.3e-06 ***
## fertile_mean                                         -0.26398     0.24239  1367.00000   -1.09   0.2763    
## scale(in_pair_desire)                                -0.05222     0.00931 26432.00000   -5.61  2.0e-08 ***
## includedhorm_contra:fertile                          -0.25511     0.04742 25950.00000   -5.38  7.5e-08 ***
## includedhorm_contra:menstruationpre                   0.07508     0.02377 25851.00000    3.16   0.0016 ** 
## includedhorm_contra:menstruationyes                   0.09089     0.02292 25929.00000    3.97  7.3e-05 ***
## includedhorm_contra:scale(in_pair_desire)             0.00388     0.01199 26363.00000    0.32   0.7460    
## fertile:scale(in_pair_desire)                         0.01731     0.03135 25910.00000    0.55   0.5809    
## includedhorm_contra:fertile:scale(in_pair_desire)    -0.02389     0.04039 25861.00000   -0.59   0.5542    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## ```

anova(m_extra_adjusted_for_in, m_extra_mod_by_in)
## Data: diary
## Models:
## object: extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean + 
## object:     in_pair_desire + (1 | person)
## ..1: extra_pair_desire ~ included * (fertile + menstruation) + fertile_mean + 
## ..1:     scale(in_pair_desire) * included * fertile + fertile_mean + 
## ..1:     menstruation + (1 | person)
##        Df   AIC   BIC logLik deviance Chisq Chi Df Pr(>Chisq)
## object 12 52266 52364 -26121    52242                        
## ..1    15 52272 52394 -26121    52242  0.37      3       0.95
lmer(in_pair_desire ~ included * (fertile + menstruation) + fertile_mean + scale(extra_pair_desire) * included * fertile + fertile_mean + menstruation + (1 | person), data = diary) %->%
  m_in_mod_by_extra %>% 
  print_summary()  %>% 
  plot_triptych(x.var = "fertile", xlevels = 2)
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: in_pair_desire ~ included * (fertile + menstruation) + fertile_mean +  
##     scale(extra_pair_desire) * included * fertile + fertile_mean +      menstruation + (1 | person)
##    Data: diary
## 
## REML criterion at convergence: 82972
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -3.529 -0.677 -0.028  0.665  3.745 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.708    0.841   
##  Residual             1.184    1.088   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                                         Estimate  Std. Error          df t value Pr(>|t|)    
## (Intercept)                                              3.49788     0.07453  1411.00000   46.93  < 2e-16 ***
## includedhorm_contra                                      0.26341     0.06100  1380.00000    4.32  1.7e-05 ***
## fertile                                                  0.25194     0.06788 25984.00000    3.71  0.00021 ***
## menstruationpre                                         -0.08354     0.03328 26005.00000   -2.51  0.01207 *  
## menstruationyes                                         -0.19894     0.03132 26117.00000   -6.35  2.2e-10 ***
## fertile_mean                                            -0.00156     0.34203  1524.00000    0.00  0.99636    
## scale(extra_pair_desire)                                -0.11931     0.01666 26318.00000   -7.16  8.2e-13 ***
## includedhorm_contra:fertile                             -0.45944     0.08566 26117.00000   -5.36  8.2e-08 ***
## includedhorm_contra:menstruationpre                      0.00794     0.04269 26002.00000    0.19  0.85253    
## includedhorm_contra:menstruationyes                      0.05078     0.04104 26093.00000    1.24  0.21600    
## includedhorm_contra:scale(extra_pair_desire)            -0.00645     0.02289 26509.00000   -0.28  0.77823    
## fertile:scale(extra_pair_desire)                         0.16934     0.05052 26146.00000    3.35  0.00080 ***
## includedhorm_contra:fertile:scale(extra_pair_desire)    -0.13265     0.07095 26059.00000   -1.87  0.06155 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## ```

lmer(in_pair_desire ~ included * (fertile + menstruation) + fertile_mean + menstruation + (1 | person), data = diary) %->%
  m_in_not_adjusted_for_extra  %>% 
  print_summary()  %>% 
  plot_all_effects()
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: in_pair_desire ~ included * (fertile + menstruation) + fertile_mean +  
##     menstruation + (1 | person)
##    Data: diary
## 
## REML criterion at convergence: 83086
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -3.481 -0.678 -0.031  0.667  3.799 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.736    0.858   
##  Residual             1.189    1.090   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                        Estimate  Std. Error          df t value     Pr(>|t|)    
## (Intercept)                             3.47053     0.07560  1399.00000   45.91      < 2e-16 ***
## includedhorm_contra                     0.29330     0.06188  1365.00000    4.74 0.0000023616 ***
## fertile                                 0.26125     0.06714 25981.00000    3.89       0.0001 ***
## menstruationpre                        -0.06767     0.03327 26000.00000   -2.03       0.0419 *  
## menstruationyes                        -0.18759     0.03135 26112.00000   -5.98 0.0000000022 ***
## fertile_mean                            0.03371     0.34713  1518.00000    0.10       0.9227    
## includedhorm_contra:fertile            -0.47357     0.08505 26113.00000   -5.57 0.0000000260 ***
## includedhorm_contra:menstruationpre    -0.00281     0.04271 25996.00000   -0.07       0.9475    
## includedhorm_contra:menstruationyes     0.03767     0.04109 26088.00000    0.92       0.3593    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) incld_ fertil mnstrtnp mnstrtny frtl_m inclddhrm_cntr:f
## inclddhrm_c             -0.473                                                        
## fertile                 -0.163  0.266                                                 
## menstrutnpr             -0.170  0.215  0.467                                          
## menstrutnys             -0.165  0.207  0.384  0.397                                   
## fertile_men             -0.772 -0.026 -0.069 -0.008   -0.005                          
## inclddhrm_cntr:f         0.163 -0.336 -0.786 -0.368   -0.303    0.010                 
## inclddhrm_cntr:mnstrtnp  0.140 -0.269 -0.363 -0.779   -0.309   -0.004  0.466          
## inclddhrm_cntr:mnstrtny  0.132 -0.254 -0.293 -0.303   -0.763   -0.004  0.381          
##                         inclddhrm_cntr:mnstrtnp
## inclddhrm_c                                    
## fertile                                        
## menstrutnpr                                    
## menstrutnys                                    
## fertile_men                                    
## inclddhrm_cntr:f                               
## inclddhrm_cntr:mnstrtnp                        
## inclddhrm_cntr:mnstrtny  0.383                 
## 
## ```

lmer(in_pair_desire ~ included * (fertile + menstruation) + fertile_mean + extra_pair_desire + (1 | person), data = diary) %->%
  m_in_adjusted_for_extra  %>% 
  print_summary()  %>% 
  plot_all_effects()
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: in_pair_desire ~ included * (fertile + menstruation) + fertile_mean +  
##     extra_pair_desire + (1 | person)
##    Data: diary
## 
## REML criterion at convergence: 82972
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -3.519 -0.678 -0.029  0.664  3.741 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.708    0.841   
##  Residual             1.185    1.088   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                        Estimate  Std. Error          df t value      Pr(>|t|)    
## (Intercept)                             3.68760     0.07700  1584.00000   47.89       < 2e-16 ***
## includedhorm_contra                     0.26761     0.06097  1377.00000    4.39 0.00001226486 ***
## fertile                                 0.29074     0.06708 25994.00000    4.33 0.00001466227 ***
## menstruationpre                        -0.08111     0.03323 26007.00000   -2.44         0.015 *  
## menstruationyes                        -0.19680     0.03130 26121.00000   -6.29 0.00000000033 ***
## fertile_mean                            0.00358     0.34207  1524.00000    0.01         0.992    
## extra_pair_desire                      -0.11953     0.01082 26093.00000  -11.05       < 2e-16 ***
## includedhorm_contra:fertile            -0.50139     0.08494 26126.00000   -5.90 0.00000000361 ***
## includedhorm_contra:menstruationpre     0.00631     0.04265 26003.00000    0.15         0.882    
## includedhorm_contra:menstruationyes     0.04840     0.04103 26097.00000    1.18         0.238    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) incld_ fertil mnstrtnp mnstrtny frtl_m extr__ inclddhrm_cntr:f
## inclddhrm_c             -0.467                                                               
## fertile                 -0.149  0.267                                                        
## menstrutnpr             -0.176  0.219  0.464                                                 
## menstrutnys             -0.169  0.211  0.383  0.397                                          
## fertile_men             -0.749 -0.026 -0.070 -0.008   -0.005                                 
## extr_pr_dsr             -0.255  0.038 -0.040  0.037    0.027    0.008                        
## inclddhrm_cntr:f         0.152 -0.339 -0.787 -0.367   -0.302    0.010  0.030                 
## inclddhrm_cntr:mnstrtnp  0.142 -0.273 -0.362 -0.779   -0.309   -0.004 -0.020  0.465          
## inclddhrm_cntr:mnstrtny  0.136 -0.258 -0.291 -0.303   -0.763   -0.004 -0.024  0.380          
##                         inclddhrm_cntr:mnstrtnp
## inclddhrm_c                                    
## fertile                                        
## menstrutnpr                                    
## menstrutnys                                    
## fertile_men                                    
## extr_pr_dsr                                    
## inclddhrm_cntr:f                               
## inclddhrm_cntr:mnstrtnp                        
## inclddhrm_cntr:mnstrtny  0.383                 
## 
## ```

anova(m_in_adjusted_for_extra, m_in_mod_by_extra)
## Data: diary
## Models:
## object: in_pair_desire ~ included * (fertile + menstruation) + fertile_mean + 
## object:     extra_pair_desire + (1 | person)
## ..1: in_pair_desire ~ included * (fertile + menstruation) + fertile_mean + 
## ..1:     scale(extra_pair_desire) * included * fertile + fertile_mean + 
## ..1:     menstruation + (1 | person)
##        Df   AIC   BIC logLik deviance Chisq Chi Df Pr(>Chisq)   
## object 12 82950 83048 -41463    82926                           
## ..1    15 82941 83064 -41456    82911  14.7      3     0.0021 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
coefficients = bind_cols(bind_rows(
  extra_not_adjusted_for_in = broom::tidy(m_extra_not_adjusted_for_in, conf.int = T),
  extra_adjusted_for_in = broom::tidy(m_extra_adjusted_for_in, conf.int = T),
  in_not_adjusted_for_extra = broom::tidy(m_in_not_adjusted_for_extra, conf.int = T),
  in_adjusted_for_extra = broom::tidy(m_in_adjusted_for_extra, conf.int = T),
  .id = c("model")
),  bind_rows( broom::tidy(m_extra_not_adjusted_for_in, conf.int = T, level = 0.8),
  broom::tidy(m_extra_adjusted_for_in, conf.int = T, level = 0.8),
  broom::tidy(m_in_not_adjusted_for_extra, conf.int = T, level = 0.8),
  broom::tidy(m_in_adjusted_for_extra, conf.int = T, level = 0.8)
)  %>% select(conf.low, conf.high)  %>% rename(conf.low80 = conf.low, conf.high80 = conf.high)
)
Summary
coefficients  %>% 
  filter(term %ends_with% "fertile") %>% 
  ggplot(aes(x = model, y = estimate, ymin = conf.low, ymax = conf.high, color = term)) +
  geom_linerange(size = 0.5) +
  geom_pointrange(aes(ymin = conf.low80, ymax = conf.high80), size = 1) +
  scale_color_manual("Contraception status", values = c("includedhorm_contra:fertile"="black","fertile" = "red"), labels = c("includedhorm_contra:fertile"="hormonally\ncontracepting","fertile" = "fertile"), guide = F) + 
  geom_hline(yintercept = 0, linetype = "dashed") +
  coord_flip()

Awareness vs. regularity?

Are there stronger effects on extra pair desire in women using fertility-awareness-based contraception only because they have more regular cycles and so our fertility predictor is more useful?

No, it actually seems to be the other way around, cycle length no longer moderates the fertility effect when awareness is also included as a moderator.

lmer(extra_pair ~ contraceptive_methods * fertile + fertile_mean + menstruation + (1 | person), data = diary, subset = !is.na(included_lax) & contraceptive_method != "other") %->%
  m_extra_not_adjusted_for_length  %>% 
  print_summary()  %>% 
  plot_triptych(xlevels = 4, panel_rows = 1) 
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: extra_pair ~ contraceptive_methods * fertile + fertile_mean +      menstruation + (1 | person)
##    Data: diary
##  Subset: !is.na(included_lax) & contraceptive_method != "other"
## 
## REML criterion at convergence: 30402
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.333 -0.557 -0.147  0.406  8.083 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.320    0.566   
##  Residual             0.313    0.560   
## Number of obs: 17026, groups:  person, 513
## 
## Fixed effects:
##                                                     Estimate  Std. Error          df t value Pr(>|t|)    
## (Intercept)                                          1.87936     0.10617   518.00000   17.70   <2e-16 ***
## contraceptive_methodsfertility_awareness            -0.07506     0.13288   524.00000   -0.56    0.572    
## contraceptive_methodsnone                           -0.17512     0.14088   530.00000   -1.24    0.214    
## contraceptive_methodshormonal                       -0.13113     0.06727   525.00000   -1.95    0.052 .  
## fertile                                              0.11889     0.05531 16564.00000    2.15    0.032 *  
## fertile_mean                                        -0.11221     0.52225   519.00000   -0.21    0.830    
## menstruationpre                                     -0.03094     0.01323 16563.00000   -2.34    0.019 *  
## menstruationyes                                      0.00506     0.01325 16569.00000    0.38    0.702    
## contraceptive_methodsfertility_awareness:fertile     0.19271     0.11667 16569.00000    1.65    0.099 .  
## contraceptive_methodsnone:fertile                   -0.01023     0.12973 16551.00000   -0.08    0.937    
## contraceptive_methodshormonal:fertile               -0.14470     0.05944 16575.00000   -2.43    0.015 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                  (Intr) cntr__ cntrcptv_mthdsn cntrcptv_mthdsh fertil frtl_m mnstrtnp mnstrtny cnt__:
## cntrcptv_m_      -0.245                                                                              
## cntrcptv_mthdsn  -0.279  0.191                                                                       
## cntrcptv_mthdsh  -0.439  0.403  0.375                                                                
## fertile          -0.077  0.065  0.060           0.133                                                
## fertile_men      -0.823 -0.012  0.047          -0.078          -0.025                                
## menstrutnpr      -0.053 -0.001 -0.002           0.006           0.238 -0.002                         
## menstrutnys      -0.046  0.000  0.002           0.008           0.189 -0.005  0.386                  
## cntrcptv__:       0.036 -0.150 -0.029          -0.061          -0.438  0.002  0.009    0.018         
## cntrcptv_mthdsn:  0.030 -0.028 -0.143          -0.055          -0.395  0.005  0.007    0.007    0.188
## cntrcptv_mthdsh:  0.069 -0.061 -0.057          -0.151          -0.867  0.008 -0.006    0.007    0.411
##                  cntrcptv_mthdsn:
## cntrcptv_m_                      
## cntrcptv_mthdsn                  
## cntrcptv_mthdsh                  
## fertile                          
## fertile_men                      
## menstrutnpr                      
## menstrutnys                      
## cntrcptv__:                      
## cntrcptv_mthdsn:                 
## cntrcptv_mthdsh:  0.370          
## 
## ```

lmer(extra_pair ~ contraceptive_methods * fertile + cycle_length_groups * fertile + fertile_mean + menstruation + (1 | person), data = diary, subset = !is.na(included_lax) & contraceptive_method != "other") %>%
  calculate_effects() %->%
  m_extra_adjusted_for_length  %>% 
  print_summary()  %>% 
  plot_triptych(xlevels = 3, term = "fertile:cycle_length_groups", panel_rows = 1) %>% 
  plot_triptych(xlevels = 4, term = "contraceptive_methods:fertile", panel_rows = 1)
## 
## 
## ```
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: extra_pair ~ contraceptive_methods * fertile + cycle_length_groups *  
##     fertile + fertile_mean + menstruation + (1 | person)
##    Data: diary
##  Subset: !is.na(included_lax) & contraceptive_method != "other"
## 
## REML criterion at convergence: 30409
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.355 -0.556 -0.147  0.406  8.088 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.321    0.566   
##  Residual             0.313    0.560   
## Number of obs: 17026, groups:  person, 513
## 
## Fixed effects:
##                                                     Estimate  Std. Error          df t value Pr(>|t|)    
## (Intercept)                                          1.88591     0.13059   520.00000   14.44   <2e-16 ***
## contraceptive_methodsfertility_awareness            -0.07171     0.13312   522.00000   -0.54   0.5904    
## contraceptive_methodsnone                           -0.17149     0.14124   528.00000   -1.21   0.2252    
## contraceptive_methodshormonal                       -0.14096     0.06885   523.00000   -2.05   0.0411 *  
## fertile                                              0.16004     0.08257 16549.00000    1.94   0.0526 .  
## cycle_length_groups(25,30]                           0.01582     0.07813   527.00000    0.20   0.8396    
## cycle_length_groups(30,35]                          -0.05283     0.11587   525.00000   -0.46   0.6486    
## fertile_mean                                        -0.15500     0.52483   517.00000   -0.30   0.7679    
## menstruationpre                                     -0.03048     0.01323 16560.00000   -2.30   0.0212 *  
## menstruationyes                                      0.00524     0.01326 16567.00000    0.40   0.6928    
## contraceptive_methodsfertility_awareness:fertile     0.19965     0.11677 16566.00000    1.71   0.0873 .  
## contraceptive_methodsnone:fertile                    0.00858     0.13014 16550.00000    0.07   0.9474    
## contraceptive_methodshormonal:fertile               -0.17435     0.06104 16580.00000   -2.86   0.0043 ** 
## fertile:cycle_length_groups(25,30]                  -0.00525     0.06800 16539.00000   -0.08   0.9384    
## fertile:cycle_length_groups(30,35]                  -0.18513     0.10377 16553.00000   -1.78   0.0744 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## ```

Extra-pair intimacy

model_summaries$extra_pair_intimacy

Model summary

Model summary

model %>% 
  print_summary()
Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ included * (menstruation + fertile) + fertile_mean +      (1 | person)
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2387     2469    -1184     2367    26693 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.992 -0.003 -0.002 -0.002  7.512 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 7.36     2.71    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                         -4.16420    0.26688  -15.60   <2e-16 ***
includedhorm_contra                 -0.10229    0.18833   -0.54     0.59    
menstruationpre                     -0.03050    0.12101   -0.25     0.80    
menstruationyes                      0.00572    0.11425    0.05     0.96    
fertile                              0.23361    0.24845    0.94     0.35    
fertile_mean                        -0.89089    1.32950   -0.67     0.50    
includedhorm_contra:menstruationpre -0.13737    0.20691   -0.66     0.51    
includedhorm_contra:menstruationyes -0.03488    0.19012   -0.18     0.85    
includedhorm_contra:fertile         -0.31393    0.39835   -0.79     0.43    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.343                                                               
menstrutnpr             -0.178  0.254                                                        
menstrutnys             -0.174  0.242  0.367                                                 
fertile                 -0.175  0.340  0.449    0.347                                        
fertile_men             -0.805 -0.023 -0.003    0.004   -0.085                               
inclddhrm_cntr:mnstrtnp  0.119 -0.367 -0.585   -0.215   -0.261 -0.012                        
inclddhrm_cntr:mnstrtny  0.112 -0.358 -0.220   -0.601   -0.208 -0.009  0.340                 
inclddhrm_cntr:f         0.169 -0.505 -0.280   -0.217   -0.618 -0.019  0.436                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.342                 
convergence code: 0
Model failed to converge with max|grad| = 0.625484 (tol = 0.001, component 1)

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.23 [-0.25;0.72].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ included + menstruation + fertile + fertile_mean +  
    (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2399     2555    -1181     2361    26684 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.607 -0.004 -0.002 -0.001  6.512 

Random effects:
 Groups Name            Variance Std.Dev. Corr          
 person (Intercept)     5.507    2.347                  
        fertile         3.607    1.899    0.72          
        menstruationpre 0.683    0.827    0.98 0.57     
        menstruationyes 0.614    0.783    0.24 0.27 0.18
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                     Estimate Std. Error z value Pr(>|z|)    
(Intercept)                         -3.803110   0.000463   -8212   <2e-16 ***
includedhorm_contra                 -0.321515   0.000463    -694   <2e-16 ***
menstruationpre                     -1.145626   0.000463   -2474   <2e-16 ***
menstruationyes                     -0.325812   0.000463    -704   <2e-16 ***
fertile                             -1.731209   0.000463   -3739   <2e-16 ***
fertile_mean                        -0.104871   0.000463    -227   <2e-16 ***
includedhorm_contra:menstruationpre  0.196076   0.000463     424   <2e-16 ***
includedhorm_contra:menstruationyes -0.018182   0.000463     -39   <2e-16 ***
includedhorm_contra:fertile          0.314216   0.000463     679   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             0.000                                                                
menstrutnpr             0.000  0.000                                                         
menstrutnys             0.000  0.000  0.000                                                  
fertile                 0.000  0.000  0.000    0.000                                         
fertile_men             0.000  0.000  0.000    0.000    0.000                                
inclddhrm_cntr:mnstrtnp 0.000  0.000  0.000    0.000    0.000  0.000                         
inclddhrm_cntr:mnstrtny 0.000  0.000  0.000    0.000    0.000  0.000  0.000                  
inclddhrm_cntr:f        0.000  0.000  0.000    0.000    0.000  0.000  0.000                  
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f        0.000                  
convergence code: 0
Model failed to converge with max|grad| = 0.154676 (tol = 0.001, component 1)
Model is nearly unidentifiable: very large eigenvalue
 - Rescale variables?
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
model 10 2387 2469 -1184 2367 NA NA NA
with_ind_diff 19 2399 2555 -1181 2361 5.628 9 0.7765
robustness_check_ovu_shift(model, diary)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : (maxstephalfit) PIRLS step-halvings failed to reduce deviance in pwrssUpdate

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : (maxstephalfit) PIRLS step-halvings failed to reduce deviance in pwrssUpdate

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )

     AIC      BIC   logLik deviance df.resid 
  1985.5   2131.3   -974.7   1949.5    24379 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.024 -0.003 -0.002 -0.002  7.219 

Random effects:
 Groups Name                                   Variance Std.Dev.
 person (Intercept)                            7.7216   2.779   
 Xr.2   s(days_filled_out):includedhorm_contra 0.0641   0.253   
 Xr.1   s(days_filled_out):includedcycling     0.0469   0.217   
 Xr.0   s(day_number):includedhorm_contra      0.0726   0.269   
 Xr     s(day_number):includedcycling          0.0125   0.112   
Number of obs: 24397, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error z value     Pr(>|z|)    
X(Intercept)                                -4.0997     0.6753   -6.07 0.0000000013 ***
Xincludedhorm_contra                        -0.0854     0.5477   -0.16         0.88    
Xmenstruationpre                             0.1767     0.1418    1.25         0.21    
Xmenstruationyes                             0.0712     0.1429    0.50         0.62    
Xfertile                                     0.5954     0.3042    1.96         0.05 .  
Xfertile_mean                               -2.2201     3.5303   -0.63         0.53    
Xincludedhorm_contra:menstruationpre        -0.2491     0.2459   -1.01         0.31    
Xincludedhorm_contra:menstruationyes        -0.0396     0.2380   -0.17         0.87    
Xincludedhorm_contra:fertile                -0.3167     0.4892   -0.65         0.52    
Xs(day_number):includedcyclingFx1            0.2171     0.2466    0.88         0.38    
Xs(day_number):includedhorm_contraFx1       -0.0190     0.3338   -0.06         0.95    
Xs(days_filled_out):includedcyclingFx1      -0.1549     0.2641   -0.59         0.56    
Xs(days_filled_out):includedhorm_contraFx1   0.0227     0.3400    0.07         0.95    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Family: binomial 
Link function: probit 

Formula:
extra_pair_intimacy ~ included + menstruation + fertile + fertile_mean + 
    s(day_number, by = included) + s(days_filled_out, by = included) + 
    included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error z value     Pr(>|z|)    
(Intercept)                          -4.0997     0.6754   -6.07 0.0000000013 ***
includedhorm_contra                  -0.0854     0.5477   -0.16         0.88    
menstruationpre                       0.1767     0.1418    1.25         0.21    
menstruationyes                       0.0712     0.1429    0.50         0.62    
fertile                               0.5954     0.3042    1.96         0.05 .  
fertile_mean                         -2.2201     3.5304   -0.63         0.53    
includedhorm_contra:menstruationpre  -0.2491     0.2459   -1.01         0.31    
includedhorm_contra:menstruationyes  -0.0396     0.2380   -0.17         0.87    
includedhorm_contra:fertile          -0.3167     0.4892   -0.65         0.52    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df Chi.sq p-value
s(day_number):includedcycling          1.16   1.16   0.69    0.42
s(day_number):includedhorm_contra      1.47   1.47   0.10    0.90
s(days_filled_out):includedcycling     1.52   1.52   1.30    0.54
s(days_filled_out):includedhorm_contra 1.39   1.39   0.03    0.95

R-sq.(adj) =  -0.000547   
glmer.ML = 1434.9  Scale est. = 1         n = 24397

Information: No AR1/ARMA autocorrelation models were fitted for binomial outcomes.

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

     AIC      BIC   logLik deviance df.resid 
  1541.8   1681.2   -752.9   1505.8    17026 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.033 -0.007 -0.003 -0.002  7.897 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 4.68     2.16    
Number of obs: 17044, groups:  person, 513

Fixed effects:
                                                         Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                              -3.80264    0.40453   -9.40   <2e-16 ***
fertile_mean                                             -0.68606    2.03840   -0.34    0.736    
contraceptive_methodsfertility_awareness                 -0.38619    0.52850   -0.73    0.465    
contraceptive_methodsnone                                 0.15123    0.45224    0.33    0.738    
contraceptive_methodshormonal                            -0.55661    0.26429   -2.11    0.035 *  
fertile                                                   0.24713    0.39099    0.63    0.527    
menstruationpre                                           0.10249    0.18946    0.54    0.589    
menstruationyes                                           0.20636    0.17425    1.18    0.236    
contraceptive_methodsfertility_awareness:fertile         -0.26345    0.86505   -0.30    0.761    
contraceptive_methodsnone:fertile                         0.00997    0.87654    0.01    0.991    
contraceptive_methodshormonal:fertile                     0.23538    0.52652    0.45    0.655    
contraceptive_methodsfertility_awareness:menstruationpre -0.29696    0.38205   -0.78    0.437    
contraceptive_methodsnone:menstruationpre                -0.55985    0.44830   -1.25    0.212    
contraceptive_methodshormonal:menstruationpre            -0.13800    0.27313   -0.51    0.613    
contraceptive_methodsfertility_awareness:menstruationyes  0.24577    0.36205    0.68    0.497    
contraceptive_methodsnone:menstruationyes                -0.75828    0.48724   -1.56    0.120    
contraceptive_methodshormonal:menstruationyes            -0.17371    0.25557   -0.68    0.497    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.48122 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 12 1527 1620 -751.4 1503 NA NA NA
by_method 18 1542 1681 -752.9 1506 0 6 1

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 18 2417 2565 -1191 2381 NA NA NA
with_mod 26 2418 2631 -1183 2366 15.69 8 0.04706

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2418     2631    -1183     2366    26677 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.011 -0.003 -0.002 -0.002  8.212 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 6.84     2.62    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                   -3.9368     0.4004   -9.83   <2e-16 ***
menstruationpre                               -0.0614     0.1208   -0.51     0.61    
menstruationyes                                0.0388     0.1127    0.34     0.73    
fertile_mean                                  -1.2594     1.3600   -0.93     0.35    
age_group(20,25]                               0.0471     0.3751    0.13     0.90    
age_group(25,30]                              -0.2444     0.4087   -0.60     0.55    
age_group(30,35]                              -0.1997     0.4947   -0.40     0.69    
age_group(35,70]                              -0.1637     0.4304   -0.38     0.70    
includedhorm_contra                           -0.0857     0.3978   -0.22     0.83    
fertile                                        0.2553     0.7189    0.36     0.72    
menstruationpre:includedhorm_contra           -0.1462     0.2115   -0.69     0.49    
menstruationyes:includedhorm_contra           -0.0654     0.1908   -0.34     0.73    
age_group(20,25]:includedhorm_contra          -0.3667     0.4705   -0.78     0.44    
age_group(25,30]:includedhorm_contra           0.0639     0.5595    0.11     0.91    
age_group(30,35]:includedhorm_contra          -0.3654     1.1436   -0.32     0.75    
age_group(35,70]:includedhorm_contra          -0.9536     1.9402   -0.49     0.62    
age_group(20,25]:fertile                      -0.5267     0.8098   -0.65     0.52    
age_group(25,30]:fertile                       0.3874     0.8058    0.48     0.63    
age_group(30,35]:fertile                      -0.0859     0.9749   -0.09     0.93    
age_group(35,70]:fertile                      -0.2771     0.9255   -0.30     0.76    
includedhorm_contra:fertile                   -0.5902     0.9213   -0.64     0.52    
age_group(20,25]:includedhorm_contra:fertile   1.0349     1.0542    0.98     0.33    
age_group(25,30]:includedhorm_contra:fertile   0.1775     1.2718    0.14     0.89    
age_group(30,35]:includedhorm_contra:fertile   0.0352     1.6152    0.02     0.98    
age_group(35,70]:includedhorm_contra:fertile   0.6360     1.7951    0.35     0.72    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.26747 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 2396 2494 -1186 2372 NA NA NA
with_mod 14 2408 2523 -1190 2380 0 2 1

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    weekend + included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2408     2523    -1190     2380    26689 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.078 -0.005 -0.003 -0.002  8.707 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 4.7      2.17    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error z value Pr(>|z|)    
(Intercept)                              -3.6002     0.2332  -15.44   <2e-16 ***
menstruationpre                          -0.2011     0.1172   -1.72    0.086 .  
menstruationyes                          -0.2002     0.1129   -1.77    0.076 .  
fertile_mean                             -1.8645     1.2421   -1.50    0.133    
weekendTRUE                               0.0276     0.1033    0.27    0.789    
includedhorm_contra                      -0.4238     0.1930   -2.20    0.028 *  
fertile                                  -0.0823     0.2983   -0.28    0.783    
menstruationpre:includedhorm_contra      -0.1475     0.2142   -0.69    0.491    
menstruationyes:includedhorm_contra       0.0303     0.1965    0.15    0.878    
weekendTRUE:includedhorm_contra           0.1102     0.1781    0.62    0.536    
weekendTRUE:fertile                      -0.5861     0.4445   -1.32    0.187    
includedhorm_contra:fertile              -0.0758     0.5039   -0.15    0.880    
weekendTRUE:includedhorm_contra:fertile   0.6851     0.7028    0.97    0.330    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.80526 (tol = 0.001, component 1)

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 22 2398 2579 -1177 2354 NA NA NA
with_mod 34 2447 2726 -1190 2379 0 12 1

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    weekday + included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2447     2726    -1190     2379    26669 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.874 -0.006 -0.004 -0.002 11.537 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 4.18     2.05    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                  -3.57619    0.24903  -14.36  < 2e-16 ***
menstruationpre                              -0.00607    0.12054   -0.05   0.9598    
menstruationyes                               0.14069    0.10900    1.29   0.1968    
fertile_mean                                 -2.66144    1.17364   -2.27   0.0233 *  
weekdayTuesday                               -0.40944    0.19273   -2.12   0.0336 *  
weekdayWednesday                             -0.20328    0.19321   -1.05   0.2927    
weekdayThursday                               0.01403    0.18091    0.08   0.9382    
weekdayFriday                                 0.05453    0.18232    0.30   0.7649    
weekdaySaturday                              -0.20091    0.19372   -1.04   0.2997    
weekdaySunday                                 0.25442    0.17469    1.46   0.1453    
includedhorm_contra                          -0.11605    0.25162   -0.46   0.6446    
fertile                                       1.16175    0.44787    2.59   0.0095 ** 
menstruationpre:includedhorm_contra          -0.08856    0.20555   -0.43   0.6666    
menstruationyes:includedhorm_contra          -0.07662    0.18442   -0.42   0.6778    
weekdayTuesday:includedhorm_contra            0.32279    0.30834    1.05   0.2952    
weekdayWednesday:includedhorm_contra         -0.07131    0.32348   -0.22   0.8255    
weekdayThursday:includedhorm_contra          -0.35791    0.32187   -1.11   0.2662    
weekdayFriday:includedhorm_contra            -0.13485    0.30409   -0.44   0.6574    
weekdaySaturday:includedhorm_contra           0.13990    0.30679    0.46   0.6484    
weekdaySunday:includedhorm_contra            -0.45816    0.30001   -1.53   0.1267    
weekdayTuesday:fertile                        0.17128    0.67728    0.25   0.8004    
weekdayWednesday:fertile                     -0.58138    0.73061   -0.80   0.4262    
weekdayThursday:fertile                      -0.93493    0.68088   -1.37   0.1697    
weekdayFriday:fertile                        -0.74077    0.66161   -1.12   0.2629    
weekdaySaturday:fertile                      -0.37281    0.70316   -0.53   0.5960    
weekdaySunday:fertile                        -4.03253    0.96082   -4.20 0.000027 ***
includedhorm_contra:fertile                  -1.48201    0.84178   -1.76   0.0783 .  
weekdayTuesday:includedhorm_contra:fertile   -0.77630    1.31809   -0.59   0.5559    
weekdayWednesday:includedhorm_contra:fertile  0.97163    1.26255    0.77   0.4415    
weekdayThursday:includedhorm_contra:fertile   1.76167    1.19466    1.47   0.1403    
weekdayFriday:includedhorm_contra:fertile     0.98219    1.19867    0.82   0.4126    
weekdaySaturday:includedhorm_contra:fertile   1.05512    1.17223    0.90   0.3681    
weekdaySunday:includedhorm_contra:fertile     5.41612    1.32002    4.10 0.000041 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 5.05203 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 2400 2531 -1184 2368 NA NA NA
with_mod 22 2412 2592 -1184 2368 0.2201 6 0.9998

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2412     2592    -1184     2368    26681 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.917 -0.003 -0.002 -0.001 10.039 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 6.85     2.62    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                             -3.80135    0.27403  -13.87   <2e-16 ***
menstruationpre                                         -0.04933    0.11911   -0.41    0.679    
menstruationyes                                         -0.03692    0.11410   -0.32    0.746    
fertile_mean                                            -3.36367    1.53938   -2.19    0.029 *  
included_levelslax                                       0.68358    0.40996    1.67    0.095 .  
included_levelsconservative                              0.24723    0.30752    0.80    0.421    
included_levelsstrict                                    0.07145    0.32894    0.22    0.828    
includedhorm_contra                                     -0.14953    0.28766   -0.52    0.603    
fertile                                                  0.00584    0.37895    0.02    0.988    
menstruationpre:includedhorm_contra                      0.07469    0.20466    0.36    0.715    
menstruationyes:includedhorm_contra                      0.14578    0.19066    0.76    0.444    
included_levelslax:includedhorm_contra                  -0.65124    0.53799   -1.21    0.226    
included_levelsconservative:includedhorm_contra         -0.30592    0.45923   -0.67    0.505    
included_levelsstrict:includedhorm_contra               -0.19858    0.48751   -0.41    0.684    
included_levelslax:fertile                               0.51509    0.56304    0.91    0.360    
included_levelsconservative:fertile                      0.24074    0.56878    0.42    0.672    
included_levelsstrict:fertile                           -0.04140    0.67940   -0.06    0.951    
includedhorm_contra:fertile                              0.27626    0.71077    0.39    0.698    
included_levelslax:includedhorm_contra:fertile          -0.08232    0.92380   -0.09    0.929    
included_levelsconservative:includedhorm_contra:fertile -0.24668    1.00210   -0.25    0.806    
included_levelsstrict:includedhorm_contra:fertile       -1.01048    1.18624   -0.85    0.394    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.6417 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 2407 2505 -1191 2383 NA NA NA
with_mod 14 2392 2507 -1182 2364 18.84 2 0.00008122

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    certainty_menstruation + included + fertile + menstruation:included +  
    certainty_menstruation:included + certainty_menstruation:fertile +  
    included:fertile + certainty_menstruation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2392     2506    -1182     2364    26689 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.126 -0.003 -0.002 -0.002  7.996 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 7.32     2.71    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                         -3.4721     0.4826   -7.20  6.2e-13 ***
menstruationpre                                     -0.0534     0.1217   -0.44    0.661    
menstruationyes                                      0.1407     0.1109    1.27    0.205    
fertile_mean                                        -0.9822     1.3538   -0.73    0.468    
certainty_menstruation                              -0.1651     0.1091   -1.51    0.130    
includedhorm_contra                                 -0.7793     0.7643   -1.02    0.308    
fertile                                             -2.1533     1.0925   -1.97    0.049 *  
menstruationpre:includedhorm_contra                 -0.1290     0.2107   -0.61    0.540    
menstruationyes:includedhorm_contra                 -0.1351     0.1886   -0.72    0.474    
certainty_menstruation:includedhorm_contra           0.1554     0.1778    0.87    0.382    
certainty_menstruation:fertile                       0.5517     0.2460    2.24    0.025 *  
includedhorm_contra:fertile                          0.9642     2.1468    0.45    0.653    
certainty_menstruation:includedhorm_contra:fertile  -0.2822     0.4752   -0.59    0.553    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.47636 (tol = 0.001, component 1)

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 2408 2522 -1190 2380 NA NA NA
with_mod 18 2414 2561 -1189 2378 1.986 4 0.7383

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    cycle_regularity + included + fertile + menstruation:included +  
    cycle_regularity:included + cycle_regularity:fertile + included:fertile +  
    cycle_regularity:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2414     2561    -1189     2378    26685 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.038 -0.004 -0.003 -0.002  9.297 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 5.33     2.31    
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                                                  Estimate Std. Error z value
(Intercept)                                                                        -3.9780     0.2740  -14.52
menstruationpre                                                                    -0.1010     0.1217   -0.83
menstruationyes                                                                     0.0364     0.1123    0.32
fertile_mean                                                                       -0.3239     1.2489   -0.26
cycle_regularityslightly irregular,\nup to 5 days off                              -0.1333     0.2463   -0.54
cycle_regularityirregular,\nmore than 5 days off                                   -0.4224     0.4148   -1.02
includedhorm_contra                                                                -0.2031     0.2082   -0.98
fertile                                                                             0.4481     0.3212    1.39
menstruationpre:includedhorm_contra                                                -0.1399     0.2076   -0.67
menstruationyes:includedhorm_contra                                                -0.2082     0.1958   -1.06
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra          -0.3813     0.9418   -0.40
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                0.4653     0.6090    0.76
cycle_regularityslightly irregular,\nup to 5 days off:fertile                      -0.8572     0.4882   -1.76
cycle_regularityirregular,\nmore than 5 days off:fertile                           -0.7337     0.6344   -1.16
includedhorm_contra:fertile                                                        -0.5403     0.4540   -1.19
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile  -0.6787     1.8451   -0.37
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile       -0.9897     1.6223   -0.61
                                                                                  Pr(>|z|)    
(Intercept)                                                                         <2e-16 ***
menstruationpre                                                                      0.407    
menstruationyes                                                                      0.746    
fertile_mean                                                                         0.795    
cycle_regularityslightly irregular,\nup to 5 days off                                0.588    
cycle_regularityirregular,\nmore than 5 days off                                     0.309    
includedhorm_contra                                                                  0.329    
fertile                                                                              0.163    
menstruationpre:includedhorm_contra                                                  0.500    
menstruationyes:includedhorm_contra                                                  0.288    
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra            0.686    
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                 0.445    
cycle_regularityslightly irregular,\nup to 5 days off:fertile                        0.079 .  
cycle_regularityirregular,\nmore than 5 days off:fertile                             0.247    
includedhorm_contra:fertile                                                          0.234    
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile    0.713    
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile         0.542    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.20935 (tol = 0.001, component 1)

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 2394 2508 -1183 2366 NA NA NA
with_mod 18 2397 2545 -1181 2361 4.484 4 0.3444

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_intimacy ~ menstruation + fertile_mean + (1 | person) +  
    cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    2397     2545    -1181     2361    26685 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.151 -0.004 -0.002 -0.002  8.326 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 6.78     2.6     
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                                -3.9906     0.2789  -14.31   <2e-16 ***
menstruationpre                                            -0.1270     0.1200   -1.06    0.290    
menstruationyes                                            -0.1325     0.1151   -1.15    0.250    
fertile_mean                                               -1.7258     1.3371   -1.29    0.197    
cohabitationLive in same city                               0.3309     0.2728    1.21    0.225    
cohabitationLong-distance                                   0.1122     0.2668    0.42    0.674    
includedhorm_contra                                        -0.1394     0.2814   -0.50    0.620    
fertile                                                     0.3942     0.3313    1.19    0.234    
menstruationpre:includedhorm_contra                         0.0269     0.2061    0.13    0.896    
menstruationyes:includedhorm_contra                         0.0898     0.1948    0.46    0.645    
cohabitationLive in same city:includedhorm_contra          -0.2022     0.4014   -0.50    0.614    
cohabitationLong-distance:includedhorm_contra              -0.4512     0.4400   -1.03    0.305    
cohabitationLive in same city:fertile                      -1.3222     0.5795   -2.28    0.023 *  
cohabitationLong-distance:fertile                          -0.0483     0.4954   -0.10    0.922    
includedhorm_contra:fertile                                -0.2367     0.6069   -0.39    0.696    
cohabitationLive in same city:includedhorm_contra:fertile   0.3229     0.9385    0.34    0.731    
cohabitationLong-distance:includedhorm_contra:fertile       0.5442     0.8285    0.66    0.511    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.77154 (tol = 0.001, component 1)

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

Does extra-pair desire predict being intimate with an extra-pair mate?

diary %>%
  group_by(person) %>% 
  mutate_at(vars(extra_pair_compliments, extra_pair_flirting, extra_pair_going_out),
    funs(mean, lag), na.rm = T) %>% 
  glmer(extra_pair_intimacy ~ 
          extra_pair_compliments_mean + extra_pair_compliments + 
          extra_pair_flirting_mean + extra_pair_flirting + 
          # extra_pair_going_out_mean + extra_pair_going_out_lag + extra_pair_going_out + 
          (1 | person), data = ., family = binomial(link = 'probit')) %>% summary()
## Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
##  Family: binomial  ( probit )
## Formula: extra_pair_intimacy ~ extra_pair_compliments_mean + extra_pair_compliments +  
##     extra_pair_flirting_mean + extra_pair_flirting + (1 | person)
##    Data: .
## 
##      AIC      BIC   logLik deviance df.resid 
##     2249     2299    -1118     2237    29833 
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -2.601 -0.002 -0.001  0.000 29.705 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  person (Intercept) 5.85     2.42    
## Number of obs: 29839, groups:  person, 1153
## 
## Fixed effects:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                 -5.91191    0.00202   -2928   <2e-16 ***
## extra_pair_compliments_mean -0.25323    0.00202    -126   <2e-16 ***
## extra_pair_compliments       0.35565    0.00201     177   <2e-16 ***
## extra_pair_flirting_mean     0.39682    0.00202     197   <2e-16 ***
## extra_pair_flirting          0.28080    0.00202     139   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) extr_pr_c_ extr_pr_c extr_pr_f_
## extr_pr_cm_ -0.001                                
## extr_pr_cmp -0.002 -0.006                         
## extr_pr_fl_ -0.001 -0.002     -0.003              
## extr_pr_flr -0.001 -0.003     -0.005    -0.002    
## convergence code: 0
## Model failed to converge with max|grad| = 0.0347624 (tol = 0.001, component 1)

Extra-pair sex

model_summaries$extra_pair_sex

Model summary

Model summary

model %>% 
  print_summary()
Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ included * (menstruation + fertile) + fertile_mean +      (1 | person)
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1022.5   1104.7   -501.3   1002.5    27347 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.743 -0.002 -0.001 -0.001  8.164 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 8.65     2.94    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                          -3.8913     0.3126  -12.45   <2e-16 ***
includedhorm_contra                  -0.5226     0.3038   -1.72    0.085 .  
menstruationpre                      -0.0963     0.1731   -0.56    0.578    
menstruationyes                      -0.1869     0.1777   -1.05    0.293    
fertile                               0.2899     0.3554    0.82    0.415    
fertile_mean                         -3.9985     2.0256   -1.97    0.048 *  
includedhorm_contra:menstruationpre   0.2450     0.3313    0.74    0.460    
includedhorm_contra:menstruationyes   0.2945     0.3255    0.90    0.366    
includedhorm_contra:fertile           0.6250     0.6038    1.04    0.301    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.223                                                               
menstrutnpr             -0.183  0.202                                                        
menstrutnys             -0.149  0.163  0.320                                                 
fertile                 -0.166  0.274  0.430    0.303                                        
fertile_men             -0.783 -0.035 -0.016   -0.007   -0.129                               
inclddhrm_cntr:mnstrtnp  0.098 -0.427 -0.522   -0.167   -0.222 -0.009                        
inclddhrm_cntr:mnstrtny  0.080 -0.359 -0.174   -0.546   -0.164 -0.007  0.317                 
inclddhrm_cntr:f         0.163 -0.585 -0.252   -0.178   -0.575 -0.027  0.453                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.341                 
convergence code: 0
Model failed to converge with max|grad| = 1.07467 (tol = 0.001, component 1)

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.29 [-0.41;0.99].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ included + menstruation + fertile + fertile_mean +  
    (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1041.6   1197.7   -501.8   1003.6    27338 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.310 -0.001  0.000  0.000  6.419 

Random effects:
 Groups Name            Variance Std.Dev. Corr          
 person (Intercept)      7.678   2.771                  
        fertile         34.732   5.893    1.00          
        menstruationpre  0.991   0.995    1.00 0.99     
        menstruationyes 30.650   5.536    0.63 0.61 0.67
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value   Pr(>|z|)    
(Intercept)                          -4.0537     0.8873   -4.57 0.00000491 ***
includedhorm_contra                  -0.2045     0.7850   -0.26    0.79450    
menstruationpre                      -0.8779     0.2595   -3.38    0.00072 ***
menstruationyes                      -6.2157     1.4931   -4.16 0.00003143 ***
fertile                              -5.8865     1.1700   -5.03 0.00000049 ***
fertile_mean                         -0.2904     4.8992   -0.06    0.95273    
includedhorm_contra:menstruationpre  -0.1242     0.4559   -0.27    0.78526    
includedhorm_contra:menstruationyes   0.0965     2.8686    0.03    0.97317    
includedhorm_contra:fertile           0.6839     1.8038    0.38    0.70459    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.329                                                               
menstrutnpr              0.326 -0.382                                                        
menstrutnys              0.233 -0.258  0.357                                                 
fertile                  0.475 -0.549  0.782    0.392                                        
fertile_men             -0.813 -0.066  0.014   -0.006    0.013                               
inclddhrm_cntr:mnstrtnp -0.215  0.469 -0.569   -0.204   -0.445  0.028                        
inclddhrm_cntr:mnstrtny -0.073  0.300 -0.187   -0.520   -0.205 -0.057  0.242                 
inclddhrm_cntr:f        -0.391  0.791 -0.506   -0.255   -0.647  0.094  0.696                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.287                 
convergence code: 0
unable to evaluate scaled gradient
Model failed to converge: degenerate  Hessian with 4 negative eigenvalues
failure to converge in 10000 evaluations
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
model 10 1023 1105 -501.3 1003 NA NA NA
with_ind_diff 19 1042 1198 -501.8 1004 0 9 1
robustness_check_ovu_shift(model, diary)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : (maxstephalfit) PIRLS step-halvings failed to reduce deviance in pwrssUpdate

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )

     AIC      BIC   logLik deviance df.resid 
   829.1    975.3   -396.5    793.1    24924 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.738 -0.001 -0.001 -0.001  9.376 

Random effects:
 Groups Name                                   Variance Std.Dev.
 person (Intercept)                            9.153442 3.0255  
 Xr.2   s(days_filled_out):includedhorm_contra 0.008261 0.0909  
 Xr.1   s(days_filled_out):includedcycling     0.000955 0.0309  
 Xr.0   s(day_number):includedhorm_contra      0.003762 0.0613  
 Xr     s(day_number):includedcycling          0.030161 0.1737  
Number of obs: 24942, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error z value Pr(>|z|)    
X(Intercept)                                 -4.680      0.466  -10.05   <2e-16 ***
Xincludedhorm_contra                         -0.124      0.356   -0.35    0.728    
Xmenstruationpre                              0.253      0.196    1.29    0.197    
Xmenstruationyes                             -0.217      0.234   -0.93    0.352    
Xfertile                                      0.707      0.427    1.66    0.098 .  
Xfertile_mean                                -0.893      2.318   -0.39    0.700    
Xincludedhorm_contra:menstruationpre         -0.306      0.370   -0.83    0.408    
Xincludedhorm_contra:menstruationyes         -0.142      0.448   -0.32    0.751    
Xincludedhorm_contra:fertile                 -0.130      0.686   -0.19    0.850    
Xs(day_number):includedcyclingFx1            -0.351      0.339   -1.04    0.301    
Xs(day_number):includedhorm_contraFx1         0.339      0.288    1.18    0.239    
Xs(days_filled_out):includedcyclingFx1        0.430      0.334    1.29    0.198    
Xs(days_filled_out):includedhorm_contraFx1   -0.263      0.297   -0.88    0.377    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
failure to converge in 10000 evaluations

Family: binomial 
Link function: probit 

Formula:
extra_pair_sex ~ included + menstruation + fertile + fertile_mean + 
    s(day_number, by = included) + s(days_filled_out, by = included) + 
    included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                           -4.680      1.066   -4.39 0.000011 ***
includedhorm_contra                   -0.124      0.941   -0.13     0.90    
menstruationpre                        0.253      0.209    1.21     0.22    
menstruationyes                       -0.217      0.243   -0.90     0.37    
fertile                                0.707      0.461    1.54     0.12    
fertile_mean                          -0.893      5.771   -0.15     0.88    
includedhorm_contra:menstruationpre   -0.306      0.398   -0.77     0.44    
includedhorm_contra:menstruationyes   -0.142      0.470   -0.30     0.76    
includedhorm_contra:fertile           -0.130      0.755   -0.17     0.86    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df Chi.sq p-value
s(day_number):includedcycling          1.20   1.20   0.88    0.38
s(day_number):includedhorm_contra      1.02   1.02   0.84    0.36
s(days_filled_out):includedcycling     1.01   1.01   1.46    0.23
s(days_filled_out):includedhorm_contra 1.03   1.03   0.48    0.50

R-sq.(adj) =  -0.000489   
glmer.ML =  574.4  Scale est. = 1         n = 24942

Information: No AR1/ARMA autocorrelation models were fitted for binomial outcomes.

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

     AIC      BIC   logLik deviance df.resid 
   655.1    794.8   -309.6    619.1    17309 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.796 -0.002 -0.001  0.000  8.338 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 6.62     2.57    
Number of obs: 17327, groups:  person, 513

Fixed effects:
                                                         Estimate Std. Error z value      Pr(>|z|)    
(Intercept)                                              -3.67937    0.58125   -6.33 0.00000000024 ***
fertile_mean                                             -3.56096    3.55183   -1.00         0.316    
contraceptive_methodsfertility_awareness                 -0.00439    0.53158   -0.01         0.993    
contraceptive_methodsnone                                -0.95267    1.06125   -0.90         0.369    
contraceptive_methodshormonal                            -0.82668    0.46450   -1.78         0.075 .  
fertile                                                   0.18951    0.58182    0.33         0.745    
menstruationpre                                          -0.09068    0.29507   -0.31         0.759    
menstruationyes                                          -0.04614    0.28244   -0.16         0.870    
contraceptive_methodsfertility_awareness:fertile          0.04392    1.05865    0.04         0.967    
contraceptive_methodsnone:fertile                         1.18355    1.61484    0.73         0.464    
contraceptive_methodshormonal:fertile                     0.65884    0.82474    0.80         0.424    
contraceptive_methodsfertility_awareness:menstruationpre  0.27534    0.46933    0.59         0.557    
contraceptive_methodsnone:menstruationpre                 0.59791    0.72170    0.83         0.407    
contraceptive_methodshormonal:menstruationpre            -0.08170    0.46732   -0.17         0.861    
contraceptive_methodsfertility_awareness:menstruationyes -0.19639    0.52347   -0.38         0.708    
contraceptive_methodsnone:menstruationyes                 0.00423    0.78435    0.01         0.996    
contraceptive_methodshormonal:menstruationyes            -0.21762    0.48104   -0.45         0.651    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.00364 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 12 643.2 736.3 -309.6 619.2 NA NA NA
by_method 18 655.1 794.8 -309.6 619.1 0.038 6 1

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 18 1047 1195 -505.5 1011 NA NA NA
with_mod 26 1056 1270 -502.1 1004 6.695 8 0.5698

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ menstruation + fertile_mean + (1 | person) +  
    age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1056.2   1269.8   -502.1   1004.2    27331 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.741 -0.002 -0.001 -0.001  8.661 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 5.63     2.37    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                   -3.5193     0.4103   -8.58   <2e-16 ***
menstruationpre                               -0.0393     0.1672   -0.23     0.81    
menstruationyes                               -0.2822     0.1851   -1.52     0.13    
fertile_mean                                  -2.1251     1.8627   -1.14     0.25    
age_group(20,25]                              -0.3613     0.3809   -0.95     0.34    
age_group(25,30]                              -0.7525     0.4705   -1.60     0.11    
age_group(30,35]                              -0.6352     0.5476   -1.16     0.25    
age_group(35,70]                              -0.5814     0.5090   -1.14     0.25    
includedhorm_contra                           -0.6734     0.5050   -1.33     0.18    
fertile                                       -0.3801     0.9748   -0.39     0.70    
menstruationpre:includedhorm_contra           -0.1937     0.3430   -0.56     0.57    
menstruationyes:includedhorm_contra           -0.1025     0.3670   -0.28     0.78    
age_group(20,25]:includedhorm_contra           0.1640     0.6197    0.26     0.79    
age_group(25,30]:includedhorm_contra           0.6453     0.7842    0.82     0.41    
age_group(30,35]:includedhorm_contra           0.2949     1.6521    0.18     0.86    
age_group(35,70]:includedhorm_contra           0.3724     1.3047    0.29     0.78    
age_group(20,25]:fertile                      -0.3651     1.1212   -0.33     0.74    
age_group(25,30]:fertile                       1.2138     1.1298    1.07     0.28    
age_group(30,35]:fertile                       1.1354     1.2633    0.90     0.37    
age_group(35,70]:fertile                      -0.0215     1.5202   -0.01     0.99    
includedhorm_contra:fertile                    0.6693     1.4582    0.46     0.65    
age_group(20,25]:includedhorm_contra:fertile   0.6081     1.6628    0.37     0.71    
age_group(25,30]:includedhorm_contra:fertile  -1.1380     1.9084   -0.60     0.55    
age_group(30,35]:includedhorm_contra:fertile  -4.3275     3.2367   -1.34     0.18    
age_group(35,70]:includedhorm_contra:fertile   0.3518     2.3227    0.15     0.88    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.37765 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 1025 1123 -500.3 1001 NA NA NA
with_mod 14 1035 1150 -503.5 1007 0 2 1

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ menstruation + fertile_mean + (1 | person) +  
    weekend + included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1035.0   1150.0   -503.5   1007.0    27343 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.768 -0.003 -0.002 -0.001 12.119 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 5.02     2.24    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error z value Pr(>|z|)    
(Intercept)                               -4.371      0.352  -12.43   <2e-16 ***
menstruationpre                           -0.142      0.175   -0.81   0.4170    
menstruationyes                           -0.215      0.180   -1.19   0.2334    
fertile_mean                              -0.268      1.652   -0.16   0.8712    
weekendTRUE                                0.265      0.158    1.68   0.0932 .  
includedhorm_contra                        0.111      0.271    0.41   0.6819    
fertile                                    0.323      0.443    0.73   0.4656    
menstruationpre:includedhorm_contra       -0.268      0.347   -0.77   0.4395    
menstruationyes:includedhorm_contra       -0.261      0.358   -0.73   0.4660    
weekendTRUE:includedhorm_contra           -0.788      0.300   -2.63   0.0086 ** 
weekendTRUE:fertile                       -1.210      0.692   -1.75   0.0802 .  
includedhorm_contra:fertile               -1.418      0.815   -1.74   0.0818 .  
weekendTRUE:includedhorm_contra:fertile    3.618      1.118    3.23   0.0012 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.07465 (tol = 0.001, component 1)

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 22 1042 1223 -499.1 998.3 NA NA NA
with_mod 34 1060 1339 -495.8 991.6 6.694 12 0.8772

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ menstruation + fertile_mean + (1 | person) +  
    weekday + included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1059.6   1338.9   -495.8    991.6    27323 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.852 -0.002 -0.001  0.000  8.526 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 5.96     2.44    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                   -3.7105     0.3451  -10.75   <2e-16 ***
menstruationpre                                0.0421     0.1751    0.24    0.810    
menstruationyes                               -0.0563     0.1786   -0.31    0.753    
fertile_mean                                  -3.9966     1.9000   -2.10    0.035 *  
weekdayTuesday                                -0.3831     0.2850   -1.34    0.179    
weekdayWednesday                              -0.3190     0.2902   -1.10    0.272    
weekdayThursday                               -0.4285     0.2923   -1.47    0.143    
weekdayFriday                                 -0.2784     0.2971   -0.94    0.349    
weekdaySaturday                               -0.1926     0.2844   -0.68    0.498    
weekdaySunday                                  0.0382     0.2530    0.15    0.880    
includedhorm_contra                            0.1108     0.3485    0.32    0.750    
fertile                                        0.1286     0.7774    0.17    0.869    
menstruationpre:includedhorm_contra           -0.5372     0.3688   -1.46    0.145    
menstruationyes:includedhorm_contra           -0.2229     0.3393   -0.66    0.511    
weekdayTuesday:includedhorm_contra            -0.0630     0.4740   -0.13    0.894    
weekdayWednesday:includedhorm_contra          -0.4757     0.5326   -0.89    0.372    
weekdayThursday:includedhorm_contra           -0.3465     0.5446   -0.64    0.525    
weekdayFriday:includedhorm_contra             -0.8447     0.6636   -1.27    0.203    
weekdaySaturday:includedhorm_contra            0.2662     0.4188    0.64    0.525    
weekdaySunday:includedhorm_contra             -0.8185     0.5123   -1.60    0.110    
weekdayTuesday:fertile                         0.7203     1.1048    0.65    0.514    
weekdayWednesday:fertile                       0.7785     1.1132    0.70    0.484    
weekdayThursday:fertile                       -0.2451     1.2812   -0.19    0.848    
weekdayFriday:fertile                          0.2575     1.1497    0.22    0.823    
weekdaySaturday:fertile                       -0.0474     1.2161   -0.04    0.969    
weekdaySunday:fertile                         -0.2689     1.1259   -0.24    0.811    
includedhorm_contra:fertile                   -0.9350     1.3555   -0.69    0.490    
weekdayTuesday:includedhorm_contra:fertile    -0.8154     2.1221   -0.38    0.701    
weekdayWednesday:includedhorm_contra:fertile  -0.3652     2.1535   -0.17    0.865    
weekdayThursday:includedhorm_contra:fertile    1.7612     2.0743    0.85    0.396    
weekdayFriday:includedhorm_contra:fertile      1.8834     2.2958    0.82    0.412    
weekdaySaturday:includedhorm_contra:fertile    0.4088     1.8390    0.22    0.824    
weekdaySunday:includedhorm_contra:fertile      2.9583     1.8711    1.58    0.114    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 1.98989 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 1031 1163 -499.7 999.3 NA NA NA
with_mod 22 1074 1255 -515 1030 0 6 1

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ menstruation + fertile_mean + (1 | person) +  
    included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    1074     1255     -515     1030    27335 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.834 -0.004 -0.002 -0.001 11.074 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 3.51     1.87    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                              -3.6420     0.3001  -12.14   <2e-16 ***
menstruationpre                                           0.1454     0.1602    0.91    0.364    
menstruationyes                                          -0.0435     0.1702   -0.26    0.798    
fertile_mean                                             -4.3097     1.8020   -2.39    0.017 *  
included_levelslax                                        0.3326     0.3808    0.87    0.382    
included_levelsconservative                               0.3104     0.3410    0.91    0.363    
included_levelsstrict                                     0.1169     0.3487    0.34    0.737    
includedhorm_contra                                      -0.4082     0.4733   -0.86    0.389    
fertile                                                  -0.2701     0.5945   -0.45    0.650    
menstruationpre:includedhorm_contra                      -0.1117     0.3206   -0.35    0.728    
menstruationyes:includedhorm_contra                       0.2045     0.3015    0.68    0.497    
included_levelslax:includedhorm_contra                   -0.1995     0.6642   -0.30    0.764    
included_levelsconservative:includedhorm_contra          -0.2913     0.6504   -0.45    0.654    
included_levelsstrict:includedhorm_contra                 0.2081     0.6008    0.35    0.729    
included_levelslax:fertile                                0.4566     0.8458    0.54    0.589    
included_levelsconservative:fertile                       0.6043     0.9063    0.67    0.505    
included_levelsstrict:fertile                             1.1351     0.8300    1.37    0.171    
includedhorm_contra:fertile                              -1.3494     1.5917   -0.85    0.397    
included_levelslax:includedhorm_contra:fertile            2.9655     1.8040    1.64    0.100    
included_levelsconservative:includedhorm_contra:fertile   2.4563     1.8990    1.29    0.196    
included_levelsstrict:includedhorm_contra:fertile         0.2871     2.0045    0.14    0.886    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 6.19799 (tol = 0.001, component 1)

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : (maxstephalfit) PIRLS step-halvings failed to reduce deviance in pwrssUpdate

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 1037 1136 -506.5 1013 NA NA NA
with_mod 14 1038 1153 -504.8 1010 3.332 2 0.189

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ menstruation + fertile_mean + (1 | person) +  
    certainty_menstruation + included + fertile + menstruation:included +  
    certainty_menstruation:included + certainty_menstruation:fertile +  
    included:fertile + certainty_menstruation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1037.7   1152.7   -504.8   1009.7    27343 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.708 -0.002 -0.001 -0.001  6.945 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 6.41     2.53    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error z value   Pr(>|z|)    
(Intercept)                                         -3.8114     0.7311   -5.21 0.00000019 ***
menstruationpre                                      0.0451     0.1696    0.27     0.7901    
menstruationyes                                     -0.2813     0.1890   -1.49     0.1367    
fertile_mean                                        -6.3769     2.1026   -3.03     0.0024 ** 
certainty_menstruation                               0.0549     0.1652    0.33     0.7394    
includedhorm_contra                                 -0.4094     1.2539   -0.33     0.7440    
fertile                                              1.0307     1.3236    0.78     0.4361    
menstruationpre:includedhorm_contra                 -0.3293     0.3484   -0.95     0.3446    
menstruationyes:includedhorm_contra                  0.2364     0.3211    0.74     0.4617    
certainty_menstruation:includedhorm_contra           0.0516     0.2838    0.18     0.8558    
certainty_menstruation:fertile                      -0.1855     0.3150   -0.59     0.5561    
includedhorm_contra:fertile                         -0.8808     3.6341   -0.24     0.8085    
certainty_menstruation:includedhorm_contra:fertile   0.2544     0.8012    0.32     0.7509    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 2.68207 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 1027 1142 -499.6 999.1 NA NA NA
with_mod 18 1046 1194 -504.8 1010 0 4 1

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: extra_pair_sex ~ menstruation + fertile_mean + (1 | person) +  
    cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
  1045.7   1193.6   -504.8   1009.7    27339 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-0.740 -0.002 -0.001  0.000  7.360 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 5.55     2.36    
Number of obs: 27357, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                                -4.0572     0.3676  -11.04   <2e-16 ***
menstruationpre                                            -0.1071     0.1656   -0.65    0.518    
menstruationyes                                            -0.4538     0.1918   -2.37    0.018 *  
fertile_mean                                               -2.2268     1.8467   -1.21    0.228    
cohabitationLive in same city                               0.4074     0.3292    1.24    0.216    
cohabitationLong-distance                                   0.2653     0.3363    0.79    0.430    
includedhorm_contra                                        -0.2553     0.3895   -0.66    0.512    
fertile                                                     0.6374     0.4973    1.28    0.200    
menstruationpre:includedhorm_contra                        -0.0461     0.3486   -0.13    0.895    
menstruationyes:includedhorm_contra                         0.4886     0.3359    1.45    0.146    
cohabitationLive in same city:includedhorm_contra          -0.4668     0.6173   -0.76    0.450    
cohabitationLong-distance:includedhorm_contra              -0.8202     0.8394   -0.98    0.329    
cohabitationLive in same city:fertile                      -1.7265     0.8505   -2.03    0.042 *  
cohabitationLong-distance:fertile                          -1.2545     0.7473   -1.68    0.093 .  
includedhorm_contra:fertile                                 0.2102     0.8216    0.26    0.798    
cohabitationLive in same city:includedhorm_contra:fertile   0.1514     1.5136    0.10    0.920    
cohabitationLong-distance:includedhorm_contra:fertile       0.8268     1.2798    0.65    0.518    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 3.75735 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)

Error: Error in pwrssUpdate(pp, resp, tol = tolPwrss, GQmat = GQmat, compDev = compDev, : Downdated VtV is not positive definite

Does extra-pair desire predict having sex with an extra-pair mate?

diary %>%
  group_by(person) %>% 
  mutate_at(vars(extra_pair_compliments, extra_pair_flirting, extra_pair_going_out),
    funs(mean, lag), na.rm = T) %>% 
  glmer(extra_pair_sex ~ 
          extra_pair_compliments_mean + extra_pair_compliments + 
          extra_pair_flirting_mean + extra_pair_flirting + 
          # extra_pair_going_out_mean + extra_pair_going_out_lag + extra_pair_going_out + 
          (1 | person), data = ., family = binomial(link = 'probit')) %>% summary()
## Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
##  Family: binomial  ( probit )
## Formula: extra_pair_sex ~ extra_pair_compliments_mean + extra_pair_compliments +  
##     extra_pair_flirting_mean + extra_pair_flirting + (1 | person)
##    Data: .
## 
##      AIC      BIC   logLik deviance df.resid 
##    983.9   1033.7   -485.9    971.9    29867 
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
##  -1.28   0.00   0.00   0.00  11.86 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  person (Intercept) 9.06     3.01    
## Number of obs: 29873, groups:  person, 1154
## 
## Fixed effects:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  -6.2267     0.4964  -12.54  < 2e-16 ***
## extra_pair_compliments_mean  -0.3000     0.1988   -1.51    0.131    
## extra_pair_compliments        0.4234     0.0552    7.68  1.6e-14 ***
## extra_pair_flirting_mean      0.3047     0.2587    1.18    0.239    
## extra_pair_flirting           0.1300     0.0614    2.12    0.034 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) extr_pr_c_ extr_pr_c extr_pr_f_
## extr_pr_cm_ -0.507                                
## extr_pr_cmp -0.405 -0.144                         
## extr_pr_fl_ -0.028 -0.698      0.141              
## extr_pr_flr  0.041  0.111     -0.456    -0.299

In-pair desire

model_summaries$in_pair_desire

Model summary

Model summary

model %>% 
  print_summary()
Linear mixed model fit by REML 
t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
Formula: in_pair_desire ~ included * (menstruation + fertile) + fertile_mean +      (1 | person)
   Data: diary

REML criterion at convergence: 83086

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.481 -0.678 -0.031  0.667  3.799 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.736    0.858   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                       Estimate  Std. Error          df t value     Pr(>|t|)    
(Intercept)                             3.47053     0.07560  1399.00000   45.91      < 2e-16 ***
includedhorm_contra                     0.29330     0.06188  1365.00000    4.74 0.0000023616 ***
menstruationpre                        -0.06767     0.03327 26000.00000   -2.03       0.0419 *  
menstruationyes                        -0.18759     0.03135 26112.00000   -5.98 0.0000000022 ***
fertile                                 0.26125     0.06714 25981.00000    3.89       0.0001 ***
fertile_mean                            0.03371     0.34713  1518.00000    0.10       0.9227    
includedhorm_contra:menstruationpre    -0.00281     0.04271 25996.00000   -0.07       0.9475    
includedhorm_contra:menstruationyes     0.03767     0.04109 26088.00000    0.92       0.3593    
includedhorm_contra:fertile            -0.47357     0.08505 26113.00000   -5.57 0.0000000260 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.473                                                               
menstrutnpr             -0.170  0.215                                                        
menstrutnys             -0.165  0.207  0.397                                                 
fertile                 -0.163  0.266  0.467    0.384                                        
fertile_men             -0.772 -0.026 -0.008   -0.005   -0.069                               
inclddhrm_cntr:mnstrtnp  0.140 -0.269 -0.779   -0.309   -0.363 -0.004                        
inclddhrm_cntr:mnstrtny  0.132 -0.254 -0.303   -0.763   -0.293 -0.004  0.383                 
inclddhrm_cntr:f         0.163 -0.336 -0.368   -0.303   -0.786  0.010  0.466                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.381                 

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.24 [0.12;0.36].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ included + menstruation + fertile + fertile_mean +  
    (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

REML criterion at convergence: 82634

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.671 -0.661 -0.033  0.646  3.661 

Random effects:
 Groups   Name            Variance Std.Dev. Corr             
 person   (Intercept)     0.826    0.909                     
          fertile         1.057    1.028    -0.29            
          menstruationpre 0.198    0.444    -0.22  0.35      
          menstruationyes 0.244    0.493    -0.21  0.25  0.27
 Residual                 1.107    1.052                     
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error t value
(Intercept)                           3.4770     0.0775    44.8
includedhorm_contra                   0.2842     0.0651     4.4
menstruationpre                      -0.0636     0.0414    -1.5
menstruationyes                      -0.1899     0.0415    -4.6
fertile                               0.2582     0.0876     2.9
fertile_mean                          0.0146     0.3522     0.0
includedhorm_contra:menstruationpre   0.0086     0.0532     0.2
includedhorm_contra:menstruationyes   0.0476     0.0539     0.9
includedhorm_contra:fertile          -0.4504     0.1113    -4.0

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.486                                                               
menstrutnpr             -0.207  0.252                                                        
menstrutnys             -0.205  0.245  0.335                                                 
fertile                 -0.213  0.329  0.410    0.325                                        
fertile_men             -0.758 -0.026 -0.005   -0.001   -0.081                               
inclddhrm_cntr:mnstrtnp  0.170 -0.319 -0.779   -0.261   -0.319 -0.007                        
inclddhrm_cntr:mnstrtny  0.162 -0.305 -0.258   -0.768   -0.249 -0.006  0.327                 
inclddhrm_cntr:f         0.207 -0.418 -0.323   -0.256   -0.783  0.012  0.411                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.322                 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
object 11 83069 83159 -41524 83047 NA NA NA
..1 20 82639 82803 -41299 82599 448.3 9 6.694e-91
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Linear mixed model fit by REML ['lmerMod']

REML criterion at convergence: 75701

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.528 -0.682 -0.034  0.656  3.727 

Random effects:
 Groups   Name                                   Variance Std.Dev.
 person   (Intercept)                            0.744    0.862   
 Xr.2     s(days_filled_out):includedhorm_contra 0.213    0.462   
 Xr.1     s(days_filled_out):includedcycling     0.120    0.347   
 Xr.0     s(day_number):includedhorm_contra      0.195    0.441   
 Xr       s(day_number):includedcycling          0.265    0.515   
 Residual                                        1.168    1.081   
Number of obs: 24377, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                            Estimate Std. Error t value
X(Intercept)                                3.433548   0.076433    44.9
Xincludedhorm_contra                        0.288701   0.063161     4.6
Xmenstruationpre                           -0.069772   0.034500    -2.0
Xmenstruationyes                           -0.206265   0.033124    -6.2
Xfertile                                    0.250923   0.071046     3.5
Xfertile_mean                               0.111169   0.348689     0.3
Xincludedhorm_contra:menstruationpre       -0.000389   0.044253     0.0
Xincludedhorm_contra:menstruationyes        0.048506   0.043355     1.1
Xincludedhorm_contra:fertile               -0.477230   0.089937    -5.3
Xs(day_number):includedcyclingFx1           0.193693   0.148884     1.3
Xs(day_number):includedhorm_contraFx1       0.496596   0.139077     3.6
Xs(days_filled_out):includedcyclingFx1     -0.161664   0.131656    -1.2
Xs(days_filled_out):includedhorm_contraFx1 -0.478781   0.141323    -3.4

Family: gaussian 
Link function: identity 

Formula:
in_pair_desire ~ included + menstruation + fertile + fertile_mean + 
    s(day_number, by = included) + s(days_filled_out, by = included) + 
    included:menstruation + included:fertile

Parametric coefficients:
                                     Estimate Std. Error t value      Pr(>|t|)    
(Intercept)                          3.433548   0.076433   44.92       < 2e-16 ***
includedhorm_contra                  0.288701   0.063161    4.57 0.00000488126 ***
menstruationpre                     -0.069772   0.034500   -2.02       0.04315 *  
menstruationyes                     -0.206265   0.033124   -6.23 0.00000000048 ***
fertile                              0.250923   0.071046    3.53       0.00041 ***
fertile_mean                         0.111169   0.348689    0.32       0.74986    
includedhorm_contra:menstruationpre -0.000389   0.044253   -0.01       0.99298    
includedhorm_contra:menstruationyes  0.048506   0.043355    1.12       0.26323    
includedhorm_contra:fertile         -0.477230   0.089937   -5.31 0.00000011288 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df    F      p-value    
s(day_number):includedcycling          4.58   4.58 3.38        0.012 *  
s(day_number):includedhorm_contra      4.49   4.49 9.10 0.0000000880 ***
s(days_filled_out):includedcycling     3.47   3.47 3.74        0.010 *  
s(days_filled_out):includedhorm_contra 4.65   4.65 9.88 0.0000000098 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

R-sq.(adj) =  0.0073   
lmer.REML =  75701  Scale est. = 1.1676    n = 24377

Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  80351 80449 -40163

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.8243     1.11

Correlation Structure: ARMA(1,0)
 Formula: ~day_number | person 
 Parameter estimate(s):
  Phi1 
0.3693 
Fixed effects: in_pair_desire ~ included * (menstruation + fertile) + fertile_mean 
                                     Value Std.Error    DF t-value p-value
(Intercept)                          3.468    0.0770 25620   45.03  0.0000
includedhorm_contra                  0.288    0.0635  1051    4.53  0.0000
menstruationpre                     -0.051    0.0394 25620   -1.29  0.1979
menstruationyes                     -0.182    0.0367 25620   -4.95  0.0000
fertile                              0.276    0.0858 25620    3.21  0.0013
fertile_mean                         0.082    0.3546  1051    0.23  0.8169
includedhorm_contra:menstruationpre -0.005    0.0506 25620   -0.10  0.9188
includedhorm_contra:menstruationyes  0.062    0.0477 25620    1.30  0.1932
includedhorm_contra:fertile         -0.457    0.1084 25620   -4.21  0.0000
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.477                                                               
menstruationpre                     -0.195  0.243                                                        
menstruationyes                     -0.191  0.237  0.404                                                 
fertile                             -0.187  0.312  0.410    0.350                                        
fertile_mean                        -0.767 -0.028 -0.007   -0.005   -0.089                               
includedhorm_contra:menstruationpre  0.159 -0.303 -0.778   -0.315   -0.318 -0.005                        
includedhorm_contra:menstruationyes  0.153 -0.289 -0.311   -0.769   -0.268 -0.004  0.389                 
includedhorm_contra:fertile          0.190 -0.394 -0.324   -0.276   -0.786  0.015  0.408                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.343                 

Standardized Within-Group Residuals:
     Min       Q1      Med       Q3      Max 
-3.38144 -0.68695 -0.03729  0.65882  3.74443 

Number of Observations: 26680
Number of Groups: 1054 
Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  80332 80438 -40153

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.8207    1.112

Correlation Structure: ARMA(1,1)
 Formula: ~day_number | person 
 Parameter estimate(s):
    Phi1   Theta1 
 0.44522 -0.08788 
Fixed effects: in_pair_desire ~ included * (menstruation + fertile) + fertile_mean 
                                     Value Std.Error    DF t-value p-value
(Intercept)                          3.468    0.0771 25620   44.99  0.0000
includedhorm_contra                  0.288    0.0636  1051    4.53  0.0000
menstruationpre                     -0.048    0.0396 25620   -1.20  0.2297
menstruationyes                     -0.182    0.0369 25620   -4.94  0.0000
fertile                              0.275    0.0869 25620    3.16  0.0016
fertile_mean                         0.085    0.3550  1051    0.24  0.8104
includedhorm_contra:menstruationpre -0.008    0.0509 25620   -0.15  0.8799
includedhorm_contra:menstruationyes  0.061    0.0480 25620    1.27  0.2042
includedhorm_contra:fertile         -0.456    0.1098 25620   -4.15  0.0000
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.477                                                               
menstruationpre                     -0.195  0.243                                                        
menstruationyes                     -0.192  0.238  0.407                                                 
fertile                             -0.188  0.314  0.401    0.347                                        
fertile_mean                        -0.767 -0.028 -0.006   -0.005   -0.090                               
includedhorm_contra:menstruationpre  0.159 -0.303 -0.778   -0.317   -0.311 -0.005                        
includedhorm_contra:menstruationyes  0.154 -0.291 -0.313   -0.769   -0.266 -0.004  0.393                 
includedhorm_contra:fertile          0.191 -0.397 -0.317   -0.274   -0.786  0.015  0.400                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.340                 

Standardized Within-Group Residuals:
     Min       Q1      Med       Q3      Max 
-3.37254 -0.68777 -0.03708  0.66182  3.72189 

Number of Observations: 26680
Number of Groups: 1054 

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

REML criterion at convergence: 52683

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.489 -0.682 -0.039  0.670  3.439 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.674    0.821   
 Residual             1.179    1.086   
Number of obs: 17026, groups:  person, 513

Fixed effects:
                                                         Estimate Std. Error t value
(Intercept)                                               3.70449    0.15897   23.30
fertile_mean                                             -0.06860    0.77147   -0.09
contraceptive_methodsfertility_awareness                 -0.02951    0.20787   -0.14
contraceptive_methodsnone                                -0.40242    0.22038   -1.83
contraceptive_methodshormonal                             0.10620    0.10475    1.01
fertile                                                   0.16094    0.12113    1.33
menstruationpre                                          -0.08107    0.05851   -1.39
menstruationyes                                          -0.20042    0.05588   -3.59
contraceptive_methodsfertility_awareness:fertile         -0.30697    0.27510   -1.12
contraceptive_methodsnone:fertile                         0.40800    0.29783    1.37
contraceptive_methodshormonal:fertile                    -0.40963    0.13531   -3.03
contraceptive_methodsfertility_awareness:menstruationpre -0.18053    0.12961   -1.39
contraceptive_methodsnone:menstruationpre                -0.16633    0.13549   -1.23
contraceptive_methodshormonal:menstruationpre            -0.00178    0.06590   -0.03
contraceptive_methodsfertility_awareness:menstruationyes  0.09994    0.13025    0.77
contraceptive_methodsnone:menstruationyes                -0.10010    0.14168   -0.71
contraceptive_methodshormonal:menstruationyes             0.00895    0.06373    0.14

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 13 52675 52775 -26324 52649 NA NA NA
by_method 19 52674 52821 -26318 52636 13.13 6 0.04103

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 19 83064 83220 -41513 83026 NA NA NA
with_mod 27 83057 83278 -41502 83003 22.8 8 0.003634

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

REML criterion at convergence: 83073

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.476 -0.678 -0.028  0.668  3.800 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.727    0.853   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                   3.69249    0.15697   23.52
menstruationpre                              -0.06926    0.03327   -2.08
menstruationyes                              -0.19202    0.03136   -6.12
fertile_mean                                  0.02076    0.34699    0.06
age_group(20,25]                             -0.17249    0.16779   -1.03
age_group(25,30]                             -0.08092    0.17272   -0.47
age_group(30,35]                             -0.32733    0.19817   -1.65
age_group(35,70]                             -0.50998    0.17947   -2.84
includedhorm_contra                           0.25205    0.16816    1.50
fertile                                       0.19954    0.19194    1.04
menstruationpre:includedhorm_contra          -0.00329    0.04271   -0.08
menstruationyes:includedhorm_contra           0.04007    0.04111    0.97
age_group(20,25]:includedhorm_contra         -0.00921    0.19130   -0.05
age_group(25,30]:includedhorm_contra         -0.21025    0.21076   -1.00
age_group(30,35]:includedhorm_contra         -0.03372    0.27432   -0.12
age_group(35,70]:includedhorm_contra         -0.18323    0.29990   -0.61
age_group(20,25]:fertile                      0.08104    0.21261    0.38
age_group(25,30]:fertile                     -0.28129    0.21915   -1.28
age_group(30,35]:fertile                      0.50175    0.25382    1.98
age_group(35,70]:fertile                      0.24387    0.22906    1.06
includedhorm_contra:fertile                  -0.53899    0.21289   -2.53
age_group(20,25]:includedhorm_contra:fertile  0.05880    0.23817    0.25
age_group(25,30]:includedhorm_contra:fertile  0.54708    0.26392    2.07
age_group(30,35]:includedhorm_contra:fertile -0.43643    0.34061   -1.28
age_group(35,70]:includedhorm_contra:fertile  0.19718    0.38702    0.51

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 82729 82836 -41352 82703 NA NA NA
with_mod 15 82731 82854 -41351 82701 1.82 2 0.4025

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    weekend + included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

REML criterion at convergence: 82758

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.596 -0.673 -0.026  0.662  3.891 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.737    0.859   
 Residual             1.173    1.083   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error t value
(Intercept)                              3.38146    0.07644    44.2
menstruationpre                         -0.06759    0.03305    -2.0
menstruationyes                         -0.18913    0.03114    -6.1
fertile_mean                             0.04679    0.34669     0.1
weekendTRUE                              0.21458    0.02881     7.4
includedhorm_contra                      0.28222    0.06364     4.4
fertile                                  0.22267    0.08114     2.7
menstruationpre:includedhorm_contra     -0.00489    0.04243    -0.1
menstruationyes:includedhorm_contra      0.04235    0.04083     1.0
weekendTRUE:includedhorm_contra          0.03480    0.03708     0.9
weekendTRUE:fertile                      0.08652    0.11173     0.8
includedhorm_contra:fertile             -0.47909    0.10309    -4.6
weekendTRUE:includedhorm_contra:fertile  0.01048    0.14211     0.1

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 23 82534 82723 -41244 82488 NA NA NA
with_mod 35 82539 82826 -41235 82469 19.32 12 0.08108

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    weekday + included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

REML criterion at convergence: 82594

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.598 -0.669 -0.021  0.662  3.943 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.739    0.86    
 Residual             1.163    1.08    
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                   3.56902    0.08261    43.2
menstruationpre                              -0.06795    0.03292    -2.1
menstruationyes                              -0.19015    0.03101    -6.1
fertile_mean                                  0.02397    0.34672     0.1
weekdayTuesday                               -0.20447    0.05134    -4.0
weekdayWednesday                             -0.25772    0.05125    -5.0
weekdayThursday                              -0.27499    0.05184    -5.3
weekdayFriday                                -0.13476    0.05271    -2.6
weekdaySaturday                               0.10928    0.05324     2.1
weekdaySunday                                 0.11856    0.05145     2.3
includedhorm_contra                           0.25455    0.07517     3.4
fertile                                       0.01847    0.14459     0.1
menstruationpre:includedhorm_contra          -0.00272    0.04226    -0.1
menstruationyes:includedhorm_contra           0.04529    0.04066     1.1
weekdayTuesday:includedhorm_contra           -0.06445    0.06596    -1.0
weekdayWednesday:includedhorm_contra          0.02847    0.06617     0.4
weekdayThursday:includedhorm_contra           0.14669    0.06681     2.2
weekdayFriday:includedhorm_contra             0.08778    0.06772     1.3
weekdaySaturday:includedhorm_contra           0.02055    0.06851     0.3
weekdaySunday:includedhorm_contra             0.07517    0.06641     1.1
weekdayTuesday:fertile                        0.12784    0.19904     0.6
weekdayWednesday:fertile                      0.18574    0.19997     0.9
weekdayThursday:fertile                       0.53738    0.20283     2.6
weekdayFriday:fertile                         0.42100    0.20319     2.1
weekdaySaturday:fertile                       0.00518    0.20589     0.0
weekdaySunday:fertile                         0.45332    0.20009     2.3
includedhorm_contra:fertile                  -0.33181    0.18495    -1.8
weekdayTuesday:includedhorm_contra:fertile    0.11935    0.25404     0.5
weekdayWednesday:includedhorm_contra:fertile -0.20132    0.25605    -0.8
weekdayThursday:includedhorm_contra:fertile  -0.52273    0.25815    -2.0
weekdayFriday:includedhorm_contra:fertile    -0.23864    0.25892    -0.9
weekdaySaturday:includedhorm_contra:fertile   0.08497    0.26265     0.3
weekdaySunday:includedhorm_contra:fertile    -0.25817    0.25559    -1.0

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 83076 83215 -41521 83042 NA NA NA
with_mod 23 83084 83272 -41519 83038 3.696 6 0.7178

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

REML criterion at convergence: 83104

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.488 -0.677 -0.031  0.667  3.764 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.736    0.858   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error t value
(Intercept)                                              3.41458    0.08395    40.7
menstruationpre                                         -0.06967    0.03330    -2.1
menstruationyes                                         -0.18737    0.03136    -6.0
fertile_mean                                             0.00622    0.35042     0.0
included_levelslax                                       0.06678    0.17141     0.4
included_levelsconservative                              0.25059    0.13379     1.9
included_levelsstrict                                    0.13118    0.13163     1.0
includedhorm_contra                                      0.32704    0.08666     3.8
fertile                                                  0.30577    0.08487     3.6
menstruationpre:includedhorm_contra                     -0.00153    0.04277     0.0
menstruationyes:includedhorm_contra                      0.03672    0.04115     0.9
included_levelslax:includedhorm_contra                  -0.10687    0.20872    -0.5
included_levelsconservative:includedhorm_contra         -0.12982    0.16719    -0.8
included_levelsstrict:includedhorm_contra               -0.11242    0.16185    -0.7
included_levelslax:fertile                              -0.30457    0.20730    -1.5
included_levelsconservative:fertile                      0.01806    0.15481     0.1
included_levelsstrict:fertile                           -0.11705    0.15492    -0.8
includedhorm_contra:fertile                             -0.49956    0.12958    -3.9
included_levelslax:includedhorm_contra:fertile           0.32379    0.25294     1.3
included_levelsconservative:includedhorm_contra:fertile -0.11028    0.20128    -0.5
included_levelsstrict:includedhorm_contra:fertile        0.12578    0.19817     0.6

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 83070 83209 -41518 83036 NA NA NA
with_mod 23 83076 83264 -41515 83030 5.943 6 0.4296

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    cycle_length_groups + included + fertile + menstruation:included +  
    cycle_length_groups:included + cycle_length_groups:fertile +  
    included:fertile + cycle_length_groups:included:fertile
   Data: diary

REML criterion at convergence: 83088

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.484 -0.679 -0.030  0.665  3.797 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.732    0.855   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                       Estimate Std. Error t value
(Intercept)                                              3.2228     0.1439   22.40
menstruationpre                                         -0.0664     0.0333   -1.99
menstruationyes                                         -0.1834     0.0316   -5.81
fertile_mean                                             0.0213     0.3507    0.06
cycle_length_groups(25,30]                               0.3151     0.1412    2.23
cycle_length_groups(30,35]                               0.1673     0.1698    0.99
cycle_length_groups(35,41]                               0.2760     0.2406    1.15
includedhorm_contra                                      0.4084     0.1605    2.54
fertile                                                  0.0987     0.1772    0.56
menstruationpre:includedhorm_contra                     -0.0031     0.0428   -0.07
menstruationyes:includedhorm_contra                      0.0339     0.0413    0.82
cycle_length_groups(25,30]:includedhorm_contra          -0.1520     0.1742   -0.87
cycle_length_groups(30,35]:includedhorm_contra          -0.1966     0.2672   -0.74
cycle_length_groups(35,41]:includedhorm_contra           0.0685     0.3412    0.20
cycle_length_groups(25,30]:fertile                       0.1666     0.1901    0.88
cycle_length_groups(30,35]:fertile                       0.2779     0.2251    1.23
cycle_length_groups(35,41]:fertile                       0.1141     0.3180    0.36
includedhorm_contra:fertile                             -0.2571     0.2092   -1.23
cycle_length_groups(25,30]:includedhorm_contra:fertile  -0.2100     0.2252   -0.93
cycle_length_groups(30,35]:includedhorm_contra:fertile  -0.8393     0.3544   -2.37
cycle_length_groups(35,41]:includedhorm_contra:fertile  -0.1653     0.4187   -0.39

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83069 83176 -41522 83043 NA NA NA
with_mod 15 83062 83185 -41516 83032 11.33 2 0.003466

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    certainty_menstruation + included + fertile + menstruation:included +  
    certainty_menstruation:included + certainty_menstruation:fertile +  
    included:fertile + certainty_menstruation:included:fertile
   Data: diary

REML criterion at convergence: 83088

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.483 -0.678 -0.032  0.668  3.822 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.734    0.857   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error t value
(Intercept)                                         3.26851    0.21152   15.45
menstruationpre                                    -0.06397    0.03328   -1.92
menstruationyes                                    -0.18188    0.03139   -5.79
fertile_mean                                        0.01146    0.34744    0.03
certainty_menstruation                              0.04943    0.04820    1.03
includedhorm_contra                                 0.33000    0.26850    1.23
fertile                                            -0.58428    0.26422   -2.21
menstruationpre:includedhorm_contra                -0.00646    0.04272   -0.15
menstruationyes:includedhorm_contra                 0.03152    0.04113    0.77
certainty_menstruation:includedhorm_contra         -0.00974    0.06252   -0.16
certainty_menstruation:fertile                      0.20489    0.06191    3.31
includedhorm_contra:fertile                         0.50259    0.34343    1.46
certainty_menstruation:includedhorm_contra:fertile -0.23533    0.07938   -2.96

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 83071 83194 -41521 83041 NA NA NA
with_mod 19 83078 83233 -41520 83040 1.613 4 0.8065

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    cycle_regularity + included + fertile + menstruation:included +  
    cycle_regularity:included + cycle_regularity:fertile + included:fertile +  
    cycle_regularity:included:fertile
   Data: diary

REML criterion at convergence: 83096

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.479 -0.678 -0.031  0.665  3.787 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.735    0.857   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                                  Estimate Std. Error t value
(Intercept)                                                                        3.56169    0.08914    40.0
menstruationpre                                                                   -0.06934    0.03330    -2.1
menstruationyes                                                                   -0.18866    0.03136    -6.0
fertile_mean                                                                       0.05098    0.34858     0.1
cycle_regularityslightly irregular,\nup to 5 days off                             -0.18858    0.10308    -1.8
cycle_regularityirregular,\nmore than 5 days off                                  -0.15007    0.12132    -1.2
includedhorm_contra                                                                0.20141    0.08108     2.5
fertile                                                                            0.19751    0.09298     2.1
menstruationpre:includedhorm_contra                                               -0.00143    0.04274     0.0
menstruationyes:includedhorm_contra                                                0.03830    0.04112     0.9
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra          0.29381    0.15565     1.9
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra              -0.03107    0.18413    -0.2
cycle_regularityslightly irregular,\nup to 5 days off:fertile                      0.07277    0.12824     0.6
cycle_regularityirregular,\nmore than 5 days off:fertile                           0.19319    0.15769     1.2
includedhorm_contra:fertile                                                       -0.41479    0.10893    -3.8
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile -0.06993    0.19043    -0.4
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile      -0.13903    0.23540    -0.6

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 83057 83180 -41513 83027 NA NA NA
with_mod 19 83056 83211 -41509 83018 9.394 4 0.05197

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

REML criterion at convergence: 83078

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.473 -0.679 -0.029  0.665  3.768 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.723    0.85    
 Residual             1.188    1.09    
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                                 3.3728     0.0858    39.3
menstruationpre                                            -0.0680     0.0333    -2.0
menstruationyes                                            -0.1877     0.0314    -6.0
fertile_mean                                               -0.0023     0.3456     0.0
cohabitationLive in same city                               0.2326     0.1162     2.0
cohabitationLong-distance                                   0.2306     0.1095     2.1
includedhorm_contra                                         0.2255     0.0921     2.4
fertile                                                     0.4097     0.0839     4.9
menstruationpre:includedhorm_contra                        -0.0039     0.0427    -0.1
menstruationyes:includedhorm_contra                         0.0365     0.0411     0.9
cohabitationLive in same city:includedhorm_contra           0.1423     0.1485     1.0
cohabitationLong-distance:includedhorm_contra              -0.0961     0.1421    -0.7
cohabitationLive in same city:fertile                      -0.3560     0.1533    -2.3
cohabitationLong-distance:fertile                          -0.3293     0.1381    -2.4
includedhorm_contra:fertile                                -0.5902     0.1226    -4.8
cohabitationLive in same city:includedhorm_contra:fertile   0.2702     0.1917     1.4
cohabitationLong-distance:includedhorm_contra:fertile       0.3165     0.1779     1.8

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 83058 83181 -41514 83028 NA NA NA
with_mod 19 83062 83218 -41512 83024 3.683 4 0.4505

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    relationship_status_clean + included + fertile + menstruation:included +  
    relationship_status_clean:included + relationship_status_clean:fertile +  
    included:fertile + relationship_status_clean:included:fertile
   Data: diary

REML criterion at convergence: 83075

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.478 -0.677 -0.030  0.667  3.786 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.723    0.85    
 Residual             1.189    1.09    
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                 Estimate Std. Error t value
(Intercept)                                                       3.56063    0.08033    44.3
menstruationpre                                                  -0.06783    0.03327    -2.0
menstruationyes                                                  -0.18765    0.03134    -6.0
fertile_mean                                                      0.04050    0.34527     0.1
relationship_status_cleanVerheiratet                             -0.33663    0.10619    -3.2
relationship_status_cleanVerlobt                                 -0.18312    0.20466    -0.9
includedhorm_contra                                               0.22621    0.06884     3.3
fertile                                                           0.20076    0.07688     2.6
menstruationpre:includedhorm_contra                              -0.00339    0.04271    -0.1
menstruationyes:includedhorm_contra                               0.03727    0.04109     0.9
relationship_status_cleanVerheiratet:includedhorm_contra         -0.22870    0.20466    -1.1
relationship_status_cleanVerlobt:includedhorm_contra              0.27110    0.30221     0.9
relationship_status_cleanVerheiratet:fertile                      0.21099    0.13534     1.6
relationship_status_cleanVerlobt:fertile                          0.16829    0.25380     0.7
includedhorm_contra:fertile                                      -0.42523    0.09371    -4.5
relationship_status_cleanVerheiratet:includedhorm_contra:fertile -0.09785    0.25486    -0.4
relationship_status_cleanVerlobt:includedhorm_contra:fertile      0.10122    0.39420     0.3
do_moderators(models$in_pair_desire, diary)

Moderators

Partner’s physical attractiveness

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) when partner’s physical attractiveness is low.

model %>%
  test_moderator("partner_attractiveness_physical", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 82861 82967 -41417 82835 NA NA NA
with_mod 15 82864 82986 -41417 82834 1.362 2 0.506

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_physical + included + fertile + menstruation:included +  
    partner_attractiveness_physical:included + partner_attractiveness_physical:fertile +  
    included:fertile + partner_attractiveness_physical:included:fertile
   Data: diary

REML criterion at convergence: 82894

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.476 -0.679 -0.029  0.667  3.765 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.593    0.77    
 Residual             1.188    1.09    
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                            Estimate Std. Error t value
(Intercept)                                                  1.31921    0.21259    6.21
menstruationpre                                             -0.06928    0.03324   -2.08
menstruationyes                                             -0.18954    0.03132   -6.05
fertile_mean                                                -0.05585    0.32099   -0.17
partner_attractiveness_physical                              0.27375    0.02544   10.76
includedhorm_contra                                          0.64365    0.27749    2.32
fertile                                                     -0.04778    0.29264   -0.16
menstruationpre:includedhorm_contra                         -0.00151    0.04267   -0.04
menstruationyes:includedhorm_contra                          0.03834    0.04105    0.93
partner_attractiveness_physical:includedhorm_contra         -0.05176    0.03381   -1.53
partner_attractiveness_physical:fertile                      0.03850    0.03586    1.07
includedhorm_contra:fertile                                 -0.05085    0.38722   -0.13
partner_attractiveness_physical:includedhorm_contra:fertile -0.05233    0.04682   -1.12

Partner’s short-term attractiveness

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) when partner’s short-term attractiveness is low.

model %>%
  test_moderator("partner_attractiveness_shortterm", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 82859 82965 -41416 82833 NA NA NA
with_mod 15 82862 82985 -41416 82832 0.3601 2 0.8352

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_shortterm + included + fertile + menstruation:included +  
    partner_attractiveness_shortterm:included + partner_attractiveness_shortterm:fertile +  
    included:fertile + partner_attractiveness_shortterm:included:fertile
   Data: diary

REML criterion at convergence: 82890

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.489 -0.680 -0.031  0.665  3.738 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.589    0.768   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                             Estimate Std. Error t value
(Intercept)                                                   3.53611    0.06974    50.7
menstruationpre                                              -0.06853    0.03324    -2.1
menstruationyes                                              -0.19000    0.03132    -6.1
fertile_mean                                                 -0.04066    0.32029    -0.1
partner_attractiveness_shortterm                              0.44389    0.03981    11.1
includedhorm_contra                                           0.20107    0.05719     3.5
fertile                                                       0.25628    0.06734     3.8
menstruationpre:includedhorm_contra                          -0.00238    0.04267    -0.1
menstruationyes:includedhorm_contra                           0.03878    0.04105     0.9
partner_attractiveness_shortterm:includedhorm_contra         -0.08985    0.05357    -1.7
partner_attractiveness_shortterm:fertile                     -0.01870    0.05632    -0.3
includedhorm_contra:fertile                                  -0.47181    0.08544    -5.5
partner_attractiveness_shortterm:includedhorm_contra:fertile  0.04253    0.07382     0.6

Partner’s short-term vs. long-term attractiveness

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) top-right (high LT, low ST), then top-left (low LT, low ST), then bottom-left (low LT, high ST), then bottom-right (high LT/ST).

add_main = update.formula(formula(model), new = as.formula(paste0(". ~ . + partner_attractiveness_longterm * included + partner_attractiveness_shortterm * included + partner_attractiveness_longterm * partner_attractiveness_shortterm"))) # reorder so that the triptych looks nice
add_mod_formula = update.formula(update.formula(formula(model), new = . ~ . - included * fertile), new = as.formula(paste0(". ~ . + partner_attractiveness_longterm * fertile * partner_attractiveness_shortterm * included"))) # reorder so that the triptych looks nice

update(model, formula = add_main) -> with_main
update(model, formula = add_mod_formula) -> with_mod
cat(pander(anova(with_main, with_mod)))

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 82832 82963 -41400 82800 NA NA NA
with_mod 23 82838 83026 -41396 82792 8.076 7 0.326
effs = allEffects(with_mod)
effs = data.frame(effs$`partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:included`) %>% 
  filter(partner_attractiveness_longterm %in% c(-2,0),partner_attractiveness_shortterm %in% c(-2,0))
ggplot(effs, aes(fertile, fit, ymin = lower, ymax = upper, color = included)) + 
  facet_grid(partner_attractiveness_shortterm ~ partner_attractiveness_longterm) +
  geom_smooth(stat='identity') +
  scale_color_manual(values = c("cycling" = 'red', 'horm_contra' = 'black'), guide = F) +
  scale_fill_manual(values = c("cycling" = 'red', 'horm_contra' = 'black'), guide = F) +
  ggtitle("Moderation", "top-to-bottom: short-term,\nleft-to-right: long-term attractiveness of the partner")+
  ylab(names(model@frame)[1])

print_summary(with_mod)
Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_longterm + fertile + partner_attractiveness_shortterm +  
    included + menstruation:included + partner_attractiveness_longterm:fertile +  
    partner_attractiveness_longterm:partner_attractiveness_shortterm +  
    fertile:partner_attractiveness_shortterm + partner_attractiveness_longterm:included +  
    fertile:included + partner_attractiveness_shortterm:included +  
    partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm +  
    partner_attractiveness_longterm:fertile:included + partner_attractiveness_longterm:partner_attractiveness_shortterm:included +  
    fertile:partner_attractiveness_shortterm:included + partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:included
   Data: diary

REML criterion at convergence: 82884

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.469 -0.679 -0.031  0.666  3.721 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.571    0.756   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                                             Estimate
(Intercept)                                                                                   3.50204
menstruationpre                                                                              -0.06820
menstruationyes                                                                              -0.18859
fertile_mean                                                                                  0.03909
partner_attractiveness_longterm                                                               0.20962
fertile                                                                                       0.27279
partner_attractiveness_shortterm                                                              0.36951
includedhorm_contra                                                                           0.23158
menstruationpre:includedhorm_contra                                                          -0.00223
menstruationyes:includedhorm_contra                                                           0.03739
partner_attractiveness_longterm:fertile                                                       0.03446
partner_attractiveness_longterm:partner_attractiveness_shortterm                              0.02908
fertile:partner_attractiveness_shortterm                                                     -0.04912
partner_attractiveness_longterm:includedhorm_contra                                          -0.09155
fertile:includedhorm_contra                                                                  -0.51024
partner_attractiveness_shortterm:includedhorm_contra                                         -0.03942
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm                     -0.05152
partner_attractiveness_longterm:fertile:includedhorm_contra                                  -0.05296
partner_attractiveness_longterm:partner_attractiveness_shortterm:includedhorm_contra         -0.09524
fertile:partner_attractiveness_shortterm:includedhorm_contra                                  0.06646
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:includedhorm_contra  0.17079
                                                                                             Std. Error
(Intercept)                                                                                     0.07067
menstruationpre                                                                                 0.03324
menstruationyes                                                                                 0.03134
fertile_mean                                                                                    0.31724
partner_attractiveness_longterm                                                                 0.04751
fertile                                                                                         0.07023
partner_attractiveness_shortterm                                                                0.04371
includedhorm_contra                                                                             0.05905
menstruationpre:includedhorm_contra                                                             0.04267
menstruationyes:includedhorm_contra                                                             0.04107
partner_attractiveness_longterm:fertile                                                         0.06782
partner_attractiveness_longterm:partner_attractiveness_shortterm                                0.03494
fertile:partner_attractiveness_shortterm                                                        0.06152
partner_attractiveness_longterm:includedhorm_contra                                             0.06055
fertile:includedhorm_contra                                                                     0.08848
partner_attractiveness_shortterm:includedhorm_contra                                            0.05692
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm                        0.05026
partner_attractiveness_longterm:fertile:includedhorm_contra                                     0.08603
partner_attractiveness_longterm:partner_attractiveness_shortterm:includedhorm_contra            0.05454
fertile:partner_attractiveness_shortterm:includedhorm_contra                                    0.07888
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:includedhorm_contra    0.07783
                                                                                             t value
(Intercept)                                                                                     49.6
menstruationpre                                                                                 -2.1
menstruationyes                                                                                 -6.0
fertile_mean                                                                                     0.1
partner_attractiveness_longterm                                                                  4.4
fertile                                                                                          3.9
partner_attractiveness_shortterm                                                                 8.5
includedhorm_contra                                                                              3.9
menstruationpre:includedhorm_contra                                                             -0.1
menstruationyes:includedhorm_contra                                                              0.9
partner_attractiveness_longterm:fertile                                                          0.5
partner_attractiveness_longterm:partner_attractiveness_shortterm                                 0.8
fertile:partner_attractiveness_shortterm                                                        -0.8
partner_attractiveness_longterm:includedhorm_contra                                             -1.5
fertile:includedhorm_contra                                                                     -5.8
partner_attractiveness_shortterm:includedhorm_contra                                            -0.7
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm                        -1.0
partner_attractiveness_longterm:fertile:includedhorm_contra                                     -0.6
partner_attractiveness_longterm:partner_attractiveness_shortterm:includedhorm_contra            -1.7
fertile:partner_attractiveness_shortterm:includedhorm_contra                                     0.8
partner_attractiveness_longterm:fertile:partner_attractiveness_shortterm:includedhorm_contra     2.2

Relative attractiveness to self

whole MV and MV_P scale

Predicted fertile phase effect sizes (in red): biggest (EP desire, partner mate retention)/smallest (IP desire) when partner’s relative attractiveness is low.

three item subsets of the MV/MV_P scale
model %>%
  test_moderator("partner_attractiveness_rel_to_self_MV_short", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83073 83179 -41523 83047 NA NA NA
with_mod 15 83074 83196 -41522 83044 2.942 2 0.2297

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_rel_to_self_MV_short + included +  
    fertile + menstruation:included + partner_attractiveness_rel_to_self_MV_short:included +  
    partner_attractiveness_rel_to_self_MV_short:fertile + included:fertile +  
    partner_attractiveness_rel_to_self_MV_short:included:fertile
   Data: diary

REML criterion at convergence: 83097

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.478 -0.678 -0.031  0.666  3.792 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.737    0.859   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                        Estimate Std. Error t value
(Intercept)                                                              3.48531    0.08488    41.1
menstruationpre                                                         -0.06752    0.03327    -2.0
menstruationyes                                                         -0.18644    0.03135    -5.9
fertile_mean                                                             0.02679    0.34747     0.1
partner_attractiveness_rel_to_self_MV_short                              0.03999    0.10675     0.4
includedhorm_contra                                                      0.27436    0.07253     3.8
fertile                                                                  0.32763    0.07982     4.1
menstruationpre:includedhorm_contra                                     -0.00276    0.04271    -0.1
menstruationyes:includedhorm_contra                                      0.03701    0.04110     0.9
partner_attractiveness_rel_to_self_MV_short:includedhorm_contra         -0.02178    0.11100    -0.2
partner_attractiveness_rel_to_self_MV_short:fertile                      0.19950    0.12973     1.5
includedhorm_contra:fertile                                             -0.53130    0.09605    -5.5
partner_attractiveness_rel_to_self_MV_short:includedhorm_contra:fertile -0.22710    0.13473    -1.7
model %>%
  test_moderator("partner_attractiveness_rel_to_self", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83072 83178 -41523 83046 NA NA NA
with_mod 15 83073 83196 -41521 83043 2.917 2 0.2326

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_rel_to_self + included + fertile +  
    menstruation:included + partner_attractiveness_rel_to_self:included +  
    partner_attractiveness_rel_to_self:fertile + included:fertile +  
    partner_attractiveness_rel_to_self:included:fertile
   Data: diary

REML criterion at convergence: 83097

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.478 -0.679 -0.031  0.665  3.795 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.737    0.858   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                               Estimate Std. Error t value
(Intercept)                                                     3.50059    0.08501    41.2
menstruationpre                                                -0.06739    0.03327    -2.0
menstruationyes                                                -0.18599    0.03136    -5.9
fertile_mean                                                    0.02296    0.34736     0.1
partner_attractiveness_rel_to_self                              0.08378    0.10964     0.8
includedhorm_contra                                             0.26103    0.07275     3.6
fertile                                                         0.33222    0.08038     4.1
menstruationpre:includedhorm_contra                            -0.00294    0.04271    -0.1
menstruationyes:includedhorm_contra                             0.03646    0.04111     0.9
partner_attractiveness_rel_to_self:includedhorm_contra         -0.07014    0.11374    -0.6
partner_attractiveness_rel_to_self:fertile                      0.21507    0.13433     1.6
includedhorm_contra:fertile                                    -0.53765    0.09652    -5.6
partner_attractiveness_rel_to_self:includedhorm_contra:fertile -0.23666    0.13917    -1.7

Partner’s shortterm attractiveness, alternative specification

model %>%
  test_moderator("partner_attractiveness_shortterm_v2", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 82928 83035 -41451 82902 NA NA NA
with_mod 15 82932 83055 -41451 82902 0.1319 2 0.9362

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_shortterm_v2 + included + fertile +  
    menstruation:included + partner_attractiveness_shortterm_v2:included +  
    partner_attractiveness_shortterm_v2:fertile + included:fertile +  
    partner_attractiveness_shortterm_v2:included:fertile
   Data: diary

REML criterion at convergence: 82959

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.489 -0.678 -0.030  0.665  3.753 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.636    0.797   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                                Estimate Std. Error t value
(Intercept)                                                      3.51036    0.07161    49.0
menstruationpre                                                 -0.06955    0.03325    -2.1
menstruationyes                                                 -0.19054    0.03133    -6.1
fertile_mean                                                    -0.05967    0.32914    -0.2
partner_attractiveness_shortterm_v2                              0.38131    0.04134     9.2
includedhorm_contra                                              0.25594    0.05857     4.4
fertile                                                          0.25675    0.06715     3.8
menstruationpre:includedhorm_contra                             -0.00143    0.04269     0.0
menstruationyes:includedhorm_contra                              0.03908    0.04107     1.0
partner_attractiveness_shortterm_v2:includedhorm_contra         -0.09950    0.05485    -1.8
partner_attractiveness_shortterm_v2:fertile                     -0.01590    0.05613    -0.3
includedhorm_contra:fertile                                     -0.46983    0.08510    -5.5
partner_attractiveness_shortterm_v2:includedhorm_contra:fertile  0.02649    0.07303     0.4

Partner’s global attractiveness

model %>%
  test_moderator("partner_attractiveness_global", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83045 83152 -41510 83019 NA NA NA
with_mod 15 83046 83169 -41508 83016 3.289 2 0.1931

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_global + included + fertile + menstruation:included +  
    partner_attractiveness_global:included + partner_attractiveness_global:fertile +  
    included:fertile + partner_attractiveness_global:included:fertile
   Data: diary

REML criterion at convergence: 83072

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.465 -0.677 -0.031  0.664  3.781 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.717    0.846   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                                3.48085    0.07485    46.5
menstruationpre                                           -0.06830    0.03327    -2.1
menstruationyes                                           -0.18857    0.03134    -6.0
fertile_mean                                              -0.02659    0.34395    -0.1
partner_attractiveness_global                              0.17364    0.04384     4.0
includedhorm_contra                                        0.29531    0.06124     4.8
fertile                                                    0.25918    0.06714     3.9
menstruationpre:includedhorm_contra                       -0.00156    0.04271     0.0
menstruationyes:includedhorm_contra                        0.03865    0.04109     0.9
partner_attractiveness_global:includedhorm_contra         -0.02735    0.05749    -0.5
partner_attractiveness_global:fertile                     -0.07899    0.05567    -1.4
includedhorm_contra:fertile                               -0.47148    0.08504    -5.5
partner_attractiveness_global:includedhorm_contra:fertile  0.02826    0.07153     0.4

Partner’s longterm attractiveness

model %>%
  test_moderator("partner_attractiveness_longterm", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 82976 83082 -41475 82950 NA NA NA
with_mod 15 82979 83102 -41475 82949 0.5225 2 0.7701

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_longterm + included + fertile + menstruation:included +  
    partner_attractiveness_longterm:included + partner_attractiveness_longterm:fertile +  
    included:fertile + partner_attractiveness_longterm:included:fertile
   Data: diary

REML criterion at convergence: 83006

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.475 -0.679 -0.030  0.666  3.784 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.669    0.818   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                            Estimate Std. Error t value
(Intercept)                                                  3.45258    0.07293    47.3
menstruationpre                                             -0.06861    0.03326    -2.1
menstruationyes                                             -0.18796    0.03136    -6.0
fertile_mean                                                 0.15132    0.33550     0.5
partner_attractiveness_longterm                              0.35500    0.04347     8.2
includedhorm_contra                                          0.28065    0.05968     4.7
fertile                                                      0.25971    0.06714     3.9
menstruationpre:includedhorm_contra                         -0.00185    0.04270     0.0
menstruationyes:includedhorm_contra                          0.03799    0.04110     0.9
partner_attractiveness_longterm:includedhorm_contra         -0.15338    0.05835    -2.6
partner_attractiveness_longterm:fertile                      0.03883    0.05945     0.7
includedhorm_contra:fertile                                 -0.47144    0.08512    -5.5
partner_attractiveness_longterm:includedhorm_contra:fertile -0.05470    0.07865    -0.7

Partner’s short-term vs. long-term attractiveness

We also test this specification of the short-term vs. long-term moderator prediction, but we think this is a suboptimal way to test it.

model %>%
  test_moderator("partner_st_vs_lt", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83055 83161 -41514 83029 NA NA NA
with_mod 15 83058 83180 -41514 83028 1.37 2 0.504

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_st_vs_lt + included + fertile + menstruation:included +  
    partner_st_vs_lt:included + partner_st_vs_lt:fertile + included:fertile +  
    partner_st_vs_lt:included:fertile
   Data: diary

REML criterion at convergence: 83085

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.494 -0.678 -0.031  0.667  3.787 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.722    0.85    
 Residual             1.189    1.09    
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                   3.49006    0.07541    46.3
menstruationpre                              -0.06726    0.03327    -2.0
menstruationyes                              -0.18709    0.03135    -6.0
fertile_mean                                 -0.01312    0.34513     0.0
partner_st_vs_lt                              0.09844    0.04082     2.4
includedhorm_contra                           0.27531    0.06163     4.5
fertile                                       0.25414    0.06751     3.8
menstruationpre:includedhorm_contra          -0.00364    0.04271    -0.1
menstruationyes:includedhorm_contra           0.03649    0.04110     0.9
partner_st_vs_lt:includedhorm_contra          0.01163    0.05195     0.2
partner_st_vs_lt:fertile                     -0.04967    0.05199    -1.0
includedhorm_contra:fertile                  -0.46828    0.08538    -5.5
partner_st_vs_lt:includedhorm_contra:fertile  0.07658    0.06554     1.2

Partner’s mate value

long scale
model %>%
  test_moderator("MV_P", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83058 83164 -41516 83032 NA NA NA
with_mod 15 83057 83180 -41513 83027 4.971 2 0.08329

Error: Error in plot.eff(x[[(i - 1) * cols + j]], row = i, col = j, nrow = rows, : x.var = ‘fertile’ is not in the effect.

short scale
model %>%
  test_moderator("MV_P_short", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83015 83121 -41494 82989 NA NA NA
with_mod 15 83012 83134 -41491 82982 7.202 2 0.0273

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    MV_P_short + included + fertile + menstruation:included +  
    MV_P_short:included + MV_P_short:fertile + included:fertile +      MV_P_short:included:fertile
   Data: diary

REML criterion at convergence: 83036

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.479 -0.680 -0.028  0.664  3.772 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.692    0.832   
 Residual             1.188    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                       Estimate Std. Error t value
(Intercept)                             2.47636    0.19252   12.86
menstruationpre                        -0.06876    0.03326   -2.07
menstruationyes                        -0.18853    0.03134   -6.02
fertile_mean                           -0.02163    0.33951   -0.06
MV_P_short                              0.29751    0.05289    5.63
includedhorm_contra                     0.39626    0.24359    1.63
fertile                                 0.54022    0.24290    2.22
menstruationpre:includedhorm_contra    -0.00105    0.04270   -0.02
menstruationyes:includedhorm_contra     0.03840    0.04108    0.93
MV_P_short:includedhorm_contra         -0.02755    0.07028   -0.39
MV_P_short:fertile                     -0.08323    0.06947   -1.20
includedhorm_contra:fertile            -0.29227    0.31384   -0.93
MV_P_short:includedhorm_contra:fertile -0.05470    0.09014   -0.61

Partner’s job and income

model %>%
  test_moderator("partner_attractiveness_money", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 83073 83179 -41523 83047 NA NA NA
with_mod 15 83076 83199 -41523 83046 0.6831 2 0.7107

Linear mixed model fit by REML ['lmerMod']
Formula: in_pair_desire ~ menstruation + fertile_mean + (1 | person) +  
    partner_attractiveness_money + included + fertile + menstruation:included +  
    partner_attractiveness_money:included + partner_attractiveness_money:fertile +  
    included:fertile + partner_attractiveness_money:included:fertile
   Data: diary

REML criterion at convergence: 83101

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.492 -0.678 -0.031  0.666  3.794 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.737    0.858   
 Residual             1.189    1.090   
Number of obs: 26680, groups:  person, 1054

Fixed effects:
                                                         Estimate Std. Error t value
(Intercept)                                               3.56519    0.17753   20.08
menstruationpre                                          -0.06767    0.03327   -2.03
menstruationyes                                          -0.18773    0.03135   -5.99
fertile_mean                                              0.02803    0.34755    0.08
partner_attractiveness_money                             -0.02962    0.05048   -0.59
includedhorm_contra                                       0.11133    0.22241    0.50
fertile                                                   0.20609    0.21358    0.96
menstruationpre:includedhorm_contra                      -0.00282    0.04271   -0.07
menstruationyes:includedhorm_contra                       0.03763    0.04110    0.92
partner_attractiveness_money:includedhorm_contra          0.05924    0.06933    0.85
partner_attractiveness_money:fertile                      0.01737    0.06392    0.27
includedhorm_contra:fertile                              -0.28289    0.28031   -1.01
partner_attractiveness_money:includedhorm_contra:fertile -0.06293    0.08661   -0.73

Self-reported perceived desirability

model_summaries$desirability_1

Model summary

Model summary

model %>% 
  print_summary()
Linear mixed model fit by REML 
t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
Formula: desirability_1 ~ included * (menstruation + fertile) + fertile_mean +      (1 | person)
   Data: diary

REML criterion at convergence: 84665

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.054 -0.629  0.030  0.659  3.660 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.727    0.853   
 Residual             1.264    1.124   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                       Estimate  Std. Error          df t value Pr(>|t|)    
(Intercept)                             3.71137     0.07578  1448.00000   48.98   <2e-16 ***
includedhorm_contra                     0.00628     0.06201  1419.00000    0.10   0.9193    
menstruationpre                        -0.11113     0.03429 26038.00000   -3.24   0.0012 ** 
menstruationyes                        -0.25228     0.03231 26151.00000   -7.81    6e-15 ***
fertile                                 0.14751     0.06921 26018.00000    2.13   0.0331 *  
fertile_mean                            0.01695     0.34834  1569.00000    0.05   0.9612    
includedhorm_contra:menstruationpre     0.02787     0.04402 26035.00000    0.63   0.5266    
includedhorm_contra:menstruationyes     0.07101     0.04235 26127.00000    1.68   0.0936 .  
includedhorm_contra:fertile            -0.28646     0.08765 26150.00000   -3.27   0.0011 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.473                                                               
menstrutnpr             -0.175  0.221                                                        
menstrutnys             -0.170  0.213  0.397                                                 
fertile                 -0.167  0.273  0.467    0.384                                        
fertile_men             -0.772 -0.026 -0.008   -0.005   -0.071                               
inclddhrm_cntr:mnstrtnp  0.144 -0.277 -0.779   -0.309   -0.363 -0.004                        
inclddhrm_cntr:mnstrtny  0.136 -0.262 -0.303   -0.763   -0.292 -0.004  0.382                 
inclddhrm_cntr:f         0.167 -0.345 -0.368   -0.303   -0.786  0.010  0.466                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.381                 

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.13 [0.01;0.25].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ included + menstruation + fertile + fertile_mean +  
    (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

REML criterion at convergence: 84426

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.140 -0.611  0.027  0.646  3.629 

Random effects:
 Groups   Name            Variance Std.Dev. Corr             
 person   (Intercept)     0.796    0.892                     
          fertile         0.796    0.892    -0.28            
          menstruationpre 0.148    0.385    -0.16  0.34      
          menstruationyes 0.142    0.376    -0.20  0.14  0.34
 Residual                 1.205    1.098                     
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error t value
(Intercept)                          3.71586    0.07716    48.2
includedhorm_contra                  0.00631    0.06449     0.1
menstruationpre                     -0.11330    0.04053    -2.8
menstruationyes                     -0.25265    0.03848    -6.6
fertile                              0.14810    0.08499     1.7
fertile_mean                        -0.00751    0.35129     0.0
includedhorm_contra:menstruationpre  0.03745    0.05202     0.7
includedhorm_contra:menstruationyes  0.07512    0.05018     1.5
includedhorm_contra:fertile         -0.28685    0.10786    -2.7

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.484                                                               
menstrutnpr             -0.191  0.237                                                        
menstrutnys             -0.207  0.246  0.374                                                 
fertile                 -0.209  0.327  0.416    0.307                                        
fertile_men             -0.760 -0.027 -0.008    0.002   -0.082                               
inclddhrm_cntr:mnstrtnp  0.158 -0.298 -0.779   -0.291   -0.323 -0.005                        
inclddhrm_cntr:mnstrtny  0.163 -0.306 -0.286   -0.767   -0.235 -0.007  0.363                 
inclddhrm_cntr:f         0.205 -0.415 -0.327   -0.242   -0.784  0.012  0.416                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.303                 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
object 11 84649 84739 -42313 84627 NA NA NA
..1 20 84430 84594 -42195 84390 236.5 9 6.882e-46
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Linear mixed model fit by REML ['lmerMod']

REML criterion at convergence: 77305

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.001 -0.627  0.027  0.664  3.811 

Random effects:
 Groups   Name                                   Variance Std.Dev.
 person   (Intercept)                            0.7241   0.851   
 Xr.2     s(days_filled_out):includedhorm_contra 0.0000   0.000   
 Xr.1     s(days_filled_out):includedcycling     0.1038   0.322   
 Xr.0     s(day_number):includedhorm_contra      0.0000   0.000   
 Xr       s(day_number):includedcycling          0.0747   0.273   
 Residual                                        1.2519   1.119   
Number of obs: 24382, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error t value
X(Intercept)                                 3.6848     0.0763    48.3
Xincludedhorm_contra                         0.0143     0.0630     0.2
Xmenstruationpre                            -0.1054     0.0357    -3.0
Xmenstruationyes                            -0.2404     0.0343    -7.0
Xfertile                                     0.1831     0.0735     2.5
Xfertile_mean                                0.0223     0.3485     0.1
Xincludedhorm_contra:menstruationpre         0.0168     0.0457     0.4
Xincludedhorm_contra:menstruationyes         0.0668     0.0448     1.5
Xincludedhorm_contra:fertile                -0.3091     0.0930    -3.3
Xs(day_number):includedcyclingFx1           -0.0202     0.1117    -0.2
Xs(day_number):includedhorm_contraFx1        0.1376     0.0484     2.8
Xs(days_filled_out):includedcyclingFx1      -0.1257     0.1208    -1.0
Xs(days_filled_out):includedhorm_contraFx1  -0.1539     0.0496    -3.1

Family: gaussian 
Link function: identity 

Formula:
desirability_1 ~ included + menstruation + fertile + fertile_mean + 
    s(day_number, by = included) + s(days_filled_out, by = included) + 
    included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)                           3.6848     0.0763   48.29  < 2e-16 ***
includedhorm_contra                   0.0143     0.0630    0.23  0.82011    
menstruationpre                      -0.1054     0.0357   -2.95  0.00315 ** 
menstruationyes                      -0.2404     0.0343   -7.01  2.4e-12 ***
fertile                               0.1831     0.0735    2.49  0.01275 *  
fertile_mean                          0.0223     0.3485    0.06  0.94899    
includedhorm_contra:menstruationpre   0.0168     0.0457    0.37  0.71359    
includedhorm_contra:menstruationyes   0.0668     0.0448    1.49  0.13633    
includedhorm_contra:fertile          -0.3091     0.0930   -3.32  0.00089 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df    F p-value   
s(day_number):includedcycling          3.10   3.10 1.58  0.1659   
s(day_number):includedhorm_contra      1.00   1.00 8.07  0.0045 **
s(days_filled_out):includedcycling     3.49   3.49 1.04  0.2880   
s(days_filled_out):includedhorm_contra 1.00   1.00 9.62  0.0019 **
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

R-sq.(adj) =  0.000688   
lmer.REML =  77305  Scale est. = 1.2519    n = 24382

Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  83366 83465 -41671

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.8315    1.137

Correlation Structure: ARMA(1,0)
 Formula: ~day_number | person 
 Parameter estimate(s):
  Phi1 
0.2633 
Fixed effects: desirability_1 ~ included * (menstruation + fertile) + fertile_mean 
                                     Value Std.Error    DF t-value p-value
(Intercept)                          3.718    0.0770 25625   48.30  0.0000
includedhorm_contra                  0.004    0.0634  1051    0.06  0.9548
menstruationpre                     -0.104    0.0392 25625   -2.66  0.0079
menstruationyes                     -0.239    0.0366 25625   -6.53  0.0000
fertile                              0.150    0.0826 25625    1.82  0.0689
fertile_mean                        -0.009    0.3542  1051   -0.02  0.9802
includedhorm_contra:menstruationpre  0.041    0.0503 25625    0.82  0.4126
includedhorm_contra:menstruationyes  0.073    0.0478 25625    1.54  0.1241
includedhorm_contra:fertile         -0.264    0.1045 25625   -2.53  0.0115
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.477                                                               
menstruationpre                     -0.195  0.244                                                        
menstruationyes                     -0.191  0.237  0.401                                                 
fertile                             -0.187  0.308  0.433    0.364                                        
fertile_mean                        -0.768 -0.028 -0.007   -0.005   -0.084                               
includedhorm_contra:menstruationpre  0.160 -0.305 -0.779   -0.312   -0.336 -0.005                        
includedhorm_contra:menstruationyes  0.153 -0.290 -0.307   -0.766   -0.278 -0.004  0.386                 
includedhorm_contra:fertile          0.189 -0.390 -0.342   -0.288   -0.786  0.014  0.432                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.358                 

Standardized Within-Group Residuals:
     Min       Q1      Med       Q3      Max 
-3.94515 -0.62888  0.03167  0.65770  3.52919 

Number of Observations: 26685
Number of Groups: 1054 
Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  83278 83384 -41626

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.8227    1.142

Correlation Structure: ARMA(1,1)
 Formula: ~day_number | person 
 Parameter estimate(s):
   Phi1  Theta1 
 0.5141 -0.2688 
Fixed effects: desirability_1 ~ included * (menstruation + fertile) + fertile_mean 
                                     Value Std.Error    DF t-value p-value
(Intercept)                          3.713    0.0772 25625   48.12  0.0000
includedhorm_contra                  0.007    0.0636  1051    0.11  0.9147
menstruationpre                     -0.093    0.0398 25625   -2.35  0.0190
menstruationyes                     -0.236    0.0374 25625   -6.31  0.0000
fertile                              0.156    0.0857 25625    1.82  0.0688
fertile_mean                         0.004    0.3553  1051    0.01  0.9906
includedhorm_contra:menstruationpre  0.034    0.0512 25625    0.66  0.5116
includedhorm_contra:menstruationyes  0.068    0.0487 25625    1.39  0.1640
includedhorm_contra:fertile         -0.275    0.1083 25625   -2.54  0.0111
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.477                                                               
menstruationpre                     -0.197  0.245                                                        
menstruationyes                     -0.195  0.241  0.410                                                 
fertile                             -0.189  0.313  0.410    0.356                                        
fertile_mean                        -0.767 -0.029 -0.006   -0.005   -0.088                               
includedhorm_contra:menstruationpre  0.161 -0.306 -0.778   -0.319   -0.318 -0.005                        
includedhorm_contra:menstruationyes  0.155 -0.295 -0.315   -0.768   -0.273 -0.004  0.396                 
includedhorm_contra:fertile          0.192 -0.396 -0.324   -0.281   -0.786  0.015  0.409                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.350                 

Standardized Within-Group Residuals:
     Min       Q1      Med       Q3      Max 
-3.90577 -0.62887  0.03436  0.65521  3.46413 

Number of Observations: 26685
Number of Groups: 1054 

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

REML criterion at convergence: 54029

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.690 -0.636  0.026  0.664  3.608 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.663    0.814   
 Residual             1.280    1.131   
Number of obs: 17029, groups:  person, 513

Fixed effects:
                                                         Estimate Std. Error t value
(Intercept)                                               3.91300    0.15846   24.69
fertile_mean                                             -0.15601    0.76802   -0.20
contraceptive_methodsfertility_awareness                 -0.00436    0.20806   -0.02
contraceptive_methodsnone                                -0.18353    0.22060   -0.83
contraceptive_methodshormonal                            -0.13147    0.10481   -1.25
fertile                                                   0.14184    0.12614    1.12
menstruationpre                                          -0.08777    0.06093   -1.44
menstruationyes                                          -0.24694    0.05819   -4.24
contraceptive_methodsfertility_awareness:fertile         -0.07389    0.28648   -0.26
contraceptive_methodsnone:fertile                         0.13475    0.31017    0.43
contraceptive_methodshormonal:fertile                    -0.37400    0.14090   -2.65
contraceptive_methodsfertility_awareness:menstruationpre -0.04693    0.13498   -0.35
contraceptive_methodsnone:menstruationpre                -0.28538    0.14109   -2.02
contraceptive_methodshormonal:menstruationpre            -0.04023    0.06863   -0.59
contraceptive_methodsfertility_awareness:menstruationyes  0.19676    0.13564    1.45
contraceptive_methodsnone:menstruationyes                -0.14919    0.14755   -1.01
contraceptive_methodshormonal:menstruationyes             0.03187    0.06636    0.48

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 13 54021 54121 -26997 53995 NA NA NA
by_method 19 54021 54168 -26992 53983 11.46 6 0.07529

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 19 84648 84803 -42305 84610 NA NA NA
with_mod 27 84651 84872 -42298 84597 12.82 8 0.1181

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

REML criterion at convergence: 84666

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.061 -0.626  0.029  0.664  3.641 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.722    0.85    
 Residual             1.263    1.12    
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                    3.7580     0.1573   23.90
menstruationpre                               -0.1096     0.0343   -3.19
menstruationyes                               -0.2534     0.0323   -7.84
fertile_mean                                   0.0220     0.3488    0.06
age_group(20,25]                               0.0944     0.1680    0.56
age_group(25,30]                              -0.0481     0.1729   -0.28
age_group(30,35]                              -0.2397     0.1984   -1.21
age_group(35,70]                              -0.1875     0.1796   -1.04
includedhorm_contra                            0.1609     0.1684    0.96
fertile                                        0.3073     0.1979    1.55
menstruationpre:includedhorm_contra            0.0254     0.0440    0.58
menstruationyes:includedhorm_contra            0.0716     0.0424    1.69
age_group(20,25]:includedhorm_contra          -0.3047     0.1914   -1.59
age_group(25,30]:includedhorm_contra          -0.3313     0.2110   -1.57
age_group(30,35]:includedhorm_contra          -0.1288     0.2745   -0.47
age_group(35,70]:includedhorm_contra          -0.2931     0.3004   -0.98
age_group(20,25]:fertile                      -0.3712     0.2192   -1.69
age_group(25,30]:fertile                      -0.2249     0.2260   -1.00
age_group(30,35]:fertile                      -0.0111     0.2617   -0.04
age_group(35,70]:fertile                       0.1332     0.2362    0.56
includedhorm_contra:fertile                   -0.5290     0.2195   -2.41
age_group(20,25]:includedhorm_contra:fertile   0.4727     0.2455    1.93
age_group(25,30]:includedhorm_contra:fertile   0.4143     0.2721    1.52
age_group(30,35]:includedhorm_contra:fertile   0.0875     0.3512    0.25
age_group(35,70]:includedhorm_contra:fertile  -0.2382     0.3990   -0.60

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 84446 84553 -42210 84420 NA NA NA
with_mod 15 84449 84572 -42210 84419 1.075 2 0.5841

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    weekend + included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

REML criterion at convergence: 84475

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.010 -0.625  0.030  0.663  3.564 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.727    0.853   
 Residual             1.254    1.120   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error t value
(Intercept)                              3.63153    0.07670    47.3
menstruationpre                         -0.11095    0.03416    -3.2
menstruationyes                         -0.25366    0.03218    -7.9
fertile_mean                             0.02565    0.34804     0.1
weekendTRUE                              0.19291    0.02978     6.5
includedhorm_contra                      0.00376    0.06391     0.1
fertile                                  0.18338    0.08387     2.2
menstruationpre:includedhorm_contra      0.02604    0.04385     0.6
menstruationyes:includedhorm_contra      0.07502    0.04219     1.8
weekendTRUE:includedhorm_contra          0.01264    0.03833     0.3
weekendTRUE:fertile                     -0.09195    0.11550    -0.8
includedhorm_contra:fertile             -0.35030    0.10654    -3.3
weekendTRUE:includedhorm_contra:fertile  0.15224    0.14690     1.0

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 23 84392 84580 -42173 84346 NA NA NA
with_mod 35 84408 84694 -42169 84338 8.196 12 0.7696

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    weekday + included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

REML criterion at convergence: 84460

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.110 -0.623  0.035  0.663  3.571 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.728    0.853   
 Residual             1.251    1.118   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                              Estimate Std. Error t value
(Intercept)                                   3.742494   0.083280    44.9
menstruationpre                              -0.110728   0.034124    -3.2
menstruationyes                              -0.254110   0.032146    -7.9
fertile_mean                                  0.015023   0.348003     0.0
weekdayTuesday                               -0.175309   0.053233    -3.3
weekdayWednesday                             -0.137642   0.053143    -2.6
weekdayThursday                              -0.125515   0.053749    -2.3
weekdayFriday                                 0.000305   0.054657     0.0
weekdaySaturday                               0.108288   0.055201     2.0
weekdaySunday                                 0.140945   0.053347     2.6
includedhorm_contra                          -0.017268   0.076178    -0.2
fertile                                       0.032089   0.149918     0.2
menstruationpre:includedhorm_contra           0.026300   0.043806     0.6
menstruationyes:includedhorm_contra           0.076766   0.042145     1.8
weekdayTuesday:includedhorm_contra            0.013002   0.068385     0.2
weekdayWednesday:includedhorm_contra          0.039471   0.068610     0.6
weekdayThursday:includedhorm_contra           0.033453   0.069263     0.5
weekdayFriday:includedhorm_contra            -0.009712   0.070213    -0.1
weekdaySaturday:includedhorm_contra           0.109794   0.071032     1.5
weekdaySunday:includedhorm_contra             0.007429   0.068856     0.1
weekdayTuesday:fertile                        0.185243   0.206371     0.9
weekdayWednesday:fertile                      0.132472   0.207340     0.6
weekdayThursday:fertile                       0.310233   0.210303     1.5
weekdayFriday:fertile                         0.110999   0.210677     0.5
weekdaySaturday:fertile                      -0.037271   0.213479    -0.2
weekdaySunday:fertile                         0.114142   0.207460     0.6
includedhorm_contra:fertile                  -0.306496   0.191748    -1.6
weekdayTuesday:includedhorm_contra:fertile   -0.016108   0.263402    -0.1
weekdayWednesday:includedhorm_contra:fertile -0.069843   0.265478    -0.3
weekdayThursday:includedhorm_contra:fertile  -0.101779   0.267608    -0.4
weekdayFriday:includedhorm_contra:fertile     0.199966   0.268454     0.7
weekdaySaturday:includedhorm_contra:fertile   0.099463   0.272330     0.4
weekdaySunday:includedhorm_contra:fertile     0.017305   0.265005     0.1

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 84654 84793 -42310 84620 NA NA NA
with_mod 23 84660 84849 -42307 84614 5.418 6 0.4914

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

REML criterion at convergence: 84680

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.048 -0.629  0.028  0.659  3.664 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.726    0.852   
 Residual             1.264    1.124   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error t value
(Intercept)                                              3.63081    0.08408    43.2
menstruationpre                                         -0.11299    0.03433    -3.3
menstruationyes                                         -0.25344    0.03232    -7.8
fertile_mean                                            -0.00629    0.35150     0.0
included_levelslax                                       0.18547    0.17081     1.1
included_levelsconservative                              0.28056    0.13334     2.1
included_levelsstrict                                    0.21165    0.13118     1.6
includedhorm_contra                                      0.06094    0.08680     0.7
fertile                                                  0.15781    0.08747     1.8
menstruationpre:includedhorm_contra                      0.02706    0.04408     0.6
menstruationyes:includedhorm_contra                      0.06870    0.04241     1.6
included_levelslax:includedhorm_contra                  -0.20062    0.20806    -1.0
included_levelsconservative:includedhorm_contra         -0.25285    0.16671    -1.5
included_levelsstrict:includedhorm_contra               -0.12881    0.16139    -0.8
included_levelslax:fertile                               0.18515    0.21370     0.9
included_levelsconservative:fertile                     -0.13198    0.15958    -0.8
included_levelsstrict:fertile                           -0.01882    0.15969    -0.1
includedhorm_contra:fertile                             -0.15120    0.13348    -1.1
included_levelslax:includedhorm_contra:fertile          -0.31641    0.26068    -1.2
included_levelsconservative:includedhorm_contra:fertile -0.11706    0.20743    -0.6
included_levelsstrict:includedhorm_contra:fertile       -0.15414    0.20423    -0.8

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 84649 84788 -42307 84615 NA NA NA
with_mod 23 84639 84827 -42296 84593 21.99 6 0.001216

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    cycle_length_groups + included + fertile + menstruation:included +  
    cycle_length_groups:included + cycle_length_groups:fertile +  
    included:fertile + cycle_length_groups:included:fertile
   Data: diary

REML criterion at convergence: 84651

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.073 -0.624  0.030  0.662  3.630 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.723    0.85    
 Residual             1.263    1.12    
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                                       Estimate Std. Error t value
(Intercept)                                              3.5643     0.1439   24.77
menstruationpre                                         -0.1125     0.0343   -3.28
menstruationyes                                         -0.2604     0.0325   -8.00
fertile_mean                                            -0.0893     0.3519   -0.25
cycle_length_groups(25,30]                               0.2083     0.1412    1.48
cycle_length_groups(30,35]                               0.1186     0.1697    0.70
cycle_length_groups(35,41]                               0.1758     0.2404    0.73
includedhorm_contra                                      0.0985     0.1605    0.61
fertile                                                  0.5136     0.1826    2.81
menstruationpre:includedhorm_contra                      0.0283     0.0441    0.64
menstruationyes:includedhorm_contra                      0.0793     0.0426    1.86
cycle_length_groups(25,30]:includedhorm_contra          -0.0845     0.1741   -0.49
cycle_length_groups(30,35]:includedhorm_contra          -0.4972     0.2669   -1.86
cycle_length_groups(35,41]:includedhorm_contra          -0.3722     0.3407   -1.09
cycle_length_groups(25,30]:fertile                      -0.3614     0.1959   -1.85
cycle_length_groups(30,35]:fertile                      -0.5683     0.2319   -2.45
cycle_length_groups(35,41]:fertile                      -0.6321     0.3276   -1.93
includedhorm_contra:fertile                             -0.7319     0.2155   -3.40
cycle_length_groups(25,30]:includedhorm_contra:fertile   0.4307     0.2321    1.86
cycle_length_groups(30,35]:includedhorm_contra:fertile   0.3432     0.3652    0.94
cycle_length_groups(35,41]:includedhorm_contra:fertile   1.6425     0.4314    3.81

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 84641 84747 -42307 84615 NA NA NA
with_mod 15 84640 84763 -42305 84610 4.2 2 0.1225

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    certainty_menstruation + included + fertile + menstruation:included +  
    certainty_menstruation:included + certainty_menstruation:fertile +  
    included:fertile + certainty_menstruation:included:fertile
   Data: diary

REML criterion at convergence: 84666

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.046 -0.629  0.031  0.661  3.661 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.719    0.848   
 Residual             1.264    1.124   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error t value
(Intercept)                                          3.4178     0.2105   16.24
menstruationpre                                     -0.1087     0.0343   -3.17
menstruationyes                                     -0.2486     0.0324   -7.69
fertile_mean                                        -0.0466     0.3476   -0.13
certainty_menstruation                               0.0735     0.0480    1.53
includedhorm_contra                                 -0.1382     0.2672   -0.52
fertile                                             -0.3775     0.2724   -1.39
menstruationpre:includedhorm_contra                  0.0260     0.0440    0.59
menstruationyes:includedhorm_contra                  0.0680     0.0424    1.60
certainty_menstruation:includedhorm_contra           0.0318     0.0622    0.51
certainty_menstruation:fertile                       0.1274     0.0638    2.00
includedhorm_contra:fertile                          0.1367     0.3540    0.39
certainty_menstruation:includedhorm_contra:fertile  -0.1036     0.0818   -1.27

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 84647 84770 -42309 84617 NA NA NA
with_mod 19 84650 84806 -42306 84612 5.382 4 0.2503

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    cycle_regularity + included + fertile + menstruation:included +  
    cycle_regularity:included + cycle_regularity:fertile + included:fertile +  
    cycle_regularity:included:fertile
   Data: diary

REML criterion at convergence: 84668

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.048 -0.627  0.030  0.658  3.679 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.723    0.851   
 Residual             1.264    1.124   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                                                                  Estimate Std. Error t value
(Intercept)                                                                         3.8160     0.0892    42.8
menstruationpre                                                                    -0.1094     0.0343    -3.2
menstruationyes                                                                    -0.2508     0.0323    -7.8
fertile_mean                                                                        0.0205     0.3493     0.1
cycle_regularityslightly irregular,\nup to 5 days off                              -0.2148     0.1028    -2.1
cycle_regularityirregular,\nmore than 5 days off                                   -0.1697     0.1211    -1.4
includedhorm_contra                                                                -0.0749     0.0810    -0.9
fertile                                                                             0.2523     0.0958     2.6
menstruationpre:includedhorm_contra                                                 0.0256     0.0440     0.6
menstruationyes:includedhorm_contra                                                 0.0691     0.0424     1.6
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra           0.1090     0.1552     0.7
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                0.0215     0.1836     0.1
cycle_regularityslightly irregular,\nup to 5 days off:fertile                      -0.1510     0.1322    -1.1
cycle_regularityirregular,\nmore than 5 days off:fertile                           -0.2499     0.1625    -1.5
includedhorm_contra:fertile                                                        -0.3717     0.1123    -3.3
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile  -0.0706     0.1963    -0.4
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile        0.3178     0.2424     1.3

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 84646 84768 -42308 84616 NA NA NA
with_mod 19 84641 84796 -42301 84603 13.09 4 0.01086

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

REML criterion at convergence: 84662

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.037 -0.629  0.032  0.659  3.651 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.722    0.85    
 Residual             1.263    1.12    
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                                3.64548    0.08638    42.2
menstruationpre                                           -0.11171    0.03429    -3.3
menstruationyes                                           -0.25322    0.03231    -7.8
fertile_mean                                              -0.00197    0.34828     0.0
cohabitationLive in same city                              0.20479    0.11671     1.8
cohabitationLong-distance                                  0.11495    0.10999     1.0
includedhorm_contra                                       -0.05580    0.09256    -0.6
fertile                                                    0.28891    0.08651     3.3
menstruationpre:includedhorm_contra                        0.02735    0.04402     0.6
menstruationyes:includedhorm_contra                        0.07100    0.04235     1.7
cohabitationLive in same city:includedhorm_contra          0.04360    0.14910     0.3
cohabitationLong-distance:includedhorm_contra              0.02242    0.14266     0.2
cohabitationLive in same city:fertile                     -0.49148    0.15801    -3.1
cohabitationLong-distance:fertile                         -0.20217    0.14232    -1.4
includedhorm_contra:fertile                               -0.49206    0.12636    -3.9
cohabitationLive in same city:includedhorm_contra:fertile  0.66664    0.19757     3.4
cohabitationLong-distance:includedhorm_contra:fertile      0.20960    0.18334     1.1

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 84643 84766 -42307 84613 NA NA NA
with_mod 19 84648 84803 -42305 84610 3.789 4 0.4353

Linear mixed model fit by REML ['lmerMod']
Formula: desirability_1 ~ menstruation + fertile_mean + (1 | person) +  
    relationship_status_clean + included + fertile + menstruation:included +  
    relationship_status_clean:included + relationship_status_clean:fertile +  
    included:fertile + relationship_status_clean:included:fertile
   Data: diary

REML criterion at convergence: 84660

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-4.058 -0.626  0.032  0.660  3.659 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.719    0.848   
 Residual             1.264    1.124   
Number of obs: 26685, groups:  person, 1054

Fixed effects:
                                                                 Estimate Std. Error t value
(Intercept)                                                       3.76245    0.08068    46.6
menstruationpre                                                  -0.11160    0.03429    -3.3
menstruationyes                                                  -0.25226    0.03231    -7.8
fertile_mean                                                      0.00803    0.34733     0.0
relationship_status_cleanVerheiratet                             -0.19461    0.10640    -1.8
relationship_status_cleanVerlobt                                 -0.04559    0.20485    -0.2
includedhorm_contra                                              -0.01763    0.06913    -0.3
fertile                                                           0.11159    0.07924     1.4
menstruationpre:includedhorm_contra                               0.02790    0.04403     0.6
menstruationyes:includedhorm_contra                               0.07030    0.04235     1.7
relationship_status_cleanVerheiratet:includedhorm_contra         -0.33862    0.20502    -1.7
relationship_status_cleanVerlobt:includedhorm_contra              0.03193    0.30268     0.1
relationship_status_cleanVerheiratet:fertile                      0.20041    0.13951     1.4
relationship_status_cleanVerlobt:fertile                         -0.23067    0.26160    -0.9
includedhorm_contra:fertile                                      -0.24289    0.09657    -2.5
relationship_status_cleanVerheiratet:includedhorm_contra:fertile -0.35969    0.26270    -1.4
relationship_status_cleanVerlobt:includedhorm_contra:fertile      0.17382    0.40633     0.4

Specific robustness checks for desirability

Although desirability is associated with self esteem, sexy and showy clothes, adjusting for them only makes the effect stronger.

summary(lmer(desirability_1 ~ self_esteem_1 + sexy_clothes + showy_clothes + included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary))
## Linear mixed model fit by REML 
## t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
## Formula: desirability_1 ~ self_esteem_1 + sexy_clothes + showy_clothes +  
##     included * (menstruation + fertile) + fertile_mean + (1 |      person)
##    Data: diary
## 
## REML criterion at convergence: 75623
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.830 -0.591  0.001  0.604  5.555 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  person   (Intercept) 0.302    0.549   
##  Residual             0.917    0.957   
## Number of obs: 26685, groups:  person, 1054
## 
## Fixed effects:
##                                        Estimate  Std. Error          df t value Pr(>|t|)    
## (Intercept)                             0.49198     0.06121  2664.00000    8.04  1.3e-15 ***
## self_esteem_1                           0.50159     0.00659 25770.00000   76.17  < 2e-16 ***
## sexy_clothes                            0.32361     0.00727 26472.00000   44.52  < 2e-16 ***
## showy_clothes                           0.03036     0.00610 26469.00000    4.97  6.6e-07 ***
## includedhorm_contra                    -0.00288     0.04320  1646.00000   -0.07  0.94694    
## menstruationpre                        -0.05064     0.02914 26188.00000   -1.74  0.08226 .  
## menstruationyes                        -0.14140     0.02745 26324.00000   -5.15  2.6e-07 ***
## fertile                                 0.20009     0.05882 26142.00000    3.40  0.00067 ***
## fertile_mean                           -0.08187     0.24433  1683.00000   -0.34  0.73761    
## includedhorm_contra:menstruationpre    -0.01248     0.03741 26184.00000   -0.33  0.73875    
## includedhorm_contra:menstruationyes    -0.02114     0.03597 26289.00000   -0.59  0.55683    
## includedhorm_contra:fertile            -0.32331     0.07443 26305.00000   -4.34  1.4e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) slf__1 sxy_cl shwy_c incld_ mnstrtnp mnstrtny fertil frtl_m
## self_estm_1             -0.406                                                            
## sexy_cloths             -0.149 -0.143                                                     
## showy_clths             -0.055 -0.043 -0.524                                              
## inclddhrm_c             -0.409  0.013 -0.018  0.003                                       
## menstrutnpr             -0.195  0.008  0.013  0.002  0.271                                
## menstrutnys             -0.199  0.022  0.019  0.005  0.259  0.395                         
## fertile                 -0.182  0.008 -0.001  0.004  0.333  0.466    0.383                
## fertile_men             -0.663  0.010 -0.011 -0.007 -0.029 -0.007   -0.005   -0.084       
## inclddhrm_cntr:mnstrtnp  0.158 -0.008 -0.002 -0.002 -0.339 -0.779   -0.308   -0.362 -0.006
## inclddhrm_cntr:mnstrtny  0.156 -0.020 -0.008 -0.002 -0.319 -0.301   -0.763   -0.292 -0.006
## inclddhrm_cntr:f         0.181 -0.015  0.008  0.002 -0.421 -0.368   -0.302   -0.786  0.011
##                         inclddhrm_cntr:mnstrtnp inclddhrm_cntr:mnstrtny
## self_estm_1                                                            
## sexy_cloths                                                            
## showy_clths                                                            
## inclddhrm_c                                                            
## menstrutnpr                                                            
## menstrutnys                                                            
## fertile                                                                
## fertile_men                                                            
## inclddhrm_cntr:mnstrtnp                                                
## inclddhrm_cntr:mnstrtny  0.380                                         
## inclddhrm_cntr:f         0.466                   0.380

Petting

model_summaries$had_petting

Model summary

Model summary

model %>% 
  print_summary()
Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ included * (menstruation + fertile) + fertile_mean +      (1 | person)
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24084    24166   -12032    24064    26693 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.280 -0.498 -0.348 -0.176  5.359 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.368    0.607   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                         -1.08824    0.06977  -15.60  < 2e-16 ***
includedhorm_contra                  0.19491    0.05696    3.42  0.00062 ***
menstruationpre                     -0.06177    0.04916   -1.26  0.20894    
menstruationyes                     -0.12024    0.04660   -2.58  0.00987 ** 
fertile                              0.13222    0.09733    1.36  0.17432    
fertile_mean                        -0.07059    0.32305   -0.22  0.82704    
includedhorm_contra:menstruationpre  0.00543    0.06165    0.09  0.92977    
includedhorm_contra:menstruationyes -0.03463    0.05984   -0.58  0.56277    
includedhorm_contra:fertile         -0.26705    0.12115   -2.20  0.02751 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.489                                                               
menstrutnpr             -0.273  0.339                                                        
menstrutnys             -0.255  0.318  0.376                                                 
fertile                 -0.264  0.423  0.459    0.374                                        
fertile_men             -0.758 -0.035 -0.005   -0.005   -0.103                               
inclddhrm_cntr:mnstrtnp  0.227 -0.417 -0.797   -0.299   -0.365 -0.008                        
inclddhrm_cntr:mnstrtny  0.207 -0.383 -0.292   -0.779   -0.291 -0.006  0.363                 
inclddhrm_cntr:f         0.262 -0.523 -0.368   -0.300   -0.797  0.018  0.460                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.370                 
convergence code: 0
Model failed to converge with max|grad| = 0.0145105 (tol = 0.001, component 1)

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.13 [-0.06;0.32].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ included + menstruation + fertile + fertile_mean +  
    (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24028    24184   -11995    23990    26684 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.089 -0.488 -0.332 -0.170  4.797 

Random effects:
 Groups Name            Variance Std.Dev. Corr             
 person (Intercept)     0.410    0.640                     
        fertile         0.587    0.766    -0.21            
        menstruationpre 0.102    0.319    -0.22  0.74      
        menstruationyes 0.214    0.463    -0.17  0.05  0.41
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                         -1.10079    0.07349  -14.98  < 2e-16 ***
includedhorm_contra                  0.19832    0.05968    3.32  0.00089 ***
menstruationpre                     -0.07412    0.05903   -1.26  0.20929    
menstruationyes                     -0.18797    0.06315   -2.98  0.00291 ** 
fertile                              0.08073    0.11941    0.68  0.49901    
fertile_mean                        -0.05684    0.33638   -0.17  0.86583    
includedhorm_contra:menstruationpre  0.00453    0.06790    0.07  0.94676    
includedhorm_contra:menstruationyes -0.02949    0.07269   -0.41  0.68500    
includedhorm_contra:fertile         -0.27399    0.13862   -1.98  0.04810 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.495                                                               
menstrutnpr             -0.313  0.346                                                        
menstrutnys             -0.258  0.298  0.339                                                 
fertile                 -0.293  0.422  0.479    0.295                                        
fertile_men             -0.744 -0.037  0.005   -0.008   -0.110                               
inclddhrm_cntr:mnstrtnp  0.252 -0.446 -0.764   -0.271   -0.379 -0.011                        
inclddhrm_cntr:mnstrtny  0.213 -0.384 -0.272   -0.733   -0.227 -0.005  0.356                 
inclddhrm_cntr:f         0.276 -0.538 -0.377   -0.227   -0.766  0.021  0.497                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.295                 
convergence code: 0
Model failed to converge with max|grad| = 0.085386 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
model 10 24084 24166 -12032 24064 NA NA NA
with_ind_diff 19 24028 24184 -11995 23990 74.04 9 2.439e-12
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )

     AIC      BIC   logLik deviance df.resid 
   21797    21943   -10880    21761    24379 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.980 -0.496 -0.336 -0.177  5.301 

Random effects:
 Groups Name                                   Variance     Std.Dev.
 person (Intercept)                            0.3683431348 0.606913
 Xr.2   s(days_filled_out):includedhorm_contra 0.0000052021 0.002281
 Xr.1   s(days_filled_out):includedcycling     0.0590677296 0.243039
 Xr.0   s(day_number):includedhorm_contra      0.0000000339 0.000184
 Xr     s(day_number):includedcycling          0.0001816739 0.013479
Number of obs: 24397, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error z value    Pr(>|z|)    
X(Intercept)                               -1.11813    0.07175  -15.58     < 2e-16 ***
Xincludedhorm_contra                        0.17193    0.05935    2.90      0.0038 ** 
Xmenstruationpre                           -0.04866    0.05141   -0.95      0.3439    
Xmenstruationyes                           -0.11928    0.04982   -2.39      0.0166 *  
Xfertile                                    0.10865    0.10432    1.04      0.2976    
Xfertile_mean                               0.02708    0.32861    0.08      0.9343    
Xincludedhorm_contra:menstruationpre        0.00562    0.06449    0.09      0.9305    
Xincludedhorm_contra:menstruationyes       -0.04073    0.06395   -0.64      0.5242    
Xincludedhorm_contra:fertile               -0.21276    0.12976   -1.64      0.1011    
Xs(day_number):includedcyclingFx1           0.29433    0.07353    4.00 0.000062559 ***
Xs(day_number):includedhorm_contraFx1       0.32977    0.05847    5.64 0.000000017 ***
Xs(days_filled_out):includedcyclingFx1     -0.12472    0.16653   -0.75      0.4539    
Xs(days_filled_out):includedhorm_contraFx1 -0.31308    0.06005   -5.21 0.000000185 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Family: binomial 
Link function: probit 

Formula:
had_petting ~ included + menstruation + fertile + fertile_mean + 
    s(day_number, by = included) + s(days_filled_out, by = included) + 
    included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                         -1.11813    0.06997  -15.98   <2e-16 ***
includedhorm_contra                  0.17193    0.05840    2.94   0.0032 ** 
menstruationpre                     -0.04866    0.05063   -0.96   0.3365    
menstruationyes                     -0.11928    0.04910   -2.43   0.0151 *  
fertile                              0.10865    0.10240    1.06   0.2887    
fertile_mean                         0.02708    0.32072    0.08   0.9327    
includedhorm_contra:menstruationpre  0.00562    0.06353    0.09   0.9295    
includedhorm_contra:menstruationyes -0.04073    0.06308   -0.65   0.5185    
includedhorm_contra:fertile         -0.21276    0.12750   -1.67   0.0952 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df Chi.sq      p-value    
s(day_number):includedcycling          1.01   1.01   17.3 0.0000335219 ***
s(day_number):includedhorm_contra      1.00   1.00   33.1 0.0000000089 ***
s(days_filled_out):includedcycling     2.87   2.87   20.8      0.00029 ***
s(days_filled_out):includedhorm_contra 1.00   1.00   28.2 0.0000001094 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

R-sq.(adj) =  0.0033   
glmer.ML =  19644  Scale est. = 1         n = 24397

Information: No AR1/ARMA autocorrelation models were fitted for binomial outcomes.

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

     AIC      BIC   logLik deviance df.resid 
   15891    16030    -7928    15855    17026 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.009 -0.516 -0.368 -0.192  6.239 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.321    0.567   
Number of obs: 17044, groups:  person, 513

Fixed effects:
                                                         Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                               -0.9620     0.1266   -7.60  2.9e-14 ***
fertile_mean                                               0.3564     0.5978    0.60    0.551    
contraceptive_methodsfertility_awareness                   0.0125     0.1832    0.07    0.946    
contraceptive_methodsnone                                 -0.2745     0.1969   -1.39    0.163    
contraceptive_methodshormonal                              0.0154     0.0901    0.17    0.865    
fertile                                                   -0.1447     0.1697   -0.85    0.394    
menstruationpre                                           -0.1081     0.0816   -1.32    0.185    
menstruationyes                                           -0.1415     0.0789   -1.79    0.073 .  
contraceptive_methodsfertility_awareness:fertile           0.2667     0.3852    0.69    0.489    
contraceptive_methodsnone:fertile                          0.2859     0.4289    0.67    0.505    
contraceptive_methodshormonal:fertile                      0.0199     0.1889    0.11    0.916    
contraceptive_methodsfertility_awareness:menstruationpre  -0.1694     0.1925   -0.88    0.379    
contraceptive_methodsnone:menstruationpre                 -0.2808     0.2195   -1.28    0.201    
contraceptive_methodshormonal:menstruationpre              0.0821     0.0917    0.90    0.371    
contraceptive_methodsfertility_awareness:menstruationyes  -0.2382     0.1973   -1.21    0.227    
contraceptive_methodsnone:menstruationyes                 -0.1147     0.2209   -0.52    0.604    
contraceptive_methodshormonal:menstruationyes             -0.0223     0.0899   -0.25    0.804    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.128582 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 12 15886 15979 -7931 15862 NA NA NA
by_method 18 15891 16030 -7928 15855 7.422 6 0.2836

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 18 24034 24181 -11999 23998 NA NA NA
with_mod 26 24046 24259 -11997 23994 4.195 8 0.8391

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + age_group +  
    included + fertile + menstruation:included + age_group:included +  
    age_group:fertile + included:fertile + age_group:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24046    24259   -11997    23994    26677 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.124 -0.502 -0.348 -0.175  5.750 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.344    0.587   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value       Pr(>|z|)    
(Intercept)                                  -0.87810    0.13170   -6.67 0.000000000026 ***
menstruationpre                              -0.06328    0.04923   -1.29         0.1986    
menstruationyes                              -0.12035    0.04666   -2.58         0.0099 ** 
fertile_mean                                 -0.06693    0.31871   -0.21         0.8337    
age_group(20,25]                             -0.07020    0.13699   -0.51         0.6084    
age_group(25,30]                             -0.11221    0.14195   -0.79         0.4293    
age_group(30,35]                             -0.38521    0.16835   -2.29         0.0221 *  
age_group(35,70]                             -0.60156    0.15241   -3.95 0.000079111073 ***
includedhorm_contra                           0.19097    0.13849    1.38         0.1679    
fertile                                      -0.00576    0.26873   -0.02         0.9829    
menstruationpre:includedhorm_contra           0.00332    0.06171    0.05         0.9570    
menstruationyes:includedhorm_contra          -0.03710    0.05989   -0.62         0.5356    
age_group(20,25]:includedhorm_contra         -0.11941    0.15515   -0.77         0.4415    
age_group(25,30]:includedhorm_contra         -0.29555    0.17344   -1.70         0.0884 .  
age_group(30,35]:includedhorm_contra         -0.17468    0.23254   -0.75         0.4525    
age_group(35,70]:includedhorm_contra         -0.10118    0.26746   -0.38         0.7052    
age_group(20,25]:fertile                      0.17301    0.29575    0.58         0.5585    
age_group(25,30]:fertile                      0.12460    0.30675    0.41         0.6846    
age_group(30,35]:fertile                      0.29123    0.36910    0.79         0.4301    
age_group(35,70]:fertile                      0.04733    0.34373    0.14         0.8905    
includedhorm_contra:fertile                  -0.27244    0.29601   -0.92         0.3574    
age_group(20,25]:includedhorm_contra:fertile -0.00695    0.32981   -0.02         0.9832    
age_group(25,30]:includedhorm_contra:fertile  0.24127    0.37010    0.65         0.5145    
age_group(30,35]:includedhorm_contra:fertile -0.22350    0.51539   -0.43         0.6645    
age_group(35,70]:includedhorm_contra:fertile -0.09399    0.63633   -0.15         0.8826    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.113113 (tol = 0.001, component 1)

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 23839 23937 -11907 23815 NA NA NA
with_mod 14 23841 23956 -11907 23813 1.397 2 0.4974

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + weekend +  
    included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   23842    23956   -11907    23814    26689 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.238 -0.495 -0.337 -0.167  5.871 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.378    0.615   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error z value     Pr(>|z|)    
(Intercept)                             -1.19928    0.07308  -16.41      < 2e-16 ***
menstruationpre                         -0.06604    0.04943   -1.34       0.1816    
menstruationyes                         -0.12373    0.04678   -2.65       0.0082 ** 
fertile_mean                            -0.05984    0.32675   -0.18       0.8547    
weekendTRUE                              0.25181    0.04284    5.88 0.0000000041 ***
includedhorm_contra                      0.17279    0.06238    2.77       0.0056 ** 
fertile                                  0.08560    0.12288    0.70       0.4860    
menstruationpre:includedhorm_contra      0.00553    0.06200    0.09       0.9289    
menstruationyes:includedhorm_contra     -0.03159    0.06013   -0.53       0.5994    
weekendTRUE:includedhorm_contra          0.05315    0.05392    0.99       0.3243    
weekendTRUE:fertile                      0.08114    0.16299    0.50       0.6186    
includedhorm_contra:fertile             -0.29233    0.15422   -1.90       0.0580 .  
weekendTRUE:includedhorm_contra:fertile  0.05026    0.20462    0.25       0.8060    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0214221 (tol = 0.001, component 1)

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 22 23633 23813 -11794 23589 NA NA NA
with_mod 34 23648 23926 -11790 23580 9.025 12 0.7008

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + weekday +  
    included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   23648    23926   -11790    23580    26669 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.537 -0.490 -0.327 -0.161  6.512 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.388    0.623   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value  Pr(>|z|)    
(Intercept)                                  -0.97802    0.08636  -11.33   < 2e-16 ***
menstruationpre                              -0.06737    0.04974   -1.35    0.1756    
menstruationyes                              -0.12518    0.04702   -2.66    0.0078 ** 
fertile_mean                                 -0.08049    0.33058   -0.24    0.8076    
weekdayTuesday                               -0.33915    0.07967   -4.26 0.0000207 ***
weekdayWednesday                             -0.37980    0.08029   -4.73 0.0000022 ***
weekdayThursday                              -0.21073    0.07886   -2.67    0.0075 ** 
weekdayFriday                                -0.17709    0.07939   -2.23    0.0257 *  
weekdaySaturday                               0.10223    0.07685    1.33    0.1834    
weekdaySunday                                 0.14595    0.07378    1.98    0.0479 *  
includedhorm_contra                           0.20979    0.08412    2.49    0.0126 *  
fertile                                      -0.13265    0.21385   -0.62    0.5351    
menstruationpre:includedhorm_contra           0.00763    0.06241    0.12    0.9028    
menstruationyes:includedhorm_contra          -0.02685    0.06047   -0.44    0.6570    
weekdayTuesday:includedhorm_contra           -0.09594    0.10064   -0.95    0.3405    
weekdayWednesday:includedhorm_contra          0.01629    0.10113    0.16    0.8720    
weekdayThursday:includedhorm_contra          -0.07927    0.09957   -0.80    0.4260    
weekdayFriday:includedhorm_contra            -0.00358    0.09953   -0.04    0.9713    
weekdaySaturday:includedhorm_contra          -0.03093    0.09674   -0.32    0.7492    
weekdaySunday:includedhorm_contra             0.07223    0.09287    0.78    0.4367    
weekdayTuesday:fertile                        0.34004    0.30466    1.12    0.2644    
weekdayWednesday:fertile                      0.47471    0.30690    1.55    0.1219    
weekdayThursday:fertile                       0.15038    0.30813    0.49    0.6255    
weekdayFriday:fertile                         0.43594    0.30103    1.45    0.1476    
weekdaySaturday:fertile                       0.07961    0.29695    0.27    0.7886    
weekdaySunday:fertile                         0.40094    0.28421    1.41    0.1583    
includedhorm_contra:fertile                  -0.25726    0.26897   -0.96    0.3388    
weekdayTuesday:includedhorm_contra:fertile   -0.02203    0.38584   -0.06    0.9545    
weekdayWednesday:includedhorm_contra:fertile -0.30586    0.38958   -0.79    0.4324    
weekdayThursday:includedhorm_contra:fertile   0.17989    0.38633    0.47    0.6415    
weekdayFriday:includedhorm_contra:fertile    -0.04421    0.37789   -0.12    0.9069    
weekdaySaturday:includedhorm_contra:fertile   0.16628    0.37261    0.45    0.6554    
weekdaySunday:includedhorm_contra:fertile    -0.06921    0.35756   -0.19    0.8465    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0978872 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 24090 24221 -12029 24058 NA NA NA
with_mod 22 24098 24278 -12027 24054 4.323 6 0.633

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + included_levels +  
    included + fertile + menstruation:included + included_levels:included +  
    included_levels:fertile + included:fertile + included_levels:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24098    24278   -12027    24054    26681 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.324 -0.499 -0.346 -0.177  5.283 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.367    0.606   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                             -1.14019    0.07797  -14.62   <2e-16 ***
menstruationpre                                         -0.06518    0.04922   -1.32   0.1855    
menstruationyes                                         -0.12079    0.04663   -2.59   0.0096 ** 
fertile_mean                                            -0.08633    0.32945   -0.26   0.7933    
included_levelslax                                       0.22612    0.13887    1.63   0.1034    
included_levelsconservative                              0.14143    0.11022    1.28   0.1994    
included_levelsstrict                                    0.07705    0.10941    0.70   0.4813    
includedhorm_contra                                      0.19946    0.08009    2.49   0.0128 *  
fertile                                                  0.18357    0.12491    1.47   0.1417    
menstruationpre:includedhorm_contra                      0.00716    0.06175    0.12   0.9077    
menstruationyes:includedhorm_contra                     -0.03498    0.05992   -0.58   0.5594    
included_levelslax:includedhorm_contra                  -0.25648    0.17088   -1.50   0.1334    
included_levelsconservative:includedhorm_contra          0.01382    0.13838    0.10   0.9204    
included_levelsstrict:includedhorm_contra               -0.01937    0.13511   -0.14   0.8860    
included_levelslax:fertile                              -0.44006    0.30450   -1.45   0.1484    
included_levelsconservative:fertile                     -0.09688    0.22129   -0.44   0.6615    
included_levelsstrict:fertile                            0.03155    0.22378    0.14   0.8879    
includedhorm_contra:fertile                             -0.30211    0.18608   -1.62   0.1045    
included_levelslax:includedhorm_contra:fertile           0.54623    0.36643    1.49   0.1360    
included_levelsconservative:includedhorm_contra:fertile -0.04823    0.28534   -0.17   0.8658    
included_levelsstrict:includedhorm_contra:fertile       -0.01740    0.28351   -0.06   0.9511    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.023207 (tol = 0.001, component 1)

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 24092 24223 -12030 24060 NA NA NA
with_mod 22 24102 24282 -12029 24058 1.852 6 0.9328

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + cycle_length_groups +  
    included + fertile + menstruation:included + cycle_length_groups:included +  
    cycle_length_groups:fertile + included:fertile + cycle_length_groups:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24102    24282   -12029    24058    26681 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.289 -0.499 -0.348 -0.176  5.367 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.368    0.606   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                       Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                            -1.28410    0.13182   -9.74   <2e-16 ***
menstruationpre                                        -0.06370    0.04925   -1.29    0.196    
menstruationyes                                        -0.11879    0.04691   -2.53    0.011 *  
fertile_mean                                           -0.05670    0.32735   -0.17    0.862    
cycle_length_groups(25,30]                              0.21661    0.12790    1.69    0.090 .  
cycle_length_groups(30,35]                              0.23434    0.15065    1.56    0.120    
cycle_length_groups(35,41]                              0.20256    0.20847    0.97    0.331    
includedhorm_contra                                     0.36704    0.14408    2.55    0.011 *  
fertile                                                 0.05961    0.28010    0.21    0.831    
menstruationpre:includedhorm_contra                     0.00753    0.06174    0.12    0.903    
menstruationyes:includedhorm_contra                    -0.03632    0.06017   -0.60    0.546    
cycle_length_groups(25,30]:includedhorm_contra         -0.18806    0.15366   -1.22    0.221    
cycle_length_groups(30,35]:includedhorm_contra         -0.24691    0.22768   -1.08    0.278    
cycle_length_groups(35,41]:includedhorm_contra         -0.19666    0.28605   -0.69    0.492    
cycle_length_groups(25,30]:fertile                      0.08890    0.29688    0.30    0.765    
cycle_length_groups(30,35]:fertile                     -0.07826    0.34428   -0.23    0.820    
cycle_length_groups(35,41]:fertile                      0.43579    0.45928    0.95    0.343    
includedhorm_contra:fertile                            -0.18578    0.32114   -0.58    0.563    
cycle_length_groups(25,30]:includedhorm_contra:fertile -0.10611    0.34230   -0.31    0.757    
cycle_length_groups(30,35]:includedhorm_contra:fertile  0.05422    0.51762    0.10    0.917    
cycle_length_groups(35,41]:includedhorm_contra:fertile -0.28973    0.59062   -0.49    0.624    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0868976 (tol = 0.001, component 1)

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 24088 24186 -12032 24064 NA NA NA
with_mod 14 24089 24204 -12031 24061 2.543 2 0.2804

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + certainty_menstruation +  
    included + fertile + menstruation:included + certainty_menstruation:included +  
    certainty_menstruation:fertile + included:fertile + certainty_menstruation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24089    24204   -12031    24061    26689 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.252 -0.499 -0.347 -0.176  5.452 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.368    0.607   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error z value    Pr(>|z|)    
(Intercept)                                        -0.97839    0.18070   -5.41 0.000000062 ***
menstruationpre                                    -0.05774    0.04916   -1.17       0.240    
menstruationyes                                    -0.11878    0.04666   -2.55       0.011 *  
fertile_mean                                       -0.07458    0.32385   -0.23       0.818    
certainty_menstruation                             -0.02692    0.04117   -0.65       0.513    
includedhorm_contra                                -0.05120    0.22748   -0.23       0.822    
fertile                                            -0.31313    0.38919   -0.80       0.421    
menstruationpre:includedhorm_contra                 0.00054    0.06165    0.01       0.993    
menstruationyes:includedhorm_contra                -0.03653    0.05990   -0.61       0.542    
certainty_menstruation:includedhorm_contra          0.05907    0.05284    1.12       0.264    
certainty_menstruation:fertile                      0.10827    0.09113    1.19       0.235    
includedhorm_contra:fertile                         0.49346    0.49573    1.00       0.320    
certainty_menstruation:includedhorm_contra:fertile -0.18189    0.11462   -1.59       0.113    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.33997 (tol = 0.001, component 1)

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 24092 24206 -12032 24064 NA NA NA
with_mod 18 24098 24246 -12031 24062 1.335 4 0.8554

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + cycle_regularity +  
    included + fertile + menstruation:included + cycle_regularity:included +  
    cycle_regularity:fertile + included:fertile + cycle_regularity:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24098    24246   -12031    24062    26685 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.297 -0.499 -0.348 -0.177  5.395 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.368    0.606   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                                                  Estimate Std. Error z value
(Intercept)                                                                       -1.07193    0.08159  -13.14
menstruationpre                                                                   -0.06409    0.04922   -1.30
menstruationyes                                                                   -0.12228    0.04664   -2.62
fertile_mean                                                                      -0.07394    0.32482   -0.23
cycle_regularityslightly irregular,\nup to 5 days off                             -0.00900    0.08784   -0.10
cycle_regularityirregular,\nmore than 5 days off                                  -0.05600    0.10566   -0.53
includedhorm_contra                                                                0.17662    0.07294    2.42
fertile                                                                            0.06552    0.13765    0.48
menstruationpre:includedhorm_contra                                                0.00718    0.06170    0.12
menstruationyes:includedhorm_contra                                               -0.03356    0.05989   -0.56
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra          0.07041    0.12976    0.54
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra               0.00267    0.15557    0.02
cycle_regularityslightly irregular,\nup to 5 days off:fertile                      0.05139    0.18649    0.28
cycle_regularityirregular,\nmore than 5 days off:fertile                           0.22594    0.22714    0.99
includedhorm_contra:fertile                                                       -0.21357    0.15858   -1.35
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile -0.03604    0.27108   -0.13
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile      -0.08448    0.33020   -0.26
                                                                                  Pr(>|z|)    
(Intercept)                                                                         <2e-16 ***
menstruationpre                                                                     0.1928    
menstruationyes                                                                     0.0087 ** 
fertile_mean                                                                        0.8199    
cycle_regularityslightly irregular,\nup to 5 days off                               0.9184    
cycle_regularityirregular,\nmore than 5 days off                                    0.5961    
includedhorm_contra                                                                 0.0155 *  
fertile                                                                             0.6341    
menstruationpre:includedhorm_contra                                                 0.9074    
menstruationyes:includedhorm_contra                                                 0.5752    
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra           0.5874    
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                0.9863    
cycle_regularityslightly irregular,\nup to 5 days off:fertile                       0.7829    
cycle_regularityirregular,\nmore than 5 days off:fertile                            0.3199    
includedhorm_contra:fertile                                                         0.1780    
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile   0.8942    
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile        0.7981    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0113852 (tol = 0.001, component 1)

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 24047 24161 -12009 24019 NA NA NA
with_mod 18 24054 24202 -12009 24018 0.5849 4 0.9647

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + cohabitation +  
    included + fertile + menstruation:included + cohabitation:included +  
    cohabitation:fertile + included:fertile + cohabitation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24054    24202   -12009    24018    26685 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.189 -0.498 -0.348 -0.174  5.243 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.346    0.589   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                               -1.16001    0.07839  -14.80  < 2e-16 ***
menstruationpre                                           -0.06234    0.04915   -1.27  0.20461    
menstruationyes                                           -0.11927    0.04658   -2.56  0.01045 *  
fertile_mean                                              -0.07783    0.31924   -0.24  0.80739    
cohabitationLive in same city                              0.32909    0.09635    3.42  0.00064 ***
cohabitationLong-distance                                  0.02378    0.09380    0.25  0.79987    
includedhorm_contra                                        0.08298    0.08177    1.01  0.31022    
fertile                                                    0.17494    0.12377    1.41  0.15753    
menstruationpre:includedhorm_contra                        0.00123    0.06165    0.02  0.98410    
menstruationyes:includedhorm_contra                       -0.03974    0.05982   -0.66  0.50645    
cohabitationLive in same city:includedhorm_contra          0.06625    0.12312    0.54  0.59048    
cohabitationLong-distance:includedhorm_contra              0.12829    0.12040    1.07  0.28666    
cohabitationLive in same city:fertile                     -0.06984    0.20932   -0.33  0.73864    
cohabitationLong-distance:fertile                         -0.10780    0.20544   -0.52  0.59978    
includedhorm_contra:fertile                               -0.35464    0.18185   -1.95  0.05116 .  
cohabitationLive in same city:includedhorm_contra:fertile  0.09178    0.26616    0.34  0.73022    
cohabitationLong-distance:includedhorm_contra:fertile      0.18203    0.26298    0.69  0.48882    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0651494 (tol = 0.001, component 1)

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 24051 24166 -12012 24023 NA NA NA
with_mod 18 24055 24203 -12010 24019 4.219 4 0.3772

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_petting ~ menstruation + fertile_mean + (1 | person) + relationship_status_clean +  
    included + fertile + menstruation:included + relationship_status_clean:included +  
    relationship_status_clean:fertile + included:fertile + relationship_status_clean:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   24055    24203   -12010    24019    26685 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.285 -0.500 -0.348 -0.178  5.284 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.35     0.591   
Number of obs: 26703, groups:  person, 1054

Fixed effects:
                                                                 Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                                      -0.97509    0.07218  -13.51  < 2e-16 ***
menstruationpre                                                  -0.06501    0.04918   -1.32   0.1862    
menstruationyes                                                  -0.12332    0.04660   -2.65   0.0081 ** 
fertile_mean                                                     -0.07227    0.31904   -0.23   0.8208    
relationship_status_cleanVerheiratet                             -0.40102    0.09453   -4.24 0.000022 ***
relationship_status_cleanVerlobt                                 -0.30031    0.17212   -1.74   0.0810 .  
includedhorm_contra                                               0.11618    0.06148    1.89   0.0588 .  
fertile                                                           0.09640    0.10882    0.89   0.3757    
menstruationpre:includedhorm_contra                               0.00777    0.06166    0.13   0.8998    
menstruationyes:includedhorm_contra                              -0.03180    0.05984   -0.53   0.5951    
relationship_status_cleanVerheiratet:includedhorm_contra         -0.27352    0.18448   -1.48   0.1382    
relationship_status_cleanVerlobt:includedhorm_contra              0.13491    0.25823    0.52   0.6014    
relationship_status_cleanVerheiratet:fertile                     -0.01926    0.21274   -0.09   0.9278    
relationship_status_cleanVerlobt:fertile                          0.64958    0.35887    1.81   0.0703 .  
includedhorm_contra:fertile                                      -0.24508    0.13133   -1.87   0.0620 .  
relationship_status_cleanVerheiratet:includedhorm_contra:fertile  0.34939    0.42388    0.82   0.4098    
relationship_status_cleanVerlobt:includedhorm_contra:fertile     -0.44956    0.57880   -0.78   0.4373    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0943412 (tol = 0.001, component 1)

Sexual intercourse

model_summaries$had_sexual_intercourse

Model summary

Model summary

model %>% 
  print_summary()
Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ included * (menstruation + fertile) +      fertile_mean + (1 | person)
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25698    25780   -12839    25678    26694 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.621 -0.546 -0.375 -0.188  6.343 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.311    0.557   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value   Pr(>|z|)    
(Intercept)                          -1.0249     0.0650  -15.76    < 2e-16 ***
includedhorm_contra                   0.2728     0.0533    5.12 0.00000031 ***
menstruationpre                      -0.0228     0.0470   -0.49    0.62684    
menstruationyes                      -0.4122     0.0478   -8.62    < 2e-16 ***
fertile                               0.0912     0.0946    0.96    0.33515    
fertile_mean                          0.4010     0.2994    1.34    0.18049    
includedhorm_contra:menstruationpre  -0.0682     0.0587   -1.16    0.24583    
includedhorm_contra:menstruationyes  -0.2119     0.0622   -3.41    0.00066 ***
includedhorm_contra:fertile          -0.3197     0.1170   -2.73    0.00630 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.492                                                               
menstrutnpr             -0.287  0.354                                                        
menstrutnys             -0.244  0.303  0.356                                                 
fertile                 -0.277  0.437  0.469    0.354                                        
fertile_men             -0.756 -0.037 -0.005   -0.004   -0.104                               
inclddhrm_cntr:mnstrtnp  0.238 -0.432 -0.800   -0.285   -0.374 -0.008                        
inclddhrm_cntr:mnstrtny  0.197 -0.360 -0.274   -0.768   -0.272 -0.006  0.338                 
inclddhrm_cntr:f         0.276 -0.538 -0.379   -0.286   -0.801  0.016  0.467                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.344                 
convergence code: 0
Model failed to converge with max|grad| = 0.0104007 (tol = 0.001, component 1)

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.09 [-0.09;0.28].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ included + menstruation + fertile +  
    fertile_mean + (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25656    25811   -12809    25618    26685 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.432 -0.542 -0.365 -0.161  4.820 

Random effects:
 Groups Name            Variance Std.Dev. Corr             
 person (Intercept)     0.3335   0.578                     
        fertile         0.2861   0.535    -0.25            
        menstruationpre 0.0655   0.256    -0.24  0.97      
        menstruationyes 0.2652   0.515     0.04 -0.05  0.09
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)    
(Intercept)                          -1.0404     0.0671  -15.50  < 2e-16 ***
includedhorm_contra                   0.2733     0.0549    4.98  6.5e-07 ***
menstruationpre                      -0.0269     0.0530   -0.51   0.6116    
menstruationyes                      -0.5579     0.0709   -7.87  3.6e-15 ***
fertile                               0.0894     0.1062    0.84   0.3997    
fertile_mean                          0.4614     0.3063    1.51   0.1320    
includedhorm_contra:menstruationpre  -0.0647     0.0629   -1.03   0.3036    
includedhorm_contra:menstruationyes  -0.2238     0.0790   -2.83   0.0046 ** 
includedhorm_contra:fertile          -0.3214     0.1260   -2.55   0.0108 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.498                                                               
menstrutnpr             -0.322  0.368                                                        
menstrutnys             -0.175  0.213  0.249                                                 
fertile                 -0.304  0.451  0.498    0.243                                        
fertile_men             -0.747 -0.036  0.006   -0.011   -0.111                               
inclddhrm_cntr:mnstrtnp  0.264 -0.462 -0.788   -0.201   -0.400 -0.014                        
inclddhrm_cntr:mnstrtny  0.157 -0.277 -0.212   -0.678   -0.202 -0.005  0.269                 
inclddhrm_cntr:f         0.295 -0.565 -0.402   -0.193   -0.785  0.017  0.514                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.257                 
convergence code: 0
Model failed to converge with max|grad| = 0.586369 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
model 10 25699 25780 -12839 25679 NA NA NA
with_ind_diff 19 25656 25811 -12809 25618 60.85 9 0.0000000009197
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )

     AIC      BIC   logLik deviance df.resid 
   23070    23216   -11517    23034    24380 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.473 -0.534 -0.366 -0.186  6.565 

Random effects:
 Groups Name                                   Variance  Std.Dev.
 person (Intercept)                            0.3091508 0.55601 
 Xr.2   s(days_filled_out):includedhorm_contra 0.1906540 0.43664 
 Xr.1   s(days_filled_out):includedcycling     0.0000078 0.00279 
 Xr.0   s(day_number):includedhorm_contra      0.2608332 0.51072 
 Xr     s(day_number):includedcycling          0.0000127 0.00356 
Number of obs: 24398, groups:  person, 1054; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error z value Pr(>|z|)    
X(Intercept)                                -1.0896     0.0669  -16.28  < 2e-16 ***
Xincludedhorm_contra                         0.2519     0.0556    4.53 0.000006 ***
Xmenstruationpre                            -0.0056     0.0493   -0.11  0.90967    
Xmenstruationyes                            -0.4325     0.0517   -8.36  < 2e-16 ***
Xfertile                                     0.0747     0.1017    0.73  0.46257    
Xfertile_mean                                0.5420     0.3043    1.78  0.07489 .  
Xincludedhorm_contra:menstruationpre        -0.0562     0.0617   -0.91  0.36223    
Xincludedhorm_contra:menstruationyes        -0.1871     0.0672   -2.79  0.00535 ** 
Xincludedhorm_contra:fertile                -0.2556     0.1257   -2.03  0.04203 *  
Xs(day_number):includedcyclingFx1            0.3015     0.0687    4.39 0.000012 ***
Xs(day_number):includedhorm_contraFx1        0.8159     0.2729    2.99  0.00279 ** 
Xs(days_filled_out):includedcyclingFx1      -0.2657     0.0709   -3.75  0.00018 ***
Xs(days_filled_out):includedhorm_contraFx1  -0.5657     0.1862   -3.04  0.00239 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Family: binomial 
Link function: probit 

Formula:
had_sexual_intercourse ~ included + menstruation + fertile + 
    fertile_mean + s(day_number, by = included) + s(days_filled_out, 
    by = included) + included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error z value  Pr(>|z|)    
(Intercept)                          -1.0896     0.0654  -16.65   < 2e-16 ***
includedhorm_contra                   0.2519     0.0548    4.60 0.0000043 ***
menstruationpre                      -0.0056     0.0485   -0.12    0.9081    
menstruationyes                      -0.4325     0.0511   -8.46   < 2e-16 ***
fertile                               0.0747     0.0998    0.75    0.4540    
fertile_mean                          0.5420     0.2977    1.82    0.0687 .  
includedhorm_contra:menstruationpre  -0.0562     0.0607   -0.93    0.3542    
includedhorm_contra:menstruationyes  -0.1871     0.0665   -2.81    0.0049 ** 
includedhorm_contra:fertile          -0.2556     0.1234   -2.07    0.0384 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df Chi.sq p-value    
s(day_number):includedcycling          1.00   1.00   20.1 7.5e-06 ***
s(day_number):includedhorm_contra      4.28   4.28   64.0 1.4e-12 ***
s(days_filled_out):includedcycling     1.00   1.00   14.6 0.00013 ***
s(days_filled_out):includedhorm_contra 3.83   3.83   61.4 2.2e-12 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

R-sq.(adj) =  0.0162   
glmer.ML =  20982  Scale est. = 1         n = 24398

Information: No AR1/ARMA autocorrelation models were fitted for binomial outcomes.

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ fertile_mean + (1 | person) + contraceptive_methods +  
    fertile + menstruation + fertile:contraceptive_methods +      menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

     AIC      BIC   logLik deviance df.resid 
   16493    16632    -8228    16457    17026 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.091 -0.552 -0.389 -0.184  6.450 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.243    0.493   
Number of obs: 17044, groups:  person, 513

Fixed effects:
                                                         Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                               -0.8688     0.1144   -7.59  3.1e-14 ***
fertile_mean                                               0.0762     0.5340    0.14   0.8865    
contraceptive_methodsfertility_awareness                  -0.0212     0.1665   -0.13   0.8988    
contraceptive_methodsnone                                 -0.6267     0.1987   -3.15   0.0016 ** 
contraceptive_methodshormonal                              0.1375     0.0833    1.65   0.0987 .  
fertile                                                   -0.0632     0.1689   -0.37   0.7083    
menstruationpre                                           -0.0474     0.0799   -0.59   0.5532    
menstruationyes                                           -0.5077     0.0847   -5.99  2.1e-09 ***
contraceptive_methodsfertility_awareness:fertile           0.3631     0.3700    0.98   0.3264    
contraceptive_methodsnone:fertile                          0.4947     0.4773    1.04   0.2999    
contraceptive_methodshormonal:fertile                     -0.1254     0.1868   -0.67   0.5020    
contraceptive_methodsfertility_awareness:menstruationpre   0.0726     0.1767    0.41   0.6809    
contraceptive_methodsnone:menstruationpre                  0.0553     0.2227    0.25   0.8039    
contraceptive_methodshormonal:menstruationpre             -0.0125     0.0893   -0.14   0.8885    
contraceptive_methodsfertility_awareness:menstruationyes   0.2860     0.1860    1.54   0.1242    
contraceptive_methodsnone:menstruationyes                 -0.2611     0.3173   -0.82   0.4105    
contraceptive_methodshormonal:menstruationyes             -0.1414     0.0967   -1.46   0.1436    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.150687 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 12 16486 16579 -8231 16462 NA NA NA
by_method 18 16493 16632 -8228 16457 5.269 6 0.5098

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 18 25696 25843 -12830 25660 NA NA NA
with_mod 26 25700 25913 -12824 25648 12.3 8 0.1382

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25700    25912   -12824    25648    26678 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.987 -0.544 -0.377 -0.181  6.044 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.304    0.551   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                  -1.12874    0.13088   -8.62  < 2e-16 ***
menstruationpre                              -0.02299    0.04699   -0.49  0.62465    
menstruationyes                              -0.41442    0.04786   -8.66  < 2e-16 ***
fertile_mean                                  0.39930    0.29873    1.34  0.18133    
age_group(20,25]                              0.12134    0.13646    0.89  0.37389    
age_group(25,30]                              0.24649    0.13997    1.76  0.07824 .  
age_group(30,35]                              0.02627    0.16168    0.16  0.87095    
age_group(35,70]                             -0.01590    0.14644   -0.11  0.91352    
includedhorm_contra                           0.43191    0.13737    3.14  0.00167 ** 
fertile                                      -0.10386    0.29664   -0.35  0.72624    
menstruationpre:includedhorm_contra          -0.06780    0.05876   -1.15  0.24856    
menstruationyes:includedhorm_contra          -0.20899    0.06221   -3.36  0.00078 ***
age_group(20,25]:includedhorm_contra         -0.14959    0.15318   -0.98  0.32880    
age_group(25,30]:includedhorm_contra         -0.35613    0.16827   -2.12  0.03431 *  
age_group(30,35]:includedhorm_contra         -0.21436    0.21930   -0.98  0.32835    
age_group(35,70]:includedhorm_contra         -0.61057    0.25452   -2.40  0.01644 *  
age_group(20,25]:fertile                      0.10196    0.32347    0.32  0.75260    
age_group(25,30]:fertile                      0.13897    0.32830    0.42  0.67208    
age_group(30,35]:fertile                      0.67145    0.37524    1.79  0.07355 .  
age_group(35,70]:fertile                      0.20389    0.34680    0.59  0.55659    
includedhorm_contra:fertile                  -0.15236    0.32078   -0.47  0.63480    
age_group(20,25]:includedhorm_contra:fertile -0.08346    0.35374   -0.24  0.81348    
age_group(25,30]:includedhorm_contra:fertile  0.00287    0.38240    0.01  0.99402    
age_group(30,35]:includedhorm_contra:fertile -1.17268    0.50531   -2.32  0.02030 *  
age_group(35,70]:includedhorm_contra:fertile  0.74198    0.57629    1.29  0.19792    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.214259 (tol = 0.001, component 1)

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 25420 25519 -12698 25396 NA NA NA
with_mod 14 25424 25538 -12698 25396 0.6656 2 0.7169

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    weekend + included + fertile + menstruation:included + weekend:included +  
    weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25424    25538   -12698    25396    26690 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.739 -0.536 -0.362 -0.165  6.169 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.321    0.566   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                        Estimate Std. Error z value      Pr(>|z|)    
(Intercept)                              -1.1427     0.0685  -16.68       < 2e-16 ***
menstruationpre                          -0.0246     0.0472   -0.52       0.60244    
menstruationyes                          -0.4209     0.0481   -8.75       < 2e-16 ***
fertile_mean                              0.4152     0.3036    1.37       0.17144    
weekendTRUE                               0.2680     0.0420    6.38 0.00000000018 ***
includedhorm_contra                       0.2430     0.0588    4.13 0.00003568475 ***
fertile                                   0.0309     0.1194    0.26       0.79553    
menstruationpre:includedhorm_contra      -0.0712     0.0591   -1.21       0.22810    
menstruationyes:includedhorm_contra      -0.2074     0.0626   -3.31       0.00092 ***
weekendTRUE:includedhorm_contra           0.0712     0.0528    1.35       0.17743    
weekendTRUE:fertile                       0.1110     0.1587    0.70       0.48422    
includedhorm_contra:fertile              -0.2497     0.1485   -1.68       0.09274 .  
weekendTRUE:includedhorm_contra:fertile  -0.1524     0.1984   -0.77       0.44240    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0364538 (tol = 0.001, component 1)

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 22 25221 25401 -12589 25177 NA NA NA
with_mod 34 25237 25516 -12585 25169 8.088 12 0.7783

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    weekday + included + fertile + menstruation:included + weekday:included +  
    weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25237    25516   -12585    25169    26670 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-3.108 -0.530 -0.353 -0.154  6.014 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.328    0.573   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                  -0.92677    0.08178  -11.33  < 2e-16 ***
menstruationpre                              -0.02366    0.04744   -0.50  0.61802    
menstruationyes                              -0.42415    0.04832   -8.78  < 2e-16 ***
fertile_mean                                  0.39517    0.30629    1.29  0.19699    
weekdayTuesday                               -0.28962    0.07738   -3.74  0.00018 ***
weekdayWednesday                             -0.30379    0.07761   -3.91 0.000091 ***
weekdayThursday                              -0.30031    0.07854   -3.82  0.00013 ***
weekdayFriday                                -0.16246    0.07769   -2.09  0.03652 *  
weekdaySaturday                               0.13711    0.07539    1.82  0.06899 .  
weekdaySunday                                 0.16002    0.07251    2.21  0.02732 *  
includedhorm_contra                           0.25776    0.08077    3.19  0.00142 ** 
fertile                                      -0.08773    0.20667   -0.42  0.67119    
menstruationpre:includedhorm_contra          -0.07253    0.05940   -1.22  0.22212    
menstruationyes:includedhorm_contra          -0.20494    0.06287   -3.26  0.00112 ** 
weekdayTuesday:includedhorm_contra           -0.09131    0.09771   -0.93  0.35007    
weekdayWednesday:includedhorm_contra         -0.03460    0.09815   -0.35  0.72442    
weekdayThursday:includedhorm_contra           0.06410    0.09852    0.65  0.51526    
weekdayFriday:includedhorm_contra             0.04062    0.09737    0.42  0.67654    
weekdaySaturday:includedhorm_contra           0.06527    0.09469    0.69  0.49062    
weekdaySunday:includedhorm_contra             0.07127    0.09146    0.78  0.43580    
weekdayTuesday:fertile                        0.08984    0.29514    0.30  0.76082    
weekdayWednesday:fertile                      0.19594    0.29618    0.66  0.50826    
weekdayThursday:fertile                       0.21843    0.30161    0.72  0.46893    
weekdayFriday:fertile                         0.43408    0.29088    1.49  0.13563    
weekdaySaturday:fertile                       0.00121    0.28769    0.00  0.99663    
weekdaySunday:fertile                         0.31208    0.27733    1.13  0.26047    
includedhorm_contra:fertile                  -0.18168    0.25796   -0.70  0.48125    
weekdayTuesday:includedhorm_contra:fertile    0.17132    0.36950    0.46  0.64290    
weekdayWednesday:includedhorm_contra:fertile -0.27482    0.37412   -0.73  0.46260    
weekdayThursday:includedhorm_contra:fertile  -0.16265    0.37491   -0.43  0.66440    
weekdayFriday:includedhorm_contra:fertile    -0.33598    0.36348   -0.92  0.35531    
weekdaySaturday:includedhorm_contra:fertile  -0.16912    0.35933   -0.47  0.63789    
weekdaySunday:includedhorm_contra:fertile    -0.21064    0.34715   -0.61  0.54401    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0370517 (tol = 0.001, component 1)
failure to converge in 10000 evaluations

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 25701 25832 -12835 25669 NA NA NA
with_mod 22 25712 25892 -12834 25668 1.381 6 0.967

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25712    25892   -12834    25668    26682 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.618 -0.545 -0.376 -0.187  6.203 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.305    0.552   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                                        Estimate Std. Error z value  Pr(>|z|)    
(Intercept)                                              -1.0088     0.0717  -14.06   < 2e-16 ***
menstruationpre                                          -0.0223     0.0470   -0.47   0.63575    
menstruationyes                                          -0.4130     0.0478   -8.64   < 2e-16 ***
fertile_mean                                              0.4704     0.3022    1.56   0.11958    
included_levelslax                                        0.0523     0.1302    0.40   0.68783    
included_levelsconservative                              -0.0341     0.1028   -0.33   0.74035    
included_levelsstrict                                    -0.1606     0.1023   -1.57   0.11646    
includedhorm_contra                                       0.3327     0.0738    4.51 0.0000066 ***
fertile                                                   0.0928     0.1185    0.78   0.43362    
menstruationpre:includedhorm_contra                      -0.0656     0.0588   -1.11   0.26488    
menstruationyes:includedhorm_contra                      -0.2095     0.0622   -3.37   0.00076 ***
included_levelslax:includedhorm_contra                   -0.2892     0.1596   -1.81   0.06997 .  
included_levelsconservative:includedhorm_contra          -0.0472     0.1288   -0.37   0.71375    
included_levelsstrict:includedhorm_contra                 0.0455     0.1257    0.36   0.71743    
included_levelslax:fertile                               -0.2289     0.2950   -0.78   0.43789    
included_levelsconservative:fertile                       0.0228     0.2163    0.11   0.91608    
included_levelsstrict:fertile                             0.0677     0.2234    0.30   0.76197    
includedhorm_contra:fertile                              -0.3903     0.1752   -2.23   0.02591 *  
included_levelslax:includedhorm_contra:fertile            0.3604     0.3545    1.02   0.30931    
included_levelsconservative:includedhorm_contra:fertile   0.0382     0.2756    0.14   0.88972    
included_levelsstrict:includedhorm_contra:fertile         0.0334     0.2773    0.12   0.90405    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0429722 (tol = 0.001, component 1)

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 25708 25839 -12838 25676 NA NA NA
with_mod 22 25713 25894 -12835 25669 6.47 6 0.3726

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    cycle_length_groups + included + fertile + menstruation:included +  
    cycle_length_groups:included + cycle_length_groups:fertile +  
    included:fertile + cycle_length_groups:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25713    25894   -12835    25669    26682 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.635 -0.544 -0.376 -0.186  6.666 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.311    0.558   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                                       Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                             -1.1725     0.1217   -9.63  < 2e-16 ***
menstruationpre                                         -0.0244     0.0470   -0.52  0.60430    
menstruationyes                                         -0.4134     0.0481   -8.60  < 2e-16 ***
fertile_mean                                             0.3933     0.3036    1.30  0.19517    
cycle_length_groups(25,30]                               0.1760     0.1180    1.49  0.13576    
cycle_length_groups(30,35]                               0.1571     0.1397    1.12  0.26070    
cycle_length_groups(35,41]                               0.1228     0.1961    0.63  0.53130    
includedhorm_contra                                      0.4531     0.1330    3.41  0.00066 ***
fertile                                                  0.1863     0.2639    0.71  0.48024    
menstruationpre:includedhorm_contra                     -0.0634     0.0588   -1.08  0.28056    
menstruationyes:includedhorm_contra                     -0.2039     0.0625   -3.26  0.00110 ** 
cycle_length_groups(25,30]:includedhorm_contra          -0.2166     0.1420   -1.53  0.12711    
cycle_length_groups(30,35]:includedhorm_contra          -0.3070     0.2137   -1.44  0.15080    
cycle_length_groups(35,41]:includedhorm_contra          -0.0152     0.2666   -0.06  0.95450    
cycle_length_groups(25,30]:fertile                      -0.1641     0.2801   -0.59  0.55802    
cycle_length_groups(30,35]:fertile                       0.0520     0.3261    0.16  0.87329    
cycle_length_groups(35,41]:fertile                       0.1192     0.4547    0.26  0.79328    
includedhorm_contra:fertile                             -0.6209     0.3044   -2.04  0.04138 *  
cycle_length_groups(25,30]:includedhorm_contra:fertile   0.4363     0.3247    1.34  0.17904    
cycle_length_groups(30,35]:includedhorm_contra:fertile   0.2894     0.5064    0.57  0.56774    
cycle_length_groups(35,41]:includedhorm_contra:fertile  -0.4057     0.5826   -0.70  0.48627    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.190291 (tol = 0.001, component 1)

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 25694 25793 -12835 25670 NA NA NA
with_mod 14 25696 25811 -12834 25668 2.236 2 0.327

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    certainty_menstruation + included + fertile + menstruation:included +  
    certainty_menstruation:included + certainty_menstruation:fertile +  
    included:fertile + certainty_menstruation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25696    25811   -12834    25668    26690 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.723 -0.546 -0.375 -0.186  6.327 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.306    0.554   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                                   Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                         -1.3501     0.1710   -7.89  2.9e-15 ***
menstruationpre                                     -0.0203     0.0470   -0.43  0.66600    
menstruationyes                                     -0.4080     0.0479   -8.52  < 2e-16 ***
fertile_mean                                         0.3730     0.3002    1.24  0.21397    
certainty_menstruation                               0.0799     0.0387    2.06  0.03908 *  
includedhorm_contra                                  0.5843     0.2130    2.74  0.00607 ** 
fertile                                             -0.4634     0.3955   -1.17  0.24123    
menstruationpre:includedhorm_contra                 -0.0707     0.0587   -1.20  0.22886    
menstruationyes:includedhorm_contra                 -0.2161     0.0622   -3.47  0.00052 ***
certainty_menstruation:includedhorm_contra          -0.0754     0.0493   -1.53  0.12592    
certainty_menstruation:fertile                       0.1313     0.0912    1.44  0.14972    
includedhorm_contra:fertile                          0.3299     0.4900    0.67  0.50077    
certainty_menstruation:includedhorm_contra:fertile  -0.1532     0.1123   -1.36  0.17237    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.101611 (tol = 0.001, component 1)

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 25702 25816 -12837 25674 NA NA NA
with_mod 18 25709 25856 -12836 25673 0.7208 4 0.9487

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    cycle_regularity + included + fertile + menstruation:included +  
    cycle_regularity:included + cycle_regularity:fertile + included:fertile +  
    cycle_regularity:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25709    25856   -12836    25673    26686 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.675 -0.545 -0.376 -0.186  6.403 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.309    0.556   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                                                                  Estimate Std. Error z value
(Intercept)                                                                        -0.9547     0.0756  -12.63
menstruationpre                                                                    -0.0250     0.0470   -0.53
menstruationyes                                                                    -0.4130     0.0478   -8.63
fertile_mean                                                                        0.3964     0.3004    1.32
cycle_regularityslightly irregular,\nup to 5 days off                              -0.0918     0.0818   -1.12
cycle_regularityirregular,\nmore than 5 days off                                   -0.1925     0.0996   -1.93
includedhorm_contra                                                                 0.2053     0.0675    3.04
fertile                                                                             0.1216     0.1281    0.95
menstruationpre:includedhorm_contra                                                -0.0662     0.0588   -1.13
menstruationyes:includedhorm_contra                                                -0.2112     0.0622   -3.39
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra           0.1074     0.1211    0.89
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                0.1462     0.1455    1.00
cycle_regularityslightly irregular,\nup to 5 days off:fertile                      -0.1051     0.1799   -0.58
cycle_regularityirregular,\nmore than 5 days off:fertile                            0.0316     0.2260    0.14
includedhorm_contra:fertile                                                        -0.3430     0.1484   -2.31
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile   0.0413     0.2628    0.16
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile       -0.0386     0.3238   -0.12
                                                                                  Pr(>|z|)    
(Intercept)                                                                        < 2e-16 ***
menstruationpre                                                                    0.59470    
menstruationyes                                                                    < 2e-16 ***
fertile_mean                                                                       0.18696    
cycle_regularityslightly irregular,\nup to 5 days off                              0.26190    
cycle_regularityirregular,\nmore than 5 days off                                   0.05326 .  
includedhorm_contra                                                                0.00236 ** 
fertile                                                                            0.34239    
menstruationpre:includedhorm_contra                                                0.25976    
menstruationyes:includedhorm_contra                                                0.00069 ***
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra          0.37535    
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra               0.31496    
cycle_regularityslightly irregular,\nup to 5 days off:fertile                      0.55928    
cycle_regularityirregular,\nmore than 5 days off:fertile                           0.88864    
includedhorm_contra:fertile                                                        0.02084 *  
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile  0.87502    
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile       0.90511    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0642138 (tol = 0.001, component 1)

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 25658 25772 -12815 25630 NA NA NA
with_mod 18 25655 25803 -12810 25619 10.41 4 0.034

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25655    25803   -12810    25619    26686 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.682 -0.545 -0.375 -0.181  6.113 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.29     0.538   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                                          Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                                -0.9638     0.0720  -13.39  < 2e-16 ***
menstruationpre                                            -0.0239     0.0469   -0.51  0.61009    
menstruationyes                                            -0.4107     0.0478   -8.60  < 2e-16 ***
fertile_mean                                                0.3345     0.2945    1.14  0.25608    
cohabitationLive in same city                               0.0188     0.0910    0.21  0.83643    
cohabitationLong-distance                                  -0.2022     0.0885   -2.29  0.02229 *  
includedhorm_contra                                         0.1199     0.0749    1.60  0.10952    
fertile                                                     0.2164     0.1154    1.88  0.06074 .  
menstruationpre:includedhorm_contra                        -0.0698     0.0587   -1.19  0.23449    
menstruationyes:includedhorm_contra                        -0.2145     0.0622   -3.45  0.00056 ***
cohabitationLive in same city:includedhorm_contra           0.3105     0.1152    2.70  0.00703 ** 
cohabitationLong-distance:includedhorm_contra               0.1780     0.1128    1.58  0.11448    
cohabitationLive in same city:fertile                      -0.0627     0.2086   -0.30  0.76367    
cohabitationLong-distance:fertile                          -0.5474     0.2087   -2.62  0.00871 ** 
includedhorm_contra:fertile                                -0.2651     0.1670   -1.59  0.11246    
cohabitationLive in same city:includedhorm_contra:fertile  -0.1969     0.2584   -0.76  0.44621    
cohabitationLong-distance:includedhorm_contra:fertile       0.3094     0.2595    1.19  0.23311    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0734515 (tol = 0.001, component 1)

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 25695 25810 -12834 25667 NA NA NA
with_mod 18 25697 25844 -12830 25661 6.193 4 0.1852

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: had_sexual_intercourse ~ menstruation + fertile_mean + (1 | person) +  
    relationship_status_clean + included + fertile + menstruation:included +  
    relationship_status_clean:included + relationship_status_clean:fertile +  
    included:fertile + relationship_status_clean:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
   25697    25844   -12830    25661    26686 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.562 -0.546 -0.376 -0.185  6.271 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.306    0.553   
Number of obs: 26704, groups:  person, 1054

Fixed effects:
                                                                 Estimate Std. Error z value  Pr(>|z|)    
(Intercept)                                                       -0.9892     0.0682  -14.49   < 2e-16 ***
menstruationpre                                                   -0.0259     0.0470   -0.55   0.58195    
menstruationyes                                                   -0.4140     0.0478   -8.66   < 2e-16 ***
fertile_mean                                                       0.4020     0.2988    1.35   0.17849    
relationship_status_cleanVerheiratet                              -0.1158     0.0865   -1.34   0.18067    
relationship_status_cleanVerlobt                                  -0.1210     0.1652   -0.73   0.46394    
includedhorm_contra                                                0.2617     0.0585    4.47 0.0000077 ***
fertile                                                            0.0124     0.1080    0.11   0.90864    
menstruationpre:includedhorm_contra                               -0.0660     0.0588   -1.12   0.26102    
menstruationyes:includedhorm_contra                               -0.2115     0.0622   -3.40   0.00068 ***
relationship_status_cleanVerheiratet:includedhorm_contra          -0.4084     0.1686   -2.42   0.01540 *  
relationship_status_cleanVerlobt:includedhorm_contra               0.0428     0.2438    0.18   0.86068    
relationship_status_cleanVerheiratet:fertile                       0.3323     0.1912    1.74   0.08225 .  
relationship_status_cleanVerlobt:fertile                          -0.0542     0.3703   -0.15   0.88371    
includedhorm_contra:fertile                                       -0.2667     0.1290   -2.07   0.03872 *  
relationship_status_cleanVerheiratet:includedhorm_contra:fertile   0.2126     0.3747    0.57   0.57052    
relationship_status_cleanVerlobt:includedhorm_contra:fertile       0.2841     0.5489    0.52   0.60467    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0763988 (tol = 0.001, component 1)

Specific robustness analyses for sexual intercourse

xtabs(~ spent_night_with_partner + had_sexual_intercourse, data = diary %>% filter(!is.na(fertile), !is.na(included)))
##                         had_sexual_intercourse
## spent_night_with_partner     0     1
##                        0 11719   681
##                        1  9236  5068
possible_nights = diary %>% filter(spent_night_with_partner == 1)
m1_night_with_partner = glmer(had_sexual_intercourse ~ included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = possible_nights, family = binomial(link = "probit"))
m1_night_with_partner %>% 
  print_summary()  %>% 
  plot_all_effects()
## 
## 
## ```
## Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
##  Family: binomial  ( probit )
## Formula: had_sexual_intercourse ~ included * (menstruation + fertile) +      fertile_mean + (1 | person)
##    Data: possible_nights
## 
##      AIC      BIC   logLik deviance df.resid 
##    15903    15979    -7942    15883    14294 
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.237 -0.619 -0.347  0.684  6.647 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  person (Intercept) 0.656    0.81    
## Number of obs: 14304, groups:  person, 972
## 
## Fixed effects:
##                                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -0.5439     0.0920   -5.92  3.3e-09 ***
## includedhorm_contra                   0.5527     0.0759    7.28  3.3e-13 ***
## menstruationpre                      -0.0128     0.0596   -0.21  0.83006    
## menstruationyes                      -0.5247     0.0597   -8.79  < 2e-16 ***
## fertile                               0.1791     0.1196    1.50  0.13417    
## fertile_mean                          0.1773     0.4278    0.41  0.67849    
## includedhorm_contra:menstruationpre  -0.0582     0.0777   -0.75  0.45371    
## includedhorm_contra:menstruationyes  -0.2889     0.0805   -3.59  0.00033 ***
## includedhorm_contra:fertile          -0.3243     0.1542   -2.10  0.03545 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
## inclddhrm_c             -0.475                                                               
## menstrutnpr             -0.253  0.317                                                        
## menstrutnys             -0.220  0.275  0.370                                                 
## fertile                 -0.245  0.386  0.476    0.369                                        
## fertile_men             -0.765 -0.036 -0.011   -0.010   -0.091                               
## inclddhrm_cntr:mnstrtnp  0.204 -0.400 -0.767   -0.284   -0.364 -0.004                        
## inclddhrm_cntr:mnstrtny  0.173 -0.343 -0.274   -0.740   -0.273 -0.004  0.350                 
## inclddhrm_cntr:f         0.247 -0.493 -0.368   -0.285   -0.769 -0.003  0.468                 
##                         inclddhrm_cntr:mnstrtny
## inclddhrm_c                                    
## menstrutnpr                                    
## menstrutnys                                    
## fertile                                        
## fertile_men                                    
## inclddhrm_cntr:mnstrtnp                        
## inclddhrm_cntr:mnstrtny                        
## inclddhrm_cntr:f         0.357                 
## convergence code: 0
## Model failed to converge with max|grad| = 0.00964787 (tol = 0.001, component 1)
## 
## 
## ```

In-pair desire predicts having sex.

summary(glmer(had_sexual_intercourse ~ in_pair_desire + included + menstruation + ( 1 | person), data = diary, family = binomial(link = "probit")))
## Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
##  Family: binomial  ( probit )
## Formula: had_sexual_intercourse ~ in_pair_desire + included + menstruation +      (1 | person)
##    Data: diary
## 
##      AIC      BIC   logLik deviance df.resid 
##    18937    18987    -9463    18925    27795 
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
##  -6.61  -0.37  -0.12  -0.01 126.16 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  person (Intercept) 0.624    0.79    
## Number of obs: 27801, groups:  person, 1054
## 
## Fixed effects:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          -4.7544     0.0775   -61.4   <2e-16 ***
## in_pair_desire        0.9464     0.0139    67.9   <2e-16 ***
## includedhorm_contra   0.0978     0.0590     1.7    0.097 .  
## menstruationpre      -0.0218     0.0306    -0.7    0.476    
## menstruationyes      -0.5436     0.0345   -15.8   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) in_pr_ incld_ mnstrtnp
## in_pair_dsr -0.793                       
## inclddhrm_c -0.474  0.001                
## menstrutnpr -0.090  0.011  0.008         
## menstrutnys -0.029 -0.059  0.013  0.201

Ovulatory but menstrual changes in sex are mediated by in-pair desire.

summary(glmer(had_sexual_intercourse ~ in_pair_desire + included * (menstruation + fertile) + fertile_mean + ( 1 | person), data = diary, family = binomial(link = "probit")))
## Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
##  Family: binomial  ( probit )
## Formula: had_sexual_intercourse ~ in_pair_desire + included * (menstruation +  
##     fertile) + fertile_mean + (1 | person)
##    Data: diary
## 
##      AIC      BIC   logLik deviance df.resid 
##    18026    18116    -9002    18004    26669 
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
##  -6.27  -0.36  -0.12  -0.01  93.86 
## 
## Random effects:
##  Groups Name        Variance Std.Dev.
##  person (Intercept) 0.614    0.784   
## Number of obs: 26680, groups:  person, 1054
## 
## Fixed effects:
##                                     Estimate Std. Error z value       Pr(>|z|)    
## (Intercept)                          -4.8912     0.1085   -45.1        < 2e-16 ***
## in_pair_desire                        0.9526     0.0144    66.1        < 2e-16 ***
## includedhorm_contra                   0.1477     0.0707     2.1          0.037 *  
## menstruationpre                       0.0190     0.0577     0.3          0.743    
## menstruationyes                      -0.3778     0.0584    -6.5 0.000000000097 ***
## fertile                              -0.1171     0.1159    -1.0          0.312    
## fertile_mean                          0.5264     0.4067     1.3          0.196    
## includedhorm_contra:menstruationpre  -0.1057     0.0722    -1.5          0.143    
## includedhorm_contra:menstruationyes  -0.3521     0.0760    -4.6 0.000003637977 ***
## includedhorm_contra:fertile          -0.0248     0.1436    -0.2          0.863    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                         (Intr) in_pr_ incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
## in_pair_dsr             -0.591                                                                      
## inclddhrm_c             -0.384 -0.003                                                               
## menstrutnpr             -0.216  0.013  0.324                                                        
## menstrutnys             -0.172 -0.010  0.280  0.356                                                 
## fertile                 -0.190 -0.022  0.403  0.467    0.355                                        
## fertile_men             -0.624  0.010 -0.040 -0.005   -0.007   -0.092                               
## inclddhrm_cntr:mnstrtnp  0.180 -0.012 -0.395 -0.800   -0.285   -0.373 -0.007                        
## inclddhrm_cntr:mnstrtny  0.168 -0.040 -0.330 -0.274   -0.767   -0.271 -0.006  0.337                 
## inclddhrm_cntr:f         0.191  0.021 -0.495 -0.377   -0.286   -0.802  0.011  0.464                 
##                         inclddhrm_cntr:mnstrtny
## in_pair_dsr                                    
## inclddhrm_c                                    
## menstrutnpr                                    
## menstrutnys                                    
## fertile                                        
## fertile_men                                    
## inclddhrm_cntr:mnstrtnp                        
## inclddhrm_cntr:mnstrtny                        
## inclddhrm_cntr:f         0.341                 
## convergence code: 0
## Model failed to converge with max|grad| = 0.563778 (tol = 0.001, component 1)

Partner initiated sex

model_summaries$partner_initiated_sexual_intercourse

Model summary

Model summary

model %>% 
  print_summary()
Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ included * (menstruation +  
    fertile) + fertile_mean + (1 | person)
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7646     7713    -3813     7626     5738 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.740 -1.111  0.659  0.779  1.288 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0914   0.302   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)   
(Intercept)                           0.1442     0.0821    1.76   0.0790 . 
includedhorm_contra                   0.1055     0.0730    1.45   0.1484   
menstruationpre                       0.0386     0.0879    0.44   0.6608   
menstruationyes                       0.0657     0.0959    0.69   0.4929   
fertile                              -0.2666     0.1761   -1.51   0.1301   
fertile_mean                          0.6074     0.3621    1.68   0.0934 . 
includedhorm_contra:menstruationpre  -0.1141     0.1088   -1.05   0.2942   
includedhorm_contra:menstruationyes  -0.3503     0.1263   -2.77   0.0055 **
includedhorm_contra:fertile           0.3013     0.2161    1.39   0.1634   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.558                                                               
menstrutnpr             -0.423  0.481                                                        
menstrutnys             -0.321  0.366  0.304                                                 
fertile                 -0.426  0.597  0.471    0.308                                        
fertile_men             -0.687 -0.047 -0.006   -0.006   -0.145                               
inclddhrm_cntr:mnstrtnp  0.351 -0.580 -0.808   -0.246   -0.377 -0.011                        
inclddhrm_cntr:mnstrtny  0.243 -0.422 -0.231   -0.759   -0.233  0.004  0.284                 
inclddhrm_cntr:f         0.423 -0.727 -0.383   -0.251   -0.799  0.008  0.466                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.295                 

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): -0.27 [-0.61;0.08].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ included + menstruation +  
    fertile + fertile_mean + (1 + fertile + menstruation | person) +  
    included:menstruation + included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7657     7783    -3809     7619     5729 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.801 -1.091  0.648  0.769  1.482 

Random effects:
 Groups Name            Variance Std.Dev. Corr             
 person (Intercept)     0.1060   0.326                     
        fertile         0.1171   0.342    -0.36            
        menstruationpre 0.0323   0.180     0.35 -0.68      
        menstruationyes 0.1306   0.361    -0.54  0.82 -0.95
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                    Estimate Std. Error z value Pr(>|z|)   
(Intercept)                           0.1389     0.0833    1.67   0.0952 . 
includedhorm_contra                   0.1112     0.0742    1.50   0.1341   
menstruationpre                       0.0580     0.0928    0.62   0.5321   
menstruationyes                       0.0593     0.1023    0.58   0.5619   
fertile                              -0.2557     0.1803   -1.42   0.1562   
fertile_mean                          0.6279     0.3667    1.71   0.0869 . 
includedhorm_contra:menstruationpre  -0.1225     0.1136   -1.08   0.2808   
includedhorm_contra:menstruationyes  -0.3509     0.1337   -2.63   0.0086 **
includedhorm_contra:fertile           0.2787     0.2202    1.27   0.2056   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.561                                                               
menstrutnpr             -0.396  0.444                                                        
menstrutnys             -0.341  0.385  0.246                                                 
fertile                 -0.432  0.599  0.444    0.325                                        
fertile_men             -0.681 -0.045 -0.011   -0.008   -0.152                               
inclddhrm_cntr:mnstrtnp  0.330 -0.541 -0.805   -0.199   -0.354 -0.009                        
inclddhrm_cntr:mnstrtny  0.258 -0.447 -0.185   -0.763   -0.245  0.004  0.230                 
inclddhrm_cntr:f         0.430 -0.734 -0.357   -0.264   -0.794  0.005  0.437                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.311                 
convergence code: 0
Model failed to converge with max|grad| = 0.00449993 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
model 10 7646 7713 -3813 7626 NA NA NA
with_ind_diff 19 7657 7783 -3809 7619 7.722 9 0.5624
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )

     AIC      BIC   logLik deviance df.resid 
    6792     6910    -3378     6756     5067 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.676 -1.108  0.662  0.787  1.302 

Random effects:
 Groups Name                                   Variance      Std.Dev. 
 person (Intercept)                            0.08828267636 0.2971240
 Xr.2   s(days_filled_out):includedhorm_contra 0.00000015125 0.0003889
 Xr.1   s(days_filled_out):includedcycling     0.00000001024 0.0001012
 Xr.0   s(day_number):includedhorm_contra      0.00000048331 0.0006952
 Xr     s(day_number):includedcycling          0.00000000161 0.0000402
Number of obs: 5085, groups:  person, 843; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error z value Pr(>|z|)  
X(Intercept)                                0.13857    0.08690    1.59    0.111  
Xincludedhorm_contra                        0.06951    0.07859    0.88    0.376  
Xmenstruationpre                           -0.00424    0.09252   -0.05    0.963  
Xmenstruationyes                           -0.00242    0.10481   -0.02    0.982  
Xfertile                                   -0.38291    0.19081   -2.01    0.045 *
Xfertile_mean                               0.82529    0.37890    2.18    0.029 *
Xincludedhorm_contra:menstruationpre       -0.04745    0.11452   -0.41    0.679  
Xincludedhorm_contra:menstruationyes       -0.29532    0.13769   -2.15    0.032 *
Xincludedhorm_contra:fertile                0.39714    0.23358    1.70    0.089 .
Xs(day_number):includedcyclingFx1          -0.02144    0.10161   -0.21    0.833  
Xs(day_number):includedhorm_contraFx1       0.06270    0.07954    0.79    0.431  
Xs(days_filled_out):includedcyclingFx1     -0.00217    0.10268   -0.02    0.983  
Xs(days_filled_out):includedhorm_contraFx1 -0.02128    0.08008   -0.27    0.790  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Family: binomial 
Link function: probit 

Formula:
partner_initiated_sexual_intercourse ~ included + menstruation + 
    fertile + fertile_mean + s(day_number, by = included) + s(days_filled_out, 
    by = included) + included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error z value Pr(>|z|)  
(Intercept)                          0.13857    0.08526    1.63    0.104  
includedhorm_contra                  0.06951    0.07723    0.90    0.368  
menstruationpre                     -0.00424    0.09074   -0.05    0.963  
menstruationyes                     -0.00242    0.10321   -0.02    0.981  
fertile                             -0.38291    0.18717   -2.05    0.041 *
fertile_mean                         0.82529    0.37208    2.22    0.027 *
includedhorm_contra:menstruationpre -0.04745    0.11239   -0.42    0.673  
includedhorm_contra:menstruationyes -0.29532    0.13549   -2.18    0.029 *
includedhorm_contra:fertile          0.39714    0.22914    1.73    0.083 .
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                       edf Ref.df Chi.sq p-value
s(day_number):includedcycling            1      1   0.05    0.83
s(day_number):includedhorm_contra        1      1   0.65    0.42
s(days_filled_out):includedcycling       1      1   0.00    0.98
s(days_filled_out):includedhorm_contra   1      1   0.07    0.79

R-sq.(adj) =  0.00468   
glmer.ML = 6344.9  Scale est. = 1         n = 5085

Information: No AR1/ARMA autocorrelation models were fitted for binomial outcomes.

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ fertile_mean + (1 | person) +  
    contraceptive_methods + fertile + menstruation + fertile:contraceptive_methods +  
    menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

     AIC      BIC   logLik deviance df.resid 
    4866     4978    -2415     4830     3631 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.752 -1.120  0.657  0.776  1.517 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0961   0.31    
Number of obs: 3649, groups:  person, 470

Fixed effects:
                                                         Estimate Std. Error z value Pr(>|z|)
(Intercept)                                                0.1653     0.1387    1.19     0.23
fertile_mean                                               0.5809     0.5932    0.98     0.33
contraceptive_methodsfertility_awareness                  -0.0831     0.2408   -0.34     0.73
contraceptive_methodsnone                                 -0.2298     0.3383   -0.68     0.50
contraceptive_methodshormonal                              0.0594     0.1194    0.50     0.62
fertile                                                   -0.1068     0.3212   -0.33     0.74
menstruationpre                                            0.0887     0.1497    0.59     0.55
menstruationyes                                            0.0993     0.1771    0.56     0.58
contraceptive_methodsfertility_awareness:fertile          -0.0350     0.6737   -0.05     0.96
contraceptive_methodsnone:fertile                         -0.7350     1.0290   -0.71     0.48
contraceptive_methodshormonal:fertile                      0.2175     0.3538    0.62     0.54
contraceptive_methodsfertility_awareness:menstruationpre  -0.3459     0.3304   -1.05     0.30
contraceptive_methodsnone:menstruationpre                  0.0671     0.4711    0.14     0.89
contraceptive_methodshormonal:menstruationpre             -0.1206     0.1670   -0.72     0.47
contraceptive_methodsfertility_awareness:menstruationyes  -0.0503     0.3684   -0.14     0.89
contraceptive_methodsnone:menstruationyes                  0.6275     0.8282    0.76     0.45
contraceptive_methodshormonal:menstruationyes             -0.3142     0.2041   -1.54     0.12
convergence code: 0
Model failed to converge with max|grad| = 0.00844026 (tol = 0.001, component 1)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 12 4858 4932 -2417 4834 NA NA NA
by_method 18 4866 4978 -2415 4830 3.134 6 0.7919

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 18 7655 7775 -3810 7619 NA NA NA
with_mod 26 7667 7841 -3808 7615 4.028 8 0.8546

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7668     7840    -3808     7616     5722 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.903 -1.111  0.655  0.783  1.366 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0874   0.296   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)   
(Intercept)                                    0.0265     0.1635    0.16   0.8712   
menstruationpre                                0.0433     0.0880    0.49   0.6231   
menstruationyes                                0.0724     0.0961    0.75   0.4512   
fertile_mean                                   0.5846     0.3626    1.61   0.1069   
age_group(20,25]                               0.0940     0.1689    0.56   0.5781   
age_group(25,30]                               0.0410     0.1715    0.24   0.8110   
age_group(30,35]                               0.1455     0.2031    0.72   0.4737   
age_group(35,70]                               0.3345     0.1866    1.79   0.0730 . 
includedhorm_contra                            0.2281     0.1711    1.33   0.1824   
fertile                                        0.2188     0.5753    0.38   0.7037   
menstruationpre:includedhorm_contra           -0.1171     0.1089   -1.07   0.2824   
menstruationyes:includedhorm_contra           -0.3527     0.1266   -2.79   0.0053 **
age_group(20,25]:includedhorm_contra          -0.1258     0.1862   -0.68   0.4994   
age_group(25,30]:includedhorm_contra           0.0459     0.2031    0.23   0.8214   
age_group(30,35]:includedhorm_contra          -0.1316     0.2753   -0.48   0.6326   
age_group(35,70]:includedhorm_contra          -0.1959     0.3592   -0.55   0.5854   
age_group(20,25]:fertile                      -0.3282     0.6248   -0.52   0.5994   
age_group(25,30]:fertile                      -0.4403     0.6264   -0.70   0.4820   
age_group(30,35]:fertile                      -0.9318     0.7087   -1.31   0.1886   
age_group(35,70]:fertile                      -0.7021     0.6805   -1.03   0.3022   
includedhorm_contra:fertile                   -0.1036     0.6169   -0.17   0.8666   
age_group(20,25]:includedhorm_contra:fertile   0.2911     0.6778    0.43   0.6676   
age_group(25,30]:includedhorm_contra:fertile   0.1260     0.7219    0.17   0.8615   
age_group(30,35]:includedhorm_contra:fertile   0.9481     1.0133    0.94   0.3495   
age_group(35,70]:includedhorm_contra:fertile  -0.0727     1.1580   -0.06   0.9499   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.00358348 (tol = 0.001, component 1)

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 7649 7728 -3812 7625 NA NA NA
with_mod 14 7651 7744 -3811 7623 1.824 2 0.4017

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + weekend + included + fertile + menstruation:included +  
    weekend:included + weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7651     7744    -3811     7623     5734 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.774 -1.111  0.656  0.780  1.329 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0913   0.302   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                        Estimate Std. Error z value Pr(>|z|)   
(Intercept)                               0.1561     0.0906    1.72   0.0849 . 
menstruationpre                           0.0387     0.0880    0.44   0.6600   
menstruationyes                           0.0659     0.0959    0.69   0.4921   
fertile_mean                              0.6060     0.3623    1.67   0.0944 . 
weekendTRUE                              -0.0224     0.0808   -0.28   0.7821   
includedhorm_contra                       0.0714     0.0873    0.82   0.4136   
fertile                                  -0.4735     0.2308   -2.05   0.0402 * 
menstruationpre:includedhorm_contra      -0.1161     0.1089   -1.07   0.2863   
menstruationyes:includedhorm_contra      -0.3500     0.1264   -2.77   0.0056 **
weekendTRUE:includedhorm_contra           0.0683     0.1003    0.68   0.4958   
weekendTRUE:fertile                       0.4038     0.2986    1.35   0.1763   
includedhorm_contra:fertile               0.5079     0.2857    1.78   0.0754 . 
weekendTRUE:includedhorm_contra:fertile  -0.4072     0.3720   -1.09   0.2737   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.00305451 (tol = 0.001, component 1)

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 22 7654 7801 -3805 7610 NA NA NA
with_mod 34 7662 7888 -3797 7594 16.56 12 0.167

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + weekday + included + fertile + menstruation:included +  
    weekday:included + weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7662     7888    -3797     7594     5714 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-2.003 -1.093  0.644  0.776  1.489 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0915   0.303   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                             Estimate Std. Error z value Pr(>|z|)   
(Intercept)                                   0.00874    0.12023    0.07   0.9421   
menstruationpre                               0.04907    0.08827    0.56   0.5783   
menstruationyes                               0.07088    0.09625    0.74   0.4614   
fertile_mean                                  0.63806    0.36368    1.75   0.0793 . 
weekdayTuesday                                0.08089    0.15143    0.53   0.5932   
weekdayWednesday                              0.23533    0.15525    1.52   0.1296   
weekdayThursday                               0.31096    0.15902    1.96   0.0505 . 
weekdayFriday                                 0.12946    0.15063    0.86   0.3901   
weekdaySaturday                               0.07980    0.13872    0.57   0.5651   
weekdaySunday                                 0.13987    0.13305    1.05   0.2931   
includedhorm_contra                           0.19016    0.13151    1.45   0.1482   
fertile                                      -0.17974    0.38580   -0.47   0.6413   
menstruationpre:includedhorm_contra          -0.12204    0.10924   -1.12   0.2639   
menstruationyes:includedhorm_contra          -0.35090    0.12677   -2.77   0.0056 **
weekdayTuesday:includedhorm_contra            0.05297    0.19100    0.28   0.7815   
weekdayWednesday:includedhorm_contra         -0.12775    0.19421   -0.66   0.5107   
weekdayThursday:includedhorm_contra          -0.43022    0.19469   -2.21   0.0271 * 
weekdayFriday:includedhorm_contra            -0.08853    0.18577   -0.48   0.6337   
weekdaySaturday:includedhorm_contra          -0.00502    0.17152   -0.03   0.9766   
weekdaySunday:includedhorm_contra            -0.06309    0.16482   -0.38   0.7019   
weekdayTuesday:fertile                       -0.58725    0.56616   -1.04   0.2996   
weekdayWednesday:fertile                     -0.60909    0.58609   -1.04   0.2987   
weekdayThursday:fertile                      -0.07329    0.60657   -0.12   0.9038   
weekdayFriday:fertile                        -0.49613    0.55146   -0.90   0.3683   
weekdaySaturday:fertile                       0.19629    0.52140    0.38   0.7066   
weekdaySunday:fertile                         0.51354    0.50332    1.02   0.3076   
includedhorm_contra:fertile                   0.37509    0.47562    0.79   0.4303   
weekdayTuesday:includedhorm_contra:fertile   -0.02941    0.71268   -0.04   0.9671   
weekdayWednesday:includedhorm_contra:fertile  0.01760    0.73787    0.02   0.9810   
weekdayThursday:includedhorm_contra:fertile   0.46696    0.74070    0.63   0.5284   
weekdayFriday:includedhorm_contra:fertile     0.70763    0.68823    1.03   0.3039   
weekdaySaturday:includedhorm_contra:fertile  -0.35474    0.64720   -0.55   0.5836   
weekdaySunday:includedhorm_contra:fertile    -0.90457    0.62110   -1.46   0.1453   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.00855557 (tol = 0.001, component 1)

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 7651 7757 -3809 7619 NA NA NA
with_mod 22 7661 7808 -3809 7617 1.263 6 0.9736

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7662     7808    -3809     7618     5726 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.782 -1.105  0.652  0.785  1.274 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.088    0.297   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                                        Estimate Std. Error z value Pr(>|z|)   
(Intercept)                                               0.1413     0.0915    1.54   0.1223   
menstruationpre                                           0.0408     0.0880    0.46   0.6427   
menstruationyes                                           0.0640     0.0958    0.67   0.5041   
fertile_mean                                              0.7028     0.3679    1.91   0.0561 . 
included_levelslax                                       -0.0459     0.1483   -0.31   0.7571   
included_levelsconservative                               0.0253     0.1235    0.20   0.8377   
included_levelsstrict                                    -0.0791     0.1271   -0.62   0.5336   
includedhorm_contra                                       0.1089     0.0970    1.12   0.2615   
fertile                                                  -0.3402     0.2184   -1.56   0.1193   
menstruationpre:includedhorm_contra                      -0.1175     0.1091   -1.08   0.2813   
menstruationyes:includedhorm_contra                      -0.3462     0.1264   -2.74   0.0062 **
included_levelslax:includedhorm_contra                   -0.1056     0.1849   -0.57   0.5678   
included_levelsconservative:includedhorm_contra          -0.1071     0.1529   -0.70   0.4837   
included_levelsstrict:includedhorm_contra                 0.1582     0.1536    1.03   0.3030   
included_levelslax:fertile                                0.2197     0.5464    0.40   0.6877   
included_levelsconservative:fertile                       0.0434     0.4063    0.11   0.9149   
included_levelsstrict:fertile                             0.2572     0.4207    0.61   0.5410   
includedhorm_contra:fertile                               0.3171     0.3147    1.01   0.3136   
included_levelslax:includedhorm_contra:fertile           -0.1722     0.6550   -0.26   0.7926   
included_levelsconservative:includedhorm_contra:fertile   0.1728     0.5103    0.34   0.7350   
included_levelsstrict:includedhorm_contra:fertile        -0.2829     0.5179   -0.55   0.5849   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.00431286 (tol = 0.001, component 1)

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 16 7645 7752 -3807 7613 NA NA NA
with_mod 22 7651 7797 -3804 7607 6.136 6 0.4082

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + cycle_length_groups + included + fertile +  
    menstruation:included + cycle_length_groups:included + cycle_length_groups:fertile +  
    included:fertile + cycle_length_groups:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7651     7798    -3804     7607     5726 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.998 -1.101  0.648  0.784  1.323 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0892   0.299   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                                       Estimate Std. Error z value Pr(>|z|)    
(Intercept)                                              0.5694     0.1605    3.55  0.00039 ***
menstruationpre                                          0.0483     0.0882    0.55  0.58364    
menstruationyes                                          0.0787     0.0965    0.82  0.41435    
fertile_mean                                             0.4948     0.3659    1.35  0.17630    
cycle_length_groups(25,30]                              -0.4710     0.1563   -3.01  0.00259 ** 
cycle_length_groups(30,35]                              -0.3828     0.1831   -2.09  0.03653 *  
cycle_length_groups(35,41]                              -0.5634     0.2495   -2.26  0.02393 *  
includedhorm_contra                                     -0.1155     0.1740   -0.66  0.50670    
fertile                                                 -1.1507     0.5123   -2.25  0.02471 *  
menstruationpre:includedhorm_contra                     -0.1246     0.1091   -1.14  0.25355    
menstruationyes:includedhorm_contra                     -0.3576     0.1269   -2.82  0.00483 ** 
cycle_length_groups(25,30]:includedhorm_contra           0.2505     0.1813    1.38  0.16706    
cycle_length_groups(30,35]:includedhorm_contra           0.0961     0.2607    0.37  0.71248    
cycle_length_groups(35,41]:includedhorm_contra           0.3904     0.3147    1.24  0.21467    
cycle_length_groups(25,30]:fertile                       1.0316     0.5408    1.91  0.05646 .  
cycle_length_groups(30,35]:fertile                       0.9828     0.6246    1.57  0.11562    
cycle_length_groups(35,41]:fertile                       0.5768     0.8539    0.68  0.49933    
includedhorm_contra:fertile                              0.9201     0.5885    1.56  0.11792    
cycle_length_groups(25,30]:includedhorm_contra:fertile  -0.6827     0.6241   -1.09  0.27398    
cycle_length_groups(30,35]:includedhorm_contra:fertile  -0.7419     0.9403   -0.79  0.43008    
cycle_length_groups(35,41]:includedhorm_contra:fertile  -0.8761     1.0913   -0.80  0.42209    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0256235 (tol = 0.001, component 1)

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 12 7650 7730 -3813 7626 NA NA NA
with_mod 14 7654 7747 -3813 7626 0.5738 2 0.7506

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + certainty_menstruation + included + fertile +  
    menstruation:included + certainty_menstruation:included +  
    certainty_menstruation:fertile + included:fertile + certainty_menstruation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7654     7747    -3813     7626     5734 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.738 -1.108  0.659  0.780  1.302 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0911   0.302   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                                    Estimate Std. Error z value Pr(>|z|)   
(Intercept)                                         0.093026   0.218977    0.42   0.6710   
menstruationpre                                     0.036696   0.088127    0.42   0.6771   
menstruationyes                                     0.063422   0.095982    0.66   0.5088   
fertile_mean                                        0.599418   0.363399    1.65   0.0990 . 
certainty_menstruation                              0.012396   0.049582    0.25   0.8026   
includedhorm_contra                                 0.106165   0.265408    0.40   0.6892   
fertile                                             0.298291   0.767330    0.39   0.6975   
menstruationpre:includedhorm_contra                -0.111973   0.109001   -1.03   0.3043   
menstruationyes:includedhorm_contra                -0.348572   0.126411   -2.76   0.0058 **
certainty_menstruation:includedhorm_contra         -0.000244   0.060829    0.00   0.9968   
certainty_menstruation:fertile                     -0.130740   0.173862   -0.75   0.4521   
includedhorm_contra:fertile                        -0.221355   0.926883   -0.24   0.8112   
certainty_menstruation:includedhorm_contra:fertile  0.120801   0.210175    0.57   0.5655   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.0234242 (tol = 0.001, component 1)

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 7651 7744 -3812 7623 NA NA NA
with_mod 18 7651 7771 -3808 7615 7.93 4 0.09418

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + cycle_regularity + included + fertile + menstruation:included +  
    cycle_regularity:included + cycle_regularity:fertile + included:fertile +  
    cycle_regularity:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7651     7771    -3808     7615     5730 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.815 -1.109  0.655  0.778  1.357 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0884   0.297   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                                                                  Estimate Std. Error z value
(Intercept)                                                                         0.2608     0.0966    2.70
menstruationpre                                                                     0.0261     0.0881    0.30
menstruationyes                                                                     0.0612     0.0959    0.64
fertile_mean                                                                        0.5441     0.3621    1.50
cycle_regularityslightly irregular,\nup to 5 days off                              -0.2225     0.0997   -2.23
cycle_regularityirregular,\nmore than 5 days off                                   -0.1528     0.1275   -1.20
includedhorm_contra                                                                 0.0268     0.0893    0.30
fertile                                                                            -0.6698     0.2346   -2.86
menstruationpre:includedhorm_contra                                                -0.1019     0.1090   -0.93
menstruationyes:includedhorm_contra                                                -0.3437     0.1263   -2.72
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra           0.0869     0.1418    0.61
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                0.0179     0.1756    0.10
cycle_regularityslightly irregular,\nup to 5 days off:fertile                       0.7322     0.3345    2.19
cycle_regularityirregular,\nmore than 5 days off:fertile                            0.8961     0.4305    2.08
includedhorm_contra:fertile                                                         0.6504     0.2717    2.39
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile  -0.4805     0.4880   -0.98
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile       -0.5690     0.6096   -0.93
                                                                                  Pr(>|z|)   
(Intercept)                                                                         0.0070 **
menstruationpre                                                                     0.7675   
menstruationyes                                                                     0.5234   
fertile_mean                                                                        0.1330   
cycle_regularityslightly irregular,\nup to 5 days off                               0.0257 * 
cycle_regularityirregular,\nmore than 5 days off                                    0.2305   
includedhorm_contra                                                                 0.7640   
fertile                                                                             0.0043 **
menstruationpre:includedhorm_contra                                                 0.3501   
menstruationyes:includedhorm_contra                                                 0.0065 **
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra           0.5398   
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra                0.9189   
cycle_regularityslightly irregular,\nup to 5 days off:fertile                       0.0286 * 
cycle_regularityirregular,\nmore than 5 days off:fertile                            0.0374 * 
includedhorm_contra:fertile                                                         0.0167 * 
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile   0.3248   
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile        0.3506   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.010458 (tol = 0.001, component 1)

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 7649 7742 -3810 7621 NA NA NA
with_mod 18 7652 7771 -3808 7616 5.22 4 0.2654

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7652     7772    -3808     7616     5730 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.805 -1.108  0.656  0.779  1.322 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0893   0.299   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                                          Estimate Std. Error z value Pr(>|z|)   
(Intercept)                                                 0.1871     0.0927    2.02   0.0436 * 
menstruationpre                                             0.0428     0.0879    0.49   0.6263   
menstruationyes                                             0.0641     0.0959    0.67   0.5042   
fertile_mean                                                0.5717     0.3632    1.57   0.1155   
cohabitationLive in same city                              -0.0139     0.1139   -0.12   0.9028   
cohabitationLong-distance                                  -0.1772     0.1139   -1.55   0.1199   
includedhorm_contra                                        -0.0142     0.0989   -0.14   0.8858   
fertile                                                    -0.5151     0.2102   -2.45   0.0143 * 
menstruationpre:includedhorm_contra                        -0.1231     0.1089   -1.13   0.2584   
menstruationyes:includedhorm_contra                        -0.3523     0.1264   -2.79   0.0053 **
cohabitationLive in same city:includedhorm_contra           0.1257     0.1412    0.89   0.3734   
cohabitationLong-distance:includedhorm_contra               0.2973     0.1431    2.08   0.0378 * 
cohabitationLive in same city:fertile                       0.5949     0.3906    1.52   0.1278   
cohabitationLong-distance:fertile                           0.7635     0.4041    1.89   0.0589 . 
includedhorm_contra:fertile                                 0.5650     0.3092    1.83   0.0677 . 
cohabitationLive in same city:includedhorm_contra:fertile  -0.5449     0.4806   -1.13   0.2569   
cohabitationLong-distance:includedhorm_contra:fertile      -0.8743     0.5013   -1.74   0.0812 . 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.00381763 (tol = 0.001, component 1)

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)
Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 14 7648 7741 -3810 7620 NA NA NA
with_mod 18 7653 7773 -3809 7617 2.363 4 0.6693

Generalized linear mixed model fit by maximum likelihood (Laplace Approximation) ['glmerMod']
 Family: binomial  ( probit )
Formula: partner_initiated_sexual_intercourse ~ menstruation + fertile_mean +  
    (1 | person) + relationship_status_clean + included + fertile +  
    menstruation:included + relationship_status_clean:included +  
    relationship_status_clean:fertile + included:fertile + relationship_status_clean:included:fertile
   Data: diary

     AIC      BIC   logLik deviance df.resid 
    7653     7773    -3809     7617     5730 

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-1.755 -1.112  0.657  0.779  1.337 

Random effects:
 Groups Name        Variance Std.Dev.
 person (Intercept) 0.0874   0.296   
Number of obs: 5748, groups:  person, 859

Fixed effects:
                                                                 Estimate Std. Error z value Pr(>|z|)   
(Intercept)                                                        0.1467     0.0857    1.71   0.0871 . 
menstruationpre                                                    0.0398     0.0879    0.45   0.6504   
menstruationyes                                                    0.0738     0.0960    0.77   0.4420   
fertile_mean                                                       0.5864     0.3610    1.62   0.1043   
relationship_status_cleanVerheiratet                               0.0661     0.1109    0.60   0.5510   
relationship_status_cleanVerlobt                                  -0.2834     0.1959   -1.45   0.1479   
includedhorm_contra                                                0.1227     0.0787    1.56   0.1189   
fertile                                                           -0.2750     0.2027   -1.36   0.1750   
menstruationpre:includedhorm_contra                               -0.1171     0.1088   -1.08   0.2817   
menstruationyes:includedhorm_contra                               -0.3624     0.1264   -2.87   0.0041 **
relationship_status_cleanVerheiratet:includedhorm_contra          -0.3023     0.2323   -1.30   0.1931   
relationship_status_cleanVerlobt:includedhorm_contra              -0.1061     0.2988   -0.36   0.7224   
relationship_status_cleanVerheiratet:fertile                      -0.1616     0.3544   -0.46   0.6484   
relationship_status_cleanVerlobt:fertile                           0.8797     0.6539    1.34   0.1786   
includedhorm_contra:fertile                                        0.3034     0.2395    1.27   0.2052   
relationship_status_cleanVerheiratet:includedhorm_contra:fertile   0.3425     0.7773    0.44   0.6595   
relationship_status_cleanVerlobt:includedhorm_contra:fertile      -0.7005     1.0092   -0.69   0.4876   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
convergence code: 0
Model failed to converge with max|grad| = 0.00469114 (tol = 0.001, component 1)

Satisfaction with sex

model_summaries$sexual_intercourse_satisfaction

Model summary

Model summary

model %>% 
  print_summary()
Linear mixed model fit by REML 
t-tests use  Satterthwaite approximations to degrees of freedom ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ included * (menstruation +  
    fertile) + fertile_mean + (1 | person)
   Data: diary

REML criterion at convergence: 14993

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.125 -0.533  0.157  0.646  2.809 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.320    0.565   
 Residual             0.651    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                      Estimate Std. Error         df t value Pr(>|t|)    
(Intercept)                            5.05605    0.07543 1345.00000   67.03   <2e-16 ***
includedhorm_contra                    0.08310    0.06138 1829.00000    1.35     0.18    
menstruationpre                       -0.01815    0.05727 5428.00000   -0.32     0.75    
menstruationyes                       -0.05805    0.06287 5436.00000   -0.92     0.36    
fertile                                0.06890    0.11519 5418.00000    0.60     0.55    
fertile_mean                          -0.02938    0.34838 1187.00000   -0.08     0.93    
includedhorm_contra:menstruationpre    0.04422    0.07074 5414.00000    0.63     0.53    
includedhorm_contra:menstruationyes   -0.00497    0.08281 5404.00000   -0.06     0.95    
includedhorm_contra:fertile           -0.23153    0.14137 5457.00000   -1.64     0.10    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.493                                                               
menstrutnpr             -0.295  0.372                                                        
menstrutnys             -0.228  0.284  0.320                                                 
fertile                 -0.300  0.464  0.483    0.315                                        
fertile_men             -0.754 -0.050 -0.010   -0.003   -0.098                               
inclddhrm_cntr:mnstrtnp  0.249 -0.449 -0.809   -0.259   -0.389 -0.005                        
inclddhrm_cntr:mnstrtny  0.176 -0.323 -0.243   -0.759   -0.239 -0.002  0.295                 
inclddhrm_cntr:f         0.299 -0.562 -0.392   -0.257   -0.808  0.007  0.475                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.297                 

Effect size standardised by residual variance (\(\frac{b}{ SD_{residual} }\)): 0.09 [-0.19;0.37].

Marginal effect plots

model %>% 
  plot_all_effects()

Outcome distribution

model %>% 
  plot_outcome(diary) + xlab(outcome_label)

Diagnostics

model %>% 
  print_diagnostics()

Curves

Here, we continuously plot the outcome over the course of the cycle. Because cycle lengths vary, we subset the data to cycles in a certain range. If the red curve traces the pink curve, our predictor accurately maps the relationship between fertile window probability and the outcome.

Cycle lengths from 21 to 36

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 36, minimum_cycle_length_diary > 20) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Cycle lengths from 27 to 30

Backward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(fertile=prc_stirn_b))
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Forward-counted
model %>% 
  plot_curve(diary %>% filter(minimum_cycle_length_diary <= 30, minimum_cycle_length_diary >= 27) %>% mutate(RCD = FCD, fertile = prc_stirn_b_forward_counted), caption_x = "Days since last menstruation")
outcome = names(model@frame)[1]
outcome_label = recode(str_replace_all(str_replace_all(str_replace_all(outcome, "_", " "), " pair", "-pair"), " 1", ""), 
                       "desirability 1" = "self-perceived desirability",
                       "NARQ admiration" = "narcissistic admiration",
                       "NARQ rivalry" = "narcissistic rivalry",
                       "extra-pair" = "extra-pair desire & behaviour",
                       "had sexual intercourse" = "sexual intercourse")

library(ggplot2)

# form a subset and run the model without the hormonal contraception and the fertility predictors
tmp = diary %>%
  filter(!is.na(fertile), !is.na(included),
         RCD > -1 * minimum_cycle_length_diary, RCD > -40)

new_form = update.formula(formula(model), new = . ~ . - fertile * included)
tmp$residuals = residuals(update(model, new_form, data = tmp , na.action = na.exclude))

tmp = tmp %>% 
  filter(!is.na(RCD), !is.na(residuals))
rcd_min = min(tmp$RCD)

tmp$real = FALSE
tmp_before = tmp
tmp_before$RCD = tmp_before$RCD + min(tmp$RCD) - 1
tmp_after = tmp
tmp_after$RCD = tmp_after$RCD - min(tmp$RCD) + 1
tmp$real = TRUE
tmp = bind_rows(tmp_before %>% filter(RCD > rcd_min - 11), tmp, tmp_after %>% filter(RCD < 11))
GAM smooth on residuals

Here, we partialled out menstruation and individual random effects, then superimposed estimated probability of being in the fertile window scaled to the range of the estimated means. To address the periodicity of the cycle, we prepended and appended ten days of the timeseries to the end and the beginning of the timeseries. We then estimated the GAM and cut off the appended subsets before plotting.

tryCatch({
  trend_plot = ggplot(tmp,aes(x = RCD, y = residuals, colour = included)) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data



ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, residuals") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

GAM smooth on raw data

As before, but without partialling anything out.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    stat_smooth(geom = 'smooth',size = 0.8, fill = "#9ECAE1", method = 'gam', formula = y ~ s(x))
}, error = function(e){cat_message(e, "danger")})

tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot1b = ggplot(trend_data) +
  geom_ribbon(aes(x = x, ymin = ymin, ymax = ymax,  fill = factor(group)), alpha = 0.2) +
  geom_line(aes(x = x, y = y, colour = factor(group)), size = 0.8, stat = "identity") +
  scale_x_continuous(caption_x) +
  geom_line(aes(x = x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("GAM smooth, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)

suppressWarnings(print(plot1b))

Means and standard errors over raw data

Nothing partialled out, just straight means with bootstrapped confidence intervals.

tryCatch({
  trend_plot = ggplot(tmp,aes_string(x = "RCD", y = outcome, colour = "included")) +
    geom_pointrange(size = 0.8, stat = 'summary', fun.data = "mean_cl_boot")
}, error = function(e){cat_message(e, "danger")})
tryCatch({
  trend_data = ggplot_build(trend_plot)$data[[1]]
}, error = function(e){cat_message(e, "danger")})

trend_data$RCD = round(trend_data$x)
trend_data = left_join(trend_data, tmp %>% select(real, RCD,fertile) %>% unique(), by = "RCD")
trend_data %>%
  filter(real == TRUE) %>%
  mutate(superimposed = ( ( (fertile - 0.01)/0.58) * (max(y)-min(y) ) ) + min(y) ) ->
  trend_data

plot3 = ggplot(trend_data) +
  geom_pointrange(aes(x = x, y = y, ymin = ymin,ymax = ymax, colour = factor(group)), size = 0.8, stat = "identity", alpha = 0.6, position = position_dodge(width = .5)) +
  scale_x_continuous("Days until next menstruation") +
  geom_line(aes(x= x, y = superimposed), color = "#a83fbf", size = 1, linetype = 'dashed') +
  annotate("text",x = mean(trend_data$x),  y = max(trend_data$superimposed,na.rm=T) + 0.1, label = 'superimposed fertility peak', color = "#a83fbf") +
  scale_y_continuous(outcome_label) +
  ggtitle("Means with standard errors, raw data") +
  scale_color_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F) +
  scale_fill_manual("Contraception status",values = c("2"="black","1"= "red"), labels = c("2"="hormonally\ncontracepting","1"="cycling"), guide = F)
suppressWarnings(print(plot3))

Robustness checks

M_r1: Random slopes for conception risk and menstruation

tryCatch({
# refit model with random effects for fertile and menstruation dummies
with_ind_diff = update(model, formula = . ~ . - (1| person) + (1 + fertile + menstruation | person))

# pull the random effects, format as tibble
rand = coef(with_ind_diff)$person %>% 
  tibble::rownames_to_column("person") %>% 
  mutate(person = as.numeric(person))

# pull the fixed effects
fixd = data.frame(fixef(with_ind_diff)) %>% 
  tibble::rownames_to_column("effect")
names(fixd) = c("effect", "pop_effect_size")

# pull apart the coefficients so that we can account for the fact that the random effect variation implicitly includes HC explaining the mean population-level effect of fertile/menstruation dummies among HC users
fixd = fixd %>% 
  separate(effect, c("included", "effect"), sep = ":", fill = "left") %>% 
  mutate(included = if_else(is.na(included), "cycling", str_replace(included, "included", "")))
fixd[2,c("included", "effect")] = c("horm_contra", "(Intercept)")
  

rand = rand %>% 
  # merge diary data on the random effects, so that we know who is a HC users and who isn't
  inner_join(diary %>% select(person, included) %>% unique(), by = 'person') %>%
  # gather into long format, to have the dataset by predictor
  gather(effect, value, -person, -included) %>% 
  inner_join(fixd, by = c('effect', 'included')) %>% 
  # pull the fixed effects
  mutate(
    # only for those who are HC users, add the moderated population effect size for this effect (the random effects have the reference category mean)
    value = if_else(included == "horm_contra", value + pop_effect_size, value),
    effect = recode(effect, "includedhorm_contra" = "HC user",
                   "includedhorm_contra:fertile" = "HC user x fertile",
                   "includedhorm_contra:menstruationpre" = "HC user x premens.",
                   "includedhorm_contra:menstruationyes" = "HC user x mens.",
                   "menstruationyes" = "mens.", 
                   "menstruationpre" = "premens.")) %>% 
  group_by(included, effect) %>% 
  # filter out predictors that aren't modelled as varying/random
  filter(sd(value) > 0)

# plot dot plot of random effects
print(
ggplot(rand, aes(x = included, y = value, color = included, fill = included)) +
  facet_wrap( ~ effect, scales = "free") + 
  # geom_violin(alpha = 0.4, size = 0) + 
  geom_dotplot(binaxis='y', dotsize = 0.1, method = "histodot") +
# geom_jitter(alpha = 0.05) + 
  coord_flip() + 
  geom_pointrange(stat = 'summary', fun.data = 'mean_sdl', color = 'darkred', size = 1.2) +
  scale_color_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","cycling"="cycling"), guide = F) +
  scale_fill_manual("Contraception status", values = c("horm_contra"="black","cycling"= "red"), labels = c("horm_contra"="hormonally\ncontracepting","1"="cycling"), guide = F) + 
  ggtitle("M_r1: allowing participant-varying slopes", subtitle = "for the conception risk measure and the menstruation dummies") +
  scale_x_discrete("Hormonal contraception", breaks = c("horm_contra", "cycling"), labels = c("yes", "no")) +
  scale_y_continuous("Random effect size distribution"))

print_summary(with_ind_diff)
cat(pander(anova(model, with_ind_diff)))
}, error = function(e){
  with_ind_diff = model
  cat_message(e, "danger")
})

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ included + menstruation + fertile +  
    fertile_mean + (1 + fertile + menstruation | person) + included:menstruation +      included:fertile
   Data: diary

REML criterion at convergence: 14956

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.051 -0.509  0.157  0.634  2.646 

Random effects:
 Groups   Name            Variance Std.Dev. Corr             
 person   (Intercept)     0.3316   0.576                     
          fertile         0.3234   0.569    -0.11            
          menstruationpre 0.0126   0.112    -0.06  0.29      
          menstruationyes 0.2405   0.490    -0.31  0.55 -0.59
 Residual                 0.6206   0.788                     
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                    Estimate Std. Error t value
(Intercept)                          5.04863    0.07595    66.5
includedhorm_contra                  0.08407    0.06189     1.4
menstruationpre                     -0.00164    0.05740     0.0
menstruationyes                     -0.04475    0.07535    -0.6
fertile                              0.06465    0.12214     0.5
fertile_mean                        -0.00109    0.35080     0.0
includedhorm_contra:menstruationpre  0.03466    0.07083     0.5
includedhorm_contra:menstruationyes -0.02735    0.09842    -0.3
includedhorm_contra:fertile         -0.22512    0.14988    -1.5

Correlation of Fixed Effects:
                        (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
inclddhrm_c             -0.495                                                               
menstrutnpr             -0.293  0.370                                                        
menstrutnys             -0.252  0.315  0.223                                                 
fertile                 -0.301  0.462  0.469    0.336                                        
fertile_men             -0.752 -0.050 -0.011   -0.005   -0.095                               
inclddhrm_cntr:mnstrtnp  0.247 -0.444 -0.810   -0.181   -0.378 -0.005                        
inclddhrm_cntr:mnstrtny  0.195 -0.361 -0.171   -0.766   -0.257  0.001  0.205                 
inclddhrm_cntr:f         0.298 -0.558 -0.381   -0.273   -0.808  0.007  0.460                 
                        inclddhrm_cntr:mnstrtny
inclddhrm_c                                    
menstrutnpr                                    
menstrutnys                                    
fertile                                        
fertile_men                                    
inclddhrm_cntr:mnstrtnp                        
inclddhrm_cntr:mnstrtny                        
inclddhrm_cntr:f         0.315                 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
object 11 14983 15056 -7480 14961 NA NA NA
..1 20 14964 15097 -7462 14924 36.63 9 0.00003061
robustness_check_ovu_shift(model, diary)

M_e: Exclusion criteria

M_p: Predictors

M_c: Covariates, controls, autocorrelation

Linear mixed model fit by REML ['lmerMod']

REML criterion at convergence: 13177

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.207 -0.536  0.158  0.646  3.217 

Random effects:
 Groups   Name                                   Variance Std.Dev.   
 person   (Intercept)                            3.25e-01 0.569663117
 Xr.2     s(days_filled_out):includedhorm_contra 0.00e+00 0.000000000
 Xr.1     s(days_filled_out):includedcycling     8.86e-14 0.000000298
 Xr.0     s(day_number):includedhorm_contra      3.90e-04 0.019750380
 Xr       s(day_number):includedcycling          0.00e+00 0.000000000
 Residual                                        6.29e-01 0.792886675
Number of obs: 5084, groups:  person, 843; Xr.2, 8; Xr.1, 8; Xr.0, 8; Xr, 8

Fixed effects:
                                           Estimate Std. Error t value
X(Intercept)                                5.05635    0.07793    64.9
Xincludedhorm_contra                        0.09256    0.06451     1.4
Xmenstruationpre                           -0.00464    0.05965    -0.1
Xmenstruationyes                            0.02330    0.06822     0.3
Xfertile                                    0.12797    0.12356     1.0
Xfertile_mean                              -0.13533    0.35518    -0.4
Xincludedhorm_contra:menstruationpre        0.03656    0.07371     0.5
Xincludedhorm_contra:menstruationyes       -0.02666    0.08958    -0.3
Xincludedhorm_contra:fertile               -0.23492    0.15154    -1.6
Xs(day_number):includedcyclingFx1           0.04794    0.07918     0.6
Xs(day_number):includedhorm_contraFx1       0.01455    0.05994     0.2
Xs(days_filled_out):includedcyclingFx1     -0.04494    0.08130    -0.6
Xs(days_filled_out):includedhorm_contraFx1 -0.00151    0.06076     0.0

Family: gaussian 
Link function: identity 

Formula:
sexual_intercourse_satisfaction ~ included + menstruation + fertile + 
    fertile_mean + s(day_number, by = included) + s(days_filled_out, 
    by = included) + included:menstruation + included:fertile

Parametric coefficients:
                                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)                          5.05635    0.07793   64.88   <2e-16 ***
includedhorm_contra                  0.09256    0.06451    1.43     0.15    
menstruationpre                     -0.00464    0.05965   -0.08     0.94    
menstruationyes                      0.02330    0.06822    0.34     0.73    
fertile                              0.12797    0.12356    1.04     0.30    
fertile_mean                        -0.13533    0.35518   -0.38     0.70    
includedhorm_contra:menstruationpre  0.03656    0.07371    0.50     0.62    
includedhorm_contra:menstruationyes -0.02666    0.08958   -0.30     0.77    
includedhorm_contra:fertile         -0.23492    0.15154   -1.55     0.12    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Approximate significance of smooth terms:
                                        edf Ref.df    F p-value
s(day_number):includedcycling          1.00   1.00 0.37    0.54
s(day_number):includedhorm_contra      1.08   1.08 0.03    0.84
s(days_filled_out):includedcycling     1.00   1.00 0.31    0.58
s(days_filled_out):includedhorm_contra 1.00   1.00 0.00    0.98

R-sq.(adj) =  -0.00228   
lmer.REML =  13177  Scale est. = 0.62867   n = 5084

Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  14976 15056  -7476

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:      0.5572   0.8135

Correlation Structure: ARMA(1,0)
 Formula: ~day_number | person 
 Parameter estimate(s):
  Phi1 
0.1942 
Fixed effects: sexual_intercourse_satisfaction ~ included * (menstruation +      fertile) + fertile_mean 
                                     Value Std.Error   DF t-value p-value
(Intercept)                          5.048    0.0760 4882   66.39  0.0000
includedhorm_contra                  0.085    0.0623  856    1.37  0.1710
menstruationpre                     -0.013    0.0594 4882   -0.21  0.8318
menstruationyes                     -0.058    0.0650 4882   -0.89  0.3722
fertile                              0.059    0.1204 4882    0.49  0.6224
fertile_mean                         0.007    0.3500  856    0.02  0.9831
includedhorm_contra:menstruationpre  0.029    0.0734 4882    0.39  0.6969
includedhorm_contra:menstruationyes -0.006    0.0852 4882   -0.07  0.9461
includedhorm_contra:fertile         -0.233    0.1476 4882   -1.58  0.1153
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.498                                                               
menstruationpre                     -0.302  0.378                                                        
menstruationyes                     -0.237  0.291  0.323                                                 
fertile                             -0.307  0.473  0.473    0.311                                        
fertile_mean                        -0.750 -0.049 -0.010   -0.002   -0.102                               
includedhorm_contra:menstruationpre  0.254 -0.457 -0.809   -0.261   -0.382 -0.005                        
includedhorm_contra:menstruationyes  0.183 -0.332 -0.246   -0.763   -0.237 -0.002  0.298                 
includedhorm_contra:fertile          0.307 -0.575 -0.385   -0.253   -0.808  0.009  0.467                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.294                 

Standardized Within-Group Residuals:
    Min      Q1     Med      Q3     Max 
-5.1235 -0.5310  0.1687  0.6519  2.7107 

Number of Observations: 5747
Number of Groups: 859 
Linear mixed-effects model fit by REML
 Data: diary 
    AIC   BIC logLik
  14977 15064  -7476

Random effects:
 Formula: ~1 | person
        (Intercept) Residual
StdDev:       0.558   0.8127

Correlation Structure: ARMA(1,1)
 Formula: ~day_number | person 
 Parameter estimate(s):
   Phi1  Theta1 
0.01951 0.18271 
Fixed effects: sexual_intercourse_satisfaction ~ included * (menstruation +      fertile) + fertile_mean 
                                     Value Std.Error   DF t-value p-value
(Intercept)                          5.049    0.0760 4882   66.48  0.0000
includedhorm_contra                  0.085    0.0622  856    1.37  0.1709
menstruationpre                     -0.014    0.0592 4882   -0.23  0.8194
menstruationyes                     -0.058    0.0648 4882   -0.89  0.3722
fertile                              0.061    0.1198 4882    0.51  0.6084
fertile_mean                         0.003    0.3497  856    0.01  0.9929
includedhorm_contra:menstruationpre  0.029    0.0732 4882    0.40  0.6887
includedhorm_contra:menstruationyes -0.004    0.0850 4882   -0.05  0.9602
includedhorm_contra:fertile         -0.233    0.1469 4882   -1.59  0.1126
 Correlation: 
                                    (Intr) incld_ mnstrtnp mnstrtny fertil frtl_m inclddhrm_cntr:mnstrtnp
includedhorm_contra                 -0.497                                                               
menstruationpre                     -0.302  0.378                                                        
menstruationyes                     -0.236  0.290  0.322                                                 
fertile                             -0.307  0.473  0.475    0.312                                        
fertile_mean                        -0.750 -0.049 -0.010   -0.002   -0.102                               
includedhorm_contra:menstruationpre  0.254 -0.456 -0.809   -0.261   -0.383 -0.005                        
includedhorm_contra:menstruationyes  0.183 -0.332 -0.245   -0.762   -0.237 -0.002  0.297                 
includedhorm_contra:fertile          0.306 -0.574 -0.386   -0.254   -0.808  0.008  0.469                 
                                    inclddhrm_cntr:mnstrtny
includedhorm_contra                                        
menstruationpre                                            
menstruationyes                                            
fertile                                                    
fertile_mean                                               
includedhorm_contra:menstruationpre                        
includedhorm_contra:menstruationyes                        
includedhorm_contra:fertile          0.295                 

Standardized Within-Group Residuals:
    Min      Q1     Med      Q3     Max 
-5.1180 -0.5290  0.1679  0.6521  2.7205 

Number of Observations: 5747
Number of Groups: 859 

M_d: Other designs

M_m1: Moderation by contraceptive method

Based on the sample with lax exclusion criteria. Users who used any hormonal contraception are classified as hormonal, users who use any awareness-based methods (counting, temperature-based) are classified as ‘fertility-awareness’, women who don’t fall into the before groups and use condoms, pessars, coitus interruptus etc. are classified as ‘barrie or abstinence’. Women who don’t use contraception or use other methods such as sterilisation are excluded from this analysis.

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ fertile_mean + (1 | person) +  
    contraceptive_methods + fertile + menstruation + fertile:contraceptive_methods +  
    menstruation:contraceptive_methods
   Data: diary
 Subset: !is.na(included_lax) & contraceptive_method != "other"

REML criterion at convergence: 9254

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.239 -0.550  0.154  0.659  2.650 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.297    0.545   
 Residual             0.611    0.782   
Number of obs: 3648, groups:  person, 470

Fixed effects:
                                                         Estimate Std. Error t value
(Intercept)                                               5.21738    0.13413    38.9
fertile_mean                                             -0.51699    0.63327    -0.8
contraceptive_methodsfertility_awareness                 -0.08470    0.19473    -0.4
contraceptive_methodsnone                                -0.44323    0.26809    -1.7
contraceptive_methodshormonal                             0.02822    0.09864     0.3
fertile                                                   0.00995    0.20524     0.0
menstruationpre                                          -0.13066    0.09382    -1.4
menstruationyes                                           0.10969    0.11344     1.0
contraceptive_methodsfertility_awareness:fertile          0.22959    0.42250     0.5
contraceptive_methodsnone:fertile                        -0.64355    0.64121    -1.0
contraceptive_methodshormonal:fertile                    -0.15156    0.22549    -0.7
contraceptive_methodsfertility_awareness:menstruationpre -0.04603    0.20604    -0.2
contraceptive_methodsnone:menstruationpre                 0.01257    0.29155     0.0
contraceptive_methodshormonal:menstruationpre             0.18988    0.10458     1.8
contraceptive_methodsfertility_awareness:menstruationyes -0.33015    0.23064    -1.4
contraceptive_methodsnone:menstruationyes                -0.46542    0.52285    -0.9
contraceptive_methodshormonal:menstruationyes            -0.20615    0.13008    -1.6

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
add_main 13 9253 9334 -4614 9227 NA NA NA
by_method 19 9259 9377 -4611 9221 6.118 6 0.4101

M_m2: Moderation by participant age

model %>% 
  test_moderator("age_group", diary, xlevels = 5)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 19 14993 15120 -7478 14955 NA NA NA
with_mod 27 15005 15185 -7476 14951 4.43 8 0.8163

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + age_group + included + fertile + menstruation:included +  
    age_group:included + age_group:fertile + included:fertile +      age_group:included:fertile
   Data: diary

REML criterion at convergence: 15008

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.069 -0.530  0.165  0.646  2.821 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.321    0.566   
 Residual             0.652    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                             Estimate Std. Error t value
(Intercept)                                   5.10899    0.15891    32.2
menstruationpre                              -0.01968    0.05734    -0.3
menstruationyes                              -0.05761    0.06298    -0.9
fertile_mean                                 -0.02124    0.35060    -0.1
age_group(20,25]                             -0.07647    0.16641    -0.5
age_group(25,30]                             -0.10313    0.16931    -0.6
age_group(30,35]                             -0.03486    0.19598    -0.2
age_group(35,70]                              0.02180    0.17950     0.1
includedhorm_contra                           0.00418    0.16550     0.0
fertile                                      -0.37924    0.37047    -1.0
menstruationpre:includedhorm_contra           0.04769    0.07082     0.7
menstruationyes:includedhorm_contra          -0.00591    0.08296    -0.1
age_group(20,25]:includedhorm_contra          0.10297    0.18345     0.6
age_group(25,30]:includedhorm_contra          0.09386    0.19909     0.5
age_group(30,35]:includedhorm_contra          0.31077    0.26220     1.2
age_group(35,70]:includedhorm_contra          0.01536    0.31926     0.0
age_group(20,25]:fertile                      0.33662    0.40434     0.8
age_group(25,30]:fertile                      0.53488    0.40455     1.3
age_group(30,35]:fertile                      0.48245    0.45587     1.1
age_group(35,70]:fertile                      0.66149    0.43817     1.5
includedhorm_contra:fertile                   0.22305    0.39721     0.6
age_group(20,25]:includedhorm_contra:fertile -0.30770    0.43849    -0.7
age_group(25,30]:includedhorm_contra:fertile -0.55413    0.46583    -1.2
age_group(30,35]:includedhorm_contra:fertile -0.75531    0.64656    -1.2
age_group(35,70]:includedhorm_contra:fertile -1.25232    0.75326    -1.7

M_m3: Moderation by weekend

model %>% 
  test_moderator("weekend", diary, xlevels = 2) 

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 14986 15072 -7480 14960 NA NA NA
with_mod 15 14989 15089 -7479 14959 0.9685 2 0.6161

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + weekend + included + fertile + menstruation:included +  
    weekend:included + weekend:fertile + included:fertile + weekend:included:fertile
   Data: diary

REML criterion at convergence: 15005

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.120 -0.535  0.157  0.648  2.810 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.320    0.565   
 Residual             0.651    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                        Estimate Std. Error t value
(Intercept)                              5.05163    0.07951    63.5
menstruationpre                         -0.01851    0.05733    -0.3
menstruationyes                         -0.05842    0.06292    -0.9
fertile_mean                            -0.02493    0.34842    -0.1
weekendTRUE                              0.00797    0.05214     0.2
includedhorm_contra                      0.11087    0.06887     1.6
fertile                                  0.06945    0.15049     0.5
menstruationpre:includedhorm_contra      0.04598    0.07080     0.6
menstruationyes:includedhorm_contra     -0.00431    0.08286    -0.1
weekendTRUE:includedhorm_contra         -0.05605    0.06468    -0.9
weekendTRUE:fertile                     -0.00323    0.19315     0.0
includedhorm_contra:fertile             -0.30139    0.18580    -1.6
weekendTRUE:includedhorm_contra:fertile  0.14177    0.23915     0.6

M_m4: Moderation by weekday

model %>% 
  test_moderator("weekday", diary, xlevels = 7)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 23 14982 15135 -7468 14936 NA NA NA
with_mod 35 14995 15228 -7463 14925 10.99 12 0.5301

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + weekday + included + fertile + menstruation:included +  
    weekday:included + weekday:fertile + included:fertile + weekday:included:fertile
   Data: diary

REML criterion at convergence: 15018

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.275 -0.531  0.153  0.645  2.802 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.317    0.563   
 Residual             0.650    0.806   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                              Estimate Std. Error t value
(Intercept)                                   5.056737   0.094334    53.6
menstruationpre                              -0.015387   0.057380    -0.3
menstruationyes                              -0.055690   0.062912    -0.9
fertile_mean                                 -0.041111   0.348005    -0.1
weekdayTuesday                               -0.011875   0.097569    -0.1
weekdayWednesday                             -0.010121   0.098971    -0.1
weekdayThursday                              -0.001797   0.100787     0.0
weekdayFriday                                -0.077344   0.096954    -0.8
weekdaySaturday                               0.052033   0.089634     0.6
weekdaySunday                                 0.014982   0.085147     0.2
includedhorm_contra                           0.218440   0.093298     2.3
fertile                                       0.279274   0.250215     1.1
menstruationpre:includedhorm_contra           0.040518   0.070859     0.6
menstruationyes:includedhorm_contra           0.000669   0.082903     0.0
weekdayTuesday:includedhorm_contra           -0.146252   0.122127    -1.2
weekdayWednesday:includedhorm_contra         -0.232791   0.123724    -1.9
weekdayThursday:includedhorm_contra          -0.119647   0.123716    -1.0
weekdayFriday:includedhorm_contra            -0.106206   0.119064    -0.9
weekdaySaturday:includedhorm_contra          -0.254815   0.110312    -2.3
weekdaySunday:includedhorm_contra            -0.118156   0.105341    -1.1
weekdayTuesday:fertile                       -0.603060   0.363902    -1.7
weekdayWednesday:fertile                     -0.028403   0.377176    -0.1
weekdayThursday:fertile                      -0.253515   0.385799    -0.7
weekdayFriday:fertile                        -0.347338   0.355634    -1.0
weekdaySaturday:fertile                      -0.296297   0.336240    -0.9
weekdaySunday:fertile                        -0.007592   0.320762     0.0
includedhorm_contra:fertile                  -0.597202   0.306451    -1.9
weekdayTuesday:includedhorm_contra:fertile    0.704113   0.455862     1.5
weekdayWednesday:includedhorm_contra:fertile  0.387140   0.472235     0.8
weekdayThursday:includedhorm_contra:fertile   0.266997   0.469467     0.6
weekdayFriday:includedhorm_contra:fertile     0.537251   0.438952     1.2
weekdaySaturday:includedhorm_contra:fertile   0.769213   0.413845     1.9
weekdaySunday:includedhorm_contra:fertile     0.047356   0.394943     0.1

M_m5: Moderation by exclusion threshold

model %>% 
  test_moderator("included_levels", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 14990 15103 -7478 14956 NA NA NA
with_mod 23 14996 15149 -7475 14950 5.53 6 0.4779

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + included_levels + included + fertile + menstruation:included +  
    included_levels:included + included_levels:fertile + included:fertile +  
    included_levels:included:fertile
   Data: diary

REML criterion at convergence: 15007

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.214 -0.531  0.153  0.650  2.823 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.320    0.566   
 Residual             0.651    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                                        Estimate Std. Error t value
(Intercept)                                              5.06634    0.08401    60.3
menstruationpre                                         -0.01720    0.05739    -0.3
menstruationyes                                         -0.05852    0.06291    -0.9
fertile_mean                                            -0.05758    0.35393    -0.2
included_levelslax                                       0.03926    0.15075     0.3
included_levelsconservative                             -0.05588    0.12033    -0.5
included_levelsstrict                                    0.00109    0.12184     0.0
includedhorm_contra                                      0.01386    0.08543     0.2
fertile                                                  0.04759    0.14275     0.3
menstruationpre:includedhorm_contra                      0.04344    0.07092     0.6
menstruationyes:includedhorm_contra                     -0.00359    0.08290     0.0
included_levelslax:includedhorm_contra                   0.13265    0.18381     0.7
included_levelsconservative:includedhorm_contra          0.18708    0.14845     1.3
included_levelsstrict:includedhorm_contra                0.02226    0.14696     0.2
included_levelslax:fertile                               0.20124    0.35926     0.6
included_levelsconservative:fertile                      0.12619    0.26396     0.5
included_levelsstrict:fertile                           -0.10212    0.27738    -0.4
includedhorm_contra:fertile                             -0.19727    0.20728    -1.0
included_levelslax:includedhorm_contra:fertile          -0.11279    0.42997    -0.3
included_levelsconservative:includedhorm_contra:fertile -0.37996    0.33197    -1.1
included_levelsstrict:includedhorm_contra:fertile        0.23538    0.33956     0.7

M_m6: Moderation by cycle length

model %>% 
  test_moderator("cycle_length_groups", diary, xlevels = 4)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 17 14988 15101 -7477 14954 NA NA NA
with_mod 23 14996 15149 -7475 14950 4.201 6 0.6495

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + cycle_length_groups + included + fertile +  
    menstruation:included + cycle_length_groups:included + cycle_length_groups:fertile +  
    included:fertile + cycle_length_groups:included:fertile
   Data: diary

REML criterion at convergence: 14998

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.127 -0.534  0.159  0.655  2.880 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.318    0.564   
 Residual             0.652    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                                       Estimate Std. Error t value
(Intercept)                                             4.77888    0.14490    33.0
menstruationpre                                        -0.02201    0.05743    -0.4
menstruationyes                                        -0.06475    0.06318    -1.0
fertile_mean                                            0.00507    0.35227     0.0
cycle_length_groups(25,30]                              0.31559    0.14218     2.2
cycle_length_groups(30,35]                              0.23088    0.16646     1.4
cycle_length_groups(35,41]                              0.44141    0.23313     1.9
includedhorm_contra                                     0.38488    0.15704     2.5
fertile                                                 0.60457    0.32820     1.8
menstruationpre:includedhorm_contra                     0.04585    0.07090     0.6
menstruationyes:includedhorm_contra                     0.00164    0.08313     0.0
cycle_length_groups(25,30]:includedhorm_contra         -0.35206    0.16714    -2.1
cycle_length_groups(30,35]:includedhorm_contra         -0.04722    0.24854    -0.2
cycle_length_groups(35,41]:includedhorm_contra         -0.70041    0.30464    -2.3
cycle_length_groups(25,30]:fertile                     -0.59270    0.34777    -1.7
cycle_length_groups(30,35]:fertile                     -0.52498    0.40219    -1.3
cycle_length_groups(35,41]:fertile                     -0.95145    0.54791    -1.7
includedhorm_contra:fertile                            -0.76748    0.37524    -2.0
cycle_length_groups(25,30]:includedhorm_contra:fertile  0.58046    0.39940     1.5
cycle_length_groups(30,35]:includedhorm_contra:fertile  0.54460    0.61405     0.9
cycle_length_groups(35,41]:includedhorm_contra:fertile  1.19246    0.70323     1.7

M_m7: Moderation by certainty about menstruation parameters

model %>% 
  test_moderator("certainty_menstruation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 13 14985 15071 -7479 14959 NA NA NA
with_mod 15 14978 15078 -7474 14948 10.97 2 0.004157

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + certainty_menstruation + included + fertile +  
    menstruation:included + certainty_menstruation:included +  
    certainty_menstruation:fertile + included:fertile + certainty_menstruation:included:fertile
   Data: diary

REML criterion at convergence: 14996

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.074 -0.529  0.157  0.652  2.810 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.32     0.566   
 Residual             0.65     0.806   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                                   Estimate Std. Error t value
(Intercept)                                          5.1923     0.2025   25.64
menstruationpre                                     -0.0106     0.0573   -0.19
menstruationyes                                     -0.0516     0.0629   -0.82
fertile_mean                                        -0.0396     0.3494   -0.11
certainty_menstruation                              -0.0319     0.0459   -0.70
includedhorm_contra                                 -0.1591     0.2473   -0.64
fertile                                             -1.5323     0.5019   -3.05
menstruationpre:includedhorm_contra                  0.0366     0.0708    0.52
menstruationyes:includedhorm_contra                 -0.0113     0.0828   -0.14
certainty_menstruation:includedhorm_contra           0.0572     0.0572    1.00
certainty_menstruation:fertile                       0.3717     0.1136    3.27
includedhorm_contra:fertile                          1.2020     0.6058    1.98
certainty_menstruation:includedhorm_contra:fertile  -0.3327     0.1372   -2.43

M_m8: Moderation by cycle regularity

model %>% 
  test_moderator("cycle_regularity", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 14976 15076 -7473 14946 NA NA NA
with_mod 19 14983 15110 -7473 14945 1.029 4 0.9054

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + cycle_regularity + included + fertile + menstruation:included +  
    cycle_regularity:included + cycle_regularity:fertile + included:fertile +  
    cycle_regularity:included:fertile
   Data: diary

REML criterion at convergence: 14993

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.076 -0.533  0.154  0.653  2.761 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.314    0.561   
 Residual             0.651    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                                                                  Estimate Std. Error t value
(Intercept)                                                                        5.17122    0.08767    59.0
menstruationpre                                                                   -0.01771    0.05739    -0.3
menstruationyes                                                                   -0.05653    0.06293    -0.9
fertile_mean                                                                      -0.02834    0.34796    -0.1
cycle_regularityslightly irregular,\nup to 5 days off                             -0.28510    0.09512    -3.0
cycle_regularityirregular,\nmore than 5 days off                                  -0.09568    0.11887    -0.8
includedhorm_contra                                                               -0.02007    0.07729    -0.3
fertile                                                                            0.14861    0.15173     1.0
menstruationpre:includedhorm_contra                                                0.04272    0.07085     0.6
menstruationyes:includedhorm_contra                                               -0.00673    0.08287    -0.1
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra          0.24762    0.13763     1.8
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra               0.00176    0.16688     0.0
cycle_regularityslightly irregular,\nup to 5 days off:fertile                     -0.14083    0.22026    -0.6
cycle_regularityirregular,\nmore than 5 days off:fertile                          -0.18625    0.28183    -0.7
includedhorm_contra:fertile                                                       -0.29384    0.17597    -1.7
cycle_regularityslightly irregular,\nup to 5 days off:includedhorm_contra:fertile  0.00687    0.31865     0.0
cycle_regularityirregular,\nmore than 5 days off:includedhorm_contra:fertile       0.11376    0.39551     0.3

M_m9: Moderation by cohabitation status

model %>% 
  test_moderator("cohabitation", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 14980 15080 -7475 14950 NA NA NA
with_mod 19 14987 15113 -7474 14949 1.767 4 0.7785

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + cohabitation + included + fertile + menstruation:included +  
    cohabitation:included + cohabitation:fertile + included:fertile +      cohabitation:included:fertile
   Data: diary

REML criterion at convergence: 15000

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.151 -0.531  0.152  0.645  2.823 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.316    0.562   
 Residual             0.651    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                                          Estimate Std. Error t value
(Intercept)                                                4.98114    0.08547    58.3
menstruationpre                                           -0.01967    0.05729    -0.3
menstruationyes                                           -0.05810    0.06290    -0.9
fertile_mean                                               0.02455    0.34855     0.1
cohabitationLive in same city                              0.05698    0.10718     0.5
cohabitationLong-distance                                  0.26132    0.10901     2.4
includedhorm_contra                                        0.08069    0.08796     0.9
fertile                                                    0.14218    0.13701     1.0
menstruationpre:includedhorm_contra                        0.04438    0.07077     0.6
menstruationyes:includedhorm_contra                       -0.00663    0.08285    -0.1
cohabitationLive in same city:includedhorm_contra         -0.03176    0.13380    -0.2
cohabitationLong-distance:includedhorm_contra             -0.09043    0.13630    -0.7
cohabitationLive in same city:fertile                     -0.18519    0.25380    -0.7
cohabitationLong-distance:fertile                         -0.17280    0.26813    -0.6
includedhorm_contra:fertile                               -0.22604    0.20173    -1.1
cohabitationLive in same city:includedhorm_contra:fertile  0.13314    0.31166     0.4
cohabitationLong-distance:includedhorm_contra:fertile     -0.00819    0.33058     0.0

M_m10: Moderation by relationship status

model %>% 
  test_moderator("relationship_status_clean", diary)

refitting model(s) with ML (instead of REML)

Data: diary
  Df AIC BIC logLik deviance Chisq Chi Df Pr(>Chisq)
with_main 15 14986 15086 -7478 14956 NA NA NA
with_mod 19 14994 15120 -7478 14956 0.732 4 0.9473

Linear mixed model fit by REML ['lmerMod']
Formula: sexual_intercourse_satisfaction ~ menstruation + fertile_mean +  
    (1 | person) + relationship_status_clean + included + fertile +  
    menstruation:included + relationship_status_clean:included +  
    relationship_status_clean:fertile + included:fertile + relationship_status_clean:included:fertile
   Data: diary

REML criterion at convergence: 14996

Scaled residuals: 
   Min     1Q Median     3Q    Max 
-5.053 -0.531  0.159  0.649  2.805 

Random effects:
 Groups   Name        Variance Std.Dev.
 person   (Intercept) 0.320    0.566   
 Residual             0.651    0.807   
Number of obs: 5747, groups:  person, 859

Fixed effects:
                                                                 Estimate Std. Error t value
(Intercept)