Deployable Tabular Transformers for Live Birth Prediction in IVF: Balancing Predictive Power and Interpretability in Clinical Decision Support Systems (HFEA 2015/16 Records)
2026-07-02
Packages
library(pacman)Warning: package 'pacman' was built under R version 4.6.1p_load(tidyverse, tidymodels, skimr, janitor, tabnet, torch, vip, themis, doParallel, parallel, ComplexUpset)Load file
# 1st file
hfea_2015_2016 <- read_csv("2015-2016-xlsb.csv", col_types = cols(), na = "NA")Warning: One or more parsing issues, call `problems()` on your data frame for details,
e.g.:
dat <- vroom(...)
problems(dat)hfea_2015_2016 |> skim()| Name | hfea_2015_2016 |
| Number of rows | 158519 |
| Number of columns | 95 |
| _______________________ | |
| Column type frequency: | |
| character | 27 |
| logical | 9 |
| numeric | 59 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| Patient Age at Treatment | 0 | 1 | 3 | 7 | 0 | 7 | 0 |
| Total Number of Previous cycles, Both IVF and DI | 0 | 1 | 1 | 3 | 0 | 7 | 0 |
| Total Number of Previous treatments, Both IVF and DI at clinic | 0 | 1 | 1 | 3 | 0 | 7 | 0 |
| Total Number of Previous IVF cycles | 0 | 1 | 1 | 3 | 0 | 7 | 0 |
| Total Number of Previous DI cycles | 0 | 1 | 1 | 3 | 0 | 7 | 0 |
| Main Reason for Producing Embroys Storing Eggs | 0 | 1 | 0 | 51 | 10413 | 13 | 0 |
| Type of Ovulation Induction | 0 | 1 | 0 | 20 | 57311 | 3 | 0 |
| Egg Donor Age at Registration | 0 | 1 | 0 | 17 | 150808 | 6 | 0 |
| Sperm Donor Age at Registration | 0 | 1 | 0 | 17 | 137451 | 8 | 0 |
| Type of treatment - IVF or DI | 0 | 1 | 2 | 3 | 0 | 2 | 0 |
| Specific treatment type | 0 | 1 | 3 | 27 | 0 | 19 | 0 |
| Egg Source | 0 | 1 | 0 | 7 | 10413 | 3 | 0 |
| Sperm From | 0 | 1 | 5 | 15 | 0 | 4 | 0 |
| Fresh Eggs Collected | 0 | 1 | 0 | 4 | 10413 | 53 | 0 |
| Early Outcome | 0 | 1 | 0 | 61 | 31520 | 18 | 0 |
| Heart One Weeks Gestation | 0 | 1 | 0 | 21 | 121177 | 14 | 0 |
| Heart One Birth Outcome | 0 | 1 | 0 | 30 | 115208 | 8 | 0 |
| Heart One Birth Weight | 0 | 1 | 0 | 24 | 121341 | 13 | 0 |
| Heart OneSex | 0 | 1 | 0 | 1 | 121067 | 3 | 0 |
| Heart Two Weeks Gestation | 0 | 1 | 0 | 21 | 153516 | 14 | 0 |
| Heart Two Birth Outcome | 0 | 1 | 0 | 30 | 152829 | 6 | 0 |
| Heart Two Birth Weight | 0 | 1 | 0 | 24 | 153577 | 13 | 0 |
| Heart Two Sex | 0 | 1 | 0 | 1 | 153510 | 3 | 0 |
| Heart Three Weeks Gestation | 0 | 1 | 0 | 21 | 158396 | 14 | 0 |
| Heart Three Birth Outcome | 0 | 1 | 0 | 16 | 158360 | 5 | 0 |
| Heart Three Birth Weight | 0 | 1 | 0 | 24 | 158401 | 8 | 0 |
| Heart Three Sex | 0 | 1 | 0 | 1 | 158396 | 3 | 0 |
Variable type: logical
| skim_variable | n_missing | complete_rate | mean | count |
|---|---|---|---|---|
| Heart One Birth Congenital Abnormalities | 158519 | 0 | NaN | : |
| Heart Two Birth Congenital Abnormalities | 158519 | 0 | NaN | : |
| Heart Three Birth Congenital Abnormalities | 158519 | 0 | NaN | : |
| Heart Four Weeks Gestation | 158519 | 0 | NaN | : |
| Heart Four Birth Outcome | 158519 | 0 | NaN | : |
| Heart Four Birth Weight | 158519 | 0 | NaN | : |
| Heart Four Sex | 158519 | 0 | NaN | : |
| Heart Four Delivery Date | 158519 | 0 | NaN | : |
| Heart Four Birth Congenital Abnormalities | 158519 | 0 | NaN | : |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Date patient started trying to become pregnant OR date of last pregnancy | 157902 | 0.00 | 13.25 | 3.09 | 2 | 11 | 13 | 15 | 20 | ▁▁▆▇▂ |
| Total number of previous pregnancies, Both IVF and DI | 1 | 1.00 | 0.19 | 0.46 | 0 | 0 | 0 | 0 | 5 | ▇▁▁▁▁ |
| Total number of IVF pregnancies | 1 | 1.00 | 0.18 | 0.45 | 0 | 0 | 0 | 0 | 5 | ▇▁▁▁▁ |
| Total number of DI pregnancies | 0 | 1.00 | 0.01 | 0.12 | 0 | 0 | 0 | 0 | 4 | ▇▁▁▁▁ |
| Total number of live births - conceived through IVF or DI | 0 | 1.00 | 0.14 | 0.37 | 0 | 0 | 0 | 0 | 5 | ▇▁▁▁▁ |
| Total number of live births - conceived through IVF | 0 | 1.00 | 0.13 | 0.36 | 0 | 0 | 0 | 0 | 5 | ▇▁▁▁▁ |
| Total number of live births - conceived through DI | 0 | 1.00 | 0.01 | 0.10 | 0 | 0 | 0 | 0 | 3 | ▇▁▁▁▁ |
| Type of Infertility - Female Primary | 0 | 1.00 | 0.00 | 0.06 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Type of Infertility - Female Secondary | 0 | 1.00 | 0.00 | 0.04 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Type of Infertility - Male Primary | 0 | 1.00 | 0.00 | 0.06 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Type of Infertility - Male Secondary | 0 | 1.00 | 0.00 | 0.04 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Type of Infertility -Couple Primary | 0 | 1.00 | 0.00 | 0.06 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Type of Infertility -Couple Secondary | 0 | 1.00 | 0.00 | 0.03 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Tubal disease | 0 | 1.00 | 0.10 | 0.30 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Ovulatory Disorder | 0 | 1.00 | 0.11 | 0.32 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Male Factor | 0 | 1.00 | 0.33 | 0.47 | 0 | 0 | 0 | 1 | 1 | ▇▁▁▁▃ |
| Cause of Infertility - Patient Unexplained | 0 | 1.00 | 0.27 | 0.44 | 0 | 0 | 0 | 1 | 1 | ▇▁▁▁▃ |
| Cause of Infertility - Endometriosis | 0 | 1.00 | 0.05 | 0.23 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Cervical factors | 0 | 1.00 | 0.00 | 0.01 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Female Factors | 0 | 1.00 | 0.00 | 0.00 | 0 | 0 | 0 | 0 | 0 | ▁▁▇▁▁ |
| Cause of Infertility - Partner Sperm Concentration | 0 | 1.00 | 0.00 | 0.01 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Partner Sperm Morphology | 0 | 1.00 | 0.00 | 0.01 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Causes of Infertility - Partner Sperm Motility | 0 | 1.00 | 0.00 | 0.00 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Cause of Infertility - Partner Sperm Immunological factors | 0 | 1.00 | 0.00 | 0.00 | 0 | 0 | 0 | 0 | 0 | ▁▁▇▁▁ |
| Stimulation used | 0 | 1.00 | 0.67 | 0.47 | 0 | 0 | 1 | 1 | 1 | ▅▁▁▁▇ |
| Donated embryo | 10413 | 0.93 | 0.01 | 0.09 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Patient acting as Surrogate | 10413 | 0.93 | 0.00 | 0.06 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| PGD | 10413 | 0.93 | 0.02 | 0.13 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| PGD treatment | 157114 | 0.01 | 1.00 | 0.00 | 1 | 1 | 1 | 1 | 1 | ▁▁▇▁▁ |
| PGS | 156590 | 0.01 | 1.00 | 0.00 | 1 | 1 | 1 | 1 | 1 | ▁▁▇▁▁ |
| PGS Treatment | 157519 | 0.01 | 1.00 | 0.00 | 1 | 1 | 1 | 1 | 1 | ▁▁▇▁▁ |
| Elective Single Embryo Transfer | 10413 | 0.93 | 0.29 | 0.45 | 0 | 0 | 0 | 1 | 1 | ▇▁▁▁▃ |
| Fresh Cycle | 10413 | 0.93 | 0.74 | 0.44 | 0 | 0 | 1 | 1 | 1 | ▃▁▁▁▇ |
| Frozen Cycle | 10413 | 0.93 | 0.26 | 0.44 | 0 | 0 | 0 | 1 | 1 | ▇▁▁▁▃ |
| Eggs Thawed | 10413 | 0.93 | 0.06 | 0.81 | 0 | 0 | 0 | 0 | 33 | ▇▁▁▁▁ |
| Fresh Eggs Stored | 10413 | 0.93 | 0.15 | 1.33 | 0 | 0 | 0 | 0 | 44 | ▇▁▁▁▁ |
| Total Eggs Mixed | 10426 | 0.93 | 5.84 | 6.37 | 0 | 0 | 4 | 9 | 50 | ▇▂▁▁▁ |
| Eggs Mixed With Partner Sperm | 10424 | 0.93 | 5.35 | 6.29 | 0 | 0 | 4 | 9 | 50 | ▇▂▁▁▁ |
| Eggs Mixed With Donor sperm | 10414 | 0.93 | 0.43 | 2.26 | 0 | 0 | 0 | 0 | 47 | ▇▁▁▁▁ |
| Total Embryos Created | 10414 | 0.93 | 3.85 | 4.53 | 0 | 0 | 2 | 6 | 43 | ▇▁▁▁▁ |
| Eggs Micro-injected | 10415 | 0.93 | 3.06 | 5.09 | 0 | 0 | 0 | 5 | 49 | ▇▁▁▁▁ |
| Embryos from Eggs Micro-injected | 10413 | 0.93 | 2.10 | 3.71 | 0 | 0 | 0 | 3 | 42 | ▇▁▁▁▁ |
| Total Embryos Thawed | 10413 | 0.93 | 0.49 | 1.19 | 0 | 0 | 0 | 1 | 30 | ▇▁▁▁▁ |
| Embryos Transfered | 10413 | 0.93 | 1.14 | 0.77 | 0 | 1 | 1 | 2 | 3 | ▃▇▁▆▁ |
| Embryos Transfered from Eggs Micro-injected | 10413 | 0.93 | 0.51 | 0.78 | 0 | 0 | 0 | 1 | 3 | ▇▂▁▂▁ |
| Embryos Stored For Use By Patient | 10413 | 0.93 | 1.00 | 2.22 | 0 | 0 | 0 | 1 | 37 | ▇▁▁▁▁ |
| Embryos (from Eggs Micro-injected) Stored For Use By Patient | 10413 | 0.93 | 0.51 | 1.61 | 0 | 0 | 0 | 0 | 34 | ▇▁▁▁▁ |
| Date of Egg Collection | 54056 | 0.66 | 0.00 | 0.00 | 0 | 0 | 0 | 0 | 0 | ▁▁▇▁▁ |
| Date of Egg Thawing | 157426 | 0.01 | 5.49 | 73.85 | 0 | 0 | 0 | 0 | 999 | ▇▁▁▁▁ |
| Date of Egg Mixing | 60712 | 0.62 | 2.91 | 53.85 | 0 | 0 | 0 | 0 | 999 | ▇▁▁▁▁ |
| Date of Embryo Thawing | 119618 | 0.25 | 0.62 | NaN | 0 | 0 | 0 | 0 | 999 | ▇▁▁▁▁ |
| Date of Embryo Transfer | 41942 | 0.74 | 5.64 | 52.73 | 0 | 0 | 3 | 5 | 999 | ▇▁▁▁▁ |
| Year of Treatment | 0 | 1.00 | 2015.51 | 0.50 | 2015 | 2015 | 2016 | 2016 | 2016 | ▇▁▁▁▇ |
| Live Birth Occurrence | 120437 | 0.24 | 1.00 | 0.00 | 1 | 1 | 1 | 1 | 1 | ▁▁▇▁▁ |
| Number of Live Births | 0 | 1.00 | 0.27 | 0.50 | 0 | 0 | 0 | 0 | 4 | ▇▂▁▁▁ |
| Number of foetal sacs with fetal pulsation | 0 | 1.00 | 0.31 | 0.55 | 0 | 0 | 0 | 1 | 40 | ▇▁▁▁▁ |
| Heart One Delivery Date | 121116 | 0.24 | 1667.62 | 482.48 | 999 | 999 | 2016 | 2016 | 2016 | ▅▁▁▁▇ |
| Heart Two Delivery Date | 153524 | 0.03 | 1723.22 | NaN | 999 | 999 | 2016 | 2016 | 2016 | ▃▁▁▁▇ |
| Heart Three Delivery Date | 158399 | 0.00 | 1668.28 | 484.18 | 999 | 999 | 2015 | 2016 | 2016 | ▅▁▁▁▇ |
Wrangling and cleaning
# Clean names
hfea_2015_2016 <- hfea_2015_2016 |>
clean_names()
hfea_2015_2016 |> names() [1] "patient_age_at_treatment"
[2] "date_patient_started_trying_to_become_pregnant_or_date_of_last_pregnancy"
[3] "total_number_of_previous_cycles_both_ivf_and_di"
[4] "total_number_of_previous_treatments_both_ivf_and_di_at_clinic"
[5] "total_number_of_previous_ivf_cycles"
[6] "total_number_of_previous_di_cycles"
[7] "total_number_of_previous_pregnancies_both_ivf_and_di"
[8] "total_number_of_ivf_pregnancies"
[9] "total_number_of_di_pregnancies"
[10] "total_number_of_live_births_conceived_through_ivf_or_di"
[11] "total_number_of_live_births_conceived_through_ivf"
[12] "total_number_of_live_births_conceived_through_di"
[13] "type_of_infertility_female_primary"
[14] "type_of_infertility_female_secondary"
[15] "type_of_infertility_male_primary"
[16] "type_of_infertility_male_secondary"
[17] "type_of_infertility_couple_primary"
[18] "type_of_infertility_couple_secondary"
[19] "cause_of_infertility_tubal_disease"
[20] "cause_of_infertility_ovulatory_disorder"
[21] "cause_of_infertility_male_factor"
[22] "cause_of_infertility_patient_unexplained"
[23] "cause_of_infertility_endometriosis"
[24] "cause_of_infertility_cervical_factors"
[25] "cause_of_infertility_female_factors"
[26] "cause_of_infertility_partner_sperm_concentration"
[27] "cause_of_infertility_partner_sperm_morphology"
[28] "causes_of_infertility_partner_sperm_motility"
[29] "cause_of_infertility_partner_sperm_immunological_factors"
[30] "main_reason_for_producing_embroys_storing_eggs"
[31] "stimulation_used"
[32] "type_of_ovulation_induction"
[33] "egg_donor_age_at_registration"
[34] "sperm_donor_age_at_registration"
[35] "donated_embryo"
[36] "patient_acting_as_surrogate"
[37] "type_of_treatment_ivf_or_di"
[38] "specific_treatment_type"
[39] "pgd"
[40] "pgd_treatment"
[41] "pgs"
[42] "pgs_treatment"
[43] "elective_single_embryo_transfer"
[44] "egg_source"
[45] "sperm_from"
[46] "fresh_cycle"
[47] "frozen_cycle"
[48] "eggs_thawed"
[49] "fresh_eggs_collected"
[50] "fresh_eggs_stored"
[51] "total_eggs_mixed"
[52] "eggs_mixed_with_partner_sperm"
[53] "eggs_mixed_with_donor_sperm"
[54] "total_embryos_created"
[55] "eggs_micro_injected"
[56] "embryos_from_eggs_micro_injected"
[57] "total_embryos_thawed"
[58] "embryos_transfered"
[59] "embryos_transfered_from_eggs_micro_injected"
[60] "embryos_stored_for_use_by_patient"
[61] "embryos_from_eggs_micro_injected_stored_for_use_by_patient"
[62] "date_of_egg_collection"
[63] "date_of_egg_thawing"
[64] "date_of_egg_mixing"
[65] "date_of_embryo_thawing"
[66] "date_of_embryo_transfer"
[67] "year_of_treatment"
[68] "live_birth_occurrence"
[69] "number_of_live_births"
[70] "early_outcome"
[71] "number_of_foetal_sacs_with_fetal_pulsation"
[72] "heart_one_weeks_gestation"
[73] "heart_one_birth_outcome"
[74] "heart_one_birth_weight"
[75] "heart_one_sex"
[76] "heart_one_delivery_date"
[77] "heart_one_birth_congenital_abnormalities"
[78] "heart_two_weeks_gestation"
[79] "heart_two_birth_outcome"
[80] "heart_two_birth_weight"
[81] "heart_two_sex"
[82] "heart_two_delivery_date"
[83] "heart_two_birth_congenital_abnormalities"
[84] "heart_three_weeks_gestation"
[85] "heart_three_birth_outcome"
[86] "heart_three_birth_weight"
[87] "heart_three_sex"
[88] "heart_three_delivery_date"
[89] "heart_three_birth_congenital_abnormalities"
[90] "heart_four_weeks_gestation"
[91] "heart_four_birth_outcome"
[92] "heart_four_birth_weight"
[93] "heart_four_sex"
[94] "heart_four_delivery_date"
[95] "heart_four_birth_congenital_abnormalities" # Select variables
hfea <- hfea_2015_2016 |>
select(
patient_age_at_treatment,
total_number_of_previous_ivf_cycles,
total_number_of_previous_di_cycles,
total_number_of_ivf_pregnancies,
total_number_of_di_pregnancies,
total_number_of_live_births_conceived_through_ivf,
total_number_of_live_births_conceived_through_di,
type_of_infertility_female_primary,
type_of_infertility_female_secondary,
type_of_infertility_male_primary,
type_of_infertility_male_secondary,
type_of_infertility_couple_primary,
type_of_infertility_couple_secondary,
cause_of_infertility_tubal_disease,
cause_of_infertility_ovulatory_disorder,
cause_of_infertility_male_factor,
cause_of_infertility_patient_unexplained,
cause_of_infertility_endometriosis,
cause_of_infertility_cervical_factors,
stimulation_used,
type_of_ovulation_induction,
egg_donor_age_at_registration,
sperm_donor_age_at_registration,
donated_embryo,
type_of_treatment_ivf_or_di,
specific_treatment_type,
pgd,
elective_single_embryo_transfer,
fresh_cycle,
frozen_cycle,
eggs_thawed,
fresh_eggs_collected,
fresh_eggs_stored,
total_eggs_mixed,
eggs_mixed_with_partner_sperm,
eggs_mixed_with_donor_sperm,
total_embryos_created,
eggs_micro_injected,
embryos_from_eggs_micro_injected,
total_embryos_thawed,
embryos_transfered,
embryos_transfered_from_eggs_micro_injected,
embryos_stored_for_use_by_patient,
embryos_from_eggs_micro_injected_stored_for_use_by_patient,
number_of_live_births,
early_outcome,
number_of_foetal_sacs_with_fetal_pulsation
)
# Type conversion ==> Categorical
hfea_names_categorical <- c("patient_age_at_treatment",
"type_of_infertility_female_primary",
"type_of_infertility_female_secondary",
"type_of_infertility_male_primary",
"type_of_infertility_male_secondary",
"type_of_infertility_couple_primary",
"type_of_infertility_couple_secondary",
"cause_of_infertility_tubal_disease",
"cause_of_infertility_ovulatory_disorder",
"cause_of_infertility_male_factor",
"cause_of_infertility_patient_unexplained",
"cause_of_infertility_endometriosis",
"cause_of_infertility_cervical_factors",
"stimulation_used",
"type_of_ovulation_induction",
"egg_donor_age_at_registration",
"sperm_donor_age_at_registration",
"donated_embryo",
"type_of_treatment_ivf_or_di",
"specific_treatment_type",
"elective_single_embryo_transfer",
"fresh_cycle",
"frozen_cycle",
"pgd",
"early_outcome")
# Convert to categorical variables
hfea <- hfea |>
mutate(across(all_of(hfea_names_categorical), factor))
# Type conversion ==> Numeric
hfea_names_numeric <- c("total_number_of_previous_ivf_cycles",
"total_number_of_previous_di_cycles",
"total_number_of_ivf_pregnancies",
"fresh_eggs_collected")
hfea <- hfea |>
mutate(across(all_of(hfea_names_numeric), as.numeric))Warning: There were 3 warnings in `mutate()`.
The first warning was:
ℹ In argument: `across(all_of(hfea_names_numeric), as.numeric)`.
Caused by warning:
! NAs introduced by coercion
ℹ Run `dplyr::last_dplyr_warnings()` to see the 2 remaining warnings.# Create categorical outcome variable
hfea <- hfea |>
mutate(
clinical_outcome = factor(
case_when(
number_of_live_births >= 1 ~ "Success",
TRUE ~ "Failure"
)
)
)
# Replace NA with 0 for numeric and "0" for categorical
# Numeric
hfea$total_number_of_previous_ivf_cycles[is.na(hfea$total_number_of_previous_ivf_cycles)] <- 0
hfea$total_number_of_previous_di_cycles[is.na(hfea$total_number_of_previous_di_cycles)] <- 0
hfea$total_number_of_ivf_pregnancies[is.na(hfea$total_number_of_ivf_pregnancies)] <- 0
hfea$donated_embryo[is.na(hfea$donated_embryo)] <- 0
hfea$eggs_thawed[is.na(hfea$eggs_thawed)] <- 0
hfea$fresh_eggs_collected[is.na(hfea$fresh_eggs_collected)] <- 0
hfea$fresh_eggs_stored[is.na(hfea$fresh_eggs_stored)] <- 0
hfea$total_eggs_mixed[is.na(hfea$total_eggs_mixed)] <- 0
hfea$eggs_mixed_with_partner_sperm[is.na(hfea$eggs_mixed_with_partner_sperm)] <- 0
hfea$eggs_mixed_with_donor_sperm[is.na(hfea$eggs_mixed_with_donor_sperm)] <- 0
hfea$total_embryos_created[is.na(hfea$total_embryos_created)] <- 0
hfea$eggs_micro_injected[is.na(hfea$eggs_micro_injected)] <- 0
hfea$embryos_from_eggs_micro_injected[is.na(hfea$embryos_from_eggs_micro_injected)] <- 0
hfea$total_embryos_thawed[is.na(hfea$total_embryos_thawed)] <- 0
hfea$embryos_transfered[is.na(hfea$embryos_transfered)] <- 0
hfea$embryos_transfered_from_eggs_micro_injected[is.na(hfea$embryos_transfered_from_eggs_micro_injected)] <- 0
hfea$embryos_stored_for_use_by_patient[is.na(hfea$eggs_thawedembryos_stored_for_use_by_patient)] <- 0Warning: Unknown or uninitialised column:
`eggs_thawedembryos_stored_for_use_by_patient`.hfea$embryos_from_eggs_micro_injected_stored_for_use_by_patient[is.na(hfea$embryos_from_eggs_micro_injected_stored_for_use_by_patient)] <- 0
# Categorical
hfea$pgd[is.na(hfea$pgd)] <- "0"
hfea$elective_single_embryo_transfer[is.na(hfea$elective_single_embryo_transfer)] <- "0"
hfea$pgd[is.na(hfea$pgd)] <- "0"
hfea$fresh_cycle[is.na(hfea$fresh_cycle)] <- "0"
hfea$frozen_cycle[is.na(hfea$frozen_cycle)] <- "0"
hfea |> str()tibble [158,519 × 48] (S3: tbl_df/tbl/data.frame)
$ patient_age_at_treatment : Factor w/ 7 levels "18 - 34","35-37",..: 4 6 2 1 1 2 2 6 1 1 ...
$ total_number_of_previous_ivf_cycles : num [1:158519] 2 3 0 2 5 0 2 2 3 4 ...
$ total_number_of_previous_di_cycles : num [1:158519] 0 0 0 0 0 3 0 0 0 0 ...
$ total_number_of_ivf_pregnancies : num [1:158519] 0 0 0 0 1 0 1 0 0 1 ...
$ total_number_of_di_pregnancies : num [1:158519] 0 0 0 0 0 0 0 0 0 0 ...
$ total_number_of_live_births_conceived_through_ivf : num [1:158519] 0 0 0 0 1 0 1 0 0 1 ...
$ total_number_of_live_births_conceived_through_di : num [1:158519] 0 0 0 0 0 0 0 0 0 0 ...
$ type_of_infertility_female_primary : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ type_of_infertility_female_secondary : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ type_of_infertility_male_primary : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ type_of_infertility_male_secondary : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ type_of_infertility_couple_primary : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ type_of_infertility_couple_secondary : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ cause_of_infertility_tubal_disease : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ cause_of_infertility_ovulatory_disorder : Factor w/ 2 levels "0","1": 1 1 1 2 1 1 2 1 2 1 ...
$ cause_of_infertility_male_factor : Factor w/ 2 levels "0","1": 1 1 1 1 2 1 1 1 1 2 ...
$ cause_of_infertility_patient_unexplained : Factor w/ 2 levels "0","1": 2 1 1 1 1 1 1 1 1 1 ...
$ cause_of_infertility_endometriosis : Factor w/ 2 levels "0","1": 1 1 1 2 2 1 1 1 1 1 ...
$ cause_of_infertility_cervical_factors : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ stimulation_used : Factor w/ 2 levels "0","1": 1 2 2 1 2 2 1 1 2 1 ...
$ type_of_ovulation_induction : Factor w/ 3 levels "","Cetrotide",..: 1 3 3 1 3 3 1 1 3 1 ...
$ egg_donor_age_at_registration : Factor w/ 6 levels "","<= 20","999",..: 1 1 1 1 1 1 1 1 1 1 ...
$ sperm_donor_age_at_registration : Factor w/ 8 levels "","<= 20","999",..: 1 1 1 1 1 5 1 1 1 4 ...
$ donated_embryo : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ type_of_treatment_ivf_or_di : Factor w/ 2 levels "DI","IVF": 2 2 2 2 2 2 2 2 2 2 ...
$ specific_treatment_type : Factor w/ 19 levels "FER","Generic DI",..: 11 4 11 19 4 4 19 4 4 19 ...
$ pgd : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
$ elective_single_embryo_transfer : Factor w/ 2 levels "0","1": 2 1 1 2 1 1 1 1 1 1 ...
$ fresh_cycle : Factor w/ 2 levels "0","1": 1 2 2 1 2 2 1 2 2 1 ...
$ frozen_cycle : Factor w/ 2 levels "0","1": 2 1 1 2 1 1 2 1 1 2 ...
$ eggs_thawed : num [1:158519] 0 0 0 0 0 0 0 0 0 0 ...
$ fresh_eggs_collected : num [1:158519] 0 4 12 0 4 6 0 1 31 0 ...
$ fresh_eggs_stored : num [1:158519] 0 0 6 0 0 0 0 0 0 0 ...
$ total_eggs_mixed : num [1:158519] 0 3 0 0 4 6 0 1 13 0 ...
$ eggs_mixed_with_partner_sperm : num [1:158519] 0 3 0 0 4 0 0 1 13 0 ...
$ eggs_mixed_with_donor_sperm : num [1:158519] 0 0 0 0 0 6 0 0 0 0 ...
$ total_embryos_created : num [1:158519] 0 3 0 0 4 3 0 1 8 0 ...
$ eggs_micro_injected : num [1:158519] 0 3 0 0 4 6 0 1 13 0 ...
$ embryos_from_eggs_micro_injected : num [1:158519] 0 3 0 0 4 3 0 1 8 0 ...
$ total_embryos_thawed : num [1:158519] 1 0 0 1 0 0 1 0 0 1 ...
$ embryos_transfered : num [1:158519] 1 2 0 1 2 2 1 0 0 1 ...
$ embryos_transfered_from_eggs_micro_injected : num [1:158519] 0 2 0 0 2 2 0 0 0 0 ...
$ embryos_stored_for_use_by_patient : num [1:158519] 0 0 0 0 0 0 0 1 0 0 ...
$ embryos_from_eggs_micro_injected_stored_for_use_by_patient: num [1:158519] 0 0 0 0 0 0 0 1 0 0 ...
$ number_of_live_births : num [1:158519] 1 0 0 0 0 0 0 0 0 0 ...
$ early_outcome : Factor w/ 18 levels "","Biochemical Pregnancy Only",..: 9 14 1 2 14 14 1 1 1 2 ...
$ number_of_foetal_sacs_with_fetal_pulsation : num [1:158519] 1 0 0 0 0 0 0 0 0 0 ...
$ clinical_outcome : Factor w/ 2 levels "Failure","Success": 2 1 1 1 1 1 1 1 1 1 ...Exploratory analysis
Variable distribution
lapply(hfea, function(x) {
if (is.numeric(x)) return(summary(x))
if (is.factor(x)) return(table(x))
})$patient_age_at_treatment
x
18 - 34 35-37 38-39 40-42 43-44 45-50 999
66316 35679 21817 21459 6912 3948 2388
$total_number_of_previous_ivf_cycles
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.00 0.00 1.00 1.02 2.00 5.00
$total_number_of_previous_di_cycles
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.1372 0.0000 5.0000
$total_number_of_ivf_pregnancies
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 0.000 0.179 0.000 5.000
$total_number_of_di_pregnancies
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.00000 0.00000 0.00000 0.01202 0.00000 4.00000
$total_number_of_live_births_conceived_through_ivf
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.1264 0.0000 5.0000
$total_number_of_live_births_conceived_through_di
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000000 0.000000 0.000000 0.008907 0.000000 3.000000
$type_of_infertility_female_primary
x
0 1
157964 555
$type_of_infertility_female_secondary
x
0 1
158291 228
$type_of_infertility_male_primary
x
0 1
158000 519
$type_of_infertility_male_secondary
x
0 1
158291 228
$type_of_infertility_couple_primary
x
0 1
157929 590
$type_of_infertility_couple_secondary
x
0 1
158357 162
$cause_of_infertility_tubal_disease
x
0 1
142100 16419
$cause_of_infertility_ovulatory_disorder
x
0 1
140650 17869
$cause_of_infertility_male_factor
x
0 1
105747 52772
$cause_of_infertility_patient_unexplained
x
0 1
115636 42883
$cause_of_infertility_endometriosis
x
0 1
149836 8683
$cause_of_infertility_cervical_factors
x
0 1
158515 4
$stimulation_used
x
0 1
52856 105663
$type_of_ovulation_induction
x
Cetrotide Yes but not recorded
57311 1 101207
$egg_donor_age_at_registration
x
<= 20 999 Between 21 and 25
150808 212 689 1423
Between 26 and 30 Between 31 and 35
2463 2924
$sperm_donor_age_at_registration
x
<= 20 999 Between 21 and 25
137451 910 552 5269
Between 26 and 30 Between 31 and 35 Between 36 and 40 Between 41 and 45
4526 4114 3660 2037
$donated_embryo
x
0 1
157185 1334
$type_of_treatment_ivf_or_di
x
DI IVF
10413 148106
$specific_treatment_type
x
FER Generic DI
3 64
ICI ICSI
7 59280
ICSI / AH ICSI / BLASTOCYST
5 33
ICSI:ICSI ICSI:IVF
1890 347
ICSI:Unknown IUI
139 10326
IVF IVF / AH
56719 1
IVF / BLASTOCYST IVF:ICSI
24 160
IVF:IVF IVF:Unknown
801 80
IVF:Unknown:Unknown:Unknown IVI
1 16
Unknown
28623
$pgd
x
0 1
156064 2455
$elective_single_embryo_transfer
x
0 1
115928 42591
$fresh_cycle
x
0 1
48985 109534
$frozen_cycle
x
0 1
119829 38690
$eggs_thawed
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.00000 0.00000 0.00000 0.05786 0.00000 33.00000
$fresh_eggs_collected
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 4.000 6.308 11.000 50.000
$fresh_eggs_stored
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.1382 0.0000 44.0000
$total_eggs_mixed
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 4.000 5.459 9.000 50.000
$eggs_mixed_with_partner_sperm
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 3.000 4.999 8.000 50.000
$eggs_mixed_with_donor_sperm
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 0.000 0.399 0.000 47.000
$total_embryos_created
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 2.000 3.593 6.000 43.000
$eggs_micro_injected
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 0.000 2.855 5.000 49.000
$embryos_from_eggs_micro_injected
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 0.000 1.959 3.000 42.000
$total_embryos_thawed
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.4546 0.0000 30.0000
$embryos_transfered
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.00 0.00 1.00 1.07 2.00 3.00
$embryos_transfered_from_eggs_micro_injected
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.4787 1.0000 3.0000
$embryos_stored_for_use_by_patient
Min. 1st Qu. Median Mean 3rd Qu. Max. NAs
0.000 0.000 0.000 1.001 1.000 37.000 10413
$embryos_from_eggs_micro_injected_stored_for_use_by_patient
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.000 0.000 0.000 0.476 0.000 34.000
$number_of_live_births
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.2689 0.0000 4.0000
$early_outcome
x
31520
Biochemical Pregnancy Only
8663
Biochemical Pregnancy Only ,Intrauterine Fetal Pulsation Seen
2
Biochemical Pregnancy Only ,Misscarriage
4
Ectopic
495
Ectopic ,Hetrotopic
1
Hetrotopic
3
Hetrotopic ,Intrauterine Fetal Pulsation Seen
2
Intrauterine Fetal Pulsation Seen
43875
Misscarriage
4451
Misscarriage ,Intrauterine Fetal Pulsation Seen
130
Molar
6
Molar ,Intrauterine Fetal Pulsation Seen
2
None
69344
None ,Biochemical Pregnancy Only
9
None ,Ectopic
1
None ,Intrauterine Fetal Pulsation Seen
8
None ,Misscarriage
3
$number_of_foetal_sacs_with_fetal_pulsation
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.0000 0.0000 0.3116 1.0000 40.0000
$clinical_outcome
x
Failure Success
120437 38082 Remove ”999” from rows
# Dimension before
hfea |> dim()[1] 158519 48# Drops the row if "" or 999 appears anywhere especially in the cloumn partner_age
clean_hfea <- hfea |>
filter(!if_any(everything(), ~ .x == "999"))
# Dimension after
clean_hfea |> dim()[1] 144716 48Visualization
Charts
# Patient age
clean_hfea |>
select(patient_age_at_treatment) |>
count(patient_age_at_treatment) |>
ggplot(aes(x = reorder(patient_age_at_treatment, n), y = n, fill = patient_age_at_treatment)) + geom_col(show.legend = FALSE) + geom_text(aes(label = n, vjust = -0.5)) + theme_minimal() + theme(axis.title.y = element_text(angle = 0)) + labs(title = "Patients age group")
# Number of previous cycle
clean_hfea |>
select(total_number_of_previous_ivf_cycles) |>
count(total_number_of_previous_ivf_cycles) |>
ggplot(aes(x = reorder(total_number_of_previous_ivf_cycles, n), y = n, fill = total_number_of_previous_ivf_cycles)) + geom_col(show.legend = FALSE) + geom_text(aes(label = n, vjust = -0.5)) + theme_minimal() + theme(axis.title.y = element_text(angle = 0)) + labs(title = "Number of previous cycle")
Horizontal Prevalence Bar Chart and Co-Occurrence Matrix Heatmap
# 1. Clean up and reshape the data for visualization
hfea_long <- clean_hfea |>
select(
cause_of_infertility_tubal_disease,
cause_of_infertility_ovulatory_disorder,
cause_of_infertility_male_factor,
cause_of_infertility_patient_unexplained,
cause_of_infertility_endometriosis,
cause_of_infertility_cervical_factors
) |>
# Convert everything to standard 1 (Yes) and 0 (No) if they are factors/text strings
mutate(across(everything(), ~ if_else(. == "Yes" | . == 1, 1, 0)))
# Observe
hfea_long |>
select(
cause_of_infertility_tubal_disease,
cause_of_infertility_ovulatory_disorder,
cause_of_infertility_male_factor,
cause_of_infertility_patient_unexplained,
cause_of_infertility_endometriosis,
cause_of_infertility_cervical_factors
) |>
head()# A tibble: 6 × 6
cause_of_infertility_tubal_dis…¹ cause_of_infertility…² cause_of_infertility…³
<dbl> <dbl> <dbl>
1 0 0 0
2 0 0 0
3 0 0 0
4 0 1 0
5 0 0 1
6 0 0 0
# ℹ abbreviated names: ¹cause_of_infertility_tubal_disease,
# ²cause_of_infertility_ovulatory_disorder, ³cause_of_infertility_male_factor
# ℹ 3 more variables: cause_of_infertility_patient_unexplained <dbl>,
# cause_of_infertility_endometriosis <dbl>,
# cause_of_infertility_cervical_factors <dbl>Horizontal Prevalence Bar Chart
hfea_long |>
summarise(across(everything(), sum)) |>
pivot_longer(cols = everything(), names_to = "Infertility_Cause", values_to = "Count") |>
mutate(
Percentage = (Count / nrow(clean_hfea)) * 100,
Infertility_Cause = str_remove(Infertility_Cause, "causes_of_infertility_") # Clean labels
) |>
ggplot(aes(x = reorder(Infertility_Cause, Percentage), y = Percentage)) +
geom_col(fill = "steelblue", width = 0.6) +
coord_flip() +
labs(
title = "Prevalence Matrix of Infertility Etiologies",
subtitle = paste("Analysis of baseline cohort distribution (N =", nrow(clean_hfea), ")"),
x = "Diagnostic Category", y = "Percentage of Total Cohort (%)"
) +
theme_minimal()
Co-Occurrence Matrix Heatmap
# Calculate cross-product matrix to discover diagnostic intersections
co_matrix <- t(as.matrix(hfea_long)) %*% as.matrix(hfea_long)
as_tibble(co_matrix, rownames = "Var1") |>
pivot_longer(-Var1, names_to = "Var2", values_to = "Overlap_Count") |>
mutate(
Var1 = str_remove(Var1, "cause_of_infertility_"),
Var2 = str_remove(Var2, "cause_of_infertility_")
) |>
ggplot(aes(x = Var1, y = Var2, fill = Overlap_Count)) +
geom_tile(color = "white") +
geom_text(aes(label = scales::comma(Overlap_Count)), color = "black", size = 3.5) +
scale_fill_gradient(low = "#e8f0fe", high = "#1a73e8") +
labs(
title = "Etiology Intersections & Patient Co-Occurrences",
subtitle = "Heatmap showing overlapping diagnoses across the clinical registry",
x = NULL, y = NULL, fill = "Patient Count"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
UpSet Plot
# 1. Isolate and clean the multi-label categorical features
upset_data <- clean_hfea |>
select(
cause_of_infertility_tubal_disease,
cause_of_infertility_ovulatory_disorder,
cause_of_infertility_male_factor,
cause_of_infertility_patient_unexplained,
cause_of_infertility_endometriosis,
cause_of_infertility_cervical_factors
) |>
# ComplexUpset requires logical (TRUE/FALSE) or binary (1/0) matrices
mutate(across(everything(), ~ if_else(. == "Yes" | . == 1, TRUE, FALSE))) |>
# Rename columns cleanly so the chart axis labels look ready for publication
rename(
`Tubal Disease` = cause_of_infertility_tubal_disease,
`Ovulatory Disorder` = cause_of_infertility_ovulatory_disorder,
`Male Factor` = cause_of_infertility_male_factor,
`Unexplained` = cause_of_infertility_patient_unexplained,
`Endometriosis` = cause_of_infertility_endometriosis,
`Cervical Factor` = cause_of_infertility_cervical_factors
)
# 2. Extract the clean column names to serve as our target sets
infertility_sets <- colnames(upset_data)
# 3. Generate the ComplexUpSet Visualization
suppressWarnings(
upset(
upset_data,
infertility_sets,
name = "Diagnostic Intersections / Combinations",
width_ratio = 0.3, # Adjusts balance between left set sizes and main matrix
height_ratio = 0.6, # Adjusts balance between top bar chart and main matrix
stripes = upset_stripes(
mapping = aes(color = "grey95"),
colors = c("white", "grey95")
),
base_annotations = list(
'Intersection Size' = intersection_size(
counts = TRUE, # Shows numerical patient totals on top of the bars
mapping = aes(fill = "steelblue")
) +
scale_fill_identity() +
theme_minimal() +
labs(y = "Patient Cohort Size")
),
set_sizes = upset_set_size() +
theme_minimal() +
labs(x = "Total Prevalence per Cause")
) +
labs(
title = "Multi-Label Clinical Cohort Mapping via UpSet Intersection Design",
subtitle = paste("Comprehensive mapping of standalone and overlapping etiologies (N =", scales::comma(nrow(clean_hfea)), ")")
)
)
Deep learning with Tabnet
Preprocess
# Set seeds for R and torch
torch::torch_manual_seed(13)
set.seed(13)
# Data splitting
data_split <- initial_split(clean_hfea, prop = 0.80, strata = clinical_outcome)
train_split <- data_split |> training()
test_split <- data_split |> testing()
# Preprocessing
hfea_recipe <- recipe(clinical_outcome ~ ., data = train_split) |>
step_novel(all_nominal_predictors()) |>
#step_dummy(all_nominal_predictors(), -all_outcomes(), one_hot = FALSE) |>
step_zv(all_nominal_predictors()) |>
step_normalize(all_numeric_predictors()) |>
step_downsample(clinical_outcome, under_ratio = 1) # Solve the 3:1 outcome variable mild imbalanceTransformer with tabnet
# Detect how many logical cores your computer has
all_cores <- parallel::detectCores(logical = TRUE)
# Register a cluster using all available cores except 1 (leaves 1 core free so my PC doesn't freeze)
cl <- makePSOCKcluster(all_cores - 1)
registerDoParallel(cl)
cat("Parallel backend registered with", all_cores - 1, "cores.\n")Parallel backend registered with 3 cores.# deep learning with tabnet
tabnet_tune_spec <- tabnet(
epochs = 40, # Number of training epochs over dataset
batch_size = 256, # Sub-cohort sizing optimized for local RAM
decision_width = 16, # Width of the prediction layer
attention_width = 16, # Width of the attention embedding mask
num_steps = 4, # Sequential attention steps (depth of processing)
learn_rate = 0.01 # Gradient descent step velocity
) |>
set_engine("torch") |>
set_mode("classification")
# Combine into a unified tuning workflow
transformer_workflow <- workflow() |>
add_recipe(hfea_recipe) |>
add_model(tabnet_tune_spec)
# Execute Attention-Based Model Optimization Loop
cat("--- Commencing Transformer Optimization Pipeline ---\n")--- Commencing Transformer Optimization Pipeline ---fitted_transformer <- fit(transformer_workflow, data = train_split)
# Predict
predictions <- augment(fitted_transformer, test_split)
ivf_metrics <- metric_set(accuracy, sensitivity, specificity, precision, npv)
predictions |>
ivf_metrics(truth = clinical_outcome,
estimate = .pred_class,
.pred_Success)# A tibble: 5 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 1.000
2 sensitivity binary 1.000
3 specificity binary 1
4 precision binary 1
5 npv binary 1.000Attention map (Clinical interpretability)
#Extracting raw TabNet feature importances driven by internal cross-attention masks
extracted_fit <- extract_fit_engine(fitted_transformer)
explain_data <- bake(prep(hfea_recipe), test_split)
# Extract attention masks
attention_explain <- tabnet_explain(extracted_fit, explain_data)
# Render Global Interpretability Plot for Clinical Support Decisions
autoplot(attention_explain) +
labs(title = "Clinical Decision Support: Global Transformer Attention Weights",
subtitle = "Feature importance maps computed natively via multi-step attention layer interactions",
x = "Clinical Predictor", y = "Aggregated Attention Score") +
theme_minimal(base_size = 14)
# Feature Importance Vip Plot
# 1. Extract the underlying engine fit cleanly
extracted_fit <- extract_fit_engine(fitted_transformer)
# 2. Generate the plot with your specific fill and theme styles
vip(extracted_fit, aesthetics = list(fill = "turquoise1", color = "black")) +
theme_minimal(base_size = 14) +
labs(
title = "Transformer Feature Importance Profile",
subtitle = "Attribution weights derived natively from cross-attention masks",
y = "Importance Score",
x = "Clinical Predictor"
)
# Close multicore
stopCluster(cl)
registerDoSEQ() # Returns R to standard single-threaded behavior