 The item relationship_satisfaction_1 had a mix-up in the response options 4 and 5, so that “mostly satisfied” came before “rather satisfied”. Hence, we cannot interpret 4 and 5 very well prior to 4/25 because we can’t know whether subjects respected the order or the phrasing. Hence, we decided to assign both 4s and 5s a 4.5 prior to April 25.
We did the same thing for the item sexual_intercourse_4 on May 29.
library(car)
table(tagebuch$relationship_satisfaction_1)
##
## 1 2 3 4 5 6
##<PHONE_NUMBER> 5569 9915 10642
tagebuch[, relationship_satisfaction_1 := as.numeric(relationship_satisfaction_1)]
tagebuch[created < as.POSIXct('2014-04-25') , relationship_satisfaction_1 := Recode(relationship_satisfaction_1, "4=4.5;5=4.5")]
table(tagebuch$relationship_satisfaction_1)
##
## 1 2 3 4 4.5 5 6
##<PHONE_NUMBER> 5036 1440 9008 10642
table(tagebuch$sexual_intercourse_4)
##
## 1 2 3 4 5 6
## 46 78 250 1060 2188 2889
tagebuch[, sexual_intercourse_4 := as.numeric(sexual_intercourse_4)]
tagebuch[created < as.POSIXct('2014-04-29') , sexual_intercourse_4 := Recode(sexual_intercourse_4, "4=4.5;5=4.5")]
table(tagebuch$sexual_intercourse_4)
##
## 1 2 3 4 4.5 5 6
## 46 78 250<PHONE_NUMBER> 2889
xsection$SOI_be = rowMeans(xsection[, list(SOI_R_1, SOI_R_2, SOI_R_3)])
xsection$SOI_im = rowMeans(xsection[, list(SOI_R_7, SOI_R_8, SOI_R_9)])
xsection$SOI_uv = rowMeans(xsection[, list(SOI_R_4, SOI_R_5, SOI_R_6)])
# this woman told us she reported masturbation as "intimacy with someone other than my partner"
tagebuch[session %begins_with% "ce8e40de7c", ]$extra_pair_1 = NA
tagebuch[session %begins_with% "ce8e40de7c", ]$extra_pair_1b = NA
xsection$duration_relationship_total <- xsection$duration_relationship_months + xsection$duration_relationship_years*12 # create new variable duration_relationship_total
xsection[, hormonal_contraception := ifelse( contraception %contains% "contraceptive_pill" | contraception %contains% "other_hormonal", 1, 0) ]
qplot(factor(xsection$hormonal_contraception))
xsection[, pill_contraception := ifelse( contraception %contains% "contraceptive_pill", 1, 0) ]
qplot(factor(xsection$pill_contraception))
# library(xlsx)
# pillen2 = read.xlsx( "item_tables/Vorab_Fragebogen1-v3.xlsx", sheetName = "Choices")
pillen = readxl::read_excel( "item_tables/Vorab_Fragebogen1-v3.xlsx",sheet = "Choices") %>% data.frame()
pillen = as.data.table(pillen[ 1:97, ])
pillen[, gestagen_ug_merged := as.numeric(as.character( str_replace_all(
str_replace_all( str_replace_all( Gestagen.Milligramm.pro.Pille, '500', ',500'), '000', '')
,pattern = ',','.') )) * 1000]
pillen[, gestagen_cycle := as.numeric(as.character( str_replace_all( Gestagen.Milligramm.pro.Zyklus , pattern = ',','.')))]
pillen[name == "yasmin", ]
crosstabs(pillen$gestagen_ug_merged)
## pillen$gestagen_ug_merged
## 30 60 75 100 125<PHONE_NUMBER> 2500 3000 <NA>
## 2 1 7 10 3 14 1 31 1 8 19
pillen[, estrogen_ug_cycle := as.numeric(as.character( Östrogenmikrogramm.pro.Zyklus )) ]
pillen[, gestagen_type := as.character(Art.des.Gestagens) ]
crosstabs(pillen$gestagen_type)
## pillen$gestagen_type
## CMA CPA DNG DSG DSP GSD LNG NES NGT NOMAC <NA>
## 16 10 8 18 8 3 26 4 2 1 1
pillen[, pills := as.character(name)]
pillen[is.na(estrogen_ug_cycle), list(pills, Östrogenmikrogramm.pro.Zyklus) ]
pillen[is.na(gestagen_ug_merged), list(pills, Gestagen.Milligramm.pro.Pille) ]
pillen = pillen[ pills != 'other', ]
pillen[is.na(Östrogenmikrogramm.pro.Zyklus), estrogen_ug_cycle := 0 ]
pillen[is.na(Östrogenmikrogramm.pro.Pille), estrogen_ug_merged := 0 ]
qplot(pillen$estrogen_ug_cycle)
table(xsection$pills == "qlaira")
##
## FALSE TRUE
## 606 4
table(xsection$pills == "zoely")
##
## FALSE TRUE
## 602 8
xsection = merge(xsection, pillen[,list(pills, estrogen_ug_merged, estrogen_ug_cycle
, gestagen_type,gestagen_ug_merged, gestagen_cycle
)], by = "pills", all.x = T)
table(xsection$pills == "other")
##
## FALSE TRUE
## 556 54
crosstabs(pillen[, estrogen_ug_cycle/estrogen_ug_merged])
## pillen[, estrogen_ug_cycle/estrogen_ug_merged]
## NaN <NA>
## 9 87
## Estrogen Levels for all people (also for those who didnt take the pill)
crosstabs(xsection$estrogen_ug_cycle)
## xsection$estrogen_ug_cycle
## 0 360 420 480 630 665 680<PHONE_NUMBER> <NA>
## 26 1 141 11 328 3 4 2 26 2 664
xsection[, estrogen_ug_all := ifelse(hormonal_contraception, estrogen_ug_cycle, 0)]
crosstabs(xsection$estrogen_ug_all)
## xsection$estrogen_ug_all
## 0 360 420 480 630 665 680<PHONE_NUMBER> <NA>
## 540 1 141 11 328 3 4 2 26 2 150
# Forming Categories
xsection[, estrogen_categories := cut(estrogen_ug_all, breaks = c(0, 300, 600, 1200), include.lowest = T)]
crosstabs(xsection$estrogen_categories)
## xsection$estrogen_categories
## [0,300] (300,600] (600,1.2e+03]
## 540 153 365
cat(xsection[ pills=='other' & is.na(estrogen_ug_cycle), str_c( str_sub(session, 1, 10),"\n", other_pill_name,"\n\n") ])
## 033d3e1d21
## yris mite
##
## 0643a31c42
## swingo
##
## 0d9a341ceb
## desofemine 20 Nova
##
## 1528e9536b
## dienovel
##
## 1c93be41a1
## Carlin
##
## 1f9fc2cc79
## Kleodina
##
## 21054c807c
## Maitalon
##
## 2433cc44b9
## ludéal glé
##
## 24af1309b4
## Estinette
##
## 29220ba555
## Swingo
##
## 319e2ce5cb
## Midane
##
## 354137dd7f
## Sibilla
##
## 37226a6cf2
## Asumate 30
##
## 3d0adfe3a2
## Aristelle
##
## 4167741e29
## yara hexal
##
## 4202863d09
## Cedia
##
## 47b6e59dfa
## Layaisa
##
## 4aafa757ef
## Eliza
##
## 511189d8a0
## Selina
##
## 59858e60ea
## Solera
##
## 5b4fad6f3f
## visanne
##
## 62f9888d39
## Swingo 30
##
## 640a7b047b
## aristelle
##
## 646c651ea4
## Leanova AL
##
## 6da65c4e45
## Dienovel
##
## 82aadd4d54
## Dienovel
##
## 83c84a5860
## Selina
##
## 86fb131347
## Aristelle
##
## 8bd7c4624b
## Dienovel
##
## 8c118bfaaa
## Swingo
##
## 8f892266fb
## Yvette
##
## 9336f57640
## Midane
##
## 9700064ee1
## Dienovel
##
## 9b49e26d03
## Minette
##
## 9c89af2b7f
## Microgynon
##
## 9f61438d5f
## Violette
##
## aa38292783
## minesse
##
## aebdd368b4
## Swingo 30
##
## b726d9cd36
## Swingo
##
## c09518da85
## Lysandra beta
##
## c33d554719
## Dienovel
##
## c6dd42db4b
## desofemono
##
## c8ca0944d9
## Velafee
##
## cf37f837bc
## Dienogenance
##
## d30783c574
## Mirelle
##
## d5b5462be5
## Solera
##
## e0eeb02960
## LISA - Studienpille
##
## e2f049ef95
## mercilon
##
## e68978de78
## Desogestrel aristo
##
## e7e992c12b
## Desogestrel atisto
##
## edb19a9192
## Solgest
##
## f42ae3caec
## sibilla
##
## f64039d090
## Swingo 30
##
## f9454c5d18
## Dienovel
xsection[ short == "0643a31c42", estrogen_ug := 20 ]
xsection[ short == "0643a31c42", gestagens_ug := 100]
xsection[ short == "0643a31c42", gestagens := "LNG"]
xsection[ short == "1528e9536b", estrogen_ug := 30 ]
xsection[ short == "1528e9536b", gestagens_ug := 2000]
xsection[ short == "1528e9536b", gestagens := "DNG"]
xsection[ short == "21054c807c", estrogen_ug := 20 ]
xsection[ short == "21054c807c", gestagens_ug := 3000]
xsection[ short == "21054c807c", gestagens := "DSP"]
#one person swapped their values
xsection[ short == "24af1309b4", estrogen_ug := 20 ]
xsection[ short == "24af1309b4", gestagens_ug := 75]
xsection[ short == "24af1309b4", gestagens := "GSD"]
xsection[ short == "4167741e29", estrogen_ug := 20 ]
xsection[ short == "4167741e29", gestagens_ug := 3000]
xsection[ short == "4167741e29", gestagens := "DSP"]
# visanne is used as a contraceptive only in combination with something containing estrogen, but we don't know what was the case here
xsection[ short == "5b4fad6f3f", estrogen_ug := NA]
xsection[ short == "5b4fad6f3f", gestagens_ug := NA]
xsection[ short == "5b4fad6f3f", gestagens := NA_character_]
xsection[ short == "71f06ef90f", estrogen_ug := 30 ]
xsection[ short == "71f06ef90f", gestagens_ug := 300]
xsection[ short == "71f06ef90f", gestagens := "DNG"]
xsection[ short == "82aadd4d54", estrogen_ug := 30 ]
xsection[ short == "82aadd4d54", gestagens_ug := 2000]
xsection[ short == "82aadd4d54", gestagens := "DNG"]
xsection[ short == "83c84a5860", estrogen_ug := 30 ]
xsection[ short == "83c84a5860", gestagens_ug := 150]
xsection[ short == "83c84a5860", gestagens := "LNG"]
xsection[ short == "8bd7c4624b", estrogen_ug := 30 ]
xsection[ short == "8bd7c4624b", gestagens_ug := 2000]
xsection[ short == "8bd7c4624b", gestagens := "DNG"]
xsection[ short == "9b49e26d03", estrogen_ug := 30 ]
xsection[ short == "9b49e26d03", gestagens_ug := 2000]
xsection[ short == "9b49e26d03", gestagens := "CMA"]
xsection[ short == "9f61438d5f", estrogen_ug := 30 ]
xsection[ short == "9f61438d5f", gestagens_ug := 2000]
xsection[ short == "9f61438d5f", gestagens := "DNG"]
xsection[ short == "b726d9cd36", estrogen_ug := 20 ]
xsection[ short == "b726d9cd36", gestagens_ug := 100]
xsection[ short == "b726d9cd36", gestagens := "LNG"]
xsection[ short == "c09518da85", estrogen_ug := 35 ]
xsection[ short == "c09518da85", gestagen_ug := 250]
xsection[ short == "c09518da85", gestagens := "NGT"]
xsection[ short == "c6dd42db4b", estrogen_ug := 0 ]
xsection[ short == "c6dd42db4b", gestagens_ug := 75]
xsection[ short == "c6dd42db4b", gestagens := "DSG"]
xsection[ short == "e2f049ef95", estrogen_ug := 20 ]
xsection[ short == "e2f049ef95", gestagens_ug := 60]
xsection[ short == "e2f049ef95", gestagens := "DSG"]
xsection[ short == "59858e60ea", estrogen_ug := 20 ]
xsection[ short == "59858e60ea", gestagens_ug := 60]
xsection[ short == "59858e60ea", gestagens := "DSG"]
xsection[ pills == "other", list(other_pill_name, estrogen_ug,estrogen_ug_cycle, gestagens, gestagens_ug)]
## could also use info on gestagens etc
xsection[ pills == "other", estrogen_ug_merged := estrogen_ug] # per pill
xsection[ pills == "other", estrogen_ug_cycle := 21 * estrogen_ug] # times 21
xsection[ pills == "other", gestagen_type := gestagens]
xsection[ pills == "other", gestagen_ug_merged := gestagens_ug]
crosstabs(~is.na(xsection$pills) + is.na(xsection$estrogen_ug_cycle)) # except qlaira and zoely
## is.na(xsection$estrogen_ug_cycle)
## is.na(xsection$pills) FALSE TRUE
## FALSE 597 13
## TRUE 0 598
qplot(xsection$estrogen_ug_cycle)
# qplot(xsection$gestagen_ug_merged)
# xsection[ gestagen_ug_merged < 100, ]
# xsection[gestagen_ug_merged <= estrogen_ug_merged, list(pills, other_pill_name, gestagen_ug_merged, estrogen_ug_merged) ]
qplot(data=xsection, estrogen_ug_cycle, estrogen_ug_merged, geom = 'jitter')
# library(xlsx)
other_hormonal = readxl::read_excel( "item_tables/Nachbefragung_other_hormonal.xlsx", sheet = "Choices") %>% data.frame()
other_hormonal = as.data.table(other_hormonal)
other_hormonal[, hormonal_2 := as.character( name)]
xsection = merge(xsection, other_hormonal[,list(hormonal_2, estrogen_ug_other)], by = "hormonal_2", all.x = T)
nrow(xsection[!is.na(xsection$estrogen_ug_other),])
## [1] 39
table(xsection$estrogen_ug_other)
##
## 0 315 420
## 12 26 1
xsection[!is.na(estrogen_ug_other), estrogen_ug_cycle := estrogen_ug_other]
qplot(data = xsection, estrogen_ug_merged, estrogen_ug_cycle)
qplot(data = xsection, estrogen_ug_cycle, weight) + geom_smooth() # no association
qplot(data = xsection, estrogen_ug_cycle / weight)
table(xsection$weight)
##
## 20 21 22 28 29 30 32 35 37 41 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
## 4 3 1 1 2 1 2 1 2 2 4 3 6 6 13 11 19 38 21 38 42 37 73 36 42 73 45
## 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
## 82 33 45 45 36 61 39 25 34 21 45 12 15 10 10 29 7 7 9 6 25 3 11 5 5 6 2
## 87 88 89 90 91 92 93 95 97 99 100 101 105 107 110 111 112 113 114 115 120 130 134 143 166
## 1 4 2 5 1 1 1 5 2 3 5 1 3 2 1 2 1 1 1 2 6 1 1 1 1
xsection[, estrogen_ug_per_kg := estrogen_ug_cycle / weight]
xsection[ estrogen_ug_per_kg > 20, list(estrogen_ug_cycle, weight, height)]
crosstabs(xsection$estrogen_ug_cycle)
## xsection$estrogen_ug_cycle
## 0 315 360 420 480 630 665 680<PHONE_NUMBER> <NA>
## 44 28 1 156 11 356 3 4 2 29 2 572
# create NARQ_K_total scale
tagebuch$NARQ_K_total = rowMeans(tagebuch[, list(NARQ_admiration_1, NARQ_admiration_2, NARQ_admiration_3, NARQ_rivalry_1, NARQ_rivalry_2, NARQ_rivalry_3 ) ])
###create extra-pair subscales
#extra-pair desire/fantasies; extra_pair_7, extra_pair_10, extra_pair_11, extra_pair_12, extra_pair_13
tagebuch$extra_pair_desire = rowMeans(tagebuch[, list(extra_pair_7, extra_pair_10, extra_pair_11, extra_pair_12, extra_pair_13)])
tagebuch$extra_pair_sexual_fantasies = tagebuch$extra_pair_13
#extra-pair flirting; extra_pair_4, extra_pair_8, extra_pair_9
tagebuch$extra_pair_flirting = rowMeans(tagebuch[, list(extra_pair_4, extra_pair_8, extra_pair_9)])
#extra-pair compliments; extra_pair_2, extra_pair_3
tagebuch$extra_pair_compliments = rowMeans(tagebuch[, list(extra_pair_2, extra_pair_3)])
#extra-pair going out; extra_pair_5, extra_pair_6
tagebuch$extra_pair_going_out = rowMeans(tagebuch[, list(extra_pair_5, extra_pair_6)])
tagebuch$extra_pair = rowMeans( subset(tagebuch, select = extra_pair_2:extra_pair_13) )
tagebuch %>%
filter(!is.na(created)) %>%
arrange(session, created) %>%
rename(sexual_intercourse_satisfaction = sexual_intercourse_4) %>%
mutate(
short_session = str_sub(session, 1, 6),
created_date = as.Date(created - dhours(9)),
partner_initiated_sexual_intercourse = ifelse(sexual_intercourse_3 == 2, 1, 0),
had_sexual_intercourse = ifelse(sexual_intercourse_2 == 3, 0, 1),
had_petting = ifelse(sexual_intercourse_5 == 3, 0, 1),
extra_pair_intimacy = ifelse(extra_pair_1 == 1, 1, 0),
extra_pair_sex = ifelse(is.na(extra_pair_1b) | extra_pair_1b != 1, 0, 1)
) -> tagebuch
tagebuch %>% select(matches("choice_of_clothing_(4|6|7)")) %>% alpha()
##
## Reliability analysis
## Call: psych::alpha(x = data.frame(x))
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.84 0.84 0.79 0.64 5.3 0.0016 3.1 1.2 0.62
##
## lower alpha upper 95% confidence boundaries
## 0.84 0.84 0.85
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## choice_of_clothing_4 0.72 0.72 0.56 0.56 2.5 0.0032 NA 0.56
## choice_of_clothing_6 0.85 0.85 0.74 0.74 5.7 0.0017 NA 0.74
## choice_of_clothing_7 0.77 0.77 0.62 0.62 3.3 0.0026 NA 0.62
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## choice_of_clothing_4 29884 0.90 0.90 0.85 0.77 3.1 1.4
## choice_of_clothing_6 29883 0.84 0.83 0.68 0.63 3.7 1.4
## choice_of_clothing_7 29881 0.88 0.88 0.80 0.72 2.5 1.4
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## choice_of_clothing_4 0.19 0.14 0.23 0.27 0.13 0.04 0.03
## choice_of_clothing_6 0.12 0.07 0.16 0.35 0.22 0.08 0.03
## choice_of_clothing_7 0.35 0.17 0.23 0.16 0.07 0.02 0.03
tagebuch$sexy_clothes = rowMeans(tagebuch %>% select(matches("choice_of_clothing_(4|6|7)")) , na.rm = T)
tagebuch$showy_clothes = tagebuch$choice_of_clothing_8
tagebuch$sexual_intercourse_1_6scale = tagebuch$sexual_intercourse_1/5*6
tagebuch %>% select(sexual_intercourse_1_6scale, desirability_partner, attention_2) %>% alpha()
##
## Reliability analysis
## Call: psych::alpha(x = data.frame(x))
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.86 0.87 0.82 0.69 6.6 0.0013 3.6 1.4 0.69
##
## lower alpha upper 95% confidence boundaries
## 0.86 0.86 0.87
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## sexual_intercourse_1_6scale 0.81 0.82 0.69 0.69 4.5 0.0021 NA 0.69
## desirability_partner 0.79 0.80 0.66 0.66 3.9 0.0023 NA 0.66
## attention_2 0.83 0.83 0.71 0.71 4.8 0.0020 NA 0.71
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## sexual_intercourse_1_6scale 29902 0.88 0.89 0.80 0.74 3.7 1.5
## desirability_partner 29879 0.89 0.90 0.82 0.77 3.8 1.5
## attention_2 29874 0.90 0.88 0.79 0.73 3.3 1.8
tagebuch$in_pair_desire = rowMeans(tagebuch %>% select(sexual_intercourse_1_6scale, desirability_partner, attention_2))
tagebuch %>% select(male_jealousy_2, male_mate_retention_1, male_mate_retention_2, male_attention_1) %>% alpha()
##
## Reliability analysis
## Call: psych::alpha(x = data.frame(x))
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.49 0.48 0.44 0.18 0.91 0.0044 2.8 1.1 0.16
##
## lower alpha upper 95% confidence boundaries
## 0.48 0.49 0.5
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## male_jealousy_2 0.51 0.50 0.43 0.25 1.00 0.0048 0.0257 0.19
## male_mate_retention_1 0.47 0.43 0.38 0.20 0.74 0.0044 0.0428 0.12
## male_mate_retention_2 0.31 0.35 0.26 0.15 0.53 0.0064 0.0019 0.13
## male_attention_1 0.32 0.33 0.26 0.14 0.50 0.0062 0.0074 0.19
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## male_jealousy_2 29877 0.38 0.55 0.25 0.16 1.4 0.98
## male_mate_retention_1 29876 0.60 0.61 0.36 0.23 2.3 1.79
## male_mate_retention_2 29876 0.75 0.67 0.52 0.38 4.0 2.06
## male_attention_1 29874 0.72 0.67 0.53 0.38 3.5 1.84
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## male_jealousy_2 0.83 0.06 0.04 0.04 0.01 0.01 0.03
## male_mate_retention_1 0.59 0.06 0.07 0.12 0.07 0.10 0.03
## male_mate_retention_2 0.25 0.04 0.07 0.12 0.12 0.40 0.03
## male_attention_1 0.24 0.09 0.13 0.18 0.16 0.20 0.03
tagebuch$partner_mate_retention = rowMeans(tagebuch %>% select(male_jealousy_2, male_mate_retention_1, male_mate_retention_2, male_attention_1))
tagebuch %>% select(mate_retention_3, mate_retention_4, mate_retention_5, mate_retention_6, attention_1) %>% alpha()
##
## Reliability analysis
## Call: psych::alpha(x = data.frame(x))
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.71 0.71 0.69 0.33 2.4 0.0024 3.1 1.1 0.37
##
## lower alpha upper 95% confidence boundaries
## 0.71 0.71 0.72
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## mate_retention_3 0.66 0.65 0.62 0.31 1.8 0.0030 0.0317 0.28
## mate_retention_4 0.65 0.64 0.59 0.30 1.7 0.0031 0.0208 0.29
## mate_retention_5 0.75 0.75 0.70 0.43 3.0 0.0023 0.0057 0.41
## mate_retention_6 0.65 0.64 0.61 0.31 1.8 0.0030 0.0311 0.28
## attention_1 0.61 0.60 0.55 0.28 1.5 0.0034 0.0118 0.28
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## mate_retention_3 29876 0.71 0.70 0.58 0.50 2.9 1.7
## mate_retention_4 29876 0.77 0.72 0.64 0.53 4.0 2.1
## mate_retention_5 29876 0.42 0.49 0.26 0.22 1.6 1.2
## mate_retention_6 29875 0.70 0.71 0.61 0.51 2.8 1.6
## attention_1 29874 0.78 0.77 0.73 0.62 4.3 1.5
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## mate_retention_3 0.35 0.10 0.16 0.18 0.12 0.08 0.03
## mate_retention_4 0.25 0.04 0.07 0.12 0.12 0.39 0.03
## mate_retention_5 0.74 0.08 0.06 0.07 0.03 0.02 0.03
## mate_retention_6 0.32 0.13 0.19 0.20 0.10 0.05 0.03
## attention_1 0.10 0.05 0.10 0.26 0.24 0.25 0.03
tagebuch$female_mate_retention = rowMeans(tagebuch %>% select(mate_retention_3, mate_retention_4, mate_retention_5, mate_retention_6, attention_1), na.rm = T)
cor.test(tagebuch$female_mate_retention, tagebuch$in_pair_desire)
##
## Pearson's product-moment correlation
##
## data: tagebuch$female_mate_retention and tagebuch$in_pair_desire
## t = 140, df = 30000, p-value <2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.6226 0.6363
## sample estimates:
## cor
## 0.6295
tagebuch %>% select(jealousy_1, male_jealousy_1, male_jealousy_3) %>% alpha()
##
## Reliability analysis
## Call: psych::alpha(x = data.frame(x))
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.35 0.46 0.37 0.22 0.85 0.0055 1.7 0.83 0.18
##
## lower alpha upper 95% confidence boundaries
## 0.34 0.35 0.36
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## jealousy_1 0.48 0.50 0.33 0.33 1.00 0.0055 NA 0.33
## male_jealousy_1 0.18 0.26 0.15 0.15 0.35 0.0061 NA 0.15
## male_jealousy_3 0.26 0.30 0.18 0.18 0.44 0.0069 NA 0.18
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## jealousy_1 29877 0.85 0.64 0.29 0.20 2.4 1.83
## male_jealousy_1 29876 0.61 0.73 0.50 0.27 1.4 0.96
## male_jealousy_3 29876 0.51 0.71 0.48 0.27 1.2 0.68
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 miss
## jealousy_1 0.56 0.06 0.07 0.12 0.08 0.10 0.03
## male_jealousy_1 0.82 0.07 0.05 0.04 0.01 0.01 0.03
## male_jealousy_3 0.92 0.04 0.02 0.01 0.01 0.01 0.03
tagebuch$female_jealousy = rowMeans(tagebuch %>% select(jealousy_1, male_jealousy_1, male_jealousy_3), na.rm = T)
tagebuch %>% select(in_pair_desire, female_jealousy, female_mate_retention, partner_mate_retention) %>% cor(use='na.or.complete') %>% round(2)
## in_pair_desire female_jealousy female_mate_retention partner_mate_retention
## in_pair_desire 1.00 0.15 0.63 0.57
## female_jealousy 0.15 1.00 0.22 0.46
## female_mate_retention 0.63 0.22 1.00 0.70
## partner_mate_retention 0.57 0.46 0.70 1.00
xsection$has_not_had_sex_yet = ifelse(xsection$first_time == 999, 1, 0)
xsection$first_time = ifelse(xsection$first_time == 999 | xsection$first_time < 8, NA_real_, xsection$first_time)
xsection[menarche == 1, menarche := NA_real_] # unlikely
xsection[age < first_time, has_not_had_sex_yet := 1] # one person, presumably entered this info before we told people how to indicate that they have not had sex
xsection[age < first_time, first_time := NA_real_]
xsection$trying_to_get_pregnant = ifelse(xsection$wish_for_child == 2, "no", "yes")
xsection$had_sex_with_partner_yet = ifelse(xsection$sexual_intercourse_partner == 2, "no", "yes")
###Tätigkeit_Cleaning
# Die Gruppen "Auszubildende" hat ein Leerzeichen in der Gruppenbezeichnung
xsection[occupation == "Auszubildende ", occupation := "Auszubildende" ]
xsection[ , occupation_clean := occupation]
xsection[ occupation %in% c('Angestellte','Beamtin','berufstätig'), occupation_clean := 'Berufstätig']
xsection[ occupation %in% c('Student (Chemie)','Examenskandidatin/Studentin'), occupation_clean := 'Studentin']
xsection[ occupation %in% c('wie "was"? Erwerbsstatus? ','In Bezug worauf?','ein Einhorn', 'glücklich', 'Mensch'), occupation_clean := NA]
(common1 = count(as.data.frame(xsection), vars = occupation_clean))
## # A tibble: 7 x 2
## # ... with 7 more rows, and 2 variables: vars <chr>, n <int>
#Religion_Cleaning
xsection[ , religion_clean := religion]
xsection[ religion %in% c('katholisch','Evangelisch','evangelisch', 'katholisch '), religion_clean := 'Christentum']
xsection[ religion %in% c('Atheist','keine','Atheismus', 'nicht organisiert gläubig', 'nichts', 'gar keiner', 'keiner'), religion_clean := 'Nicht gläubig']
xsection[ religion %in% c('agnostisch','Agnostizismus','evangelisch - buddhistisch'), religion_clean := NA]
(common2 = count(as.data.frame(xsection), vars = religion_clean))
## # A tibble: 6 x 2
## # ... with 6 more rows, and 2 variables: vars <chr>, n <int>
#Beziehungsstatus_Cleaning
xsection[ , relationship_status_clean := relationship_status]
xsection[ relationship_status %in% c('feste Beziehung, es kriselt ein wenig','vergeben','in einer festen Partnerschaft', 'feste Partnerschaft', 'Partnerschaft (nicht verheiratet)', 'in einer Beziehung', 'feste Beziehung', 'Fernbeziehung', 'Beziehung', 'Freundin', 'offen', 'frisch verliebt', 'es ist kriselt'), relationship_status_clean := 'Partnerschaft']
xsection[ relationship_status %in% c('verheiratet'), relationship_status_clean := 'Verheiratet']
(common3 = count(as.data.frame(xsection), vars = relationship_status_clean))
## # A tibble: 3 x 2
## # ... with 3 more rows, and 2 variables: vars <chr>, n <int>
# Verhütungsmethode beim Kennenlernen_Cleaning
xsection[ , method_meeting_clean := method_meeting]
xsection[ method_meeting %in% c('pille', 'pille, wie bereits 30 mal gesagt'), method_meeting_clean := 'Pille']
xsection[ method_meeting %in% c('diese'), method_meeting_clean := NA]
(common4 = count(as.data.frame(xsection), vars = method_meeting_clean))
## # A tibble: 7 x 2
## # ... with 7 more rows, and 2 variables: vars <chr>, n <int>
xsection[age < 10+ duration_relationship_total/12, list(age, duration_relationship_total/12, duration_relationship_years, duration_relationship_months)]
xsection[age < 10+ duration_relationship_total/12, duration_relationship_total := NA]
qplot(as.numeric(xsection$ended.vorab - xsection$created.vorab),binwidth=1) + xlim(0,120)
qplot(as.numeric(xsection$ended.vorab - xsection$created.vorab)) + xlim(0,NA)
#Verhütung
count(as.data.frame(xsection), vars=contraception) %>% arrange(desc(n)) %>% head(15)
## # A tibble: 15 x 2
## # ... with 15 more rows, and 2 variables: vars <chr>, n <int>
contrabroad = count(as.data.frame(xsection), vars=contraception) %>% arrange(desc(n))
## Transformation of contraceptive methods into broader categories
xsection[ contraception == "none, contraceptive_pill, morning_after_pill, other_hormonal, infertile, partner_infertile, intrauterine_pessar, kalendermethode, coitus_interruptus, spermicide", contraception := NA] # this one simply clicked everything
xsection$contraceptives_broad_categories = xsection$contraception
xsection[contraceptives_broad_categories %in% contrabroad[contrabroad$n <= 10, ]$vars, contraceptives_broad_categories := "other"]
xsection[ contraception %contains% "temperature_billings", contraceptives_broad_categories := "counting_and_or_temperature_methods"]
xsection[ contraception %contains% "kalendermethode", contraceptives_broad_categories := "counting_and_or_temperature_methods"]
xsection[ contraception %contains% "computer", contraceptives_broad_categories := "counting_and_or_temperature_methods"]
xsection[ contraception %contains% "coitus_interruptus", contraceptives_broad_categories := "occasionally_use_coitus_interruptus"]
(contrabroad = count(as.data.frame(xsection), vars=contraceptives_broad_categories) %>% arrange(desc(n)))
## # A tibble: 11 x 2
## # ... with 11 more rows, and 2 variables: vars <chr>, n <int>
# Contraception Categories "barrier or abstinence" vs "fertility awareness" vs "hormonal"
xsection[, contraceptive_method := NA_character_]
xsection[ contraception %contains% "condoms" | contraception %contains% "intrauterine_pessar" | contraception %contains% "partner_sterilised"| contraception %contains% "partner_infertile" | contraception %contains% "coitus_interruptus" | (contraception == "none" & had_sex_with_partner_yet == "no"), contraceptive_method := "barrier_or_abstinence"]
xsection[ contraception %contains% "temperature_billings" | contraception %contains% "kalendermethode" | contraception %contains% "computer", contraceptive_method := "fertility_awareness"]
xsection[ contraception %contains% "contraceptive_pill" | contraception %contains% "other_hormonal", contraceptive_method := "hormonal"]
xsection[ contraception == "none", contraceptive_method := "none"]
xsection[ is.na(contraceptive_method), contraceptive_method := "other"]
xsection[, contraceptive_method_by_pearl := NA_character_]
xsection[ contraception %contains% "temperature_billings" | contraception %contains% "kalendermethode" | contraception %contains% "computer", contraceptive_method_by_pearl := "fertility_awareness"]
xsection[ contraception %contains% "condoms" | contraception %contains% "intrauterine_pessar" | contraception %contains% "partner_sterilised" | contraception %contains% "partner_infertile" | (contraception == "none" & had_sex_with_partner_yet == "no"), contraceptive_method_by_pearl := "barrier_or_abstinence"]
xsection[ is.na(contraceptive_method_by_pearl) & contraception %contains% "coitus_interruptus" , contraceptive_method_by_pearl := "barrier_or_abstinence"]
xsection[ contraception %contains% "contraceptive_pill" | contraception %contains% "other_hormonal", contraceptive_method_by_pearl := "hormonal"]
xsection[ contraception == "none", contraceptive_method_by_pearl := "none"]
xsection[ is.na(contraceptive_method_by_pearl), contraceptive_method_by_pearl := "other"]
(count(as.data.frame(xsection[contraceptive_method == "other", ]), vars=contraception) %>% arrange(desc(n)) %>% data.frame())
## vars n
## 1 andere 8
## 2 sterilised 7
## 3 2
## 4 infertile 2
## 5 none, andere 2
## 6 infertile, sterilised 1
## 7 morning_after_pill 1
## 8 none, infertile 1
## 9 none, morning_after_pill 1
## 10 none, sterilised 1
## 11 <NA> 1
(contramethod = count(as.data.frame(xsection), vars=contraceptive_method) %>% arrange(desc(n)) %>% data.frame())
## vars n
## 1 hormonal 693
## 2 barrier_or_abstinence 329
## 3 none 98
## 4 fertility_awareness 61
## 5 other 27
crosstabs(~ contraceptive_method, data = xsection)
## contraceptive_method
## barrier_or_abstinence fertility_awareness hormonal none other
## 329 61 693 98 27
xsection[contraceptive_method == "other",list(contraception, had_sex_with_partner_yet == "yes", age, occupation, wish_for_child==1, breast_feeding==1, pregnant==1)] %>% na.omit()%>% pander()
| contraception | V2 | age | occupation | V5 | V6 | V7 |
|---|---|---|---|---|---|---|
| TRUE | 23 | Studentin | TRUE | FALSE | FALSE | |
| andere | TRUE | 28 | Studentin | FALSE | FALSE | FALSE |
| sterilised | TRUE | 36 | Berufstätig | FALSE | FALSE | FALSE |
| andere | FALSE | 24 | Studentin | FALSE | FALSE | FALSE |
| andere | TRUE | 23 | Studentin | FALSE | FALSE | FALSE |
| andere | FALSE | 23 | Studentin | FALSE | FALSE | FALSE |
| andere | TRUE | 58 | Berufstätig | FALSE | FALSE | FALSE |
| sterilised | TRUE | 37 | Berufstätig | FALSE | FALSE | FALSE |
| none, infertile | TRUE | 25 | Studentin | FALSE | FALSE | FALSE |
| sterilised | TRUE | 48 | Hausfrau | FALSE | FALSE | FALSE |
| andere | TRUE | 41 | Berufstätig | FALSE | FALSE | FALSE |
| infertile | TRUE | 57 | Berufstätig | FALSE | FALSE | FALSE |
| none, sterilised | TRUE | 53 | Berufstätig | FALSE | FALSE | FALSE |
| sterilised | TRUE | 50 | Berufstätig | FALSE | FALSE | FALSE |
| none, andere | TRUE | 26 | Studentin | FALSE | FALSE | FALSE |
| andere | TRUE | 28 | Studentin | FALSE | TRUE | TRUE |
| none, morning_after_pill | TRUE | 28 | Berufstätig | FALSE | FALSE | FALSE |
| sterilised | TRUE | 53 | Berufstätig | FALSE | FALSE | FALSE |
| andere | FALSE | 19 | Studentin | FALSE | FALSE | FALSE |
| sterilised | TRUE | 49 | Berufstätig | FALSE | FALSE | FALSE |
| none, andere | TRUE | 25 | Studentin | FALSE | FALSE | TRUE |
| infertile, sterilised | TRUE | 49 | Berufstätig | FALSE | FALSE | FALSE |
| infertile | TRUE | 46 | Berufstätig | FALSE | FALSE | FALSE |
| morning_after_pill | FALSE | 21 | Studentin | FALSE | FALSE | FALSE |
| sterilised | TRUE | 50 | Berufstätig | FALSE | FALSE | FALSE |
| TRUE | 22 | Studentin | FALSE | FALSE | FALSE |
(contramethod = count(as.data.frame(xsection), vars = contraceptive_method) %>% arrange(desc(n)) %>% data.frame())
## vars n
## 1 hormonal 693
## 2 barrier_or_abstinence 329
## 3 none 98
## 4 fertility_awareness 61
## 5 other 27
##Transformation of contraceptive methods into natural and artifical categories
# Hier müssen wir nochmal schauen, in welcher Reihenfolge wir das machen wollen. Im Moment werden - glaube ich? - die letzten Befehle als wichtigstes Kriterium eingeschätzt.
xsection$contraceptives_categories_natural = xsection$contraception
xsection[ contraception == "", contraceptives_categories_natural := NA_character_]
xsection[ contraception %contains% "none", contraceptives_categories_natural := "none"]
xsection[ contraception %contains% "condoms", contraceptives_categories_natural := "artifical"]
xsection[ contraception %contains% "contraceptive_pill", contraceptives_categories_natural := "artifical"]
xsection[ contraception %contains% "other_hormonal", contraceptives_categories_natural := "artifical"]
xsection[ contraception %contains% "intrauterine_pessar", contraceptives_categories_natural := "artifical"]
xsection[ contraception %contains% "morning_after_pill", contraceptives_categories_natural := "artifical"]
xsection[ contraception %contains% "coitus_interruptus", contraceptives_categories_natural := "natural"]
xsection[ contraception %contains% "kalendermethode", contraceptives_categories_natural := "natural"]
xsection[ contraception %contains% "computer", contraceptives_categories_natural := "natural"]
xsection[ contraception %contains% "temperature_billings", contraceptives_categories_natural := "natural"]
xsection[ contraception %contains% "sterilised", contraceptives_categories_natural := NA_character_]
xsection[ contraception %contains% "andere", contraceptives_categories_natural := NA_character_]
xsection[ contraception %contains% "partner_sterilised", contraceptives_categories_natural := NA_character_]
(contrabroadnatural = count(as.data.frame(xsection), vars=contraceptives_categories_natural) %>% arrange(desc(n)))
## # A tibble: 6 x 2
## # ... with 6 more rows, and 2 variables: vars <chr>, n <int>
## Transformation of number of children (combined into: "children" and "no children")
xsection$children_broad_categories = xsection$children
xsection[ children == "", children_broad_categories := 'no_children']
xsection[ children %contains% 1, children_broad_categories := "children"]
xsection[ children %contains% 2, children_broad_categories := "children"]
xsection[ children %contains% 3, children_broad_categories := "children"]
xsection[ children %contains% 4, children_broad_categories := "children"]
xsection[ children %contains% 5, children_broad_categories := "no_children"]
summary(xsection$children_broad_categories)
## Length Class Mode
## 1208 character character
## Attractiveness_finance
xsection$attractiveness_finance = (xsection$attractiveness_finance_1 + xsection$attractiveness_finance_2)/2
give proper variable labels for plots etc.
xsection$breast_feeding_in_last_3_months = ifelse(xsection$breast_feeding == 2, "no", "yes")
xsection$pregnant_in_last_3_months = ifelse(xsection$pregnant == 2, "no", "yes")
xsection$hormonal_medication_in_last_3_months = ifelse(xsection$antibiotics == 2, "no", "yes")
xsection$pill_in_last_3_months = ifelse(xsection$pille_control == 2, "no", "yes")
childrenrecode = c("1" = "Biological children", "2" = "Adopted children", "3" = "Step children", "4" = "Foster children", "5" = "No children")
# xsection$children_categories = str_replace_all(xsection$children, childrenrecode)
xsection$children_narrow_categories = childrenrecode[xsection$children]
xsection$children_narrow_categories[is.na(xsection$children_narrow_categories)] = "Complex family"
xsection$children_narrow_categories[xsection$children == ""] = "No children"
incomebrackets = c("1" = "< 500€", "2" = "500-1000€", "3" = "1000-2000€", "4" = "2000-3000€", "5" = "> 3000€")
# xsection$children_categories = str_replace_all(xsection$children, childrenrecode)
xsection$income = recode_ordered(incomebrackets, xsection$attractiveness_finance_self)
xsection$income_partner = incomebrackets[xsection$attractiveness_finance_2]
cohabitation = c("1" = "Long-distance", "2" = "Live in same city", "3" = "Live in same apartment")
xsection$cohabitation = cohabitation[xsection$long_distance_relationship]
living_situation = c("1" = "living alone", "2" = "living in flatshare")
xsection$living_situation = living_situation[xsection$situation_of_living]
xsection$living_situation = ifelse(xsection$long_distance_relationship == 3, "living with partner", xsection$living_situation)
xsection$living_situation = ifelse(xsection$living_situation == 'living in flatshare', ifelse(xsection$flat_share == 1, 'living in all-female flatshare', 'living in mixed-sex flatshare'), xsection$living_situation)
days_with_partner_per_month = c("1" = '< 3 days', '2' = '3-5 days', '3' = '5-7 days', '4' = '7-14 days', '5' = '> 14 days')
xsection$days_with_partner_per_month = recode_ordered(days_with_partner_per_month, xsection$long_distance_relationship_2)
distance_to_partner_hours = c("1" = '< 1h', '2' = '1-2h', '3' = '2-3h', '4' = '3-5h', '5' = '5-9h', '6' = '9-12h', '7' = '>12h')
xsection$distance_to_partner_hours = recode_ordered(distance_to_partner_hours, xsection$distance_partner)
days_with_partner = c('1' = '< 3 days', '2' = '3-5 days', '3' = '7 days') # forgot 6...
nights_with_partner = c('1' = '< 3 nights', '2' = '3-5 nights', '3' = '7 nights')
xsection$days_with_partner = recode_ordered(days_with_partner, xsection$days_with_partner)
xsection$nights_with_partner = recode_ordered(nights_with_partner, xsection$nights_with_partner)
xsection$duration_relationship_years = xsection$duration_relationship_total/12
xsection$cycle_length = xsection$cyklus_3
xsection$cycle_length_groups = cut(xsection$cycle_length, breaks = c(19,25,30,35,41))
xsection$certainty_menstruation = factor(round(rowMeans(xsection[, list(cyklus_2, cyklus_4, cyklus_6)])))
xsection$cycle_regularity = factor(xsection$cyklus_5, levels = 1:3, labels = c("very regular,\nup to 2 days off", "slightly irregular,\nup to 5 days off", "irregular,\nmore than 5 days off"))
xsection$sexual_intercourse_partner = NULL
xsection$wish_for_child = NULL
prev_names = names(xsection)
stopifnot(sum(duplicated(xsection$session)) == 0)
diary = merge(xsection, tagebuch, by = "session", all.x = T)
diary = setDF(diary)
table(is.na(diary$created.vorab))
##
## FALSE
## 30956
# diary[is.na(created.vorab),list(session, choice_of_clothing_2, created.vorab, created.abschluss)]
crosstabs(as.Date(diary$created) == as.Date(diary$created - dhours(9))) # we can left shift dates by 7 hours, because even though were supposed to start filling out before midnight, bugs in our survey software sometimes led to the invitations being sent a little and rarely a lot late)
## as.Date(diary$created) == as.Date(diary$created - dhours(9))
## FALSE TRUE <NA>
## 188 30736 32
diary = diary %>% filter(!is.na(created.vorab))
diary$weekend = factor(weekdays( diary$created) %in% c("Friday","Saturday","Sunday"))
diary$weekday = factor(weekdays( diary$created) , levels = c("Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"))
diary$first_day = ave(diary$created_date, diary$session, FUN = min)
diary$day_number = as.integer(round(as.numeric(diary$created_date - diary$first_day, units = "days")))
combos = diary %>% select(session, day_number)
combos$sess_day = paste(combos$session, combos$day_number)
table(duplicated(combos$sess_day))
##
## FALSE
## 30956
# head(combos)
diary$spent_night_with_partner = ifelse(diary$mate_retention_1 == 1, 1, 0)
diary$in_pair_public_intimacy = ifelse(diary$mate_retention_2 != 3, 1, 0)
diary2 = diary
To compute menstrual onsets from the diary data, we have to clear a few hurdles:
Therefore we use a multi-step procedure:
diary = diary2
diary = diary %>% setDF %>% group_by(session) %>%
mutate(
menstruation_dates = created_date, # get dates
menstruation_dates = if_else(menstruation_1 == 2 | is.na(menstruation_1), as.Date(NA), menstruation_dates), # set to missing one dates where no menstruation was reported
days = length(unique(created_date)),
day_count = seq_along(created),
first_diary_date = min(created_date),
last_diary_date = max(created_date),
timespan = as.numeric( last_diary_date - first_diary_date ),
# diary[, timespan := ave(x= created_num, session, FUN = function(x) { round((max(x,na.rm=T)-min(x,na.rm=T))/(24*3600)) } )]
days_responded_percentage = ifelse( timespan==0, NA_real_, days/timespan),
sufficient_diary_coverage = days >= 30 & days_responded_percentage > 0.5,
last_menstruation = if_else(all(is.na(menstruation_dates)), as.Date(NA), max(menstruation_dates, na.rm=T)),
last_lag = ifelse(is.na(last_menstruation), NA_real_, as.numeric(last_diary_date - last_menstruation)) # how many days after their last observed menstruation did they last fill out the diary
) %>% data.table()
crosstabs(diary$menstruation_2)
## diary$menstruation_2
## 1 2 3 4 5 6 <NA>
## 781 897 824 800<PHONE_NUMBER>2
diary[, days_since_menstrual_onset := ifelse(menstruation_2 == 6, NA_real_, menstruation_2 - 1 )] # the way we collected this variable, we have to set "more than 4 days ago" to missing, because it's unspecific
diary[, menstrual_onset_date_inferred := created_date - ddays(days_since_menstrual_onset)] ### count back from each current diary day, to create a menstrual onset date
crosstabs(is.na(diary$menstrual_onset_date_inferred))
## is.na(diary$menstrual_onset_date_inferred)
## FALSE TRUE
## 4068 26888
### define a variable containing the number of days since the last menstruation as counted on the current diary day
# step 1
menstrual_onsets = diary %>% setDF() %>%
group_by(session) %>%
arrange(created) %>%
select(session, created_date, menstrual_onset_date_inferred)
followup_survey = nachbe %>% setDF() %>%
mutate(
menstrual_onset_date_inferred = if_else(menstrual_bleeding_1 == 1, as.Date(created), as.Date(menstrual_bleeding_2)),
created_date = menstrual_onset_date_inferred) %>%
select(session, created_date, menstrual_onset_date_inferred)
pre_survey = vorab %>% setDF() %>%
mutate(menstrual_onset_date_inferred = as.Date(cyklus_1),
created_date = menstrual_onset_date_inferred) %>%
select(session, created_date, menstrual_onset_date_inferred)
mons = menstrual_onsets %>%
select(session, created_date, menstrual_onset_date_inferred) %>%
bind_rows(
pre_survey,
followup_survey
) %>%
filter( !is.na(menstrual_onset_date_inferred)) %>%
unique() %>%
group_by(session) %>%
arrange(session, created_date) %>%
# step 3: prefer reports closer to event if they conflict
mutate(
onset_diff = abs( as.double( lag(menstrual_onset_date_inferred) - menstrual_onset_date_inferred, units = "days")), # was there a change in the reference menstrual onset
onset_diff = if_else(onset_diff == 0, NA_real_, onset_diff, NA_real_), # we want to take the date that is freshest in memory. no switch is set to missing
menstrual_onset_date_inferred = if_else(is.na(lag(menstrual_onset_date_inferred)), # if last date not known
menstrual_onset_date_inferred, # use current date
if_else(onset_diff < 7, # if last date is known, but is slightly different from current date
as.Date(NA), # attribute it to memory, not extremely short cycle, use fresher date
menstrual_onset_date_inferred, # if it's a big difference, use the current date
as.Date(NA))), # if no date is assigned today, keep it like that
menstrual_onset_date_inferred = formr::repeat_last(menstrual_onset_date_inferred)) %>%
mutate(created_date = menstrual_onset_date_inferred) %>%
filter(!is.na(menstrual_onset_date_inferred)) %>%
select(-onset_diff) %>%
unique()
avg_cycle_lengths = mons %>%
select(session, menstrual_onset_date_inferred) %>%
unique() %>%
arrange(session, menstrual_onset_date_inferred) %>%
mutate(
number_of_cycles = n(),
cycle_nr = row_number(),
cycle_length_diary = as.double(lead(menstrual_onset_date_inferred) - menstrual_onset_date_inferred, units = "days"),
mean_cycle_length_diary = mean(cycle_length_diary, na.rm = TRUE),
median_cycle_length_diary = median(cycle_length_diary, na.rm = TRUE))
menstrual_onsets = menstrual_onsets %>% select(session, created_date) %>%
bind_rows(
diary = .,
demo = pre_survey %>% select(session, created_date),
followup = followup_survey %>% select(session, created_date),
.id = "date_origin") %>%
filter(!is.na(created_date)) %>%
unique() %>%
group_by(session) %>%
arrange(session, created_date) %>%
# step 2 expand into time-series for participant
complete(created_date = full_seq(created_date, period = 1)) %>%
left_join(mons, by = c("session", "created_date")) %>%
unique()
menstrual_onsets = menstrual_onsets %>%
group_by(session) %>%
mutate(
# carry the last observation (the last observed menstrual onset) backward/forward (within person).
# first we carry it backward (because reporting is retrospective)
next_menstrual_onset = formr::repeat_last(menstrual_onset_date_inferred, forward = FALSE),
# then we carry it forward
last_menstrual_onset = formr::repeat_last(menstrual_onset_date_inferred),
# calculate the diff to current date
menstrual_onset_days_until = as.numeric(created_date - next_menstrual_onset),
menstrual_onset_days_since = as.numeric(created_date - last_menstrual_onset)
)
# mons %>% filter(session %contains% "43a25b") %>% View()
# menstrual_onsets %>% filter(session %contains% "43a25b") %>% View()
# menstrual_onsets %>% filter(session %starts_with% "020f65ea45") %>% View()
diary = diary %>%
setDF() %>%
left_join(menstrual_onsets %>%
select(session, created_date, next_menstrual_onset, last_menstrual_onset, menstrual_onset_days_until, menstrual_onset_days_since) %>%
unique() # unique because some women reported the last menstrual date in the diary again in the followup
,
by = c("session", "created_date")
) %>%
left_join(avg_cycle_lengths %>% rename(last_menstrual_onset = menstrual_onset_date_inferred), by = c("session", "last_menstrual_onset")) %>%
mutate(
next_menstrual_onset_inferred = if_else(is.na(next_menstrual_onset),
last_menstrual_onset + days(cyklus_3),
next_menstrual_onset),
RCD_inferred = as.numeric(created_date - next_menstrual_onset_inferred)
) %>%
data.table()
diary[!duplicated(session) & median_cycle_length_diary <= 40 & median_cycle_length_diary >= 20, qplot(median_cycle_length_diary, cyklus_3) + geom_smooth()]
diary[!duplicated(session) & median_cycle_length_diary <= 40 & median_cycle_length_diary >= 20, lm(median_cycle_length_diary ~ cyklus_3)]
##
## Call:
## lm(formula = median_cycle_length_diary ~ cyklus_3)
##
## Coefficients:
## (Intercept) cyklus_3
## 20.681 0.287
# diary %>% filter(session %starts_with% "020f65ea45") %>% select(created_date, next_menstrual_onset, last_menstrual_onset, menstrual_onset_days_until, menstrual_onset_days_since) %>% View()
xtabs(~ is.na(menstrual_onset_days_until) + is.na(menstrual_onset_days_since), diary)
## is.na(menstrual_onset_days_since)
## is.na(menstrual_onset_days_until) FALSE TRUE
## FALSE 18614 0
## TRUE 12310 32
diary = diary %>%
mutate(
FCD = menstrual_onset_days_since + 1,
RCD = menstrual_onset_days_until,
RCD_for_merge = (RCD * -1) + 1,
RCD_squished = if_else(
cycle_length_diary - FCD < 14,
29 - (cycle_length_diary - FCD),
round((FCD/ (cycle_length_diary - 14) ) * 15)),
RCD_inferred = (RCD_inferred * -1) + 1,
# add 15 days to the reverse cycle days to arrive at the estimated day of ovulation
RCD_rel_to_ovulation = RCD + 15
)
crosstabs(diary$RCD_squished)
## diary$RCD_squished
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
## 74 426 444 382 437 458 467 310 547 488 534 509 641 574 663 643 606 612
## 18 19 20 21 22 23 24 25 26 27 28 29 <NA>
## 663 668 694 716 762 768 801 780 820 828<PHONE_NUMBER>8
crosstabs(diary$RCD_for_merge)
## diary$RCD_for_merge
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
## 934 857 846 828 820 780 801 768 759 715 693 667 661 609 601 582 563 542
## 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
## 529 499 477 449 419 401 370 342 305 252 159 119 100 77 65 49 49 44
## 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
## 37 34 24 33 28 31 32 25 27 24 17 19 14 21 20 18 12 16
## 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## 15 10 13 8 10 9 9 11 7 8 4 5 8 8 7 8 10 9
## 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
## 9 7 9 8 7 5 9 4 5 3 4 2 2 6 6 5 3 2
## 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
## 5 3 5 3 4 4 3 2 3 2 5 3 6 5 2 1 2 1
## 109 112 113 114 115 117 118 120 121 122 123 124 125 126 127 128 129 130
## 3 1 2 1 2 1 1 2 1 2 1 1 1 2 1 1 2 2
## 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 150 151 155
## 2 1 2 3 1 2 2 2 1 1 1 1 2 2 2 1 1 1
## 156 157 158 159 161 163 164 166 167 168 170 171 174 175 178 179 182 183
## 1 1 2 2 1 1 1 1 1 1 1 1 2 1 1 1 1 1
## 186 187 189 190 191 192 193 194 195 196 197 198 199 200 201 203 205 208
## 2 1 2 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1
## 209 210 211 218 224 227 242 248 249 250 251 252 253 265 282 300 301 302
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 315 317 318 319 323 344 347 348 349 350 351 352 353 354 355 356 357 358
## 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1
## 359 360 <NA>
## 1 1 12342
crosstabs(diary$FCD)
## diary$FCD
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
## 934 951<PHONE_NUMBER> 951 938 978 957 960 939 939 936 948 923 899 933 883 896 924 882 872
## 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
## 861 849 812 743 723 644 415 271 215 195 172 150 142 140 116 101 97 90 92 85 91 82
## 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
## 91 82 77 84 80 70 64 58 63 65 56 54 38 45 41 36 47 49 75 77 74 73
## 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
## 63 67 63 65 51 51 58 50 49 56 49 45 52 43 44 38 42 36 36 40 34 33
## 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
## 35 32 28 31 31 32 30 26 27 21 26 26 21 21 14 19 13 8 8 10 8 9
## 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
## 4 6 4 5 5 4 6 10 6 6 5 2 1 2 6 4 4 2 7 3 5 3
## 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
## 8 2 3 2 4 2 4 3 6 3 3 2 4 5 2 2 2 1 1 2 2 2
## 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
## 2 2 4 5 2 1 3 4 3 4 1 3 1 2 3 2 1 2 1 4 2 2
## 178 179 181 183 186 188 192 195 196 197 198 200 201 204 206 207 208 209 211 214 216 218
## 2 1 1 1 1 2 2 2 1 3 1 1 2 1 1 1 1 1 3 2 2 3
## 220 221 222 223 225 229 233 234 235 236 239 240 242 245 247 250 251 252 257 258 260 261
## 1 2 1 1 2 1 1 1 1 1 1 1 1 1 1 2 1 1 1 2 3 1
## 262 263 264 265 267 268 271 272 275 280 281 283 284 285 292 294 299 300 301 303 304 310
## 1 1 1 1 3 1 2 2 1 2 2 2 1 1 1 2 1 1 2 2 1 1
## 311 312 313 318 321 322 326 329 330 331 332 333 334 336 337 338 342 351 375 396 397 398
## 1 2 1 2 1 1 1 1 2 1 1 1 1 1 1 2 1 2 1 1 1 1
## 404 432 440 483 615 <NA>
## 1 1 1 1 1 32
crosstabs(~RCD_squished+ RCD_for_merge, diary %>% filter(cycle_length_diary<40))
## RCD_for_merge
## RCD_squished 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
## 1 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 2 21 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 3 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 8 7
## 4 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 4 7 19
## 5 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 9 18 31
## 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 3 4 6 35 146
## 7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 20 48 55
## 8 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 3 16 27 78 184 62
## 9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 6 8 91 205 47 25
## 10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 4 17 116 216 56 25 19
## 11 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 5 59 250 64 28 4 0
## 12 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 9 82 339 62 17 0 0 0
## 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 17 358 56 2 0 0 0 0
## 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 481 32 0 0 0 0 0 0
## 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 533 0 0 0 0 0 0 0 0
## 16 5 0 0 0 0 0 0 0 0 0 0 0 0 0 542 0 0 0 0 0 0 0 0 0
## 17 3 0 0 0 0 0 0 0 0 0 0 0 0 555 0 0 0 0 0 0 0 0 0 0
## 18 2 0 0 0 0 0 0 0 0 0 0 0 599 0 0 0 0 0 0 0 0 0 0 0
## 19 1 0 0 0 0 0 0 0 0 0 0 608 0 0 0 0 0 0 0 0 0 0 0 0
## 20 1 0 0 0 0 0 0 0 0 0 629 0 0 0 0 0 0 0 0 0 0 0 0 0
## 21 1 0 0 0 0 0 0 0 0 644 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 22 3 0 0 0 0 0 0 0 681 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 23 0 0 0 0 0 0 0 685 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 24 0 0 0 0 0 0 720 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 25 0 0 0 0 0 703 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 26 0 0 0 0 742 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 27 0 0 0 749 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 28 0 0 772 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 29 0 772 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## RCD_for_merge
## RCD_squished 25 26 27 28 29 30 31 32 33 34 35 36 37 38
## 1 0 0 0 0 0 0 0 0 0 0 6 4 5 1
## 2 0 29 36 79 41 20 25 20 13 13 6 8 2 0
## 3 16 39 83 40 19 28 10 6 11 10 6 0 0 0
## 4 30 92 48 40 31 19 10 9 6 1 0 0 0 0
## 5 133 46 48 10 17 11 12 8 1 0 0 0 0 0
## 6 56 46 23 25 11 6 5 0 0 0 0 0 0 0
## 7 48 25 16 13 6 1 0 0 0 0 0 0 0 0
## 8 29 27 17 5 0 0 0 0 0 0 0 0 0 0
## 9 21 4 0 0 0 0 0 0 0 0 0 0 0 0
## 10 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## 11 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 12 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 13 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 15 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 16 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 17 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 18 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 19 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 20 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 21 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 22 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 23 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 24 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 26 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 27 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 28 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 29 0 0 0 0 0 0 0 0 0 0 0 0 0 0
ggplot(diary %>% filter(cycle_length_diary<40), aes(FCD, RCD_squished)) + geom_point() + facet_wrap(~cycle_length_diary)
days = data.frame(
RCD_for_merge = c(29:1, 30:41),
FCD = c(1:41),
prc_stirn_b = c(.01, .01, .02, .03, .05, .09, .16, .27, .38, .48, .56, .58, .55, .48, .38, .28, .20, .14, .10, .07, .06, .04, .03, .02, .01, .01, .01, .01, .01, rep(.01, times = 12)),
# rep(.01, times = 70)), # gangestad uses .01 here, but I think such cases are better thrown than kept, since we might simply have missed a mens
prc_wcx_b = c(.000, .000, .001, .002, .004, .009, .018, .032, .050, .069, .085, .094, .093, .085, .073, .059, .047, .036, .028, .021, .016, .013, .010, .008, .007, .006, .005, .005, .005, rep(.005, times = 12))
)
# rep(NA_real_, times = 70)) # gangestad uses .005 here, but I think such cases are better thrown than kept, since we might simply have missed a mens
days = days %>% mutate(
fertile_narrow = ifelse(between(RCD_for_merge,15,19), mean(prc_stirn_b[between(RCD_for_merge,15, 19)], na.rm = T),
ifelse(between(RCD_for_merge,4,12), mean(prc_stirn_b[between(RCD_for_merge,4,12)], na.rm = T), NA_real_)), # these days are likely infertile
fertile_broad = ifelse(between(RCD_for_merge,14,22), mean(prc_stirn_b[between(RCD_for_merge,14,22)], na.rm = T),
ifelse(between(RCD_for_merge,4,12), mean(prc_stirn_b[between(RCD_for_merge,4,12)], na.rm = T), NA_real_)), # these days are likely infertile
fertile_window = factor(ifelse(fertile_broad, ifelse(!is.na(fertile_narrow), "narrow", "broad"),"infertile"), levels = c("infertile","broad", "narrow")),
premenstrual_phase = ifelse(between(RCD_for_merge, 2, 7), TRUE, FALSE)
)
rcd_days = days %>% select(-FCD)
diary = left_join(diary %>% setDF(), rcd_days, by = "RCD_for_merge")
fcd_days = days %>% select(-RCD_for_merge)
names(fcd_days) = paste0(names(fcd_days), "_forward_counted")
fcd_days = fcd_days %>% rename(FCD = FCD_forward_counted)
diary = left_join(diary, fcd_days, by = "FCD")
rcd_inferred_days = days %>% select(-FCD)
names(rcd_inferred_days) = paste0(names(rcd_inferred_days), "_backward_inferred")
rcd_inferred_days = rcd_inferred_days %>%
rename(RCD_inferred = RCD_for_merge_backward_inferred)
diary = left_join(diary, rcd_inferred_days, by = "RCD_inferred")
rcd_squished = days %>% select(-RCD_for_merge)
names(rcd_squished) = paste0(names(rcd_squished), "_squished")
rcd_squished = rcd_squished %>%
rename(RCD_squished = FCD_squished)
diary = left_join(diary, rcd_squished, by = "RCD_squished")
ggplot(diary %>% filter(cycle_length_diary<40), aes(FCD, prc_stirn_b_squished))+geom_point() + facet_wrap(~cycle_length_diary )
ggplot(diary %>% filter(cycle_length_diary<40), aes(RCD, prc_stirn_b_squished))+geom_point() + facet_wrap(~cycle_length_diary )
ggplot(diary %>% filter(cycle_length_diary<40) %>% select(FCD,RCD,prc_stirn_b,prc_stirn_b_squished,cycle_length_diary) %>% gather(approach,prc_stirn_b,-RCD,-FCD, -cycle_length_diary), aes(RCD, prc_stirn_b, colour = approach))+geom_point() + facet_wrap(~cycle_length_diary ) + geom_vline(aes(xintercept = cycle_length_diary/2 * -1))
diary %>% select(starts_with("prc_stirn_b")) %>%
cor(use='pairwise.complete.obs')
## prc_stirn_b prc_stirn_b_forward_counted prc_stirn_b_backward_inferred
## prc_stirn_b 1.0000 0.6846 1.0000
## prc_stirn_b_forward_counted 0.6846 1.0000 0.7153
## prc_stirn_b_backward_inferred 1.0000 0.7153 1.0000
## prc_stirn_b_squished 0.8578 0.6695 0.8578
## prc_stirn_b_squished
## prc_stirn_b 0.8578
## prc_stirn_b_forward_counted 0.6695
## prc_stirn_b_backward_inferred 0.8578
## prc_stirn_b_squished 1.0000
pander(missingness_patterns(diary %>% ungroup %>% select(prc_stirn_b, prc_stirn_b_forward_counted, prc_stirn_b_backward_inferred)))
index col missings 1 prc_stirn_b 13069 2 prc_stirn_b_backward_inferred 3813 3 prc_stirn_b_forward_counted 3576
| Pattern | Freq | Culprit |
|---|---|---|
| _____ | 16782 | _ |
| 1____ | 9256 | prc_stirn_b |
| 1_2_3 | 2471 | |
| 1_2__ | 1342 | |
| ____3 | 1105 | prc_stirn_b_forward_counted |
diary = diary %>%
mutate(fertile_fab = if_else(is.na(prc_stirn_b), prc_stirn_b_backward_inferred, prc_stirn_b),
premenstrual_phase_fab = if_else(is.na(premenstrual_phase), premenstrual_phase_backward_inferred, premenstrual_phase),
fertile_forward_and_backward = fertile_fab
) %>%
data.table()
diary[, menstruated_at_all := menstruation_1 == 1]
diary[ is.na(menstruated_at_all), menstruated_at_all := F]
table(diary$menstruated_at_all, exclude = NULL)
##
## FALSE TRUE
## 26151 4805
diary[, menstruation := factor(ifelse(menstruated_at_all,"yes", ifelse(premenstrual_phase, "pre","no")), levels = c("no", "pre", "yes"))]
diary[is.na(menstruation), menstruation := "no"]
# diary %>% select(short, created_date, ended, last_menstrual_onset,next_menstrual_onset, menstrual_onset_days_until, menstrual_onset_days_since, prc_stirn_b, prc_stirn_b_forward_counted, fertile_fab) %>% View()
diary[, ever_menstruated := ave(menstruated_at_all, session, FUN = any)]
diary[, any_RCD := !ave(is.na(RCD), session, FUN = all)]
diary[, menstruation_strength := menstruation_3]
diary[ is.na(menstruation_strength), menstruation_strength := 0]
diary[, menstruation_strength := factor(menstruation_strength)]
diary[, menstrual_onset := created_date == next_menstrual_onset]
diary[, we_know_fertile_days := ave(!is.na(prc_stirn_b) | !is.na(prc_stirn_b_forward_counted), session, FUN = any)]
crosstabs(diary[!duplicated(session),]$we_know_fertile_days)
## diary[!duplicated(session), ]$we_know_fertile_days
## FALSE TRUE
## 96 1112
diary$fertile_cont = diary$prc_stirn_b
diary %>% filter(sufficient_diary_coverage==T & ever_menstruated == T & any_RCD == T) %>%
ggplot(aes(x = menstrual_onset_days_until, y = as.factor(as.numeric(as.factor(session)))))+
scale_y_discrete("Person") +
geom_tile(aes(fill = fertile_cont)) +
scale_x_continuous("Relative to last observed menstrual onset", limits= c(-40, 15), breaks = seq(-40,15, by = 5)) +
geom_point(aes(colour=menstruation_strength)) +
scale_fill_distiller() +
scale_color_manual(values = c("0"="transparent","1"="pink","2"="red","3"="darkred")) +
geom_vline(aes(xintercept = limits, linetype = Window),data = data.frame(limits= c(-14.5,-19.5, -13.5,-22.5,-3.5,-12.5), Window = rep(c("narrow","broad","infertile"),each=2)),color = 'black', size = 0.9, alpha = 0.9,show.legend = T) +
scale_linetype_manual(values = c("narrow"="solid","broad"="dashed","infertile"="dotted"))
# a case where the nachbe helped
# diary[session %contains% "eaca39", list(created_date, menstruation_dates, next_menstrual_onset, last_menstrual_onset, menstruated_at_all, menstruation_2,RCD, fertile_cont,fertile_broad) ] %>% arrange(created_date) %>% View()
# a case where we observed a menstruation at the end and in the beginning, but missed the onsets
# diary[session %contains% "b270e1", list(created_date, menstruation_dates, next_menstrual_onset, last_menstrual_onset, menstruated_at_all, menstruation_2,RCD, fertile_cont,fertile_broad) ] %>% arrange(created_date) %>% View()
# a case where we observed a menstruation at the end and in the beginning
# diary[session %contains% "0b8734", list(created_date, menstruation_dates, next_menstrual_onset, last_menstrual_onset, menstruated_at_all, menstruation_2,RCD, fertile_cont,fertile_broad) ] %>% arrange(created_date) %>% View()
# a case where she first indicated menstrual onset on the day it occurred (likely correct), then two days later reported that it occurred yesterday (likely incorrect). problem solved by not treating extremely close together menstrual onsets as separate, instead using the earlier date (closer to onset, more likely to be correct)
# diary[session %contains% "c7cc8e", list(created_date, menstruation_dates, next_menstrual_onset, last_menstrual_onset, menstruated_at_all, menstruation_2,RCD, fertile_cont,fertile_broad) ] %>% arrange(created_date) %>% View()
## two cases with a little misreporting of ongoing periods
# diary[session %contains% "43a25b", list(created_date, menstruation_dates, next_menstrual_onset, last_menstrual_onset, menstruated_at_all, menstruation_2,RCD, fertile_cont,fertile_broad) ] %>% arrange(created_date) %>% head(60) %>% View()
# diary[session %contains% "8d4629", list(created_date, menstruation_dates, next_menstrual_onset, last_menstrual_onset, menstruated_at_all, menstruation_2,RCD, fertile_cont,fertile_broad) ] %>% arrange(created_date) %>% head(60) %>% View()
qplot(data = diary[!duplicated(session) & between(median_cycle_length_diary, 20,40), ], median_cycle_length_diary, cyklus_3, colour = factor(cyklus_4)) + geom_smooth(method = 'lm')
cor.test(diary[!duplicated(session) & between(median_cycle_length_diary, 20,40) & cyklus_4 > 4, ]$median_cycle_length_diary, diary[!duplicated(session) & between(median_cycle_length_diary, 20,40) & cyklus_4 > 4, ]$cyklus_3)
##
## Pearson's product-moment correlation
##
## data: diary[!duplicated(session) & between(median_cycle_length_diary, and diary[!duplicated(session) & between(median_cycle_length_diary, 20, 40) & cyklus_4 > 4, ]$median_cycle_length_diary and 20, 40) & cyklus_4 > 4, ]$cyklus_3
## t = 4.5, df = 250, p-value = 0.00001
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.1537 0.3815
## sample estimates:
## cor
## 0.2714
diary$week_number = cut(diary$day_number, c(0,7,14,21,28,35,600), include.lowest = T)
diary = diary %>%
group_by(session, cycle_nr) %>%
mutate(minimum_cycle_length_diary = if_else(!is.na(cycle_length_diary), cycle_length_diary,
max(FCD,na.rm = T)),
minimum_cycle_length_diary = if_else(minimum_cycle_length_diary == -Inf, NA_real_, minimum_cycle_length_diary)
) %>%
group_by(session) %>%
data.table()
pipeline$completed_pre_survey = nrow(xsection)
some preparations:
library(dplyr)
min_max_diff = function(x) {as.numeric(max(as.Date(x),na.rm=T) - min(as.Date(x)),na.rm=T) }
diary_summaries = diary %>%
group_by(session) %>%
summarise(took_days = min_max_diff(created),
n_days = sum(!is.na(ended) & !is.na(communication_partner_1)), # look at first item too, because some had ended due to being "closed" after some time of non-response, a software thing
avg_diff = mean(as.numeric(diff(created), units = "days"),na.rm = T),
biggest_diff = max(as.numeric(diff(created), units = "days"),na.rm = T),
had_any_period = any(menstruation_1 == 1, na.rm = T),
fertile_days_known_backward = sum(!is.na(ended) & !is.na(communication_partner_1) & !is.na(prc_stirn_b)),
fertile_days_known_backward_inferred = sum(!is.na(ended) & !is.na(communication_partner_1) & !is.na(prc_stirn_b_backward_inferred)),
fertile_days_known_forward = sum(!is.na(ended) & !is.na(communication_partner_1) & !is.na(prc_stirn_b_forward_counted))
)
diary_summaries[, any_fertile_days_known := fertile_days_known_backward_inferred > 0]
crosstabs(~ any_fertile_days_known + had_any_period, diary_summaries)
## had_any_period
## any_fertile_days_known FALSE TRUE
## FALSE 124 6
## TRUE 174 904
crosstabs(~ had_any_period + (n_days > 20), data = diary_summaries)
## n_days > 20
## had_any_period FALSE TRUE
## FALSE 229 69
## TRUE 163 747
diary_summaries[any_fertile_days_known == T, had_any_period := T]
xsection = merge(xsection, diary_summaries, by = "session", all.x = T) %>% data.table()
crosstabs(~ age + had_any_period, data = xsection[n_days > 35, ])
## had_any_period
## age FALSE TRUE
## 18 1 10
## 19 0 28
## 20 0 41
## 21 0 32
## 22 2 27
## 23 2 34
## 24 1 14
## 25 0 17
## 26 0 15
## 27 0 9
## 28 0 7
## 29 0 7
## 30 0 5
## 31 0 5
## 32 0 7
## 33 1 2
## 34 0 4
## 35 0 3
## 36 0 2
## 37 0 3
## 38 0 1
## 39 0 3
## 40 0 3
## 41 0 3
## 42 0 2
## 43 0 1
## 45 0 3
## 46 0 2
## 47 0 3
## 48 0 2
## 49 2 2
## 50 1 3
## 51 0 1
## 53 1 0
## 55 0 1
## 58 0 1
## 60 1 0
crosstabs(~ age + any_fertile_days_known, data = xsection[n_days > 35, ])
## any_fertile_days_known
## age FALSE TRUE
## 18 1 10
## 19 0 28
## 20 0 41
## 21 0 32
## 22 2 27
## 23 2 34
## 24 1 14
## 25 0 17
## 26 0 15
## 27 0 9
## 28 0 7
## 29 0 7
## 30 0 5
## 31 0 5
## 32 0 7
## 33 1 2
## 34 0 4
## 35 0 3
## 36 0 2
## 37 0 3
## 38 0 1
## 39 0 3
## 40 0 3
## 41 0 3
## 42 0 2
## 43 0 1
## 45 0 3
## 46 0 2
## 47 0 3
## 48 0 2
## 49 2 2
## 50 1 3
## 51 0 1
## 53 1 0
## 55 0 1
## 58 0 1
## 60 1 0
crosstabs(~ age + (fertile_days_known_backward > 0), data = xsection[n_days > 35, ])
## fertile_days_known_backward > 0
## age FALSE TRUE
## 18 1 10
## 19 1 27
## 20 3 38
## 21 1 31
## 22 3 26
## 23 4 32
## 24 1 14
## 25 0 17
## 26 1 14
## 27 0 9
## 28 0 7
## 29 0 7
## 30 1 4
## 31 0 5
## 32 0 7
## 33 1 2
## 34 0 4
## 35 0 3
## 36 0 2
## 37 0 3
## 38 1 0
## 39 0 3
## 40 0 3
## 41 0 3
## 42 0 2
## 43 1 0
## 45 0 3
## 46 1 1
## 47 1 2
## 48 0 2
## 49 2 2
## 50 3 1
## 51 0 1
## 53 1 0
## 55 1 0
## 58 1 0
## 60 1 0
crosstabs(~ age + (fertile_days_known_forward > 0), data = xsection)
## fertile_days_known_forward > 0
## age FALSE TRUE
## 18 7 29
## 19 6 68
## 20 8 85
## 21 8 104
## 22 9 96
## 23 11 118
## 24 7 101
## 25 3 73
## 26 5 80
## 27 5 47
## 28 7 39
## 29 3 32
## 30 5 24
## 31 0 16
## 32 0 20
## 33 4 23
## 34 1 11
## 35 0 11
## 36 0 13
## 37 1 9
## 38 0 9
## 39 1 12
## 40 1 9
## 41 1 8
## 42 0 3
## 43 0 3
## 44 0 7
## 45 2 7
## 46 0 3
## 47 1 7
## 48 1 3
## 49 3 6
## 50 3 8
## 51 1 3
## 52 2 1
## 53 3 2
## 54 1 0
## 55 1 1
## 57 0 1
## 58 1 1
## 60 2 0
## 69 0 1
unique(xsection[n_days > 0, list(age, n_days, fertile_days_known_forward, fertile_days_known_backward, had_any_period,any_fertile_days_known)]) %>% arrange(age) %>% tail(40)
unique(xsection[n_days >= 30, list(age, n_days, fertile_days_known_forward, fertile_days_known_backward, had_any_period,any_fertile_days_known)]) %>% arrange(age) %>% tail(40)
xsection[age > 45 & !had_any_period, any_fertile_days_known := FALSE]
unique(xsection[n_days >= 30 & any_fertile_days_known == T, list(age, n_days, fertile_days_known_forward, fertile_days_known_backward, had_any_period,any_fertile_days_known)]) %>% arrange(age) %>% tail(40)
excluded_old = NULL
xsection[, include_all := T] # default is to include everybody
xsection[ include_all == T, include_all := !is.na(n_days) & n_days > 0] # ever responded to diary
pipeline$never_did_diary = n_excluded(xsection$include_all)
## 54 excluded
xsection[str_sub(session, 1,10) == "cd78621db4", include_all := F] # reported hormonal treatment in preparation for IVF
xsection[ include_all == T, include_all := ! pregnant %contains% "1"] # only non-pregnant (in last 3 months)
pipeline$pregnant = n_excluded(xsection$include_all)
## 24 excluded
xsection[ include_all == T, include_all := ! contraception %contains_word% "infertile"] # only not infertile
pipeline$infertile = n_excluded(xsection$include_all)
## 5 excluded
xsection[ include_all == T, include_all := ! contraception %contains_word% "sterilised"] # only non-pregnant (in last 3 months)
pipeline$sterilised = n_excluded(xsection$include_all)
## 12 excluded
xsection[ include_all == T, include_all := any_fertile_days_known] # only those where we could infer fertility on at least one day
pipeline$fertility_not_estimable = n_excluded(xsection$include_all)
## 59 excluded
# here we allow those who breastfed in last 3 months, because those we excluded those with lactational amenorrhoe already above
# xsection[ include_all == T, include_all := ! breast_feeding %contains% "1"] # only non-breast_feeding
# n_excluded(xsection$include_all)
xsection[, hormonal_all := include_all]
pipeline$naturally_cycling = sum(xsection[ include_all == T,
! contraception %contains% "contraceptive_pill" &
!contraception %contains% "other_hormonal"], na.rm = T)
xsection[ include_all == T, include_all :=
! contraception %contains% "contraceptive_pill" &
!contraception %contains% "other_hormonal"] # only non-hormonally contracepting, in this case we leave women who take the morning after pill with the naturally cycling women
pipeline_hc$HC_users = sum(xsection[ hormonal_all == T,
contraception %contains% "contraceptive_pill" |
contraception %contains% "other_hormonal"], na.rm = T)
xsection[ hormonal_all == T, hormonal_all :=
contraception %contains% "contraceptive_pill" |
contraception %contains% "other_hormonal"] # only hormonally contracepting
xsection[, included_bool := include_all & !hormonal_all]
xsection[hormonal_all == F & include_all == F, included_bool := NA]
xsection[, included_all := factor(ifelse(included_bool, "cycling", "horm_contra"))]
crosstabs(~ included_all, xsection)
## included_all
## cycling horm_contra
## 429 625
429 non-hormonally contracepting women and 625 hormonally contracepting women are included in the sample with only mandatory exclusion criteria.
excluded_old = NULL
xsection[, include_lax := include_all] # default is to include everybody
n_excluded(xsection$include_lax)
## 779 excluded
## [1] 779
xsection[ include_lax == T, include_lax := age < 40] # include only those who are younger than 40
pipeline$older_than_40 = n_excluded(xsection$include_lax)
## 54 excluded
xsection[ include_lax == T, include_lax := ! is.na (ended.abschluss)] # include only those who finished the abschluss survey
pipeline$finished_post_survey = n_excluded(xsection$include_lax)
## 137 excluded
xsection[ include_lax == T, include_lax := ! contraception %contains% "contraceptive_pill" & ! contraception %contains% "morning_after_pill" & !contraception %contains% "other_hormonal" & !contraception %contains% "infertile"] # only non-hormonally contracepting
pipeline$hc_users_broad = n_excluded(xsection$include_lax)
## 2 excluded
xsection[ include_lax == T, include_lax := ! breast_feeding %contains% "1"] # only non-breast_feeding
pipeline$breast_feeding = n_excluded(xsection$include_lax)
## 6 excluded
xsection[ include_lax == T, include_lax := !pille_control %contains% "1"] # pill in the last 3 months
pipeline$pill_last_3m = n_excluded(xsection$include_lax)
## 14 excluded
xsection[ include_lax == T, include_lax := !antibiotics %contains% "1"] # no hormonal medication
pipeline$hormonal_medicine = n_excluded(xsection$include_lax)
## 25 excluded
table(xsection$cyklus_3) #show cycle lengths
##
## 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
## 13 22 7 23 28 87 66 57 504 84 150 29 31 13 9 36 2 2 2 1 42
xsection[, hormonal_contra := contraception %contains% "contraceptive_pill" & ! contraception %contains% "morning_after_pill" & !contraception %contains% "other_hormonal" & !contraception %contains% "infertile"]
crosstabs(~ xsection$hormonal_contra + xsection$cyklus_4)
## xsection$cyklus_4
## xsection$hormonal_contra 1 2 3 4 5
## FALSE 62 66 119 169 189
## TRUE 33 46 95 194 234
## <NA> 0 0 0 1 0
xtabs(~ cyklus_3 + cyklus_4, data = xsection)
## cyklus_4
## cyklus_3 1 2 3 4 5
## 20 4 0 1 4 4
## 21 1 3 4 7 7
## 22 2 1 1 2 1
## 23 1 1 10 7 4
## 24 2 0 3 14 9
## 25 16 13 17 26 15
## 26 4 4 11 33 14
## 27 4 9 12 16 16
## 28 17 28 70 141 248
## 29 1 5 15 34 29
## 30 17 26 39 42 26
## 31 3 0 4 12 10
## 32 3 7 6 5 10
## 33 0 3 3 4 3
## 34 0 1 2 3 3
## 35 4 4 9 7 12
## 36 1 0 0 0 1
## 37 0 0 1 0 1
## 38 1 0 0 1 0
## 39 0 0 1 0 0
## 40 14 7 5 6 10
xsection[ include_lax == T, include_lax := cyklus_3 > 21 & cyklus_3 < 38] #exclude those with wrong cycle lengths
pipeline$long_or_short_cycle = n_excluded(xsection$include_lax)
## 10 excluded
crosstabs(~ include_lax + hypothesis_guessed, data = xsection)
## hypothesis_guessed
## include_lax hormones menstruation pille zyklus zyklus, pille
## FALSE 986 6 1 3 29 1
## TRUE 157 0 0 3 21 0
## <NA> 1 0 0 0 0 0
xsection[ include_lax == T, include_lax := is.na(hypothesis_guessed) | ! hypothesis_guessed %contains% "zyklus"] #exclude those who guessed hypotheses
pipeline$guessed_hypothesis = n_excluded(xsection$include_lax)
## 21 excluded
xsection[ include_lax == T, include_lax := !(took_days > 70 | avg_diff > 10)] #exclude laggards
pipeline$laggards = n_excluded(xsection$include_lax)
## 17 excluded
pipeline$criterion_lax = sum(xsection$include_lax, na.rm = T)
143 non-hormonally contracepting women and 0 hormonally contracepting women are included in the sample with lax inclusion criteria.
excluded_old = NULL
xsection[, hormonal_lax := hormonal_all] # default is to include everybody
n_excluded(xsection$hormonal_lax)
## 583 excluded
## [1] 583
xsection[ hormonal_lax == T, hormonal_lax := age < 40] # include only those below 40
pipeline_hc$older_than_40 = n_excluded(xsection$hormonal_lax)
## 10 excluded
xsection[ hormonal_lax == T, hormonal_lax := ! is.na (ended.abschluss)] # include only those who finished the abschluss survey
pipeline_hc$finished_post_survey = n_excluded(xsection$hormonal_lax)
## 168 excluded
xsection[ hormonal_lax == T, hormonal_lax := ! breast_feeding %contains% "1"] # only non-breast_feeding
pipeline_hc$breast_feeding = n_excluded(xsection$hormonal_lax)
## 2 excluded
xsection[ hormonal_lax == T, hormonal_lax := cyklus_3 > 21 & cyklus_3 < 38] #exclude those with wrong cycle lengths
pipeline_hc$long_or_short_cycle = n_excluded(xsection$hormonal_lax)
## 28 excluded
xsection[ hormonal_lax == T, hormonal_lax := ! hypothesis_guessed %contains% "zyklus" & ! hypothesis_guessed %contains% "hormones"] #exclude those who guessed hypotheses
pipeline_hc$guessed_hypothesis = n_excluded(xsection$hormonal_lax)
## 19 excluded
xsection[ hormonal_lax == T, hormonal_lax := !(took_days > 70 | avg_diff > 10)] #exclude laggards
pipeline_hc$laggards = n_excluded(xsection$hormonal_lax)
## 24 excluded
xsection[, included_bool := include_lax & !hormonal_lax]
xsection[hormonal_lax == F & include_lax == F, included_bool := NA]
xsection[, included_lax := factor(ifelse(included_bool, "cycling", "horm_contra"))]
is.na(xsection$included_lax)[is.na(xsection$included_bool)] <- TRUE
crosstabs( ~factor(xsection$included_lax,exclude = NULL))
## factor(xsection$included_lax, exclude = NULL)
## cycling horm_contra <NA>
## 143 374 691
pipeline_hc$criterion_lax = sum(xsection$hormonal_lax, na.rm = T)
excluded_old = NULL
xsection[, include_conservative := include_lax]
n_excluded(xsection$include_conservative)
## 1065 excluded
## [1] 1065
xsection[include_conservative == T, include_conservative := ! cigarettes > 10]
pipeline$heavy_smokers = n_excluded(xsection$include_conservative)
## 4 excluded
xsection[include_conservative == T, include_conservative := ! intensive_sports > 7]
pipeline$intensive_sports = n_excluded(xsection$include_conservative)
## 6 excluded
xsection[include_conservative == T, include_conservative := ! breakup == 1]
pipeline$broke_up = n_excluded(xsection$include_conservative)
## 3 excluded
xsection[include_conservative == T, include_conservative := ! change_contraception_1 %contains% "1"]
pipeline$changed_contraception = n_excluded(xsection$include_conservative)
## 0 excluded
xsection[include_conservative == T, include_conservative := weight_post - weight > -8]
pipeline$lost_more_than_8kg = n_excluded(xsection$include_conservative)
## 2 excluded
xsection[, BMI := ((weight_post + weight)/2) /((height/100)^2)] #creating new variable "BMI" in dataset
qplot(xsection$BMI)
xsection[include_conservative == T, include_conservative := BMI > 17]
pipeline$BMI_lt_17 = n_excluded(xsection$include_conservative)
## 3 excluded
xsection[include_conservative == T, include_conservative := BMI < 30]
pipeline$BMI_gt_30 = n_excluded(xsection$include_conservative)
## 8 excluded
table(xsection$cyklus_5) #show if and how much cycle was off during the last three months
##
## 1 2 3
## 779 237 192
xtabs(~ cyklus_5 + cyklus_6, data = xsection)
## cyklus_6
## cyklus_5 1 2 3 4 5
## 1 18 10 23 128 600
## 2 9 15 34 72 107
## 3 22 4 12 31 123
xsection[include_conservative == T, include_conservative := cyklus_5 < 3 | cyklus_6 == 5] #exclude those with irregular cycles, IF they have expressed some certainty in this
pipeline$confident_that_cycle_irregular = n_excluded(xsection$include_conservative)
## 5 excluded
pipeline$criterion_conservative = sum(xsection$include_conservative, na.rm = T)
excluded_old = NULL
xsection[, hormonal_conservative := hormonal_lax]
n_excluded(xsection$hormonal_conservative)
## 834 excluded
## [1] 834
xsection[hormonal_conservative == T, hormonal_conservative := ! cigarettes > 10]
pipeline_hc$heavy_smokers = n_excluded(xsection$hormonal_conservative)
## 10 excluded
xsection[hormonal_conservative == T, hormonal_conservative := ! intensive_sports > 7]
pipeline_hc$intensive_sports = n_excluded(xsection$hormonal_conservative)
## 18 excluded
xsection[hormonal_conservative == T, hormonal_conservative := ! breakup == 1]
pipeline_hc$broke_up = n_excluded(xsection$hormonal_conservative)
## 10 excluded
xsection[hormonal_conservative == T, hormonal_conservative := ! change_contraception_1 %contains% "1"]
pipeline_hc$changed_contraception = n_excluded(xsection$hormonal_conservative)
## 14 excluded
xsection[hormonal_conservative == T, hormonal_conservative := weight_post - weight > -8]
pipeline_hc$lost_more_than_8kg = n_excluded(xsection$hormonal_conservative)
## 6 excluded
xsection[, BMI := ((weight_post + weight)/2) /((height/100)^2)] #creating new variable "BMI" in dataset
qplot(xsection$BMI)
xsection[hormonal_conservative == T, hormonal_conservative := BMI > 17]
pipeline_hc$BMI_lt_17 = n_excluded(xsection$hormonal_conservative)
## 7 excluded
xsection[hormonal_conservative == T, hormonal_conservative := BMI < 30]
pipeline_hc$BMI_gt_30 = n_excluded(xsection$hormonal_conservative)
## 10 excluded
table(xsection$cyklus_5) #show if and how much cycle was off during the last three months
##
## 1 2 3
## 779 237 192
xtabs(~ cyklus_5 + cyklus_6, data = xsection)
## cyklus_6
## cyklus_5 1 2 3 4 5
## 1 18 10 23 128 600
## 2 9 15 34 72 107
## 3 22 4 12 31 123
xsection[hormonal_conservative == T, hormonal_conservative := cyklus_5 < 3 | cyklus_6 == 5] #exclude those with irregular cycles, IF they have expressed some certainty in this
pipeline_hc$confident_that_cycle_irregular = n_excluded(xsection$hormonal_conservative)
## 6 excluded
xsection[, included_bool := include_conservative & ! hormonal_conservative]
xsection[ hormonal_conservative == F & include_conservative == F, included_bool := NA]
xsection[, included_conservative := factor(ifelse(included_bool, "cycling", "horm_contra"))]
is.na(xsection$included_conservative)[is.na(xsection$included_bool)] <- TRUE
crosstabs( ~factor(xsection$included_conservative,exclude = NULL))
## factor(xsection$included_conservative, exclude = NULL)
## cycling horm_contra <NA>
## 112 294 802
pipeline_hc$criterion_conservative = sum(xsection$hormonal_conservative, na.rm = T)
112 non-hormonally contracepting women and 293 hormonally contracepting women are included in the sample with conservative exclusion criteria.
excluded_old = NULL
xsection[, include_strict := include_conservative]
n_excluded(xsection$include_strict)
## 1096 excluded
## [1] 1096
xsection[include_strict == T, include_strict := cyklus_5 < 3] #exclude those with irregular cycles, even the uncertain ones
pipeline$cycle_possibly_irregular = n_excluded(xsection$include_strict)
## 12 excluded
xsection[include_strict == T, include_strict := ! stress == 1]
pipeline$stressed = n_excluded(xsection$include_strict)
## 43 excluded
pipeline$criterion_strict = sum(xsection$include_strict, na.rm = T)
excluded_old = NULL
xsection[, hormonal_strict := hormonal_conservative]
n_excluded(xsection$hormonal_strict)
## 915 excluded
## [1] 915
xsection[hormonal_strict == T, hormonal_strict := cyklus_5 < 3] #exclude those with irregular cycles, even the uncertain ones
pipeline_hc$cycle_possibly_irregular = n_excluded(xsection$hormonal_strict)
## 12 excluded
xsection[hormonal_strict == T, hormonal_strict := ! stress == 1]
pipeline_hc$stressed = n_excluded(xsection$hormonal_strict)
## 120 excluded
pipeline_hc$criterion_strict = sum(xsection$hormonal_strict, na.rm = T)
xsection[, included_bool := include_strict & ! hormonal_strict]
xsection[ hormonal_strict == F & include_strict == F, included_bool := NA]
xsection[, included_strict := factor(ifelse(included_bool, "cycling", "horm_contra"))]
is.na(xsection$included_strict)[is.na(xsection$included_bool)] <- TRUE
crosstabs( ~factor(xsection$included_strict,exclude = NULL))
## factor(xsection$included_strict, exclude = NULL)
## cycling horm_contra <NA>
## 57 162 989
crosstabs(~ factor(included_strict, exclude = NULL), xsection[!is.na(included_strict), ])
## factor(included_strict, exclude = NULL)
## cycling horm_contra
## 57 162
57 non-hormonally contracepting women and 161 hormonally contracepting women are included in the sample with overly strict exclusion criteria.
crosstabs(~ factor(included_strict, exclude = NULL), xsection[!is.na(included_strict), ])
## factor(included_strict, exclude = NULL)
## cycling horm_contra
## 57 162
xsection$included_levels = ifelse(!is.na(xsection$included_all),"all", NA_character_)
xsection$included_levels = ifelse(!is.na(xsection$included_lax), "lax", xsection$included_levels)
xsection$included_levels = ifelse(!is.na(xsection$included_conservative), "conservative", xsection$included_levels)
xsection$included_levels = ifelse(!is.na(xsection$included_strict), "strict", xsection$included_levels)
xsection$included_levels = factor(xsection$included_levels, levels = c("all", "lax", "conservative", "strict"))
xsection[, hormonal := contraception %contains% "contraceptive_pill" | contraception %contains% "other_hormonal"]
crosstabs(~ factor(xsection$included_levels, exclude = NULL))
## factor(xsection$included_levels, exclude = NULL)
## all lax conservative strict <NA>
## 537 111 187 219 154
crosstabs(~ factor(included_levels, exclude = NULL) + hormonal, data = xsection)
## hormonal
## factor(included_levels, exclude = NULL) FALSE TRUE <NA>
## all 286 251 0
## lax 31 80 0
## conservative 55 132 0
## strict 57 162 0
## <NA> 85 68 1
See descriptives.
library(DiagrammeR)
pipeline$hc = pipeline_hc
save(pipeline, file = "pipeline.rdata")
Save the data.
new_names = c("session", setdiff(names(xsection), prev_names))
diary = merge(xsection %>% select(one_of(new_names)), diary, by = "session", all.x = T)
save( xsection, diary, file = "full_data.rdata")


This is a simple Bankruptcy Prediction Machine Learning website with few features as input.
Below are our services. Please click one of them to get started.


Public Types | |
| typedef untyped_sender | predecessor_type |
| The predecessor type for this node. | |
|
typedef internal::edge_container < predecessor_type > | built_predecessors_type |
|
typedef built_predecessors_type::edge_list_type | predecessor_list_type |
Public Member Functions | |
| virtual | ~untyped_receiver () |
| Destructor. | |
| template<typename X > | |
| bool | try_put (const X &t) |
| Put an item to the receiver. | |
| virtual bool | register_predecessor (predecessor_type &) |
| Add a predecessor to the node. | |
| virtual bool | remove_predecessor (predecessor_type &) |
| Remove a predecessor from the node. | |
| virtual built_predecessors_type & | built_predecessors ()=0 |
| virtual void | internal_add_built_predecessor (predecessor_type &)=0 |
| virtual void | internal_delete_built_predecessor (predecessor_type &)=0 |
| virtual void | copy_predecessors (predecessor_list_type &)=0 |
| virtual size_t | predecessor_count ()=0 |
Protected Member Functions | |
| template<typename X > | |
| task * | try_put_task (const X &t) |
| virtual task * | try_put_task_wrapper (const void *p, bool is_async)=0 |
| virtual graph & | graph_reference ()=0 |
| virtual void | reset_receiver (reset_flags f=rf_reset_protocol)=0 |
| put receiver back in initial state | |
| virtual bool | is_continue_receiver () |


One: Play the first beat of every bar.
Reverse: Play all beats in reverse order.
Origininal: Play the original track.


Profile
username
stevewoz1
name
steve woz
bio
ios developer
email
<EMAIL_ADDRESS>usertype
programmer
skills
objective-C, swift, C, C++, Java
experience
12 years experience in Java
23 Android Apps
edit profile
change email address
change password


The Cheese Shrine
Get to know my favorite kinds of cheese.
Cheddar Cheese
Cheddar cheese is a relatively hard, off-white, sometimes sharp-tasting, natural cheese.
Originating in the English village of Cheddar in Somerset, cheeses of this style are now produced beyond the region and in several countries around the world.
Brie
Brie is a soft cow's-milk cheese named after Brie, the French region from which it originated.
It is pale in color with a slight grayish tinge under a rind of white mould. The rind is typically eaten, with its flavor depending largely upon the ingredients used and its manufacturing environment.


Ping-Pong
About Ping Pong
Created By:
Said Ahmed
More Information on Ping-Pong:
Lorem ipsum dolor sit amet.
Lorem ipsum dolor sit amet.
Lorem ipsum dolor sit amet.
Let's play!
Rules:
Ping Pong will count up to your number from 1 with the following exceptions:
Numbers divisible by 3 are replaced with "ping"
Numbers divisible by 5 are replaced with "pong"
Numbers divisible by 15 are replaced with "ping-pong"
Enter your number:
Submit


“Divāvihārā nikkhamma,
gijjhakūṭamhi pabbate;
Nāgaṁ ogāhamuttiṇṇaṁ,
nadītīramhi addasaṁ.
Leaving my day’s meditation
on Vulture’s Peak Mountain,
I saw an elephant on the riverbank
having just come up from his bath.
Puriso aṅkusamādāya,
‘dehi pādan’ti yācati;
Nāgo pasārayī pādaṁ,
puriso nāgamāruhi.
A man, taking a pole with a hook,
asked the elephant, “Give me your foot.”
The elephant presented his foot,
and the man mounted him.
Disvā adantaṁ damitaṁ,
manussānaṁ vasaṁ gataṁ;
Tato cittaṁ samādhesiṁ,
khalu tāya vanaṁ gatā”ti.
Seeing a wild beast so tamed,
submitting to human control,
my mind became serene:
*that* is why I’ve gone to the forest!
… Dantikā therī ….


Need assistance?
Our help document assists you to know more about FileExplorer control.
Please refer ->
Help Document


Analyze chess positions to find your strength.
A chess rating is a system used to calculate an estimate of the strength of the player when compared to other players. However...
 One does not know where they are weak. Our app fixes that.
It's Over 9000! determines your estimated playing strength during different phases of a chess game, from opening to endgame.
Our AI has combed through millions of games to assess the strength of any given position.
Normal chess engines will not explain why one position is stronger than another. They try to do everything, unlike the focused design of It's Over 9000!


Status
Pause
Completed
0
Status
Pause
Completed
0
Your browser does not support the HTML5 canvas tag.
Start


HOME
ABOUT ME
MY BLOGS
✍ My Blogs ✍
Sprint 1 | Core Blog: My Identity & Values
Sprint 2 | Tech Blog: CSS Positionings
Sprint 2 | Core Blog: My Foundations Learning Plan
Sprint 3 | Core Blog: Emotional Intelligence
Sprint 3 | Tech Blog: Java & The DOM
Sprint 4 | Core Blog: Neuroplasticity & Mindset
Sprint 4 | Tech Blog: Problem Solving
Sprint 5 | Core Blog: Post Foundations Reflections
Sprint 5 | Core Blog: My Bootcamp Learning Plan


| Source | Status | Merged | |
| {{attrEntry.record.filename}} | User-entered | {{attrEntry.merge_reason}} | {{attrEntry.merged | date:'short'}} |
| {{attrEntry.record.filename}} | User-entered | {{attrEntry.merge_reason}} | {{attrEntry.merged | date:'short'}} |
| Term | Number reported (out of {{totalReports}} ) |
| {{event.term}} | {{event.count | number:2}} % |


Span Tag Demo
Main Content
Div 1
Div 2
This is the first line. This is Span 1's Content. This is Span 2's Content.
Main Content
This is the first line. This is Span 1's Content. This is Span 2's Content.


W
rld Conqueror
v{{game.version}}
Governance
Construction
Military
Research
War
Current turn: {{game.myCountry.baseStats.currentTurn}}
Reset
Land +100
Units +100
Unlock Structures +10
Add Science +1k
Stability +10
Stability -10
StabilityIndex +1
StabilityIndex -1


[§78-1.5] Definitions. As used herein, unless the context clearly requires otherwise, the terms "appointing authority", "chief executive", "director", "employee", "employer", and "jurisdiction" shall have the same meaning as those terms are defined in section 76-11. [L 2000, c 253, pt of §74]


Over at The Dabbler today you will find Old Key's Almanacke, a list of a dozen prognostications of what will befall us in the coming twelvemonth. The spooky thing about Old Key is that he has been proved unerringly accurate, time and time again. I am not entirely sure who he is, or was, other than that his papers were discovered in a shoebox underneath a sink in a cubby in an old manse perched on a windswept hillside. The papers, bound into a series of Almanackes, had been piddled upon by generations of feral cats. On the rotting linoleum next to the shoebox lay a wand and a pointy hat. They too had been piddled upon, by something bigger and more terrible than a feral cat.


Create an account
Log in
Try your luck every hour playing our simple game and you could win up to $100 in free bitcoins black!
Winning chance of big prizes
1 : 100!
Participate in Weekly Jackpot contest!
Refer your friends after singing up and get 50% of free bitcoins black program!
User friendly mobile wallets. Send money as simple as sending a text message.


char
type used in addition or subtraction expressions.
Such code is not necessarily an issue but may result in bugs (for example, if a string is expected).
Example: int a = 'a' + 42;
After the quick-fix is applied: int a = (int) 'a' + 42;
For the String
context:
int i1 = 1;
int i2 = 2;
System.out.println(i2 + '-' + i1 + " = " + (i2 - i1));
After the quick-fix is applied:
System.out.println(i2 + "-" + i1 + " = " + (i2 - i1));


Home
Installation
Web Panel
Logout
Hawkchat
A intuitive support web application for businesses.
You're currently logged in.
View Applications
Home
Installation
Web Panel
Terms of Service
Privacy Policy
All rights reserved.


--- layout: default title: "Members" description: "" group: navigation navorder: 2 --- {% include JB/setup %}
{% for position in site.data.jobtypes %} {% assign people = site.data.members | where: "position", position[0] %} {% assign current_people = '' | split: '' %} {% for person in people %} {% unless person.departed %} {% assign counter = "*" | split: '' | first | split: '' %} {% assign current_people = current_people | concat: counter %} {% endunless %} {% endfor %} {% assign current_count = current_people.size %} {% if current_count == 0 %} {% continue %} {% else %}| Name | Position | Dates | Last Whereabouts |
|---|---|---|---|
| {{ member.name }} | {{ site.data.jobtypes[member.position][0] }} | {{ member.joined | date: "%b %y" }} - {{ member.departed | date: "%b %y" }} | {{ member.whereabouts }} |


Pause
Resume
/
Volume:
01. Voices of Winter.mp3
02. Eternal Winter.mp3
03. Rounds of the Fates.mp3
04. Redemption and Forgiveness.mp3
05. Little Dancing Light.mp3
06. Of Noble Blood.mp3
07. Dark Anomaly.mp3
08. Frozen Grief.mp3
09. Town by the Sea.mp3
10. Song in the Wind.mp3
11. Old Hearth.mp3
12. Sorrowful Winds.mp3
13. Safe Haven.mp3
14. The Warmth of Hope.mp3
15. What Meets the Eye.mp3
16. The Power of Time.mp3
17. Frozen Highlands.mp3
18. The Forrest of Light.mp3
19. Hidden Motives.mp3
20. The Last Stretch.mp3
21. Once Upon a Time.mp3
22. The Ancient Bloodline.mp3
23. Whisper to the Heart.mp3
24. Like a Boss!.mp3
25. Stories of Old.mp3
26. Beyond the Snow (ft. Kotringo).mp3
27. An End to the Journey.mp3


TINMEN is office food delivery startup. They have 500 repeated customers in cyberabad area. most of their customers are software employees. they offer a unique ad-space, which is their food packing covers.
WeShtul is a hyper local delivery service provider. They have unique customer base of 200 customers everyday. Most of the customers are food lovers and order their food online. they offered a unique ad-space. which is distribution of flyers and coupen codes.
T-hub is a startup community and co-working space. Mostly t-hub members are startups, but they have on-board guests who are investors. and t-hub offers their TV network as a space. and entrance of t-hub also.


Data Engineer professional with a strong foundation in software engineering and development principles across multiple platforms. Very detail oriented when it comes to working with data, and enjoys solving problems using data. Experienced in object-oriented programming; developing, testing and debugging code, and designing interfaces. Can quickly learn and use new technologies; successful working in both team and self-directed settings.
Relevant Courses
A RESTful API meant to help you manage the selling and donating of tickets for shows within your own theater. Details of the project requirements can be found here
Utilized
Based on Chicago Police Department (CPD) dispatch data, analysis was done to figure out when the most crime (as well as the type of crime) would occur. The dataset included 1.6 million records and included features such as squad car number, type of crime, and time an officer spent on a specific call.
Utilized
Android application for those who want to keep a close eye on the stock market. Can search stocks by company and follow them.
Utilized
Based on your location, this Android application shows you local government officials, their party affiliation, contact information, and links to their social media accounts.
Utilized
I was born and raised in the beautiful city of Chicago. As a result, I love to venture around my city at all times of the year (yes, even in the winter). I am a die hard Chicago sports fan. Yes, I go for the Sox and the Cubs, but if I were to choose between one or the other, it would be the Sox!
My favorite movies are those coming out of the Marvel Cinematic Universe (MCU). Here are my top 5 movies in no particular order ;) (as of April 2022)
Some of my hobbies include


- Consulting
- Financial Planning
- Investment Management
- Individual Taxes
CHOOSE PLAN
Market & Strategic Review
- Business Succession Planning
- Data Analytics and Insights
- Executive search
- Organizational benchmarking
CHOOSE PLAN
- Bookkeeping, Annual Reports
- Business Taxes
- Audits, Accounting
- Aonsulting and Accounting Solutions
CHOOSE PLAN


Using your email address as username and this password, you may publish to the Basic Publish or SWORD interfaces your own digitally signed resource data envelopes.
The following will be appended to the resource data document's identity signer field along with your email address so that your submissions may be identified.
Use the following when connecting your application to LR to sign on your behalf. If the OAuth signature is present when you publish, the documents you publish will be signed by the node.


Mbappe With Ronaldo-Like Reaction To Substitution, Coach Responds
by David KappelIt seems Cristiano Ronaldo is not the only player who reacts with frustration to being substituted in recent times, with Kylian Mbappe visibly annoyed when he was replaced on the weekend, and his coach has since commented on the incident.
Read: The Best Players In Europe Revealed: CR7 Not in Top 20
The French sensation was on the scoresheet as PSG came from a goal behind to beat Keagan Dolly's Montpellier 3-1 on Saturday.
However, it was not all rosy as Mbappe snubbed Thomas Tuchel's handshake after being taken off in the 90th minute for Eric Maxim Choupo-Moting.
The German coach, though, has since downplayed the incident, which many compared to Ronaldo's recent reaction to being substituted by Maurizio Sarri.
Earn Airtime & Data With Soccer Laduma's Social Media App - Download Now
"Mbappe never wants to be substituted – it's understandable, and it's quite obvious," Tuchel said, as quoted by AS.
"He didn't want to be taken off in the Nantes games and he didn't want to come off today.
"On 90 minutes, I decided to take him off, but now it's all been forgotten about. It was my decision.
"Choupo deserved to play – we need to respect that and that is in line with the decisions I take. Mbappe isn't happy when he's substituted, but it's no big deal."
Read: Best XI To Never Win The Ballon d'Or
Mbappe has missed six Ligue 1 games this season already, but has scored seven goals and provided four assists in his 10 league appearances for his club so far in this campaign.


With your permission, we can send you push notifications. These notifications will typically be sent when someone in your local area needs help.


The Interpolate Points tool allows you to predict values at new locations based on measurements from a collection of points. The tool takes point data with values at each point and returns areas classified by predicted values. For example
The point layer to use as the basis of interpolation.
In addition to choosing a layer from your map, you can select Choose Living Atlas Analysis Layer or Choose Analysis Layer found at the bottom of the drop-down list. This opens a gallery containing a collection of layers useful for many analyses.
Choose the field containing the values you wish to interpolate.
Choose your preference for speed versus accuracy. More accurate predictions take longer to calculate.
If checked, a layer of standard errors for the interpolation predictions will be created. The name of the output layer will be the result layer name with 'Errors' appended.
Standard errors are useful because they provide information about the reliability of the predicted values. A simple rule of thumb is that the true value will fall within two standard errors of the predicted value 95 percent of the time. For example, suppose a new location gets a predicted value of 50 with a standard error of 5. This means that this tool's best guess is that the true value at that location is 50, but it reasonably could be as low as 40 or as high as 60. To calculate this range of reasonable values, multiply the standard error by 2, add this value to the predicted value to get the upper end of the range, and subtract it from the predicted value to get the lower end of the range.
Choose how predicted values will be classified into areas.
Specifies the number of classes (range of predicted values) in the result layer. Each class defines the boundary of areas. The values of these classes will be determined by the Classify by parameter above.
Enter the desired class break values separated by spaces. For
example, if you want class breaks at values of 1.5, 3, and 7, enter
1.5 3 7
. These values will define the upper limit of each class, so the
number of classes will equal the number of entered values. Areas
will not be created for any locations with predicted values above
the largest entered break value. You must enter at least two values
and no more than 32.
Either draw or provide a layer specifying the area where you want the result to be drawn. For example, if you are interpolating lake pollution measurements, you can use the boundary of the lake in this parameter and the output will only draw within the boundary of the lake.
Either draw or provide a layer specifying point locations to calculate prediction values. This allows you to make predictions at specific locations of interest. For example, if the input layer represents measurements of pollution levels, you can use this parameter to predict the pollution levels of locations with large at-risk populations, such as schools or hospitals. You can then use this information to give recommendations to health officials in those locations.
If supplied, this tool will output a point layer of predictions at the specified locations. The name of the output layer will be the result layer name with 'Points' appended.
This is the name of the layer that will be created in My Content and added to the map. The default name is based on the tool name and the input layer name. If the layer already exists, you will be asked to provide another name.
Using the Save result in drop-down box, you can specify the name of a folder in My Content where the result will be saved.