My Digital Library on Everyday Is A School Day

Learning Carbapenemase Producing Genes

Mon, 02 Mar 2026 00:00:00 +0000

Learnt major carbapenemase genes (KPC, NDM, OXA) using NCBI isolate data and molecular dynamics. Includes gene frequency trends, co-resistance patterns, and MM/PBSA binding comparisons of avibactam with KPC vs NDM to illustrate mechanistic differences 🧬

Motivations:

We’ve previously learnt about ESBL genes and took a peek under the hood of the nucleotides and explore NCBI library and assess their frequency. Why not let’s pick another AMR gene and learn! Let’s explore Carbapenemase producing organisms! In this blog, we’ll spare you the code, as we basically use the same workflow previous, change a few search keys and variables and out comes the result!

Objectives:

Which Are Carbapenemase Producing Genes?

These are the major carbapanemase:
class A - KPC.
class B Metallo-B-lactamases (MBLs) - NDM, VIM, IMP.
class D - OXA-48, OXA-181, OXA-232, OXA-244.

Carbapenemases are classified into three molecular classes based on their hydrolytic mechanism. Class A & D carbapenemases all utilizing a serine-based active site. Class B MBLs rely on zinc in their active site. This is interesting, because while Avibactam was developed to have activities against Class A, C, and D beta-lactamases. However, it does not work on Class B! 😵‍💫 Hence, before susceptibility result is back, knowing which carbapenemase exists would be ideal. In fact the NG-Test CARBA 5 (also called “Carba 5”) is a rapid immunochromatographic lateral flow assay that detects and differentiates the five most common carbapenemase families: KPC, NDM, VIM, IMP, and OXA-48-like. I heard it takes about 15 minutes to run one colony.

Interesting thing on MBL-producing Enterobacterales, the IDSA recommends either ceftazidime-avibactam + aztreonam combination therapy or cefiderocol monotherapy. The rationale for the combination is that aztreonam (a monobactam) is stable against metallo-β-lactamases, while avibactam inhibits the serine β-lactamases (ESBLs, AmpC, KPC, OXA-48-like) that frequently co-exist in MBL-producing organisms and would otherwise hydrolyze aztreonam.

How Are We Going To Do This?

Well, first of all, let’s get all NCBI bacterial isolates fasta with meropenem resistance here. Then download all carbapenemase producing genese, here, then insert this gene_family:(blaKPC blaNDM blaVIM blaIMP blaOXA-48 blaOXA-181 blaOXA-232 blaOXA-244) to the filter.

Then, run through the code we had previously here, assess exact match and visualize the frequency just like before! Assess what are the proportions of these fastas do not match our carbapenemase producing genes, as not all meropenem resistance is due to beta lactamases, some could be due to porin loss, overexpression of efflux pump, ESBL + porin loss, AmpC + porin loss!

After that, let’s visualize the distribution based on the submission dates.

Remember we mentioned that with MBLs we either need to use combination therapy of aztreonam + ceftaz/avibactam or cefidericol monotherapy due to co-existence of other resistance? Let’s take a look at all MBLs and see what other carbapenemase genes co-exist!

Lastly, lets test out our molecular dynamic experiment on KPC and NDM with avibactam! We should see a strong binding affinity for KPC and a very weak binding affinity for NDM! We’re going to include another post-simulation process called MM/PBSA and MM/GBSA as well. What that does it calculates the binding free energy of the ligand to the protein. The more negative the value, the stronger the binding affinity. This is a great way to quantify our results from our simulation and compare between different simulations!

Results

The Proportion of Carbapenemase producing Genes in Meropenem Resistant Organism?

We have a total of 1027 isolates, and 45.86% have detected carbapenamase genes! That’s with exact match, I did not check for low level mismatches.

The Frequency of Carbapanemase Genes

Wow, NDM-1 is at the top? I’ve always thought KPCs is more frequent. Note, these are the sequences that were submitted to NCBI, not necessarily resembling the actual distribution in the real world. But still, interesting to see that NDM-1 is more frequently submitted than KPCs.

Visualize Carbapanemase Gene Frequency By Year

Looking at the above, KPCs submissions were dominating up until 2018. In 2019, NDM-1 started to creep up to top 1. Since then, NDM-1 remained number one until 2025.

Do MBLs Frequently Have Co-resistance Of Other Carbapenamase?

primary_gene	gene	n
NDM-1	OXA-48	13
NDM-5	OXA-48	12
NDM-1	OXA-232	5
NDM-5	OXA-181	5
NDM-5	OXA-232	2
NDM-7	OXA-232	2
NDM-1	NDM-4	1
NDM-1	VIM-1	1
NDM-1	VIM-2	1

Interestingly when we look at MBL with co-resistance, it’s usually OXA-48 and OXA-48-like! But, when looking at all the MBLs (n=257) that were submitted, co-resistance with OXA is only 15.18% (n=39). There were 3 NDMs with another MBL. That makes sense to combine aztreonam and ceftaz/avibactam to counter OXA-48 beta lactamase. Note that we did not include ESBLs, ampC on our search.

Let’s Take a Look At Avibactam-KPC and Avibactam-NDM Molecular Dynamic Simulation

We’ll use the same pipeline as before, but this time we’ll add Molecular Mechanic / PBSA.

Installation

conda create -n gmxpbsa -c conda-forge gmx_mmpbsa ambertools
conda activate gmxpbsa

Write `mmpbsa.in`

You can use nano or nvim, then paste the below

&general
   startframe=1,
   endframe=500,
   interval=5,
   verbose=2,
/
&pb
   istrng=0.150,
   fillratio=4.0,
   inp=1,
   radiopt=0,
/

Note: Make sure to change the startframe and endframe to where the the protein rmsd and ligand rmsd is stable. Essentially sampling from the stable portion of the simulation.

When running MM/GBSA use the parameters below, maybe name is mmgbsa.in

&general
  startframe = 1,
  endframe = 500,
  interval = 1,
  verbose = 1,
  keep_files = 0,
/
&gb
  igb = 5,
  saltcon = 0.15,
/

To Run MM/PBSA or MM/GBSA

gmx_MMPBSA \
  -O \
  -i mmpbsa.in \
  -cs md.tpr \
  -ct md_noPBC.xtc \
  -ci index.ndx \
  -cg 1 13 \
  -cp topol.top \
  -o FINAL_RESULTS.dat \
  -eo FINAL_RESULTS.csv

Note: Make sure to write our regular pipeline first, create index etc, and leave the MM/PBSA or MM/GBSA until last.

Equation of the bond: Delta G_bind = Delta G_gas + Delta G_solv Where: Delta G_gas = gas-phase molecular mechanics energy (bonds, angles, dihedrals, van der Waals, electrostatics) BOND+ANGLE+DIHED+VDWAALS+EEL+1-4 VDW+1-4 EEL Delta G_solv = solvation free energy (how the molecule interacts with the surrounding water) EPB+ENPOLAR

Note: when you read the FINAL_RESULTS.csv, go to the last section, that’s the delta. Total = sum of all the columns except Total. Negative == 👍

KPC181-Avibactam

Alright, with the above, we have RMSD plateaud at around 20ns and RMSD ligand is pretty good and stable as well. Along with good H bonds and interaction energy, and reducing and converged minimal distance between protein and ligand and also distance between center of protein and ligand reduced and stablized as well. Let’s visualize the first frame and last frame to ensure before we run MM/PBSA and MM/GBSA.

Looks convincing! Let’s take a look at MM/PBSA and MM/GBSA.

Alright, we have quite a few columns in facets here, but most are not helpful since we have 0 data mainly because we used inp=1. But total binding energy is negative, which is good! You can see that on the TOTAL. The median (IQR) is -8.07(-16.79 - -1.29). Now what about GBPA ?

And the Median Total (IQR) is -10.615(-19.84 - -3.38) . Not too shabby!

NDM1-Avibactam

RMSD ligand seems quite big, hbond is intermittent, one of interaction energy crosses zero, the min distance variance is quite wide towards the end of simulation. From these numbers, it looked like it did not bind well, which is expected since avibactam does not work on MBLs. Let’s see visualize.

Wow, they’re not in the same position! It completely flipped! Usually in this setting, we shouldn’t need to perform MM/PBSA. But what if we did?

Wow, even though looking at TOTAL the median is in the negative, but you see significant fluctuations (large variance) with lots of zeros! Compare this to our previous MM/PBSA and MM/GBSA, you can see the difference!

What is interesting is that, I would imagine the ligand would have drifted away but it didn’t. Let’s investigate.

I think the ligand is stuck in the pocket as the protein was undergoing conformational change and stabilized after ~30ns, and I think it may have trapped the ligand in the pocket, hence it didn’t drift out of the pocket. I think 🤔 . Also, take note that the early simulation animation was without surface (only atoms), whereas the later one did have surface. With the matched protein and ligand of frame 0 and last frame proved that the initial pose was not optimal.

There you have it!

Note: While MM/PBSA provides relative binding estimates, these simulations do not capture full enzymatic hydrolysis dynamics and should be interpreted as comparative rather than absolute

Opportunities for improvement

need to learn ampC, porin loss, and other MDR genes
need to test our MM/PBSA and MM/GBSA more, adjust isp=2 and see how they look like
need to find a proper way to interpret/assess alphafold proteins prediction, which is considered good, which isn’t, and how to deal with them
need to dive into the math, physics, and organic chemistry of these simulations.
need to do replicates of 3, report seeds, and also include 2 other similar coordinate poses with high scores.
need to learnt covalent docking

Lessons Learnt

learnt carbapenemase genes
learnt MBLs may contain co-resistance of OXA, hence combo aztreonam
learnt MM/PBSA and MM/GBSA

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

Assessing TEM, CTX-M, and KPC-2 With Molecular Docking and Molecular Dynamic Simulation

Sat, 21 Feb 2026 00:00:00 +0000

🧬 Testing beta-lactamase resistance with AlphaFold + DiffDock + GROMACS! Watch clavulanic acid bind TEM-5, CTX-M-15, KPC-2, and get rejected by TEM-30. Simulation confirms biology! 🔬💊

Motivations

Now that we’ve learnt the pipeline of molecular docking and molecular dynamic simulation. Let’s check some of the other proteins and ligand and see if these make sense. Let’s assess ESBL beta lactamase since we did something before ( here). Let’s check some of the hypothesis here, some TEMs are inhibitor resistant such as TEM-30, whereas ESBL beta lactamases like TEM-5 and CTX-M-15 can be susceptible to beta lactamase inhibitor such as clavulanic acid, whereas TEM-30, we should see that it won’t bind. We’ll also assess KPC2, which is a carbapanemase, it does bind to clavulanic acid, however, instead of being an inhibtor, it actually hydrolyzes it. But let’s see what MD results we get!

This time, we will get protein sequence of interest and use AlphaFold Server to predict our protein and generate pdb, and instead of relying on known coordinates of the protein, let’s use DiffDock to screen the best docking site, then use that for MD simulation. We will write some instructions on DiffDock, how to install and run it. But we will leave off the MD simulation part, we can refer to here. But I will run a good chunk of code to assess our results so that at least I don’t have to copy and paste multiple times to assess RMSD, RMSF, hydrogen bonds, gyration, and distance. We will also have some cool visuals! Let’s test this out!

Objectives:

Get Our Proteins

We go here and select the gene of interest and go to Refseq.

Then click on Fasta which will bring us to this.

Copy the protein sequence and we’ll move on to our next step. Also don’t forget to copy the other proteins of interest, in our case TEM-30, CTX-M-15, and KPC2.

Protein Prediction With AlphaFold

We will then visit Alphafold Server, you will have to login and then enter the sequence, and continue. Make sure to rename it to something you can recognize. Let it run, will likely take a minute. Then download it. Unzip it and you will see 5 cif files. I usually use the first one which ends with 0.

Using DiffDock to predict binding sites

Install

git clone https://github.com/gcorso/DiffDock.git
conda env create --file environment.yml
conda activate diffdock

You can check the github link out. From my experience, the above worked on Ubuntu but failed on my mac. I actually had to use Claude Code to help me install it. Could be just a me thing.

Let’s take a look at this protein with ChimeraX.

Do you see the big protein with a long tail? The long tail has low prediction score and is likely to be disordered, so we will remove that part and just keep the globular part. We can do that with ChimeraX, just select the tail and delete it. Then save it as a new pdb file.

Then we will run DiffDock to predict the binding site. We will use clavulanic acid as our ligand. You can download it from PubChem. Then we will run DiffDock with the following command:ea, we should be very careful not to use it.

obabel alphafold0.cif -O tem5.pdb

# make sure you're in DiffDock folder and has activate your conda env that used to install
python3 inference.py \
  --protein_path tem5.pdb \
  --ligand "OC(=O)[C@@H]2/C=C\1OC[C@@H](O)/C1=C\N2" \ 
  --out_dir results_tem5_step20 \
  --inference_steps 20 \
  --samples_per_complex 10 \
  --batch_size 5
  
# create ligand pdb
obabel rank1.sdf -O clav_acid.pdb

You see the ligand SMILES? 😀 We don’t need to download one from pubchem. You can just copy the SMILES from it. Woo hoo! Once you ran the above it will have 10 ranks. Open (with ChimeraX) the protein pdb first and then all the rank docked positions to visually assess the predicted docking sites.

Alright, it looks like there is one pocket (including the top 1 ranked position) is in that one pocket that in the middle of the picture.

If you take a look at the files produced by DiffDock, it ranks its confidence score at the end of the file, the lower the better.

Alright, go through the MD simulation procedure, wait and assess!

Note: I found that I could use 2 GTX 1080 and run each GPU with one protein-ligand interaction, and also use && and chain multiple mdrun commands so that it can go from one simulation to another after it’s done! For example gmx mdrun blab blah && cd /path/to/another && gmx mdrun blah blah. Also, make sure to use tmux when you’re running the production.

Assess Results

echo -e "\"Protein\" | \"UNL\"\nq" | gmx make_ndx -f md.gro -o index.ndx
echo "0" | gmx trjconv -s md.tpr -f md.xtc -o md_nojump.xtc -pbc nojump
echo "Protein_UNL System" | gmx trjconv -s md.tpr -f md_nojump.xtc -o md_noPBC.xtc -pbc mol -center -n index.ndx
echo '4 13' | gmx rms -s md.tpr -f md_noPBC.xtc -o rmsd_ligand.xvg -tu ns -n index.ndx
echo '4 4' | gmx rms -s md.tpr -f md_noPBC.xtc -o rmsd_protein.xvg -tu ns -n index.ndx
echo 4 | gmx rmsf -s md.tpr -f md_noPBC.xtc -o rmsf_protein.xvg -res 
echo 13 | gmx rmsf -s md.tpr -f md_noPBC.xtc -o rmsf_ligand.xvg 
echo '1' | gmx gyrate -s md.tpr -f md_noPBC.xtc -o gyrate.xvg 
echo '1 13' | gmx hbond -s md.tpr -f md_noPBC.xtc -num hbond_ligand_protein.xvg -tu ns 
echo '1 13' | gmx mindist -f md_noPBC.xtc -s md.tpr -od mindist_prot_lig.xvg -on numcont_prot_lig.xvg -d 0.4
gmx distance -f md_noPBC.xtc -s md.tpr -select 'com of group "Protein" plus com of group "UNL"' -oall distance_prot_lig.xvg
if grep -q "^;energygrps" md.mdp; then
    sed -i 's/^;energygrps/energygrps/' md.mdp
    echo "Uncommented energygrps"
elif grep -q "^energygrps" md.mdp; then
    echo "energygrps already active, doing nothing"
else
    echo "energygrps = Protein UNL" >> md.mdp
    echo "Added energygrps"
fi
gmx grompp -f md.mdp -c md.gro -p topol.top -o rerun.tpr 
gmx mdrun -s rerun.tpr -rerun md_nojump.xtc -e rerun.edr -ntmpi 1 -ntomp 4 
printf "Coul-SR:Protein-UNL\nLJ-SR:Protein-UNL\n0\n" | gmx energy -f rerun.edr -o interaction_energy.xvg
cp *.xvg /path/to/your/analysis

Note: Make sure to run the above after we’re done with all of the simulation, otherwise it will bottleneck both. Meaning, it will be slow for the above and also your active simulation. Well, I only have 4 core, so it might be different for yours! It might not matter at all. Above I would use -ntomp 2 if my other simulation is still running but i want to check the result.

Create function to visualize all

R Code

library(tidyverse)
library(xvm)
library(ggpubr)

plot_all <- function(path,int=T) {
prot <- read_xvg(paste0(path,"rmsd_protein.xvg"))
ligand <- read_xvg(paste0(path,"rmsd_ligand.xvg"))
rmsf_prot <- read_xvg(paste0(path,"rmsf_protein.xvg"))
rmsf_ligand <- read_xvg(paste0(path,"rmsf_ligand.xvg"))
gy <- read_xvg(paste0(path,"gyrate.xvg")) 
if (int) {
interaction <- read_xvg(paste0(path,"interaction_energy.xvg"))
plot_interaction <- plot_xvg(interaction)}
hbond <- read_xvg(paste0(path,"hbond_ligand_protein.xvg"))
mindist <- read_lines(paste0(path,"mindist_prot_lig.xvg"))
dist <- read_lines(paste0(path,"distance_prot_lig.xvg"))

plot_rmsd_prot <- plot_xvg(prot)
plot_rmsd_ligand <- plot_xvg(ligand)
plot_rmsf_prot <- plot_xvg(rmsf_prot)
plot_rmsf_ligand <- plot_xvg(rmsf_ligand)
plot_gy <- plot_xvg(gy)
plot_hbond <- tibble(hbond$hbond_ligand_protein.xvg$data) |> 
  distinct() |>
 ggplot(aes(x=`Time (ns)`,y=`Hydrogen bonds`)) +
 geom_line(color = "red", alpha=0.8) +
 theme_bw() +
  ggtitle("Hydrogen bonds")

mindist_list <- mindist[!str_detect(mindist, "^@|^#")] |> str_split(" ")
time <- mindist_val <- vector(mode = "numeric", length = length(mindist_list))
for (i in 1:length(mindist_list)) {
  time[i] <- mindist_list[[i]][1]
  mindist_val[i] <- mindist_list[[i]][3]
}

mindist_df <- tibble(time = time, mindist_val = mindist_val) |>
  mutate(time = as.numeric(time),
         mindist_val = as.numeric(mindist_val))

plot_mindist <- mindist_df |>
  ggplot(aes(x=time,y=mindist_val)) +
  geom_point(color = "red", alpha=0.7) +
  theme_bw() +
  ggtitle("Min Distance")


dist_list <- dist[!str_detect(dist, "^@|^#")] |> str_trim() |> str_split("    ")

time <- dist_val <- vector(mode = "numeric", length = length(dist_list))
for (i in 1:length(dist_list)) {
  time[i] <- dist_list[[i]][1] 
  dist_val[i] <- dist_list[[i]][2]
}

dist_df <- tibble(time = time, dist_val = dist_val) |>
  mutate(time = as.numeric(time),
         dist_val = as.numeric(dist_val))

plot_dist <- dist_df |>
  ggplot(aes(x=time,y=dist_val)) +
  geom_point(color = "red", alpha=0.7) +
  theme_bw() +
  ggtitle("Distance Between Protein and Ligand")

if (int) {
plotlist <- list(plot_rmsd_prot, plot_rmsd_ligand, plot_rmsf_prot, plot_rmsf_ligand,
                 plot_gy, plot_interaction, plot_hbond, plot_mindist, plot_dist) }
else {plotlist <- list(plot_rmsd_prot, plot_rmsd_ligand, plot_rmsf_prot, plot_rmsf_ligand,
                 plot_gy, plot_hbond, plot_mindist, plot_dist)}
return(ggarrange(plotlist = plotlist, ncol = 2))
}

TEM-5

plot_all("tem5_result/")

Overall, clavulanic acid and TEM-5 demonstrated stable binding throughout the 60 ns simulation. The protein RMSD plateaued early, confirming stable conformation, ligand rmsf has also plateaud. The total radius of gyration remained largely stable, and both Coulombic and Lennard-Jones interaction energies stayed consistently negative, indicating favorable protein–ligand interactions. Hydrogen bonds were maintained at around 2–4 throughout the simulation, which is adequate for a small molecule ligand. Both the center-of-mass and minimum distances converged to stable low values and remained consistent for the remainder of the trajectory. Collectively, these results support a successful molecular dynamics simulation with stable ligand binding.

CTX-M-15

plot_all("ctxm15_result/")

Overall, clavulanic acid and CTX-M-15 also demonstrated stable binding throughout the 50 ns simulation. Although the ligand RMSD shows significant noise — likely due to improper initial coordinate assignment when using the ACPYPE-generated .gro file instead of the docked ligand coordinates — the protein RMSD plateaued and remained stable. This is not a sign of dissociation as a true dissociation ( see here) would look like this. The total radius of gyration was similarly stable. Interaction energies and hydrogen bond counts were consistent throughout the trajectory, indicating sustained non-covalent interactions. Both the minimum distance and center-of-mass distance between the protein and ligand converged and remained low, further supporting stable binding. Also, upon visualizing the md.xtc in reference to the first frame of pdb, we can see there was at one point the ligand may have dissociated at a short period of time and then reattached.

TEM-30

plot_all("tem30_result/")

This simulation presents a clear case of true ligand dissociation, indicating that clavulanic acid does not bind well to TEM-30. Notably, the simulation terminated early. Both the protein and ligand RMSD rose continuously without plateauing, though the protein RMSD values may be inflated due to the same coordinate assignment error noted previously. More definitively, both hydrogen bond counts and interaction energies dropped to zero, and the minimum distance as well as the center-of-mass distance between the protein and ligand diverged progressively over time. Collectively, these findings confirm that stable binding was not achieved in this simulation. Below, you can see ligand flies away from the pocket site.

KPC2

plot_all("kpc2_result/")

Finally, the KPC-2 and clavulanic acid simulation also demonstrated stable binding throughout the 50 ns trajectory. As noted previously, the ligand RMSD cannot be accurately interpreted due to the coordinate assignment error. Nevertheless, both interaction energies and hydrogen bond counts remained consistent throughout, and the minimum distance as well as the center-of-mass distance between the protein and ligand converged to lower values and remained stable. Importantly, however, stable binding in this simulation does not imply that clavulanic acid acts as an inhibitor of KPC-2. In fact, KPC-2 is known to hydrolyze clavulanic acid — a covalent enzymatic process that a non-covalent molecular dynamics simulation such as this cannot capture or reflect.

Final Thought

Wow, having the previous workflow really helps with lower the risk of error! I definitely learnt that my mistake of using acpype coordinates have caused significant noise on rmsd ligand and should really use the docked ligand position to create the complex.gro. Still so much to learn! But this is a really cool simulation where we can test the tested hypothesis and see it with our own eyes! I’m so grateful and fortunate to be able to be at this time period to learn these without TOO much disappointments. And also so grateful for all these scientists to be able to share these techniques for free! That is truly amazing and inspiring! ❤️

Opportunities for improvement

I have been mistakenly using acpype gro coordinates to make complex.gro, where the rmsd ligand was way off but everything else seem to be fine. We should be using the docked pose to convert to gro using gmx editconf -f diffdock_pose.pdb -o ligand_positioned.gro
Learn how to find out if there is consistent non-covalent bond between ligand and protein, how do we then differentiate between the ligand inactivating the protein or that the protein hydrolyzes the ligand like KPC2
Learn how to perform covalent docking and covalent md simulation
rewrite md sim pipeline into something easier to automate. currently i have to copy and paste from my previous documentation, mind you it’s already REALLY helpful because i was able to do all those in the matter of minutes. Let’s see how we can further optimize that, more ergnomics.
Try colabfold locally to produce protein, might take some time

Lessons Learnt

I did not know that CTX-M-15 can bind to clavulanic acid, did the simulation first then realized it bound and verified literature and apparently it does! Simulation is another tool to help to learn something new!
I change the output md.mdp to 50000 instead of 5000 to reduce bottle neck between cpu and gpu
use && chaining to run one production after another
can independently use 2 or more GPU if motherboard allows
gromacs automatically chooses a GPU that has better capacity and assign that as 0?
need to center in order for a good visualization, otherwise you will see protein and ligand might split as it exits the edge of simulation box, it enters from the other end.

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

Exploring Molecular Docking & Molecular Dynamic Simulations - A Note To Myself

Sat, 14 Feb 2026 00:00:00 +0000

🧬 Explored molecular docking & MD simulations with penicillin binding to PBP2x — lots of stumbling through GROMACS but slowly piecing it together! 💊 Still much more to learn, but we’re getting there! 🔬

Motivations:

Since last year I’ve been fascinated by how scientists are able to use computational methods and simulation of the physical world. Things such as moelcular dynamic is quite amazing! And we can learn by running through these processes. Since we know that penicillin binds to penicillin binding protein 2x, why don’t we use that as a stepping stone and see how far we can go? Oh, have you used Claude Code or OpenAI Codex? If not, these are great tools to maybe get to the end first and see the results and then document and learn step by step from 0 to n to get to that final result? I found that extremely helpful because I know that if this works, it should work by going through the steps again and there is light at the end of the tunnel! Also, not to mention, these tools as they’re getting to the end, will let you know if your machine is not powerful enough to get there 🤣 Now, buckle up! This is REALLY going to be bumpy. All codes are in bash. We’ll set a pipeline with either python or R in the future for more experiments!

Just so happen, today is Valentine’s Day. Happy Valentine’s Day! ❤️ Molecular docking and simulation is like a match making activity 🤣 What a coincidence!

Disclaimer:

I am not a biochemist. This blog serves as a note for reproducibility for my own and only for educational purposes and documentation of what worked and what didn’t, so that I won’t repeat the same mistake in the future. If you noticed any error, please educate me! Also, most codes below are run in Ubuntu bash, some in R for visualization. Also I used a lot of Claude to help discover, debug, learn.

Objectives:

Please take a look at this Gromacs Tutorials, has a lot o fanstastic code to help beginners like me!

What Is Molecular Docking & Molecular Dynamic Simulations?

Molecular docking is basically computational lock and key exploration - you’re predicting how a small molecule (like a medicine) will bind to a protein target by testing different orientations and conformations to find the lowest energy binding pose. It’s a static snapshot: protein and ligand are treated as relatively rigid (or semi-flexible), and you get binding scores that estimate affinity. Molecular dynamics (MD) simulation takes it way further - it’s like watching a molecular movie where you simulate the actual physics of atoms moving over time (picoseconds to microseconds), accounting for solvent, temperature, and all the wiggling and conformational changes that happen in real biological systems. Docking gives you the “where and how tight,” while MD gives you the “what happens next” - stability, induced fit, binding pathways, and whether that docked pose actually holds up when everything’s allowed to move realistically. You often use docking first to generate binding hypotheses, then validate or refine them with MD.

Molecular Docking

Installation

sudo apt update
sudo apt install autodock-vina # I have version `1.2.5`. 
sudo apt install openbabel # I have version 3.1.0

Download

Now, we have to download ligand and protein structures. Let’s go to RCSB and download our protein.

We’ll be working with Penicillin-binding Protein 2x.

This one is from Streptococcus pneumoniae with cefepime already bound to it. So at least we know where is the binding site and we can estimate using the coordinates on our penicillin.

Download the pdb. If we use ChimeraX to visualize the pdb, it will look something like this. With the ligand (cefepime) highlighted in green.

If we simply just read the pdb file of what we just downloaded, as you scroll through you will see ATOM means standard protein/nucleic acid atoms and HETATM = heteroatoms like ligands, waters or ions.

In the middle where we see lots of columns of numbers, the xyz coordinates of where ligand (cefepime aka 9WT) is located on this protein. We will use this coordinate to set up our docking later on. Take note that in the middle where we see lots of columns of numbers, the xyz coordinates of where ligand (cefepime aka 9WT) is located on this protein. The coordinates are around x=30, y=-15, z=50. Remember this, because we will need this for docking.

Next we’ll download a penicillin G where we will go to PubChem instead.

Convert Protein and Ligand Structures

This is not always the case, but because of our protein already contains a ligand, let’s remove that ligand and createa clean pbp2x_protein.pdb then pdbqt which is the format that vina uses.

# remove ligand from protein pdb
grep "^ATOM" 5OJ0.pdb > pbp2x_protein.pdb

# convert pdb and sif files to pdbqt for autodock
obabel pbp2x_protein.pdb -O pbp2x_protein.pdbqt -xr #(-xr removes non-polar hydrogens)
obabel Conformer3D_COMPOUND_CID_5904.sdf -O pcn.pdbqt -xh #(-xh add hydrogen needed for proper docking)

Run Vina

vina --receptor pbp2x_protein.pdbqt --ligand pcn.pdbqt \
     --center_x 30.0 --center_y -15.0 --center_z 50.0 \
     --size_x 30.0 --size_y 30.0 --size_z 30.0 \
     --exhaustiveness 16 \
     --num_modes 1 \
     --out pcn_docked.pdbqt 

## turn pdbqt back to pdb
obabel pcn_docked.pdbqt -O pcn_docked.pdb

--num_nodes will only show the top 1 predicted pose and turn it into pcn_docked.pdbqt. We will convert this back to pdb for visualization and later use in molecular dynamic simulations.

After it’s done. It will look something like this. For more question and answer information please see this. It has a lot of answers, one of them is what is a good search size?

You should probably avoid search spaces bigger than 30 x 30 x 30 Angstrom, unless you also increase “–exhaustiveness”.

With affinity of -6.83 kcal/mol. Is this considered OK? From my shallow reading, the smaller the better. General < -7 is good (some said -10 arbitarily). If it’s > -5, it means it’s less likely to bind. So this is borderline, but we can still use it for molecular dynamic simulations to see if it holds up. But before that, let’s try an experiment, what if we dock a compound that we know doesn’t bind to this protein, say aspirin?

Alright! Pretty good! -4.968 is the predicted binding affinity of aspirin to our protein target. Much less than our penicillin! Ideally with virtual screening, we want to have a lot of ligands that we want to run through and find the top hits.

Molecular Dynamic Simulation

Install Gromacs

# Install dependencies
sudo apt update
sudo apt install -y build-essential cmake git libfftw3-dev libopenmpi-dev wget

# Install NVIDIA drivers and CUDA (if not already installed)
sudo apt install -y nvidia-driver-535 nvidia-cuda-toolkit

# Download GROMACS
cd ~
wget https://ftp.gromacs.org/gromacs/gromacs-2024.4.tar.gz
tar xfz gromacs-2024.4.tar.gz
cd gromacs-2024.4

# Build with GPU support
mkdir build
cd build
cmake .. -DGMX_BUILD_OWN_FFTW=ON -DGMX_GPU=CUDA -DCUDA_TOOLKIT_ROOT_DIR=/usr/lib/cuda -DREGRESSIONTEST_DOWNLOAD=ON
make -j$(nproc)
sudo make install

# Add GROMACS to PATH permanently
echo 'source /usr/local/gromacs/bin/GMXRC' >> ~/.bashrc
source ~/.bashrc

# Verify installation
gmx --version

# Test GPU detection
gmx detect

Prepare Protein For Gromac

gmx pdb2gmx -f pbp2x_protein.pdb -o pbp2x_processed.gro -water tip3p -ff amber99sb-ildn

What this does is that it converts your protein PDB file into a simulation-ready format by adding hydrogen atoms, applying the AMBER99SB-ILDN force field parameters, and selecting the TIP3P water model. It outputs a processed structure file pbp2x_processed.gro and a topology file topol.top that contains all the molecular interaction parameters needed for running molecular dynamics simulations.

Prepare Ligand

acpype -i pcn_docked.mol2 -n 0 -a gaff2 -c bcc

This will create a directory called pcn_docked.acpype. what acpype does is that it takes your ligand structure (in this case pcn_docked.pdb) and generates the necessary topology and coordinate files for GROMACS. It uses the Antechamber tool to assign atom types and partial charges based on the AMBER force field, and outputs files like pcn_docked_GMX.itp (topology) and pcn_docked_GMX.gro (coordinates) that can be directly included in your GROMACS simulations.

Create Position Restraints For The Ligand

echo 0 | gmx genrestr -f pcn_docked.acpype/pcn_docked_GMX.gro \
             -o posre_ligand.itp \
             -fc 1000 1000 1000
             
## echo 0 means select "system"

Why do we need to do this? Because we want to make sure that our ligand doesn’t fly away during the equilibration phase. By creating a position restraint file for the ligand, we’re essentially telling GROMACS to apply a strong force (1000 kJ/mol/nm) to keep the ligand in place while the rest of the system (protein, water, ions) relaxes around it. This is especially important if we want to see how well our docked pose holds up under more realistic conditions without it drifting away from the binding site. I will use this ⛓️‍💥 to remind us where it is applied

Edit topol.top

By now you should have topol.top file. Open it and scroll down to

; Include Position restraint file
#ifdef POSRES
#include "posre.itp"
#endif

then add these chunk after it

; Include ligand position restraint file
#ifdef POSRES_LIGAND
#include "posre_ligand.itp"    ; remember this ⛓️‍💥 ?
#endif

Do you remember posre_ligand.itp that we created here ? We want to include this in topol.top so that when we’re at the phase of NVT and NPT, it will call this file to apply the restraint. We’re not done yet! More editing! Scary, right? I know.

After this, include these on your topol.top file as well.

#include "amber99sb-ildn.ff/forcefield.itp"
#include "pcn_docked.acpype/pcn_docked_GMX.itp"  ; Include ligand topology

[ system ]
Protein-Ligand Complex

[ molecules ]
Protein_chain_A    1
pcn_docked                1  ; Your ligand name from pcn_docked_GMX.itp

Take note that in [molecules] you have to insert your specific ligand name in your .itp file made from acpype.

Create The Complex

I’ve written myself a little cheat to do this by code

code

python3 << 'PYEOF'
   # Combine protein and ligand GRO files into complex.gro                      
                                         
   protein = "/your/path/pbp_test/pbp2x_processed.gro"
   ligand = "/your/path/pbp_test/pcn_docked.acpype/pcn_docked_GMX.gro"
   output = "/your/path/pbp_test/complex.gro"

   with open(protein) as f:
       prot_lines = f.readlines()

   with open(ligand) as f:
       lig_lines = f.readlines()

   # Parse protein
   prot_title = prot_lines[0].strip()
   prot_natoms = int(prot_lines[1].strip())
   prot_atoms = prot_lines[2:2+prot_natoms]
   prot_box = prot_lines[2+prot_natoms].strip()

   # Parse ligand
   lig_natoms = int(lig_lines[1].strip())
   lig_atoms = lig_lines[2:2+lig_natoms]

   total_atoms = prot_natoms + lig_natoms

   # GRO format: residue number (5 chars), residue name (5 chars), atom name
   (5 chars),
   # atom number (5 chars), x y z (8.3f each)
   # Atom numbers wrap at 99999

   with open(output, 'w') as f:
       f.write(f"{prot_title} with ligand\n")
       f.write(f"{total_atoms}\n")

       # Write protein atoms as-is
       for line in prot_atoms:
           f.write(line)

       # Write ligand atoms, renumbering atoms continuing from protein
       # Get the last residue number from protein
       last_prot_resnum = int(prot_atoms[-1][:5])
       new_resnum = last_prot_resnum + 1

       for i, line in enumerate(lig_atoms):
           # Renumber residue and atom
           atom_num = (prot_natoms + i + 1) % 100000
           # Format: %5d%-5s%5s%5d%8.3f%8.3f%8.3f
           resname = line[5:10]  # residue name
           atomname = line[10:15]  # atom name
           x = line[20:28]
           y = line[28:36]
           z = line[36:44]
           vel = line[44:] if len(line) > 44 else ""

           new_line =
   f"{new_resnum:5d}{resname}{atomname}{atom_num:5d}{x}{y}{z}"
           if vel.strip():
               new_line += vel
           else:
               new_line += "\n"
           f.write(new_line)

       # Write box vectors from protein
       f.write(f"{prot_box}\n")

   print(f"Combined {prot_natoms} protein + {lig_natoms} ligand =
   {total_atoms} total atoms")
   print("Written to complex.gro")

   # Verify
   with open(output) as f:
       lines = f.readlines()
   print(f"Output file: {len(lines)} lines")
   print(f"Header: {lines[0].strip()}")
   print(f"Atom count: {lines[1].strip()}")
   print(f"Last atom line: {lines[-2].strip()}")
   print(f"Box: {lines[-1].strip()}")
   PYEOF

Note: The above code may not work. Might have to rewrite it to make it more robust

We essentially want to combine our pbp2x_processed.gro, remember this?, and also our pcn_docked.gro, into a single protein-ligand complex and call it complex.gro.

Convert Oringally Docked Pose To gro

gmx editconf -f pcn_docked.pdb -o pcn_docked.gro

You go to this:

Then copy this:

Change the total atoms numbers 100842 from 10041 + 41 = 10082. Then insert the pcn_docked.gro coordinates right after the protein’s coordinates like so.

Warning! Note: Do not use acpype gro because the coordinates may not be the same, use this something like this gmx editconf -f diffdock_pose.pdb -o ligand_positioned.gro from your original docked pose pdb.

Define Simulation Box

gmx editconf -f complex.gro -o complex_box.gro -c -d 1.0 -bt dodecahedron

Before we can do anything useful, we need to give our protein-ligand complex a “home” — and that’s exactly what this step does. We’re using gmx editconf to center the complex and build a box around it, leaving at least 1.0 nm of breathing room between the protein and the box walls so things don’t awkwardly interact with themselves across periodic boundaries. We’re going with a dodecahedron shape instead of a plain cube because it’s more sphere-like, which means we need to fill it with about 30% less water — and less water means faster simulations. I think…

Solvate The System

gmx solvate -cp complex_box.gro -cs spc216.gro -o complex_solv.gro -p topol.top

A protein floating in an empty box isn’t very biologically realistic, so let’s add some water. gmx solvate takes the pre-equilibrated SPC/E water model (spc216.gro) and floods our box with water molecules around the complex. It also automatically updates topol.top to keep track of how many water molecules were added

Add Ions

Make sure to create ion.mdp before hand with the following parameter

ion.mdp

; ion.mdp - Parameters for adding ions

; Run control
integrator = steep        ; Steepest descent minimization
nsteps     = 50000        ; Maximum number of steps
emtol      = 1000.0       ; Convergence when max force < 1000 kJ/mol/nm
emstep     = 0.01         ; Initial step size (nm)

; Output control
nstlog     = 500          ; Frequency to write to log file
nstenergy  = 500          ; Frequency to write energies

; Neighbor searching
cutoff-scheme = Verlet
ns-type       = grid
nstlist       = 10
rlist         = 1.0       ; Short-range cutoff (nm)

; Electrostatics
coulombtype   = PME       ; Particle Mesh Ewald
rcoulomb      = 1.0       ; Coulomb cutoff (nm)

; Van der Waals
vdwtype       = Cut-off
rvdw          = 1.0       ; VdW cutoff (nm)

; Periodic boundary conditions
pbc           = xyz       ; 3D periodic boundaries

; Temperature and pressure (not really used, but good practice)
tcoupl        = no
pcoupl        = no
gen-vel       = no

Then to add ions

gmx grompp -f ion.mdp -c complex_solv.gro -p topol.top -o ion.tpr -maxwarn 1
echo 15 | gmx genion -s ion.tpr -o complex_solv_ions.gro -p topol.top -pname NA -nname  CL -neutral 
## select 15 or SOL

Our solvated system is probably carrying a net charge at this point, and running a simulation like that is a recipe for trouble. To fix this, we first prep a run input file with gmx grompp, then use gmx genion to swap out some water molecules for sodium (NA) and chloride (CL) ions. The -neutral flag handles the math for you and adds just enough ions to zero out the total charge.

Note: I learnt that -maxwarn can sometimes be a problem, if you use it too routinely, eventually something will break either during EM, NVT, NPT, or production. I try to debug it when there is a warning to make sure it doesn’t cause a problem later on.

Energy Minimization

Make sure to create em.mdp before hand with the following parameter

em.mdp

; Energy minimization parameters
integrator  = steep         ; Steepest descent minimization
emtol       = 1000.0        ; Stop when max force < 1000.0 kJ/mol/nm
emstep      = 0.01          ; Initial step size
nsteps      = 50000         ; Maximum number of steps

; Output control
nstlog      = 100           ; Write to log file every 100 steps
nstenergy   = 100           ; Write energies every 100 steps

; Neighbor searching
cutoff-scheme = Verlet
nstlist     = 10
ns_type     = grid
pbc         = xyz           ; Periodic boundary conditions

; Electrostatics
coulombtype = PME
rcoulomb    = 1.0

; Van der Waals
vdwtype     = Cut-off
rvdw        = 1.0

; Temperature and pressure coupling (off for EM)
tcoupl      = no
pcoupl      = no

gmx grompp -f em.mdp -c complex_solv_ions.gro -p topol.top -o em.tpr
gmx mdrun -v -deffnm em

At this point the system is solvated and neutralized, but it’s probably a bit of a mess geometrically — atoms may be too close together, bonds at weird angles, that sort of thing. Energy minimization is basically the “calm down” step where we let GROMACS iron out all those clashes and bad geometries before we start any real dynamics. We’re using the steepest descent algorithm, which just keeps nudging atoms downhill on the energy landscape until the forces are small enough that we’re happy. No actual physics happening here — just cleaning up the structure so we have a solid starting point.

NVT Equilibration

Make sure to create nvt.mdp before hand with the following parameter

nvt.mdp

; NVT EQUILIBRATION
; Position restraints on protein and ligand
define = -DPOSRES -DPOSRES_LIGAND.  ; remember this? ⛓️‍💥

; Run parameters
integrator              = md        ; leap-frog integrator
nsteps                  = 50000     ; 2 * 50000 = 100 ps
dt                      = 0.002     ; 2 fs
; Output control
nstxout                 = 500       ; save coordinates every 1.0 ps
nstvout                 = 500       ; save velocities every 1.0 ps
nstenergy               = 500       ; save energies every 1.0 ps
nstlog                  = 500       ; update log file every 1.0 ps
nstxout-compressed      = 500       ; save compressed coordinates every 1.0 ps
compressed-x-grps       = System    ; save the whole system
; Bond parameters
continuation            = no        ; first dynamics run
constraint_algorithm    = lincs     ; holonomic constraints 
constraints             = h-bonds   ; bonds involving H are constrained
lincs_iter              = 1         ; accuracy of LINCS
lincs_order             = 4         ; also related to accuracy
; Nonbonded settings 
cutoff-scheme           = Verlet    ; Buffered neighbor searching
ns_type                 = grid      ; search neighboring grid cells
nstlist                 = 10        ; 20 fs, largely irrelevant with Verlet
rcoulomb                = 1.0       ; short-range electrostatic cutoff (in nm)
rvdw                    = 1.0       ; short-range van der Waals cutoff (in nm)
DispCorr                = EnerPres  ; account for cut-off vdW scheme
; Electrostatics
coulombtype             = PME       ; Particle Mesh Ewald for long-range electrostatics
pme_order               = 4         ; cubic interpolation
fourierspacing          = 0.16      ; grid spacing for FFT
; Temperature coupling
tcoupl                  = V-rescale             ; modified Berendsen thermostat
tc-grps                 = Protein Non-Protein   ; two coupling groups - more accurate
tau_t                   = 0.1     0.1           ; time constant, in ps
ref_t                   = 300     300           ; reference temperature, one for each group, in K
; Pressure coupling
pcoupl                  = no        ; no pressure coupling in NVT
; Periodic boundary conditions
pbc                     = xyz       ; 3-D PBC
; Velocity generation
gen_vel                 = yes       ; assign velocities from Maxwell distribution
gen_temp                = 300       ; temperature for Maxwell distribution
gen_seed                = -1        ; generate a random seed

gmx grompp -f nvt.mdp -c em.gro -r em.gro -p topol.top -o nvt.tpr
gmx mdrun -deffnm nvt -nb gpu -pme gpu -bonded gpu

# or with cpu
gmx mdrun -deffnm nvt

Now the real fun begins — sort of. Before we let everything run free, we need to carefully bring the system up to temperature while keeping the protein and ligand held in place with position restraints. This NVT (constant volume and temperature) run heats things up to 300 K over 100 ps using the V-rescale thermostat, while the water and ions get to move around and settle in naturally. Think of it like slowly warming up before a workout.

NPT Equilibration

Make sure to create npt.mdp before hand with the following parameter

npt.mdp

; NPT EQUILIBRATION
; Position restraints on protein and ligand
define = -DPOSRES -DPOSRES_LIGAND.  ; remember this? ⛓️‍💥

; Run parameters
integrator              = md        ; leap-frog integrator
nsteps                  = 50000     ; 2 * 50000 = 100 ps
dt                      = 0.002     ; 2 fs
; Output control
nstxout                 = 500       ; save coordinates every 1.0 ps
nstvout                 = 500       ; save velocities every 1.0 ps
nstenergy               = 500       ; save energies every 1.0 ps
nstlog                  = 500       ; update log file every 1.0 ps
nstxout-compressed      = 500       ; save compressed coordinates every 1.0 ps
compressed-x-grps       = System    ; save the whole system
; Bond parameters
continuation            = yes       ; continuing from NVT
constraint_algorithm    = lincs     ; holonomic constraints 
constraints             = h-bonds   ; bonds involving H are constrained
lincs_iter              = 1         ; accuracy of LINCS
lincs_order             = 4         ; also related to accuracy
; Nonbonded settings 
cutoff-scheme           = Verlet    ; Buffered neighbor searching
ns_type                 = grid      ; search neighboring grid cells
nstlist                 = 10        ; 20 fs, largely irrelevant with Verlet
rcoulomb                = 1.0       ; short-range electrostatic cutoff (in nm)
rvdw                    = 1.0       ; short-range van der Waals cutoff (in nm)
DispCorr                = EnerPres  ; account for cut-off vdW scheme
; Electrostatics
coulombtype             = PME       ; Particle Mesh Ewald for long-range electrostatics
pme_order               = 4         ; cubic interpolation
fourierspacing          = 0.16      ; grid spacing for FFT
; Temperature coupling
tcoupl                  = V-rescale             ; modified Berendsen thermostat
tc-grps                 = Protein Non-Protein   ; two coupling groups - more accurate
tau_t                   = 0.1     0.1           ; time constant, in ps
ref_t                   = 300     300           ; reference temperature, one for each group, in K
; Pressure coupling
pcoupl                  = Parrinello-Rahman     ; Pressure coupling on in NPT
pcoupltype              = isotropic             ; uniform scaling of box vectors
tau_p                   = 2.0                   ; time constant, in ps
ref_p                   = 1.0                   ; reference pressure, in bar
compressibility         = 4.5e-5                ; isothermal compressibility of water, bar^-1
refcoord_scaling        = com                   ; scale center of mass of reference coordinates
; Periodic boundary conditions
pbc                     = xyz       ; 3-D PBC
; Velocity generation
gen_vel                 = no        ; velocity generated in NVT

gmx grompp -f npt.mdp -c nvt.gro -r nvt.gro -t nvt.cpt -p topol.top -o npt.tpr
gmx mdrun -deffnm npt -nb gpu -pme gpu -bonded gpu

# or with cpu
gmx mdrun -deffnm npt

Temperature is sorted, now let’s get the pressure and density right too. In this NPT (constant pressure and temperature) step, we swap in the Parrinello-Rahman barostat to let the box size adjust until the pressure stabilizes at 1.0 bar. The protein and ligand are still restrained here — we’re just letting the solvent finish getting comfortable. This step is what makes sure your water density is physically reasonable before you remove the training wheels and start production. Another 100 ps and you’re good to go.

Run Production

Make sure to create md.mdp before hand with the following parameter

md.mdp

; PRODUCTION MD
; Run parameters
integrator              = md        ; leap-frog integrator
nsteps                  = 5000000   ; 2 * 5000000 = 10 ns (10,000 ps)
dt                      = 0.002     ; 2 fs
; Output control
nstxout                 = 0         ; suppress bulky .trr file by specifying 0
nstvout                 = 0         ; suppress bulky .trr file by specifying 0
nstenergy               = 5000      ; save energies every 10 ps
nstlog                  = 5000      ; update log file every 10 ps
nstxout-compressed      = 5000      ; save compressed coordinates every 10 ps
compressed-x-grps       = System    ; save the whole system
compressed-x-precision  = 1000      ; precision with which to write to the compressed trajectory file
; energygrps            = Protein UNL ; turn this back on after gpu mdrun  
; Bond parameters
continuation            = yes       ; continuing from NPT
constraint_algorithm    = lincs     ; holonomic constraints 
constraints             = h-bonds   ; bonds involving H are constrained
lincs_iter              = 1         ; accuracy of LINCS
lincs_order             = 4         ; also related to accuracy
; Nonbonded settings 
cutoff-scheme           = Verlet    ; Buffered neighbor searching
ns_type                 = grid      ; search neighboring grid cells
nstlist                 = 10        ; 20 fs, largely irrelevant with Verlet
rcoulomb                = 1.0       ; short-range electrostatic cutoff (in nm)
rvdw                    = 1.0       ; short-range van der Waals cutoff (in nm)
DispCorr                = EnerPres  ; account for cut-off vdW scheme
; Electrostatics
coulombtype             = PME       ; Particle Mesh Ewald for long-range electrostatics
pme_order               = 4         ; cubic interpolation
fourierspacing          = 0.16      ; grid spacing for FFT
; Temperature coupling
tcoupl                  = V-rescale             ; modified Berendsen thermostat
tc-grps                 = Protein Non-Protein   ; two coupling groups - more accurate
tau_t                   = 0.1     0.1           ; time constant, in ps
ref_t                   = 300    300           ; reference temperature, one for each group, in K
; Pressure coupling
pcoupl                  = Parrinello-Rahman     ; Pressure coupling on in NPT
pcoupltype              = isotropic             ; uniform scaling of box vectors
tau_p                   = 2.0                   ; time constant, in ps
ref_p                   = 1.0                   ; reference pressure, in bar
compressibility         = 4.5e-5                ; isothermal compressibility of water, bar^-1
; Periodic boundary conditions
pbc                     = xyz       ; 3-D PBC
; Velocity generation
gen_vel                 = no        ; continuing from NPT

gmx grompp -f md.mdp -c npt.gro -t npt.cpt -p topol.top -o md.tpr
gmx mdrun -deffnm md -nb gpu -pme gpu

# or cpu
gmx mdrun -deffnm md

# if ctrl+c and want to resume/continue
gmx mdrun -v -deffnm md -nb gpu -pme gpu -cpi md.cpt -append

This is what we’ve been working toward. Restraints are off, the system is equilibrated, and we’re letting the simulation run freely for 10 nanoseconds. Every 10 ps the coordinates get saved to a compressed .xtc trajectory file for analysis later. Sit back, let it cook, and get ready for the analysis phase.

Note: The above default is 10 ns. We did extend to 50 ns to further assess the rmsd issue we saw initially (not documented here) (see note how to do so). Also! These are quite memory intensive! Make sure your harddrive has lots of storage!

Asessment

Run this first to re-center

# Step 1: Make molecules whole first
echo "0" | gmx trjconv -s md.tpr -f md.xtc -o md_nojump.xtc -pbc nojump

# Step 2: Center on protein and apply mol PBC
echo "1 0" | gmx trjconv -s md.tpr -f md_nojump.xtc -o md_noPBC.xtc -pbc mol -center

RMSD — Root Mean Square Deviation

What it measures: How much a structure deviates from a reference (usually the starting, post-equilibration frame).

A stable complex should reach a plateau. Continuous drift means the system hasn’t equilibrated or the ligand is dissociating.

# Protein backbone RMSD
echo '4 4' | gmx rms -s md.tpr -f md_noPBC.xtc -o rmsd_protein.xvg -tu ns 

# Ligand RMSD (after fitting to protein backbone — critical!)
echo '4 13' | gmx rms -s md.tpr -f md_noPBC.xtc -o rmsd_ligand.xvg -tu ns

We typically want to assess both protein and ligand (with respect to protein) rmsd. We essentially want to see a stable protein with rmsd plateauing, some said <2-3 Å ? 🤷‍♂️ Same goes with the ligand rmsd.

If we see large numbers on the ligand as time passes, that means there is instability or dissociation. Let’s take a look at our result!

code

library(tidyverse)
library(xvm)

prot <- read_xvg("rmsd_protein.xvg")
ligand <- read_xvg("rmsd_ligand.xvg")

plot_xvg(prot)

plot_xvg(ligand)

Backbone RMSD rises from 0 to ~0.5 nm within the first ~5 ns and plateaus around 0.5–0.6 nm for the remainder of the 50 ns simulation, indicating the protein equilibrates early and maintains a stable conformation throughout — consistent across all simulation lengths tested. The ligand (UNL) RMSD tells a different story: it fluctuates around 0.2–0.4 nm for the first ~20 ns, then drifts progressively upward to ~0.5–0.7 nm after ~25 ns with no plateau, suggesting the ligand undergoes a conformational transition away from its original docked pose mid-simulation. However, this should be interpreted alongside the minimum distance, COM distance, H-bond, and interaction energy data.

Note: I had to use echo “1 0” | gmx trjconv -s md.tpr -f md.xtc -o md_noPBC.xtc -pbc mol -center to re-center because there were some outliers of the RMSD of the ligand with 12-15 values. This disappeared after re-centering

Note: I also had to extend 10ns to 50ns to further assess if protein rmsd plateaud as it kept rising. To extend use this:

gmx convert-tpr -s md.tpr -extend 40000 -o md_extended.tpr

gmx mdrun -deffnm md_extended \
  -s md_extended.tpr \
  -cpi md.cpt \
  -nb gpu -pme gpu -bonded gpu -update gpu \
  -ntmpi 1 -ntomp 4 \
  -v

RMSF — Root Mean Square Fluctuation

What it measures: Per-residue (or per-atom) flexibility over time.

Identifies which regions of the protein and which atoms of the ligand are mobile. High flexibility at the binding site residues suggests the ligand isn’t holding them in place as expected.

# Per-residue protein flexibility
echo 4 | gmx rmsf -s md.tpr -f md_noPBC.xtc -o rmsf_protein.xvg -res 

# Per-atom ligand flexibility
echo 13 | gmx rmsf -s md.tpr -f md_noPBC.xtc -o rmsf_ligand.xvg

Binding site residues with low RMSF (< 1–1.5 Å) = well-restrained by ligand. If RMSF of active site residues is HIGH while your ligand RMSD is also high → ligand is not stabilizing the pocket. What does our say?

A few minor peaks around residues 200, 300, and 580–600 suggest localized loop flexibility mid-structure but nothing dramatic. Overall the RMSF profile is consistent with a stable, well-folded protein throughout the 50 ns simulation, with flexibility confined primarily to the N-terminal region as expected for a large multimeric protein like PBP2x.

rmsf_ligand <- read_xvg("rmsf_ligand.xvg")

plot_xvg(rmsf_ligand)

Ligand RMSF analysis shows per-atom fluctuations ranging from ~0.02–0.27 nm across all 41 atoms (system atoms 10041–10082), with a notable peak around atom 10068 corresponding to H7 on the aromatic ring region (benzene ring), suggesting this part of the ligand is the most dynamically flexible. Overall fluctuation levels are moderate and consistent with the dynamic pose sampling behavior observed throughout the simulation.

Now let’s visualize with ChimeraX and use color pallete of the temperature factor (bfactor) via gmx rmsf -s md.tpr -f md_noPBC.xtc -o rmsf.xvg -oq rmsf_bfactor.pdb -res. Blue means minimal wiggliness, white is middle, red is lots of wiggliness.

And we can see that (boxed by green color), our ligand rest quite comfortably in the pocket of prior cefepime with not a whole lot of wiggliness indicating not a whole lot of conformational change around the attached site.

Radius of Gyration (Rg)

What it measures: Compactness of the protein.

If the protein unfolds or the binding pocket opens/closes dramatically due to ligand binding/unbinding, Rg will change. It’s a global indicator of structural integrity.

echo '1' | gmx gyrate -s md.tpr -f md_noPBC.xtc -o gyrate.xvg

According to Claude, the radius of gyration plot for the 50 ns simulation shows total Rg remaining stable at ~2.9 nm throughout, confirming the protein maintains its overall fold with no unfolding or collapse. RgX stays relatively flat around ~2.75 nm. However RgY and RgZ show dramatic and unusual fluctuations between ~20,000–45,000 ps — RgY drops sharply from ~2.75 nm down to ~2.3 nm then recovers, while RgZ spikes from ~1.8 nm up to ~2.45 nm then returns to baseline. These large axial swings occurring simultaneously in opposite directions are concerning and could indicate significant domain reorganization, partial chain separation, or a PBC artifact requiring further investigation. Will visualize in ChimeraX to determine the cause.

In ChimeraX, load fullsystem.gro then load md_noPBC.xtc and enter command below. Then move to around 23000-30000 and see if it’s just a rotation.

hide solvent
hide :NA
hide :CL
cartoon
color bychain

Alright, it’s just a rotation! The RgY and RgZ fluctuations between ~20–45 ns are attributable to protein rotation/tumbling in the simulation box rather than genuine conformational change, as confirmed by visual inspection of the trajectory in ChimeraX. Total Rg remains flat throughout, and the axial variations reflect reorientation rather than structural instability. Overall the protein fold is well-maintained across the full 50 ns simulation

Ligand-Protein Interaction Energy

What it measures: Short-range Lennard-Jones (van der Waals) and Coulomb (electrostatic) energies between ligand and protein.

The most direct thermodynamic indicator. If the ligand is truly bound, the interaction energy should be negative (favorable) and stable. If it dissociates, the energy approaches 0.

Add this to md.mdp

energygrps = Protein UNL ; the UNL is your ligand, use whichever it's listed

then rerun:

gmx grompp -f md.mdp -c md.gro -p topol.top -n index.ndx -o rerun.tpr
gmx mdrun -s rerun.tpr -rerun md_noPBC.xtc -e rerun.edr -ntmpi 1 -ntomp 4

gmx energy -f md.edr -o interaction_energy.xvg 

# then enter these
Coul-SR:Protein-LIG
LJ-SR:Protein-LIG
0

interaction <- read_xvg("interaction_energy.xvg")
plot_xvg(interaction)

Interaction energy plots show LJ/vdW interaction is more stable and consistently negative (~-80 to -130 kJ/mol) throughout the simulation, while Coulomb interaction is highly variable (0 to -80 kJ/mol) with frequent excursions toward zero, indicating the ligand maintains physical contact with the protein but repeatedly loses and regains specific electrostatic interactions. This pattern is consistent with dynamic surface sampling rather than stable binding mode occupancy.

Note: For assessing interaction energy, we will have to rerun mdrun, only uses core, no gpu. But won’t take too long even for 50ns. I would do this after hbond. I tried to doing this together from the first production but it won’t let me.

Hydrogen Bond Analysis

What it measures: Number and occupancy of H-bonds between ligand and protein over the trajectory.

Critical for beta-lactam/PBP interactions — the acylation mechanism involves specific H-bonds. Persistent H-bonds = meaningful interaction.

more info than pdb during acpype conversion, so maybe try that out as well.

echo '1 13' | gmx hbond -s md.tpr -f md_noPBC.xtc -num hbond_ligand_protein.xvg -tu ns

Ligand-protein H-bond analysis reveals 1–3 persistent H-bonds throughout the simulation with only rare drops to zero, indicating the ligand maintains contact with the protein but does not settle into a single stable binding pose — consistent with the progressive RMSD drift. Rather than full dissociation, the ligand appears to be dynamically sampling multiple interaction geometries. This suggests weak or non-specific binding at this site, and a more favorable docking pose or alternative binding site may need to be explored.

Note: Try simulating ligand-protein complex where you know it won’t bind and see this hydrogen bonds to be 0 0 0 0 all the way. Quite often, when i mistakenly docked in the wrong coordinates, my first few minutes production has very low hydrogen bond average. Usually in those situation, I’ll stop instead of continuing. What do you guys do?

Binding Pocket Distance Analysis

What it measures: Distance between the ligand center-of-mass (or key atoms) and key binding site residues.

RMSD can be misleading if the ligand rotates in place. Tracking distances to known catalytic residues (e.g., active site Ser, Lys, Thr in PBPs) gives mechanistically interpretable data.

echo '1 13' | gmx mindist -f md_noPBC.xtc -s md.tpr -n index.ndx -od mindist_prot_lig.xvg -on numcont_prot_lig.xvg -d 0.4

gmx distance -f md_noPBC.xtc -s md.tpr -n index.ndx -select 'com of group "Protein" plus com of group "UNL"' -oall distance_prot_lig.xvg

code

mindist <- read_lines("mindist_prot_lig.xvg")

mindist_list <- mindist[!str_detect(mindist, "^@|^#")] |> str_split(" ")

time <- mindist_val <- vector(mode = "numeric", length = length(mindist_list))
for (i in 1:length(mindist_list)) {
  time[i] <- mindist_list[[i]][1]
  mindist_val[i] <- mindist_list[[i]][3]
}

mindist_df <- tibble(time = time, mindist_val = mindist_val) |>
  mutate(time = as.numeric(time),
         mindist_val = as.numeric(mindist_val))

plot_mindist <- mindist_df |>
  ggplot(aes(x=time,y=mindist_val)) +
  geom_point(color = "red", alpha=0.7) +
  theme_bw()

dist <- read_lines("distance_prot_lig.xvg")

dist_list <- dist[!str_detect(dist, "^@|^#")] |> str_trim() |> str_split("    ")

time <- dist_val <- vector(mode = "numeric", length = length(dist_list))
for (i in 1:length(dist_list)) {
  time[i] <- dist_list[[i]][1] 
  dist_val[i] <- dist_list[[i]][2]
}

dist_df <- tibble(time = time, dist_val = dist_val) |>
  mutate(time = as.numeric(time),
         dist_val = as.numeric(dist_val))

plot_dist <- dist_df |>
  ggplot(aes(x=time,y=dist_val)) +
  geom_point(color = "red", alpha=0.7) +
  theme_bw()

Minimum distance analysis between the ligand and protein confirms the ligand remains in close proximity (~0.15–0.25 nm) throughout the entire 50 ns simulation with no upward drift, ruling out full dissociation. Together with the persistent 1–3 protein-ligand H-bonds, this suggests the ligand maintains continuous contact with the protein surface but explores multiple binding geometries rather than converging on a single stable pose — consistent with weak or dynamic binding at this site.

Center of mass distance between ligand and protein remains stable at ~2.75–2.95 nm throughout the 50 ns simulation with no directional drift, confirming the ligand does not dissociate from the protein. Combined with the minimum distance (~0.15–0.25 nm) and persistent 1–3 H-bonds, the collective picture is one of a ligand that remains associated with the protein but dynamically samples multiple surface poses rather than adopting a single locked binding mode — suggesting the binding interaction is real but relatively weak or non-specific at this site.

Visual Inspection

🙌 These trajectory is from the last few steps of the 50ns. looks like it’s still at the same place! Fantastic!

Let’s plot our frame 0 and frame 5000 and see where our ligand is.

# Extract full system at time 0
gmx trjconv -s md.tpr -f md_noPBC.xtc -o frame0.pdb -dump 0
# Select System

# Extract full system at time 50000
gmx trjconv -s md.tpr -f md_noPBC.xtc -o frame50000.pdb -dump 50000
# Select System

In ChimeraX, open both, then:

hide solvent
hide protein
hide :NA
hide :CL
cartoon
matchmaker #2 to #1 pairing bb
color #1:UNL red
color #2:UNL green
transparency 80 target c

The matchmaker aligns both frames.

Great! Looks like it the coordinates are quite similar! Especially the beta lactam ring area, which is the most important part for the interaction. The tail area seems to have more wiggle room, which is consistent with our RMSF analysis.

Wow, I learnt so much, and so much more to learn! The physics is really fascinating! I don’t understanding all of the them, but at least this is a step to knowing what I don’t know, which is a lot! The trials and erros we’ve gone through, and thanks to Claude, I was able to get unstuck! But still, took quite a long time from experimentation, reproducing with different pdbs, then the documentation! My heart goes to those who do this for a living… it’s not easy! ❤️ Thanks to all who contribute to the scientific community! All the software I used are freely available! And you can reproduce this at your own home as well! Please be sure to cite them!

Opportunities for Improvement

Try out protein structures from AlphaFold Protein Structure Database
Try out ColabFold
Incorporate diffdock in discovering binding poses, compare it with fpocket, and perhaps also vina
I was told that using mol2 directly has more info than pdb during acpype
we did not assess covalent docking
I need to turn all of the above into a pipeline where there is less copy and paste and typing! So I can run more!
I am really curious about how certain ESBL beta lactamase has affinity to beta lactamase inhibitor. Want to see if gromacs can simulate this!
I should really be using index in gromacs
learn about MM-GBSA / MM-PBSA for post-processing
learn about protonation (physiological pH), probably using obabel

Lessons Learnt

learn that you can use echo 15 | gmx something to insert 15 onto the next command response. Or gmx something << EOF 15 EOF
learnt some basic gromacs workflow, interpretation, assessment
learnt autodock vina and diffdock
learnt to visualize with ChimeraX
for GTX 1080, average around 40-50ns/day

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

Setting Up A Cluster of Tiny PCs For Parallel Computing - A Note To Myself

Fri, 16 Jan 2026 00:00:00 +0000

Enjoyed learning the process of setting up a cluster of tiny PCs for parallel computing. A note to myself on installing Ubuntu, passwordless SSH, automating package installation across nodes, distributing R simulations, and comparing CV5 vs CV10 performance. Fun project!

Motivations

Part of something I want to learn this year is getting a little more into parallel computing. How we can distribute simulation computations across different devices. Lately, we have more reasons to do this because quite a few of our simulations require long running computation and leaving my laptop running overnight or several days is just not a good use it. We have also tried cloud computing as well and without knowing how those distributed cores are, well, distributed, it’s hard for me to conceptualize how these are done and what else we could optimize. Hence, what is a better way of doing it on our own! Sit tight, this is going to be a bumpy one. Let’s go!

Objectives

Which PCs to Get?

Preferably something functional and cheap! Something like a used Lenovo M715q Tiny PCs or something similar.

Install Ubuntu

Download Ubuntu Server
Create a bootable USB using balenaEtcher
When starting Lenovo up, press F12 continuously until it shows an option to boot from USB. If F12 does not work, reboot and press F1 to BIOS. Go to Startup Tab, change CSM Support to Enabled. Then set Primary Boot Priority to USB by moving priority to first. Then F10 to save configuration and exit. It will then reboot to USB.
Make sure it’s connected to internet via LAN for smoother installation.
Follow the instructions to install Ubuntu, setting username, password etc. Then reboot.
Make sure to remove USB drive, if you didn’t it’ll remind you. Et voila!

The installations were very quick, compared to the other OS I’ve installed in the past. Very smooth as well. I thoroughly enjoyed seeting these up.

Align and Fix IPs

For organizational purpose, make sure you go to your router setting and set your computer clusters to convenient IPs such as 192.168.1.101, 192.168.1.102, 192.168.1.103 etc. You may have to reboot your computer clusters after changing it on your router.

Passwordless SSH

Next, you want to set up passwordless SSH. This is crucial for R to work!

1. Create a key

ssh-keygen -t ed25519

2. Send Copy of Key To Your Node

ssh-copy-id -i .ssh/my_key.pub username1@192.168.1.101

it will prompt you to enter your password, then after that you won’t need a pssword to ssh in.

Passwordless Sudo

This is optional. But if you’re like me, don’t want to repeat lots of typing on installation, and see if you can use bash or R to install packages, you’d need this.

ssh -t username2@192.168.1.102 'echo "$(whoami) ALL=(ALL) NOPASSWD: ALL" | sudo tee /etc/sudoers.d/$(whoami)'

It would prompt you to enter your password. You would have to do this for all your nodes

Send Multiple Commands Via SSH

Install R

for host in username1@192.168.1.101 username2@192.168.1.102 username3@192.168.1.103; do
  ssh -t $host 'sudo apt update && sudo apt install -y r-base r-base-dev'
done

This is basically installing R on all of our clusters one after another.

Create A Template R script For Simulation

Why do we do this? We want to take advantage of the multicore of each nodes as opposed to using clusters on future as the overhead network may add on to the time and makes optimization less efficiency. Instead, we will send a script to each node so that it can fork its own cores to run the simulation. Also, if we specify packages on our script, we can automate the process of installing these packages on our nodes.

code

library(future)
library(future.apply)
library(dplyr)
library(SuperLearner)
library(ranger)
library(xgboost)
library(glmnet)

plan(multicore, workers = 4)

set.seed(1)

n <- 10000
W1 <- rnorm(n)
W2 <- rnorm(n)
W3 <- rbinom(n, 1, 0.5)
W4 <- rnorm(n)

# TRUE propensity score model
A <- rbinom(n, 1, plogis(-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4))

# TRUE outcome model
Y <- rbinom(n, 1, plogis(-1 + 0.2*A + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2))

# Calculate TRUE ATE
logit_Y1 <- -1 + 0.2 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2
logit_Y0 <- -1 + 0 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2

Y1_true <- plogis(logit_Y1)
Y0_true <- plogis(logit_Y0)
true_ATE <- mean(Y1_true - Y0_true)

df <- tibble(W1 = W1, W2 = W2, W3 = W3, W4 = W4, A = A, Y = Y)

tune <- list(
  ntrees = c(500,1000),           
  max_depth = c(5,7),                  
  shrinkage = c(0.001,0.01)    
)

tune2 <- list(
  ntrees = c(250, 500, 1000),
  max_depth = c(3,5,7,9),
  shrinkage = c(0.001,0.005,0.01)
)

learners <- create.Learner("SL.xgboost", tune = tune, detailed_names = TRUE, name_prefix = "xgb")
learners2 <- create.Learner("SL.xgboost", tune = tune2, detailed_names = TRUE, name_prefix = "xgb")

# Super Learner library 
SL_library <- list(
  c("SL.xgboost", "SL.ranger", "SL.glm", "SL.mean"),
  c("SL.xgboost","SL.ranger"),
  c("SL.xgboost","SL.glm"),
  list("SL.ranger", c("SL.xgboost", "screen.glmnet")),
  c("SL.glmnet","SL.glm"),
  c("SL.ranger","SL.glm"),
  c(learners$names, "SL.glm"),
  c(learners$names, "SL.glmnet"),
  c("SL.gam","SL.glm"),
  c(learners2$names, "SL.glm"))

# sample
allnum <- START:END
n_sample <- length(allnum)
n_i <- 6000

# Function to run one TMLE iteration
run_tmle_iteration <- function(seed_val, df, n_i, SL_library) {
  set.seed(seed_val)
  data <- slice_sample(df, n = n_i, replace = T) |> select(Y, A, W1:W4)
  
  # Prepare data
  X_outcome <- data |> select(A, W1:W4) |> as.data.frame()
  X_treatment <- data |> select(W1:W4) |> as.data.frame()
  Y_vec <- data$Y
  A_vec <- data$A
  
  # Outcome model
  SL_outcome <- SuperLearner(
    Y = Y_vec,
    X = X_outcome,
    family = binomial(),
    SL.library = SL_library,
    cvControl = list(V = 5)
  )
  
  # Initial predictions
  outcome <- predict(SL_outcome, newdata = X_outcome)$pred
  
  # Predict under treatment A=1
  X_outcome_1 <- X_outcome |> mutate(A=1)
  outcome_1 <- predict(SL_outcome, newdata = X_outcome_1)$pred
  
  # Predict under treatment A=0
  X_outcome_0 <- X_outcome |> mutate(A=0)
  outcome_0 <- predict(SL_outcome, newdata = X_outcome_0)$pred
  
  # Bound outcome predictions to avoid qlogis issues
  outcome <- pmax(pmin(outcome, 0.9999), 0.0001)
  outcome_1 <- pmax(pmin(outcome_1, 0.9999), 0.0001)
  outcome_0 <- pmax(pmin(outcome_0, 0.9999), 0.0001)
  
  # Treatment model
  SL_treatment <- SuperLearner(
    Y = A_vec,
    X = X_treatment,
    family = binomial(),
    SL.library = SL_library,
    cvControl = list(V = 5)
  )
  
  # Propensity scores
  ps <- predict(SL_treatment, newdata = X_treatment)$pred
  
  # Truncate propensity scores 
  ps_final <- pmax(pmin(ps, 0.95), 0.05)
  
  # Calculate clever covariates
  a_1 <- 1/ps_final
  a_0 <- -1/(1 - ps_final)
  clever_covariate <- ifelse(A_vec == 1, 1/ps_final, -1/(1 - ps_final))
  
  epsilon_model <- glm(Y_vec ~ -1 + offset(qlogis(outcome)) + clever_covariate, 
                       family = "binomial")
  epsilon <- coef(epsilon_model)
  
  updated_outcome_1 <- plogis(qlogis(outcome_1) + epsilon * a_1)
  updated_outcome_0 <- plogis(qlogis(outcome_0) + epsilon * a_0)
  
  # Calc ATE
  ate <- mean(updated_outcome_1 - updated_outcome_0)
  
  # Calc SE
  updated_outcome <- ifelse(A_vec == 1, updated_outcome_1, updated_outcome_0)
  se <- sqrt(var((Y_vec - updated_outcome) * clever_covariate + 
                   updated_outcome_1 - updated_outcome_0 - ate) / n_i)
  
  return(list(ate = ate, se = se))
}

# Run iterations in parallel
for (num in 1:length(SL_library)) {
  if (num %in% c(1:9)) { next }
  cat(num)
  cat("TMLE iterations in parallel with 4 workers (multicore)...\n")
  start_time <- Sys.time()
  
  results_list <- future_lapply(START:END, function(i) {
    result <- run_tmle_iteration(i, df, n_i, SL_library[[num]])
    if (i %% 100 == 0) cat("Completed iteration:", i, "\n")
    return(result)
  }, future.seed = TRUE)
  
  end_time <- Sys.time()
  run_time <- end_time - start_time
  
  # Extract results
  predicted_ate <- sapply(results_list, function(x) x$ate)
  pred_se <- sapply(results_list, function(x) x$se)
  
  # Results
  results <- tibble(
    iteration = START:END,
    ate = predicted_ate,
    se = pred_se,
    ci_lower = ate - 1.96 * se,
    ci_upper = ate + 1.96 * se,
    covers_truth = true_ATE >= ci_lower & true_ATE <= ci_upper
  )
  
  # Summary stats
  summary_stats <- tibble(
    metric = c("true_ATE", "mean_estimated_ATE", "median_estimated_ATE", 
               "sd_estimates", "mean_SE", "coverage_probability", "bias"),
    value = c(
      true_ATE,
      mean(predicted_ate),
      median(predicted_ate),
      sd(predicted_ate),
      mean(pred_se),
      mean(results$covers_truth),
      mean(predicted_ate) - true_ATE
    )
  )
  
  # Create output directory if it doesn't exist
  if (!dir.exists("tmle_results")) {
    dir.create("tmle_results")
  }
  
  # Save detailed results (all iterations)
  write.csv(results, paste0("tmle_results/tmle_iterations",num,".csv"), row.names = FALSE)
  
  # Save summary statistics
  write.csv(summary_stats, paste0("tmle_results/tmle_summary",num,".csv"), row.names = FALSE)
  
  # Save simulation parameters
  sim_params <- tibble(
    parameter = c("n_population", "n_sample_iterations", "n_bootstrap_size", 
                  "SL_library", "n_workers", "runtime_seconds"),
    value = c(n, n_sample, n_i, 
              paste(SL_library[[num]], collapse = ", "), 
              4, as.numeric(run_time, units = "secs"))
  )
  write.csv(sim_params, paste0("tmle_results/simulation_parameters",num,".csv"), row.names = FALSE)
  
  # Save as RData for easy loading
  save(results, summary_stats, sim_params, true_ATE, file = paste0("tmle_results/tmle_results",num,".RData"))

}

What we did above is basically a template script (We are saving this as par_test_script.R), one where we can edit where to begin and end in terms of which iteration to start and end per node. And also instruction to save result. This is when we can put a little more effort in incorporating some instructions to inform us when task is completed (e.g., via email) and also it would also be nice to know what is the ETA of the entire task by perhaps benchmarking how long the first iteration took to complete, then multiple by total iters per node. Again, this can be sent via email, and also maybe only for the first node as opposed to all nodes, so we’re not bombarded with messages beginning and the end. 🤣

Install Packages On All Nodes

## List all of our nodes
my_clusters <- list(
  c("username1@192.168.1.101"),
  c("username2@192.168.1.102"),
  c("username3@192.168.1.103"))


## Grab all of the packages needed on our script  
packages <- gsub("library\\(([^)]+)\\)", "\\1",grep("^library",readLines("par_test_script.R"),value = T))

## Create function to run sudo
remote_r_sudo <- function(host, r_code, intern = FALSE) {
  escaped <- gsub('"', '\\\\"', r_code)
  cmd <- sprintf("ssh %s 'sudo Rscript -e \"%s\"'", host, escaped)
  system(cmd, intern = intern)
}

## Loop over to install
for (cluster_i in my_clusters) {
  print(cluster_i)
  for (package in packages) {
  command <- sprintf('if (!require("%s")) install.packages("%s")', package, package)
  remote_r_sudo(cluster_i, command)
  }
}

Make sure your computer doesn’t go to sleep with this. If this is the first time your nodes are installing these extensive libraries, it will take a while. Another way we can do this is to use future_lapply for all nodes and also tmux for all installations so that we don’t need to rely on our local workstation to be turned on to continue with the installation. See below on how we used tmux to set and forget method.

Upload Rscript to Nodes

Alright, now we have installed the appropriate packages above, let’s upload scripts to our nodes.

Distribute Work

num_list <- list()
clust_num <- 3
total_loop <- 1000
div_iter <- total_loop/clust_num
final_iter <- total_loop #only use this for custom e.g., if one node did not work and it's in charge of 300:500, we can put 500 for this and set first_iter as 300
first_iter <- 1
last_iter <- round(div_iter,0) + first_iter

for (i in 1:clust_num) {
  if (i == clust_num) {
    num_list[[i]] <- paste0(first_iter,":",final_iter)
    next
  }
  num_list[[i]] <- paste0(first_iter,":",last_iter)
  first_iter <- round(first_iter + div_iter, 0) 
  last_iter <- round(last_iter + div_iter, 0)
}

num_list

## [[1]]
## [1] "1:334"
## 
## [[2]]
## [1] "334:667"
## 
## [[3]]
## [1] "667:1000"

for (i in 1:length(my_clusters)) {
  username <- sub("@.*","",my_clusters[[i]])
  system(sprintf("sed 's/START:END/%s/g' par_test_script.R > par_test_script1.R & scp par_test_script1.R %s:/home/%s/par_test_script1.R",num_list[[i]],my_clusters[[i]],username))
}

We’ll iterate and insert the appropriate iters for each node and save it to par_test_script1.R. Then upload to each nodes with the code above.

Check set.seed in multicore

sample_df <- function(seed, df, n = 6000) {
  set.seed(seed)
  df_sample <- slice_sample(n = n, .data = df)
  return(df_sample)
}

future_lapply(100, function(x) sample_df(seed=x,df=df))

When we did the above on local computer and also in terminal with multicore. It’s still the same! Woo hoo!

The interesting thing is I didn’t have to set future.seed = T or future.seed = some_number for this. However, if we put a number on future.seed, it will return the reproducible data! This is great, next time I’ll just use this seed and I don’t have to use set.seed(i). 🙌

Run Rscript

for (i in 1:length(my_clusters)) {
  # set your tmux new session name, here we call it "test"
  cluster_name <- "test"
  
  # terminate any existing tmux with the existing name
  system(sprintf("ssh %s 'tmux kill-session -t %s 2>/dev/null || true'", my_clusters[[i]], cluster_name))
  
  # create new tmux session
  system(sprintf("ssh %s 'tmux new-session -d -s %s'", my_clusters[[i]], cluster_name))
  
  # run rscript in tmux
  system(sprintf("ssh %s 'tmux send-keys -t %s \"Rscript par_test_script1.R > result_%d.txt\"' ENTER",
                 my_clusters[[i]], cluster_name, i))
}

The code above is quite self-explanatory. Once the above code is run and completed, there we have it! it should be running in the background! 🙌 You can do a spot check and see if it’s actually running. Once completed, we’ll extract the data.

Extract Data

Since we have 10 combinations we want to assess, we will set nums as 1:10 and get our data! On your template script you can set however you want to save your data, and for extraction, just look for those and download them, read and merge! Or however you want to do it.

nums <- 1:10
df <- tibble()
for (num in nums) {
  print(num)
for (i in 1:length(my_clusters)) {
  response <- system(sprintf("scp %s:tmle_results/simulation_parameters%d.csv simulation_parameters%d.csv", my_clusters[[i]], num, num), intern = F)
  if (response == 1) { next }
  df_i <- read_csv(paste0("simulation_parameters",num,".csv"), show_col_types = F) 
  sl_i <- df_i |> filter(parameter == "SL_library") |> pull(value)
  df <- rbind(df, df_i |> mutate(method = sl_i, num = num))
}
}

df_sim_param <- df

df <- tibble()
for (num in nums) {
for (i in 1:length(my_clusters)) {
  response <- system(sprintf("scp %s:tmle_results/tmle_iterations%d.csv tmle_iterations%d.csv", my_clusters[[i]], num, num), intern = F)
  if (response == 1) { print(paste0(my_clusters[[i]]," is missing num", num)) ; next }
  df_i <- read_csv(paste0("tmle_iterations",num,".csv"), show_col_types = F) |>
    mutate(num = num)
  df <- rbind(df, df_i)
}
}

df_iter <- df

Take note that sometimes you may encounter issues, if for some reason the node is unable to complete the task, you can identify it then redistribute those tasks to the entire computer cluster.

Compare Time

Let’s take at our compute time for 1 cluster, 3 cluster with 5-fold cv, 3 cluster with 10-fold cv.

method	hour_1clus_cv5	hour_3clus_cv5	hour_3clus_cv10
SL.xgboost, SL.ranger, SL.glm, SL.mean	4.02	1.4126466	2.5179200
SL.xgboost, SL.ranger	4.00	1.4136567	2.5108584
SL.xgboost, SL.glm	0.47	0.1680019	0.3034212
SL.ranger, c("SL.xgboost", "screen.glmnet")	4.23	1.4960542	2.5165429
SL.glmnet, SL.glm	NA	0.1074466	0.1995869
SL.ranger, SL.glm	NA	1.2544446	2.2254909
xgb_500_5_0.001, xgb_1000_5_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, SL.glm	3.29	1.8059939	3.3030737
xgb_500_5_0.001, xgb_1000_5_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, SL.glmnet	NA	1.8956873	3.4821903
SL.gam, SL.glm	NA	0.1094693	0.2072266
xgb_250_3_0.001, xgb_500_3_0.001, xgb_1000_3_0.001, xgb_250_5_0.001, xgb_500_5_0.001, xgb_1000_5_0.001, xgb_250_7_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_250_9_0.001, xgb_500_9_0.001, xgb_1000_9_0.001, xgb_250_3_0.005, xgb_500_3_0.005, xgb_1000_3_0.005, xgb_250_5_0.005, xgb_500_5_0.005, xgb_1000_5_0.005, xgb_250_7_0.005, xgb_500_7_0.005, xgb_1000_7_0.005, xgb_250_9_0.005, xgb_500_9_0.005, xgb_1000_9_0.005, xgb_250_3_0.01, xgb_500_3_0.01, xgb_1000_3_0.01, xgb_250_5_0.01, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_250_7_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, xgb_250_9_0.01, xgb_500_9_0.01, xgb_1000_9_0.01, SL.glm	NA	NA	4.6127172

Looking at the time, we can definitely see the improvement of time from 1 cluster to 3 cluster. Take a look at our good old tuned xgboost and logistic regression, it took use previously for a quadcore 3.29 hours to complete, down to 1.8 hours. You’d imagine that if we use 3 pc’s as a cluster, we would notice improvement to ~1.1 hours, but I guess not for xgboost. Will have to investigate this. But if we look at xgboost + logistic regression without tuning, we went from 0.47 hours to 0.17 hours which made sense! Very interesting. Now if we up our CV to 10 fold, then we see that it took longer (makes senses), but still better than using 1 quadcore. I’ve heard people said that if you increase your K-fold CV, you reduce your bias, but increase variance. Let’s see if that’s true in our case here.

method	bias_3clus_cv5	bias_3clus_cv10	variance_3clus_cv5	variance_3clus_cv10
SL.xgboost, SL.ranger, SL.glm, SL.mean	-0.0007695	-0.0007257	0.0001866	0.0001940
SL.xgboost, SL.ranger	-0.0007677	-0.0007257	0.0001866	0.0001940
SL.xgboost, SL.glm	-0.0010481	0.0001018	0.0001586	0.0001617
SL.ranger, c("SL.xgboost", "screen.glmnet")	-0.0008349	-0.0007257	0.0001868	0.0001940
SL.glmnet, SL.glm	-0.0449075	-0.0449065	0.0001502	0.0001503
SL.ranger, SL.glm	-0.0007695	-0.0007257	0.0001866	0.0001940
xgb_500_5_0.001, xgb_1000_5_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, SL.glm	0.0006449	0.0010681	0.0001491	0.0001504
xgb_500_5_0.001, xgb_1000_5_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, SL.glmnet	0.0005986	0.0010492	0.0001502	0.0001511
SL.gam, SL.glm	-0.0062967	-0.0062967	0.0001537	0.0001537
xgb_250_3_0.001, xgb_500_3_0.001, xgb_1000_3_0.001, xgb_250_5_0.001, xgb_500_5_0.001, xgb_1000_5_0.001, xgb_250_7_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_250_9_0.001, xgb_500_9_0.001, xgb_1000_9_0.001, xgb_250_3_0.005, xgb_500_3_0.005, xgb_1000_3_0.005, xgb_250_5_0.005, xgb_500_5_0.005, xgb_1000_5_0.005, xgb_250_7_0.005, xgb_500_7_0.005, xgb_1000_7_0.005, xgb_250_9_0.005, xgb_500_9_0.005, xgb_1000_9_0.005, xgb_250_3_0.01, xgb_500_3_0.01, xgb_1000_3_0.01, xgb_250_5_0.01, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_250_7_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, xgb_250_9_0.01, xgb_500_9_0.01, xgb_1000_9_0.01, SL.glm	NA	0.0013250	NA	0.0001528

Wow, not too shabby! Indeed when we went from cv5 to cv10, we have reduced bias and slightly increased variance! How about that. Everything except gam + lr, which make sense because we don’t really tune them. Though that being said, I wonder what’s under the hood that controls the knot for gam in superlearner. Will need to check that out. With this, it looks like tuned xgboost + lr might have the best numbers. Well, now we’ve seen bias and variance, what about coverage?

method	coverage_3clus_cv5	coverage_3clus_cv10
SL.xgboost, SL.ranger, SL.glm, SL.mean	0.536	0.517
SL.xgboost, SL.ranger	0.536	0.517
SL.xgboost, SL.glm	0.811	0.799
SL.ranger, c("SL.xgboost", "screen.glmnet")	0.539	0.517
SL.glmnet, SL.glm	0.051	0.052
SL.ranger, SL.glm	0.536	0.517
xgb_500_5_0.001, xgb_1000_5_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, SL.glm	0.882	0.878
xgb_500_5_0.001, xgb_1000_5_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, SL.glmnet	0.881	0.876
SL.gam, SL.glm	0.926	0.926
xgb_250_3_0.001, xgb_500_3_0.001, xgb_1000_3_0.001, xgb_250_5_0.001, xgb_500_5_0.001, xgb_1000_5_0.001, xgb_250_7_0.001, xgb_500_7_0.001, xgb_1000_7_0.001, xgb_250_9_0.001, xgb_500_9_0.001, xgb_1000_9_0.001, xgb_250_3_0.005, xgb_500_3_0.005, xgb_1000_3_0.005, xgb_250_5_0.005, xgb_500_5_0.005, xgb_1000_5_0.005, xgb_250_7_0.005, xgb_500_7_0.005, xgb_1000_7_0.005, xgb_250_9_0.005, xgb_500_9_0.005, xgb_1000_9_0.005, xgb_250_3_0.01, xgb_500_3_0.01, xgb_1000_3_0.01, xgb_250_5_0.01, xgb_500_5_0.01, xgb_1000_5_0.01, xgb_250_7_0.01, xgb_500_7_0.01, xgb_1000_7_0.01, xgb_250_9_0.01, xgb_500_9_0.01, xgb_1000_9_0.01, SL.glm	NA	0.844

as not expecting gam + lr to have so much coverage! But looking at bias from the previous table, it's actually quite horrible. So it seems like gam + lr is assymetrical in its estimates, sometimes overestimating, sometimes underestimating, leading to a wider confidence interval, hence more coverage. But that being said, it's not a good estimator because of its bias. Tuned xgboost + glmnet seems to be the best bet here with low bias, low variance and decent coverage. Wow, I was not expecting gam + lr to have so much coverage! But looking at bias from the previous table, it's actually quite horrible. Let's visualize it!

5-fold CV

code

library(tidyverse)

num_df <- sim_param_cv5_clus5 |>
  select(num, method)

df_coverage <- df_iter_cv5_clus3 |>
  group_by(num) |>
  arrange(ate) |>
  mutate(iter = row_number()) |>
  mutate(cover = case_when(
    covers_truth == F & ate < true_ATE ~ "right_missed",
    covers_truth == F & ate > true_ATE ~ "left_missed",
    covers_truth == T ~ "covered"
  )) |>
  select(num, cover) |>
  group_by(num, cover) |>
  tally() |>
  ungroup(cover) |>
  mutate(prop = n*100/sum(n)) |>
  pivot_wider(id_cols = num, names_from = "cover", values_from = "prop") |>
  mutate(text = paste0("right missed: ",right_missed,"% covered: ",covered,"% left missed: ",left_missed,"%")) |>
  select(num, text)

method <- tibble(
  num = c(1:9),
  method = c("xgb + rf + lr + mean","xgb + rf","xgb + lr","rf + (xgb + preprocess w glmnet)","glmnet + lr","rf + lr","tuned xgb + lr","tuned xgb + glmnet","gam + lr")
)

plot <- df_iter_cv5_clus3 |>
  group_by(num) |>
  arrange(ate) |>
  mutate(iter = row_number()) |>
  mutate(cover = case_when(
    covers_truth == F & ate < true_ATE ~ "right_missed",
    covers_truth == F & ate > true_ATE ~ "left_missed",
    covers_truth == T ~ "covered"
  )) |>
  ggplot(aes(x=iter,y=ate,color=cover)) +
  geom_point(alpha=0.2) +
  geom_errorbar(aes(x=iter,ymin=ci_lower,ymax=ci_upper), alpha=0.2) +
  geom_hline(aes(yintercept=0.0373518), color = "blue") +
  geom_text(data = df_coverage,
            aes(x = 500, label = text),
            y = -0.05,  
            inherit.aes = FALSE,
            size = 3,
            hjust = 0.5) +
  scale_color_manual(values = c("covered" = "#619CFF", 
                                  "left_missed" = "#F8766D", 
                                  "right_missed" = "#00BA38")) +
  theme_bw() +
  facet_wrap(.~num, ncol = 1,labeller = as_labeller(setNames(method$method, method$num))) +
  theme(legend.position = "bottom")

lr: logistic regression, xgb: xgboost, rf : random forest, gam : generalized additive model.

Wow, look at gam + lr’s assymetrical coverage! This is so true then when we’re assessing, a point estimate of coverage is not adequate to assess the global usefulness of a method. We can see that this method is very bias indeed with asymmetrical tails. Since CV5 and CV10 do not have significant difference in coverage, we’ll skip the visualization.

Opportunities for improvement

plenty of opportunities to turn our personal project into a package that will help us
Use parallel computing on local to run system (such as installation) since this takes a lot of time
Write function to let us know when tasks are completed
Write function to estimate time of completion
Write function to redistribute missing iterations
learn openMPI
make a package for the functions above so I can reuse in the future

Lessons Learnt:

used more sprintf with this learning experience when using with system.
learn that in future_lapply in multicore future.seed=100 or whatever number will help reproduce the same data
Made a few pipeline to install packages on multiple nodes
learnt set.seed in multicore works fine
observed reduced bias with increase variance from cv5 to cv10

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

Testing Super Learner's Coverage - A Note To Myself

Fri, 02 Jan 2026 00:00:00 +0000

Testing Super Learner with TMLE showed some interesting patterns 🤔 XGBoost + random forest only hit ~54% coverage, but tuned xgboost + GLM reached ~90%. Seems like pairing flexible learners with stable (even misspecified) models helps? Need to explore this more with different setups 📊

Motivations:

We have previously looked at TMLE without Super Learner and observed the poor coverage of TMLE with unspecified xgboost when compared to a correctly specified logistic regression. Now since we’ve learnt NNLS the default method behind Super Learner, why dont we test it out and take a look at the coverage! Let’s take a look at our previous coverage plot.

We saw that with xgboost and TMLE, our coverage is about 71.1-87.6% and the lower and upper tails are asymmetrical. What if we use SuperLearner, can we improve these coverage?

Objectives

Let’s Code

We will be using the same data generating mechanism as before, but this time we will be using Super Learner to estimate the propensity score and outcome regression.Let’s write a code where we can use multicore and also a cheap 2nd hand lenovo with quad-core and Ubuntu to run and store results. Part of my learning goal for 2026 is to experiment more with parallel computing and see if we can explore mathematical platonic space more using simulation! Stay tuned on that, more to come on the simple parallel computing cluster set up!

code

library(dplyr)
library(SuperLearner)
library(future)
library(future.apply)

# Set up parallel processing
plan(multicore, workers = 4)

set.seed(1)

n <- 10000
W1 <- rnorm(n)
W2 <- rnorm(n)
W3 <- rbinom(n, 1, 0.5)
W4 <- rnorm(n)

# TRUE propensity score model
A <- rbinom(n, 1, plogis(-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4))

# TRUE outcome model
Y <- rbinom(n, 1, plogis(-1 + 0.2*A + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2))

# Calculate TRUE ATE
logit_Y1 <- -1 + 0.2 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2
logit_Y0 <- -1 + 0 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2

Y1_true <- plogis(logit_Y1)
Y0_true <- plogis(logit_Y0)
true_ATE <- mean(Y1_true - Y0_true)

df <- tibble(W1 = W1, W2 = W2, W3 = W3, W4 = W4, A = A, Y = Y)

tune = list(
  ntrees = c(500,1000),           # More trees for better performance
  max_depth = c(3,5),                    # Deeper trees capture interactions
  shrinkage = c(0.001,0.01)    # Finer learning rate control
)

learners <- create.Learner("SL.xgboost", tune = tune, detailed_names = TRUE, name_prefix = "xgb")

# Super Learner library 
SL_library <- list(c("SL.xgboost", "SL.ranger", "SL.glm", "SL.mean"),
                   c("SL.xgboost","SL.ranger"),
                   c("SL.xgboost","SL.glm"),
                   list("SL.ranger", c("SL.xgboost", "screen.glmnet")),
                   c(learners$names, "SL.glm"))

# sample
n_sample <- 1000
n_i <- 6000

# Function to run one TMLE iteration
run_tmle_iteration <- function(seed_val, df, n_i, SL_library) {
  set.seed(seed_val)
  data <- slice_sample(df, n = n_i, replace = T) |> select(Y, A, W1:W4)
  
  # Prepare data
  X_outcome <- data |> select(A, W1:W4) |> as.data.frame()
  X_treatment <- data |> select(W1:W4) |> as.data.frame()
  Y_vec <- data$Y
  A_vec <- data$A
  
  # Outcome model
  SL_outcome <- SuperLearner(
    Y = Y_vec,
    X = X_outcome,
    family = binomial(),
    SL.library = SL_library,
    cvControl = list(V = 5)
  )
  
  # Initial predictions
  outcome <- predict(SL_outcome, newdata = X_outcome)$pred
  
  # Predict under treatment A=1
  X_outcome_1 <- X_outcome |> mutate(A=1)
  outcome_1 <- predict(SL_outcome, newdata = X_outcome_1)$pred
  
  # Predict under treatment A=0
  X_outcome_0 <- X_outcome |> mutate(A=0)
  outcome_0 <- predict(SL_outcome, newdata = X_outcome_0)$pred
  
  # Bound outcome predictions to avoid qlogis issues
  outcome <- pmax(pmin(outcome, 0.9999), 0.0001)
  outcome_1 <- pmax(pmin(outcome_1, 0.9999), 0.0001)
  outcome_0 <- pmax(pmin(outcome_0, 0.9999), 0.0001)
  
  # Treatment model
  SL_treatment <- SuperLearner(
    Y = A_vec,
    X = X_treatment,
    family = binomial(),
    SL.library = SL_library,
    cvControl = list(V = 5)
  )
  
  # Propensity scores
  ps <- predict(SL_treatment, newdata = X_treatment)$pred
  
  # Truncate propensity scores 
  ps_final <- pmax(pmin(ps, 0.95), 0.05)
  
  # Calculate clever covariates
  a_1 <- 1/ps_final
  a_0 <- -1/(1 - ps_final)
  clever_covariate <- ifelse(A_vec == 1, 1/ps_final, -1/(1 - ps_final))
  
  epsilon_model <- glm(Y_vec ~ -1 + offset(qlogis(outcome)) + clever_covariate, 
                       family = "binomial")
  epsilon <- coef(epsilon_model)
  
  updated_outcome_1 <- plogis(qlogis(outcome_1) + epsilon * a_1)
  updated_outcome_0 <- plogis(qlogis(outcome_0) + epsilon * a_0)
  
  # Calc ATE
  ate <- mean(updated_outcome_1 - updated_outcome_0)
  
  # Calc SE
  updated_outcome <- ifelse(A_vec == 1, updated_outcome_1, updated_outcome_0)
  se <- sqrt(var((Y_vec - updated_outcome) * clever_covariate + 
                   updated_outcome_1 - updated_outcome_0 - ate) / n_i)
  
  return(list(ate = ate, se = se))
}

# Run iterations in parallel
for (num in 1:length(SL_library)) {
cat("TMLE iterations in parallel with 4 workers (multicore)...\n")
start_time <- Sys.time()

results_list <- future_lapply(1:n_sample, function(i) {
  result <- run_tmle_iteration(i, df, n_i, SL_library[[num]])
  if (i %% 100 == 0) cat("Completed iteration:", i, "\n")
  return(result)
}, future.seed = TRUE)

end_time <- Sys.time()
run_time <- end_time - start_time

# Extract results
predicted_ate <- sapply(results_list, function(x) x$ate)
pred_se <- sapply(results_list, function(x) x$se)

# Results
results <- tibble(
  iteration = 1:n_sample,
  ate = predicted_ate,
  se = pred_se,
  ci_lower = ate - 1.96 * se,
  ci_upper = ate + 1.96 * se,
  covers_truth = true_ATE >= ci_lower & true_ATE <= ci_upper
)

# Summary stats
summary_stats <- tibble(
  metric = c("true_ATE", "mean_estimated_ATE", "median_estimated_ATE", 
             "sd_estimates", "mean_SE", "coverage_probability", "bias"),
  value = c(
    true_ATE,
    mean(predicted_ate),
    median(predicted_ate),
    sd(predicted_ate),
    mean(pred_se),
    mean(results$covers_truth),
    mean(predicted_ate) - true_ATE
  )
)

# Create output directory if it doesn't exist
if (!dir.exists("tmle_results")) {
  dir.create("tmle_results")
}

# Save detailed results (all iterations)
write.csv(results, paste0("tmle_results/tmle_iterations",num,".csv"), row.names = FALSE)

# Save summary statistics
write.csv(summary_stats, paste0("tmle_results/tmle_summary",num,".csv"), row.names = FALSE)

# Save simulation parameters
sim_params <- tibble(
  parameter = c("n_population", "n_sample_iterations", "n_bootstrap_size", 
                "SL_library", "n_workers", "runtime_seconds"),
  value = c(n, n_sample, n_i, 
            paste(SL_library[[num]], collapse = ", "), 
            4, as.numeric(run_time, units = "secs"))
)
write.csv(sim_params, paste0("tmle_results/simulation_parameters",num,".csv"), row.names = FALSE)

# Save as RData for easy loading
save(results, summary_stats, sim_params, true_ATE, file = paste0("tmle_results/tmle_results",num,".RData"))

As previously, we’ve set up our true ATE and simulation and will sample 60% of the N=10000 and ran a bootstrap of 1000. This time, instead of solo ML, we will use Super Learner to ensemble several models and then estimate our ATE and if the 95% CI covers the true ATE. Below are the combinations we will investigate:

xgboost + randomforest + glm + mean
xgboost + randomforest
xgboost + glm
randomforest + (xgboost + screen.glmnet) + glm
xgboost_tuned + glm

What’s The Result

Wow, these are very interesting results! Looking at 1) where we have xgboost, randomforest, glm, and mean, our coverage was pretty horrible at ~50%. For 3) with xgboost and glm, coverage increased to ~80%, very similar to our solo tuned xgboost previously but at least with symmetrical non-coverage, very interesting. But when 2) we combined both xgboost and randomforest, the coverage dropped back to ~50%. Same thing happened when we used feature engineering 4) glmnet prior to xgboost, then couple with xgboost, coverage was only ~50%. But, when we 5) tune xgboost and combine it with glm, coverage increased to ~90%! I was not expecting this result but this is quite amazing! With regards to how long it took for each combination for a quadcore processor with multicore feature:

method	time_hours
SL.xgboost, SL.ranger, SL.glm, SL.mean	4.02
SL.xgboost, SL.ranger	4.00
SL.xgboost, SL.glm	0.47
SL.ranger, SL.xgboost, screen.glmnet	4.23
tuned SL.xghboost, SL.glm	3.29

Opportunities for improvement

attempt using optimized hyperparameters for both xgboost and randomforest
write a function for splitting multicore to several nodes
try using NNloglik / maximize on auc instead of nnls, would it work better?
need to test the theory that whether set.seed works differently with multicore? Or does future automatically chooses L'Ecuyer-CMRG Algorithm? does our current method of set.seed(i) of iteration number work ok?
need to try mcSuperLearner, built-in multicore

Lessons Learnt

learnt future_lapply
learnt multicore is so much faster!!! Though when we future_lapply the function it appears to have the same time as multisession
tested Super Learner, it’s pretty cool! It already has options for parallel computing
found out that mixing flexible model like xgboost (tuned) and logreg regularizes the ensembled model

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

Happy New Year 2026

Thu, 01 Jan 2026 00:00:00 +0000

My 2026 New Year Resolutions. Reflect on 2025. Writing it down for 2026 to make it more accountable

My 2025 New Year Resolutions

Explore Gimp
~~Explore useful VIM key binding~~
~~Learn nodejs, javascript, fasthtml, fashapi, plumber to create a simple tool for calling API and storing data~~
~~Explore and implement LLM-assisted learning scenarios for eval score calibration (DE Level 3)~~
~~re-create automation at wrk~~
~~?sti dashboard~~
~~Complete my neural network study. This time we’re getting close!~~
Practice 华语
Dive into McElReath’s Statistical Rethinking 2nd time
~~Maintain coaching skill and practice more! ?reach out to CECM for 2~~
Finish 2 manuscripts

I did explore gimp a little bit but not enough to strike that off the list. We’ll see if I’ll resume that in 2026. One thing I found that often times it’s not the initial action that made me commit to learning something but usually it’s the second, third, or even fourth time with long period in between that brings me closer to understanding certain things. Or at least the illusion of understanding, that is. 🤣

I did start using vim key binding. Thanks Alec for the motivation! I need to get better this year for sure! With regards to plumber API, we did explore that! Wrote 2 blogs on it too! here and here.

Quite satisfied with some of the completion in 2025, LLM-assisted scenarios, completed neural network study, re-created automation, sti dashboard, maintaing coaching skill, prepared 1 manuscript instead of 2. Let’s work on that in 2026!

Something that I wasn’t expecting in 2025 was a year of diving head on into bioinformatics. Wow, I thought it was just 1 or 2 blogs but no, the various topics, the interesting math and methods behind it, I just couldn’t resist learning more and more of the surface of these topics! Very intriguing indeed! I did 8 blogs total on bioinformatics, and there are more that I want to dive into! Such as ampC, CRE, mec, vanA etc. Looking forward!

Things that didn’t go as planned -> I started out ok with 华语 with duolingo but then got tapered off. Didn’t really dive into Richard McElreath’s statistical rethinking the second time. Did only 1 manuscript. Didn’t put too much effort on gimp. Maybe better effort this year!

My 2026 New Year Resolutions

Explore molecular docking & medication discovery
Explore more bioinformatics (e.g ampC, CRE, mec, vanA etc), 59 skill
Use more parallel computing (at least once a month with future and personally built function for multicore)
Build a computer cluster
Explore simple quantum computing
Use more tidymodels, keras and torch; I do think I’ll be exploring more AI/ML models in 2026 due to research
Git, can’t get away from this
Healthy life style
Attend res conference at least 4x/month
work research
use more vim (at least cumulative 15 mins per week - try working on copy & pasting)
Rewatch Richard McElreath’s Statistical Rethinking, especially on Gaussian Process and ordered logistic regression

My Messy Notes on Building a Super Learner: Peeking Under The Hood of NNLS

Sun, 21 Dec 2025 00:00:00 +0000

📚 Tried building Super Learner from scratch to understand what’s happening under the hood. Walked through the NNLS algorithm step-by-step—turns out ensembling models may beat solo models! Our homegrown version? Surprisingly close to nnls package results ❤️ But, does it really work in real life? 🤷‍♂️

Motivations

Previously we have learnt the workflow of TMLE and most people would say to use it with Super Learner. But what is Super Learner? The name sounds fancy and cool. Let’s take a look under the hood of how super is this Super Learner. In this blog, we will see what non-negative least square is and what is the algorithm that is behind this method that fuels Super Learner. We’ll take a look at the mathematical procedures and then code from scratch and see if we can reproduce the result. Let’s do this!

Objectives:

What is Super Learner?

Super Learner is an ensemble machine learning algorithm that optimally combines predictions from multiple candidate algorithms to create a single ensembled model. Rather than selecting a single “best” model through traditional model selection methods, Super Learner leverages the strengths of various algorithms by creating a weighted average of their predictions. The fundamental insight is elegant: why choose between a random forest, generalized linear model, or gradient boosting machine when you can let the data determine the optimal combination of all three? This approach was introduced by Mark van der Laan and colleagues and has become particularly popular in causal inference and epidemiology, often paired with Targeted Maximum Likelihood Estimation (TMLE) to obtain robust, efficient estimates of causal effects.

What is the algorithm behind Super Learner?

The beauty of Super Learner lies in its theoretical guarantee: it will perform at least as well as the best single algorithm in your library of candidate learners, and often performs substantially better. This property, known as the oracle inequality, means that Super Learner asymptotically achieves the lowest possible prediction error among the combinations of the candidate algorithms. 🤔 To be transparent, I don’t really understand all these. But, let’s move on. The engine behind this is Non-Negative Least Squares (NNLS), an elegant constrained optimization method that finds the optimal weights for combining your candidate algorithms.

Note: The Super Learner theory does not require NNLS, but works well in practice and is often much faster than true convex combination optimization, and can be seen in the early work on Stacked Regression by Leo Breiman.

NNLS

At its core, NNLS solves a seemingly simple problem: given a matrix X of predictions from your candidate algorithms and an outcome vector y, find weights β that minimize the squared prediction error ||y - Xβ||² subject to two crucial constraints:

all weights must be non-negative (β ≥ 0)
~~the weights must sum to one (ensuring a proper convex combination).~~

Note: Unlike the theoretical Super Learner which requires weights to sum to one (convex combination), NNLS only enforces non-negativity. This relaxation makes the optimization much faster while performing just as well in practice. Thanks to Eric Polley for correcting and educating me on the above. Much appreciated!

Lawson-Hanson Algorithm

The most commonly used algorithm for solving NNLS is the active set method developed by Lawson and Hanson in 1974. This iterative algorithm is remarkably intuitive: it maintains two sets of variables—an “active set” of variables currently in the model with positive weights, and a “passive set” of variables currently excluded (with zero weights). The algorithm begins with all variables in the passive set, then iteratively identifies which passive variable, if added to the active set, would most improve the fit. Once a variable enters the active set, the algorithm solves an unconstrained least squares problem using only the active variables. If any weights become negative during this step, the algorithm removes the most negative variable from the active set and repeats the process. This addition-and-removal dance continues until no passive variables would improve the fit and all active variables have positive weights—at which point we’ve found our optimal solution.

OK, too many words above. Not a fan. 😵‍💫 Lots of procedures above, let’s break it down to steps and write a simple example with code to go through the process. Let’s create a simple example.

code

X <- rbind(
  c(1.5,3,4),
  c(0.5,2,3),
  c(4.5,6,6)
)

y <- c(2,1,5)

$$ \begin{gather} \text{X} = \begin{bmatrix} 1.5 & 3 & 4 \\ 0.5 & 2 & 3 \\ 4.5 & 6 & 6 \end{bmatrix} ; \text{y} = \begin{bmatrix} 2 \\ 1 \\ 5 \end{bmatrix} \end{gather} $$

Let’s take a quick look at the matrices above. Just glancing at it you would think the weights for each models (columns) should be within column 1 and column 2. Let’s go through Lawson-hanson algorithm procedure

Step 0: Initialize Your Sets

Start with all variables in the passive set (R) and none in the active set (P). Like so:

$$ \text{P} = \emptyset $$

$$ R = \{1, 2, 3\} $$ $$ \beta = \begin{bmatrix} 0 \\ 0 \\ 0 \end{bmatrix} $$

P : Active Set (Take note, I used P as active, not passive; also these are indexes)
R : Passive Set (take note, these are indexes)
β : weights

We will go throught the iterative procedure below, move Passive set (R) one by one to Active set (P) until we no longer have any passive sets available.

Step 1 Find Gradient

code

# step 1: find gradient 
gradient <- t(X) %*% (y-X %*% beta)
if (sum(gradient<=0)==dim(X)[2]) { stop("all gradients are zero or negative, we have achieved optimality") }
if (length(R)==0) { stop("R is empty")}

$$ \begin{gather} \text{Gradient} = \text{X}^{\text{T}} \cdot (\text{y} - \text{X}\beta) \end{gather} $$ The above is the procedure to find gradient for ||y - Xβ||². Let’s put in the numbers and calculate

$$ \begin{gather} \text{Gradient} = \text{X}^{\text{T}} \cdot (\text{y} - \text{X}\beta) \\ = \begin{bmatrix} 1.5 & 3 & 4 \\ 0.5 & 2 & 3 \\ 4.5 & 6 & 6 \end{bmatrix}^\text{T} \cdot ( \begin{bmatrix} 2 \\ 1 \\ 5 \end{bmatrix} - \begin{bmatrix} 1.5 & 3 & 4 \\ 0.5 & 2 & 3 \\ 4.5 & 6 & 6 \end{bmatrix} \begin{bmatrix} 0 \\ 0 \\ 0 \end{bmatrix} ) \\ = \begin{bmatrix} 1.5 & 0.5 & 4.5 \\ 3 & 2 & 6 \\ 4 & 3 & 6 \end{bmatrix} \cdot ( \begin{bmatrix} 2 \\ 1 \\ 5 \end{bmatrix} - \begin{bmatrix} 1.5 & 3 & 4 \\ 0.5 & 2 & 3 \\ 4.5 & 6 & 6 \end{bmatrix} \begin{bmatrix} 0 \\ 0 \\ 0 \end{bmatrix} ) \\ = \begin{bmatrix} 1.5 & 0.5 & 4.5 \\ 3 & 2 & 6 \\ 4 & 3 & 6 \end{bmatrix} \cdot \begin{bmatrix} 2 \\ 1 \\ 5 \end{bmatrix} \\ = \begin{bmatrix} 26.5 \\ 44 \\ 41 \end{bmatrix} \end{gather} $$

Step 2 Check Optimality & Find Next Variable to Add To P

If all gradients are non-positive, we have achieved optimality. If not, proceed to the next step. Find the index of R of the maximum gradient. In this case, max of 26.5, 44, 41 is 44, which is the second column of X.

$$ \begin{gather} \text{Next Variable} = \text{argmax}_{j \in R} \text{Gradient}_j \\ = 2 \end{gather} $$ We then move 2 from R (passive set) to P (active set) like so:

$$ \text{P} = \{2\} $$ $$ R = \{1, 3\} $$

Step 3 Solve the Unconstrained Least Squares Problem for Active Set P.

$$ \begin{gather} \beta_P = (\text{X}_P^{\text{T}} \cdot \text{X}_P)^{-1} \cdot \text{X}_P^{\text{T}} \cdot \text{y} \\ = (\begin{bmatrix} 3 \\ 2 \\ 6 \end{bmatrix}^{\text{T}} \cdot \begin{bmatrix} 3 \\ 2 \\ 6 \end{bmatrix})^{-1} \cdot \begin{bmatrix} 3 \\ 2 \\ 6 \end{bmatrix}^{\text{T}} \cdot \begin{bmatrix} 2 \\ 1 \\ 5 \end{bmatrix} \\ = (9 + 4 + 36)^{-1} \cdot \begin{bmatrix} 3 & 2 & 6 \end{bmatrix} \cdot \begin{bmatrix} 2 \\ 1 \\ 5 \end{bmatrix} \\ = 49^{-1} \cdot \begin{bmatrix} 3 \cdot 2 + 2 \cdot 1 + 6 \cdot 5 \end{bmatrix} \\ = 49^{-1} \cdot \begin{bmatrix} 44 \end{bmatrix} \\ = \begin{bmatrix} 0.8979592 \end{bmatrix} \end{gather} $$

Where X_P is the sub-matrix of X containing only the columns in the active set P. In our case, P = {2}, so β is:

$$ \begin{gather} \beta = \begin{bmatrix} 0 \\ 0.8979592 \\ 0 \end{bmatrix} \end{gather} $$ Still with me? We went from initializing zero weights (beta) for all 3 to now with the second model having weight of 0.89796

Step 4 Check For Negative Weights

$$ \begin{gather} \text{If any } \beta_P \leq 0, \text{ calculate } \alpha \text{ else go back to step 1}\\ \alpha = \min_{\beta_P \leq 0} \frac{\beta_{old}}{\beta_{old} - \beta_P} \\ \text{If } \alpha < 1, \text{ update } \beta = \beta_{old} + \alpha (\beta_P - \beta_{old}) \\ \text{Remove any variables from P where } \beta \leq 0 \text{ and return them to R} \end{gather} $$ Since our weights $\beta$ cannot be negative, and if we hit a negative value, we want to shift all $\beta$ by $\alpha$ proportion of the difference and make the calculated negative weight 0 and adjust the other weights equally.

After the above, we go iterate until R set is empty. You get the point, instead of latex the entire calculation, let’s use code to get to our answers.

P <- c()
R <- c(1:dim(X)[2])
beta <- rep(0, dim(X)[2])

while (T) {
# step 1: find gradient 
gradient <- t(X) %*% (y-X %*% beta)
if (sum(gradient<=0)==dim(X)[2]) { print("all gradients are zero or negative, we have achieved optimality") ; break }
if (length(R)==0) { print("R is empty") ; break }

# step 2: check optimality
gradient_not_active <- gradient
gradient_not_active[P] <- -Inf
P_x <- which(gradient_not_active==max(gradient_not_active))
P <- c(P,P_x) |> unique() |> sort()
R <- setdiff(R, P_x)

# solve P
beta_i <- beta
beta_i[P] <- solve(t(X[,P]) %*% X[,P]) %*% t(X[,P])%*%y
if (any(beta_i<0)) { 
  print(paste0("negative weights: ",paste(beta_i, collapse = " ")))  
  idx <- which(beta_i<0)
  beta_old <- beta[idx]
  beta_new <- beta_i[idx]
  alpha <- beta_old/-(beta_new-beta_old)
  beta_i_new <- beta - alpha*(beta-beta_i) 
  beta <- beta_i_new |> round(digits = 4)
  print(paste0("new weights after setting negative weight as zero: ", paste(beta,collapse = " ")))
  } else {  beta <- beta_i ; print(beta) }
}

## [1] 0.0000000 0.0000000 0.6721311
## [1] 0.8683544 0.0000000 0.1810127
## [1] "negative weights: 0.666666666666675 0.333333333333364 -7.105427357601e-15"
## [1] "new weights after setting negative weight as zero: 0.6667 0.3333 0"
## [1] "R is empty"

beta

## [1] 0.6667 0.3333 0.0000

X %*% beta

##         [,1]
## [1,] 1.99995
## [2,] 0.99995
## [3,] 4.99995

Wow, it worked! Look at our weights (beta) and our final results! As suspected, column 1 and 2 will have the weights (more on column 1) and when combined our final numbers are quite close to our y, which is 2, 1, 5 . Awesome! Now, let’s simulate more data and see if our code works and compare it with nnls package!

Let’s Put Them All Together

Simulate Data

# labels/outcome/y
num_labels <- 1000
label_range <- 1:5
y <- sample(label_range, num_labels, replace=T)

# X matrix
num_models <- 5
X <- matrix(nrow = num_labels, ncol = num_models)
for (i in 1:num_models) {
  sd <- sample(c(0.01,1,10))
  for (j in 1:num_labels) {
  X[j, i] <- rnorm(1, mean = y[j], sd = sd)
}
}

Alright, what we did above is basically simulated y and X

P <- c()
R <- c(1:dim(X)[2])
beta <- rep(0, dim(X)[2])

while (T) {
# step 1: find gradient 
gradient <- t(X) %*% (y-X %*% beta)
if (sum(gradient<=0)==dim(X)[2]) { print("all gradients are zero or negative, we have achieved optimality") ; break }
if (length(R)==0) { print("R is empty") ; break }

# step 2: check optimality
gradient_not_active <- gradient
gradient_not_active[P] <- -Inf
P_x <- which(gradient_not_active==max(gradient_not_active))
P <- c(P,P_x) |> unique() |> sort()
R <- setdiff(R, P_x)

# solve P
beta_i <- beta
beta_i[P] <- solve(t(X[,P]) %*% X[,P]) %*% t(X[,P])%*%y
if (any(beta_i<0)) { 
  print(paste0("negative weights: ",paste(beta_i, collapse = " ")))  
  idx <- which(beta_i<0)
  beta_old <- beta[idx]
  beta_new <- beta_i[idx]
  alpha <- beta_old/-(beta_new-beta_old)
  beta_i_new <- beta - alpha*(beta-beta_i) 
  beta <- beta_i_new |> round(digits = 4)
  print(paste0("new weights after setting negative weight as zero: ", paste(beta,collapse = " ")))
  } else {  beta <- beta_i ; print(beta) }
}

## [1] 0.000000 0.000000 1.000061 0.000000 0.000000
## [1] 1.289716e-05 0.000000e+00 1.000049e+00 0.000000e+00 0.000000e+00
## [1] "negative weights: -4.80441441441621e-06 0 0.530291436850037 0 0.469820844889452"
## [1] "new weights after setting negative weight as zero: 0 0 0.6578 0 0.3423"
## [1] "negative weights: -4.57899476983191e-06 6.81265663325082e-05 0.530205009482599 0 0.469839806590533"
## [1] "new weights after setting negative weight as zero: 0 0 0.6578 0 0.3423"
## [1] "negative weights: -4.73337830228063e-06 6.51033708645959e-05 0.530467184328906 -5.88823524796493e-06 0.469586269810267"

## Warning in alpha * (beta - beta_i): longer object length is not a multiple of
## shorter object length

## [1] "new weights after setting negative weight as zero: 0 0 0.6578 0 0.3423"
## [1] "R is empty"

Let’s look at our weights and RMSE

beta

## [1] 0.0000 0.0000 0.6578 0.0000 0.3423

sqrt(mean((y - X %*% beta)^2))

## [1] 0.007206879

Let’s look at nnls package and see if we can the same result

model <- nnls::nnls(A=X,b=y)
model

## Nonnegative least squares model
## x estimates: 0 6.970084e-05 0.53029 0 0.4697488 
## residual sum-of-squares: 0.04886
## reason terminated: The solution has been computed sucessfully.

sqrt(mean((y - X %*% model$x)^2))

## [1] 0.006989728

wow! Awesome!!! Looks the same or at least very similar. Alright, now we’re at least able to reproduce the nnls portion from scratch. Let’s see if we can simulate a non-linear data and train with different models and see how our end result is!

Let’s Super Learn this thing

Click below at code to expand for the entire procedures. We basically ran 3 different models in tidymodels, linear regression, xgboost, and random forest with recipe (y ~ .), not specifying any interaction/polynomial relationships for a simulated data below.

n <- 1000
x <- rnorm(n)
w <- rnorm(n, 0.5*x)
y <- 0.2*x + 0.5*w + 0.2*x*w + 0.05*x^2

Made sure to set seed for reproducibility, create 5 fold for cross validation. Then extract all the prediction for validation sets from each models and stack them into X matrix. Then extract the RMSE from each models and stack them into metrics matrix. Finally, we run our nnls code above to get the weights and RMSE for super learner. We repeat this for 1000 iterations and log the results.

This cross-validation step is the defining feature of the Super Learner. By fitting each base learner on training folds and generating out-of-fold predictions, we obtain an unbiased prediction matrix that is then used to estimate optimal ensemble weights via NNLS.

code

library(tidymodels)
library(future)
library(furrr)

# Set up parallel processing
plan(multisession, workers = availableCores() - 2)

# Define the function to run for each iteration
run_iteration <- function(i) {
  set.seed(i)
  n <- 1000
  x <- rnorm(n)
  w <- rnorm(n, 0.5*x)
  y <- 0.2*x + 0.5*w + 0.2*x*w + 0.05*x^2
  
  df <- tibble(x,w,y)
  split <- initial_split(df)
  train <- training(split)
  test <- testing(split)
  # preprocess
  rec <- recipe(y ~ ., data=train) 
  
  # linear regression
  lr_spec <- linear_reg()
  wf <- workflow() |>
    add_recipe(rec) |>
    add_model(lr_spec)
  folds <- vfold_cv(train, 5)
  cv_results <- wf |>
    fit_resamples(folds, control = control_resamples(save_pred = TRUE))
  cv_metrics <- collect_metrics(cv_results) |> filter(.metric == "rmse") |> pull(mean)
  cv_preds <- collect_predictions(cv_results) 
  
  #xgboost
  xgb_spec <- boost_tree(engine = "xgboost", mode = "regression")
  wf <- workflow() |>
    add_recipe(rec) |>
    add_model(xgb_spec)
  cv_results <- wf |>
    fit_resamples(folds, control = control_resamples(save_pred = T))
  cv_metrics2 <- collect_metrics(cv_results) |> filter(.metric == "rmse") |> pull(mean)
  cv_preds2 <- collect_predictions(cv_results) 
  
  # random forest
  rf_spec <- rand_forest(mode = "regression")
  wf <- workflow() |>
    add_recipe(rec) |>
    add_model(rf_spec)
  cv_results <- wf |>
    fit_resamples(folds, control = control_resamples(save_pred = T))
  cv_metrics3 <- collect_metrics(cv_results) |> filter(.metric == "rmse") |> pull(mean)
  cv_preds3 <- collect_predictions(cv_results) |>
    mutate(model = "rf")
  X <- cbind(cv_preds |> select(X1=.pred),cv_preds2 |> select(X2=.pred), cv_preds3 |> select(X3=.pred)) |> as.matrix()
  y <- cv_preds |> select(y) |> as.matrix()
  metrics <- cbind(cv_metrics,cv_metrics2,cv_metrics3)
  
  # nnls
  P <- c()
  R <- c(1:dim(X)[2])
  beta <- rep(0, dim(X)[2])
  
  while (T) {
    # step 1: find gradient 
    gradient <- t(X) %*% (y-X %*% beta)
    if (sum(gradient<=0)==dim(X)[2]) { print("all gradients are zero or negative, we have achieved optimality") ; break }
    if (length(R)==0) { print("R is empty") ; break }
    # step 2: check optimality
    gradient_not_active <- gradient
    gradient_not_active[P] <- -Inf
    P_x <- which(gradient_not_active==max(gradient_not_active))
    P <- c(P,P_x) |> unique() |> sort()
    R <- setdiff(R, P_x)
    # solve P
    beta_i <- beta
    beta_i[P] <- solve(t(X[,P]) %*% X[,P]) %*% t(X[,P])%*%y
    if (any(beta_i<0)) { 
      print(paste0("negative weights: ",paste(beta_i, collapse = " ")))  
      idx <- which(beta_i<0)
      beta_old <- beta[idx]
      beta_new <- beta_i[idx]
      alpha <- beta_old/-(beta_new-beta_old)
      beta_i_new <- beta - alpha*(beta-beta_i) 
      beta <- beta_i_new |> round(digits = 4)
      print(paste0("new weights after setting negative weight as zero: ", paste(beta,collapse = " ")))
    } else {  beta <- beta_i ; print(beta) }
  }

  rmse_superlearner <- sqrt(mean((y - X %*% beta)^2))
  rmse_result <- if (sum(metrics < rmse_superlearner) >= 1) { "solo_better" } else { "superlearner_better" }
  
  model <- nnls::nnls(A=X,b=y)
  rmse_ours_nnls <- c(rmse_superlearner, sqrt(mean((y - X %*% model$x)^2)))
  same_weights_result <- if (sum(round(beta, 4) == round(model$x, 4)) == 3) { "same" } else { "not_same" }
  weights_log <- c(model$x, beta)
  
  return(list(rmse_log = rmse_result, same_weights_log = same_weights_result, weights_log=weights_log))
}

# Run with future_map
results <- future_map(1:1000, run_iteration, .options = furrr_options(seed = TRUE), .progress = TRUE)

Let’s Compare RMSE of Solo models vs Super Learner models

code

library(tidyverse)

# Extract results
rmse_log <- map_chr(results, "rmse_log")
same_weights_log <- map_chr(results, "same_weights_log")
weight_logs <- matrix(NA, ncol = 6, nrow = 1000)
for (i in 1:1000) {
  weight_logs[i, 1:6] <- results[[i]]$weights_log
}

plotrmse_log <- tibble(rmse=rmse_log) |>
  ggplot(aes(x=rmse)) +
  geom_bar() +
  theme_bw()

Wow, look at that! superlearner/ensembled model does appear to have better RMSE compared to solo models! Let’s take a look and see if our noob nnls from scratch is comparable with nnls package.

Comparing Our NNLS to `nnls` package

code

plotsameweights <- tibble(same_weights=same_weights_log) |>
  ggplot(aes(x=same_weights)) +
  geom_bar() +
  theme_bw()

Wow, most of the weights are the same if we round up to 4 digits! Let’s check on the ones with difference, is it REALLY that different?

code

plotdiff123 <- weight_logs |>
  as_tibble() |>
  mutate(diff1 = round(V4-V1, 4),
         diff2 = round(V5-V2, 4),
         diff3 = round(V6-V3, 4),
         sum_diff = diff1+diff2+diff3) |>
  filter(sum_diff != 0) |>
  pivot_longer(cols = c(diff1,diff2,diff3), names_to = "diff", values_to = "values") |>
  ggplot(aes(x=values,fill=diff)) +
  geom_histogram(position = "dodge2") +
  theme_bw()

This makes sense, most of the differences are between xgboost (diff2) and random forest (diff3), as our linear regression (diff1) model without correct specification probably won’t have a whole of contributions, hence if there is a difference between our algorithm and nnls, it would be minimal (center in red). It also make sense that if there is a difference in xgboost or random forest model, we would see different weight on the other model contribution. Now the question is, with these weight differences, does it make a huge difference in RMSE? I suspect not so much.

code

rmse_compare <- matrix(NA, ncol = 2, nrow = 1000)
for (i in 1:1000) {
  rmse_compare[i,1:2] <- results[[i]]$rmse_ours_nnls 
}

plotcompare <- weight_logs |>
  as_tibble() |>
  mutate(row = row_number()) |>
  mutate(diff1 = round(V4-V1, 4),
         diff2 = round(V5-V2, 4),
         diff3 = round(V6-V3, 4),
         sum_diff = diff1+diff2+diff3) |>
  filter(sum_diff != 0) |>
  left_join(as_tibble(rmse_compare) |>
              mutate(row = row_number()), by = "row") |>
  mutate(V1.y = round(V1.y, 4),
         V2.y = round(V2.y, 4)) |>
  mutate(check = case_when(
    V1.y == V2.y ~ "same",
    V1.y < V2.y ~ "our_nnls_better",
    V1.y > V2.y ~ "nnls_package_better",
    TRUE ~ NA_character_
  )) |>
  ggplot(aes(x=check)) +
  geom_bar() +
  theme_bw()

lol, nnls package clearly is better than our home-grown algorithm! But by how much?

code

plotdiffrmse <- weight_logs |>
  as_tibble() |>
  mutate(row = row_number()) |>
  mutate(diff1 = round(V4-V1, 4),
         diff2 = round(V5-V2, 4),
         diff3 = round(V6-V3, 4),
         sum_diff = diff1+diff2+diff3) |>
  filter(sum_diff != 0) |>
  left_join(as_tibble(rmse_compare) |>
              mutate(row = row_number()), by = "row") |>
  mutate(V1.y = round(V1.y, 4),
         V2.y = round(V2.y, 4)) |>
  mutate(diff_rmse = V1.y - V2.y) |>
  ggplot(aes(diff_rmse)) +
  geom_histogram() +
  theme_bw()

😵‍💫 It’s really not that much different! Let’s find the max.

code

weight_logs |>
  as_tibble() |>
  mutate(row = row_number()) |>
  mutate(diff1 = round(V4-V1, 4),
         diff2 = round(V5-V2, 4),
         diff3 = round(V6-V3, 4),
         sum_diff = diff1+diff2+diff3) |>
  filter(sum_diff != 0) |>
  left_join(as_tibble(rmse_compare) |>
              mutate(row = row_number()), by = "row") |>
  mutate(V1.y = round(V1.y, 4),
         V2.y = round(V2.y, 4)) |>
  mutate(diff_rmse = V1.y - V2.y) |>
  pull(diff_rmse) |> max()

## [1] 9e-04

## [1] 9e-04

🥹 Does that mean our home-grown algorithm works just as well? You be the judge. Let me know if this is due to pure luck!

Acknowledgement:

Thanks Eric Polley for correcting and educating me on that NNLS does not require the beta coefficients sum up to 1 (only non-negative). Also The Super Learner theory does not require NNLS, but works well in practice and is often much faster than true convex combination optimization, and can be seen in the early work on Stacked Regression by Leo Breiman. Much appreciated!

Opportunities for improvement

will try multicore sometime in the future, is it really faster than multisession?
need to learn/figure out FAST nnls algorithm which I believe nnls package uses
need to venture more in parallel computing
compare with the actual SuperLearner package

Lessons learnt

learnt to build Super Learner using non-negative least square model
learnt Lawson-Hanson algorithm and how it’s implemented, compared with nnls and results not too shabby!
learnt some basics of parallel computing

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

Bias, Variance, and Doubly Robust Estimation: Testing The Promise of TMLE in Simulated Data

Sun, 16 Nov 2025 00:00:00 +0000

Finally understood TMLE’s “doubly robust” property through simulation. Works well when either outcome OR treatment model is correct. XGBoost + TMLE captured complex relationships without manual specification. But beware the confidence intervals - Frank Harrell was right to say “prepare to be disappointed!” 🤔

Motivations:

I’ve always heard about Targeted Maximum Likelihood Estimation (TMLE) and I’ve read Katherine Hoffman’s blog post several times. Printed her cheat sheet and go through it several times. Each time I thought I understood it, the next time I found myself questioning my understanding. 🤣 So, what a better way to dive a tad deeper as to the machinery behind this, and why is it useful? Let’s go!

Just to set the context right, we’re going to estimate Average Treatment Effect (ATE) and use g-computation as a standard approach.

Objectives:

What is TMLE?

TMLE is a statistical method used for estimating causal effects in observational studies and clinical trials. It combines elements of machine learning and traditional statistical techniques to provide robust estimates of treatment effects while controlling for confounding variables. TMLE operates in two main steps: first, it estimates the outcome model and the treatment model, and then it uses these models to adjust the treatment effect estimate, targeting the parameter of interest directly. This approach is particularly useful in settings where standard methods may be biased or inefficient, as it allows for the incorporation of flexible machine learning algorithms to improve estimation accuracy. You will hear the term Doubly Robust about this method. What’s do robust x 2 about this?

What Does Doubly Robust mean?

Doubly Robust (DR) estimation refers to a statistical property of certain estimators that remain consistent if either the model for the treatment assignment (propensity score) or the model for the outcome is correctly specified, but not necessarily both. In other words, a doubly robust estimator provides two chances for obtaining a valid estimate of the causal effect: if one of the models is misspecified, as long as the other model is correctly specified, the estimator will still yield consistent results. This property is particularly advantageous in observational studies where there may be uncertainty about the correct specification of either model, enhancing the reliability of causal inferences drawn from the data. I didn’t quite understand this until we simulated the data to test this theory. It will, hopefully, be more clear when we go through the simulation. But, wait, what metrics should we use for this? Bias and variance!

What is Bias and Variance?

Bias and variance are two fundamental concepts in statistics and machine learning that describe different sources of error in predictive models. Bias refers to the systematic error that occurs when a model consistently overestimates or underestimates the true value of a parameter. High bias can lead to underfitting, where the model fails to capture the underlying patterns in the data. Variance, on the other hand, refers to the variability of model predictions for different training datasets. High variance can lead to overfitting, where the model captures noise in the training data rather than the true signal. The trade-off between bias and variance is a key consideration in model selection and evaluation, as it affects the overall accuracy and generalizability of predictive models.

The formula for bias is: $$ \text{Bias}(\hat{\theta}) = E[\hat{\theta}] - \theta $$ Where:

$\hat{\theta}$ is the estimator of the parameter $\theta$
$E[\hat{\theta}]$ is the expected value of the estimator

In pseudo-R code would look something like this:

predicted_theta <- vector(mode = "numeric", length=1000)

for (i in 1:1000) {
  training_data <- dplyr::slice_sample(original_training_data, n = nrow(original_training_data), replace = T)
  model <- glm(outcome~treatment+confounder,data=training_data)
  outcome_hat_1 <- predict(model,newdata = training_data |> mutate(treatment = 1))
  outcome_hat_0 <- predict(model,newdata = training_data |> mutate(treatment = 0))
  predicted_theta[i] <- mean(outcome_hat_1) - mean(outcome_hat_0)
}

bias <- mean(predicted_theta) - theta

In my own language, bias is, how close our estimation on average is to the true value.

The formula for variance is: $$ \text{Var}(\hat{\theta}) = E[(\hat{\theta} - E[\hat{\theta}])^2] $$

Where:

$\hat{\theta}$ is the estimator of the parameter $\theta$
$E[\hat{\theta}]$ is the expected value of the estimator

In pseudo-R code would look something like this:

predicted_theta <- vector(mode = "numeric", length=1000)

for (i in 1:1000) {
  training_data <- dplyr::slice_sample(original_training_data, n = nrow(original_training_data), replace = T)
  model <- glm(outcome~treatment+confounder,data=training_data)
  outcome_hat_1 <- predict(model,newdata = training_data |> mutate(treatment = 1))
  outcome_hat_0 <- predict(model,newdata = training_data |> mutate(treatment = 0))
  predicted_theta[i] <- mean(outcome_hat_1) - mean(outcome_hat_0)
}

variance <- mean((predicted_theta-mean(predicted_theta))^2)
# or 
variance <- var(predicted_theta)

We will be using bias and variance to test the doubly robust theory. But first, let’s simulate some data!

Simulate Data

library(tidyverse)

set.seed(1)

n <- 10000
W1 <- rnorm(n)
W2 <- rnorm(n)
W3 <- rbinom(n, 1, 0.5)
W4 <- rnorm(n)

# TRUE propensity score model
A <- rbinom(n, 1, plogis(-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4))

# TRUE outcome model
Y <- rbinom(n, 1, plogis(-1 + 0.2*A + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2))

# Calculate TRUE ATE
logit_Y1 <- -1 + 0.2 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2
logit_Y0 <- -1 + 0 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2

Y1_true <- plogis(logit_Y1)
Y0_true <- plogis(logit_Y0)
true_ATE <- mean(Y1_true - Y0_true)

df <- tibble(W1 = W1, W2 = W2, W3 = W3, W4 = W4, A = A, Y = Y,
           true_ATE = true_ATE, Y1_true = Y1_true, Y0_true = Y0_true)

Alright, our true ATE here is 0.0373518. We’ll see if doubly robust method can be able to estimate this either outcome or treatment model is misspecified.

Write a Function to Estimate

Let’s look at the WRONG Outcome model ❌

model <- glm(Y ~ A + W1 + W2 + W3 + W4, family = "binomial")

summary(model)

## 
## Call:
## glm(formula = Y ~ A + W1 + W2 + W3 + W4, family = "binomial")
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.045765   0.041489 -25.206   <2e-16 ***
## A           -0.050142   0.047732  -1.050    0.293    
## W1           0.767386   0.026058  29.449   <2e-16 ***
## W2          -0.024726   0.022807  -1.084    0.278    
## W3           0.561572   0.045658  12.300   <2e-16 ***
## W4          -0.003209   0.022382  -0.143    0.886    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 12737  on 9999  degrees of freedom
## Residual deviance: 11519  on 9994  degrees of freedom
## AIC: 11531
## 
## Number of Fisher Scoring iterations: 4

Ouch. Looking quickly at the coefficient of A is -0.0501418. Totally inverse of the true ATE. Alright let’s look at g-computation and see if it returns the same result.

g-computation function

g_comp <- function(model,data,ml=F) {
  if (ml==T) {
   y1 <- predict(model, new_data=data |> mutate(A=as.factor(1)), type = "prob")[,2] |> pull()
   y0 <- predict(model, new_data=data |> mutate(A=as.factor(0)), type = "prob")[,2] |> pull()
  } else {
  y1 <- predict(model, newdata=data |> mutate(A=1), type = "response")
  y0 <- predict(model, newdata=data |> mutate(A=0), type = "response")
  }
  return(mean(y1-y0))
}

g_comp(model,df)

## [1] -0.009823307

Yup, incorrect! Now what if we use the RIGHT Outcome model?

The correct outcome model ✅

model <- glm(Y ~ A + W1 + I(W2^2) + W3 + W1:W2 + W4, family = "binomial")

g_comp(model,df)

## [1] 0.03576854

Wow! Look at that! if we correctly specify the outcome model, it actually is VERY close to true ATE!

The wrong treatment model ❌

Now what if we use IPW but with the wrong treatment model and see if we can estimate ATE

ps_model <- glm(A ~ W1 + W2 + W3 + W4, family = "binomial")  
ps <- ps_model$fitted.values
ps_final <- pmax(pmin(ps, 0.95), 0.05)
weights <- ifelse(A == 1, 1/ps_final, 1/(1-ps_final))

model <- glm(Y ~ A, family = "binomial", weights = weights)
g_comp(model,df)

## [1] -0.0095777

Wow, very wrong indeed! Now let’s look at the right treatment model

The Correct treatment model ✅

ps_model <- glm(A ~ W1 + I(W2^2) + W3 + W1:W2 + W4, family = "binomial")  #-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4

ps <- ps_model$fitted.values
ps_final <- pmax(pmin(ps, 0.95), 0.05)
weights <- ifelse(A == 1, 1/ps_final, 1/(1-ps_final))

model <- glm(Y ~ A, family = "binomial", weights = weights)
g_comp(model,df)

## [1] 0.03874379

Not too shabby! very close to our true ATE! To be honest, how on earth are we supposed to know before hand the complex equation to specify on either treatment or outcome model !?

Let’s Try ML xgboost

Let’s see if xgboost can tease out outcome model without us specifying all these weird interactions and quadratic relationships.

library(tidymodels)
library(doParallel)  
library(future)

workers <- parallel::detectCores(logical = FALSE) - 1
plan(multisession, workers = workers)
future::nbrOfWorkers() 

# Set up parallel processing
all_cores <- parallel::detectCores(logical = FALSE)
cl <- makePSOCKcluster(all_cores - 1)  # Leave 1 core free
registerDoParallel(cl)

df_ml <- df |> 
  select(Y,A,W1,W2,W3,W4) |>
  mutate(Y = as.factor(Y),
         A = as.factor(A))

# Define model specification
xgb_spec <- boost_tree(
  trees = 1000,
  tree_depth = tune(),
  min_n = tune(),
  loss_reduction = tune(),
  # sample_size = tune(),
  mtry = tune(),
  learn_rate = tune()
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")  

# Create workflow
xgb_wf <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(Y ~ .)

# Tuning grid
xgb_grid <- grid_space_filling(
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),df_ml),
  learn_rate(),
  size = 20
)

# Cross-validation and tuning
set.seed(1)
folds <- vfold_cv(df_ml, v = 5)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE,
                         parallel_over = "everything")
)

# Select best model
best_xgb <- select_best(xgb_res, metric = "roc_auc")

# Finalize and fit
final_xgb <- finalize_workflow(xgb_wf, best_xgb)
final_fit <- fit(final_xgb, data = df_ml)

# g-comp
g_comp(final_fit, df_ml, T)

## [1] 0.03447109

Wow, nice! ✅ Quite close to our true ATE without specifying any interactions or quadratic relationship. Mind you, this dataset is quite large.

Now, let’s try out if we can use xgboost to create an accurate treatment model and use its weights to plug into our good trust glm.

# Rereate workflow
xgb_wf <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(A ~ .)

# Tuning grid
xgb_grid <- grid_space_filling(
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),df_ml |> select(-Y)),
  learn_rate(),
  size = 20
)

# Cross-validation and tuning
set.seed(1)
folds <- vfold_cv(df_ml |> select(-Y), v = 5)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE,
                         parallel_over = "everything")
)

# Select best model
best_xgb <- select_best(xgb_res, metric = "roc_auc")

# Finalize and fit
final_xgb <- finalize_workflow(xgb_wf, best_xgb)
final_fit <- fit(final_xgb, data = df_ml |> select(-Y))

# calc ps
ps <- predict(final_fit, new_data = df_ml |> select(-Y), type = "prob")[,2] |> pull()
ps_final <- ps
weights <- ifelse(A == 1, 1/ps_final, 1/(1-ps_final))

# glm model 
model <- glm(Y ~ A, family = "binomial", weights = weights)
g_comp(model, df_ml)

## [1] 0.04840169

Wow, compared to this, our ATE is much closer to our true ATE than the wrongly specified treatment model. Though it’s still quite biased, isn’t it? it’s far from the true ATE. But at least we know ML methods can probably handle these complex relationhip.

Now let’s write function to estimate bias and variance! Since that’s our major question. And then we’ll look into TMLE procedure.

code

bias <- function(predicted_theta, theta) {
  return(mean(predicted_theta - theta))
}

variance <- function(predicted_theta) {
  return(var(predicted_theta))
}

TMLE

Since we know xgboost is able to estimate the correct outcome model, why don’t we just use logistic regression here. Let’s imagine we somehow got only treatment model correct, but not the outcome model, will TMLE be able to tease this out?

Step 1. Create Outcome Model

model_outcome <- glm(Y ~ A + W1 + W2 + W3 + W4, family = "binomial") #wrong
model_outcome_all <- predict(model_outcome, newdata = df, type = "response")
model_outcome_1 <- predict(model_outcome, newdata = df |> mutate(A = 1), type = "response")
model_outcome_0 <- predict(model_outcome, newdata = df |> mutate(A = 0), type = "response")

Step 2. Create Treatment Model & Clever Covariate

model_treatment <- glm(A ~ W1 + I(W2^2) + W3 + W1:W2 + W4, family = "binomial")  #-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4

ps <- model_treatment$fitted.values
ps_final <- ps
# ps_final <- pmax(pmin(ps, 0.95), 0.05)
a_1 <- 1/(predict(model_treatment, df, type = "response"))
a_0 <- -1/(1 - predict(model_treatment, df, type = "response"))
clever_covariate <- ifelse(A == 1, 1/ps_final, -1/(1-ps_final))

Step 3. Estimate Fluctuation Parameter

epsilon_model <- glm(Y ~ -1 + offset(qlogis(model_outcome$fitted.values)) + clever_covariate, family = "binomial")
summary(epsilon_model)

## 
## Call:
## glm(formula = Y ~ -1 + offset(qlogis(model_outcome$fitted.values)) + 
##     clever_covariate, family = "binomial")
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## clever_covariate 0.041886   0.009675   4.329  1.5e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 11519  on 10000  degrees of freedom
## Residual deviance: 11497  on  9999  degrees of freedom
## AIC: 11499
## 
## Number of Fisher Scoring iterations: 4

epsilon <- epsilon_model$coefficients

Step 4. Update Initial Outcomes

updated_outcome_1 <- plogis(qlogis(model_outcome_1)+epsilon*a_1)
updated_outcome_0 <- plogis(qlogis(model_outcome_0)+epsilon*a_0)

Step 5. Compute ATE

(ate <- mean(updated_outcome_1-updated_outcome_0))

## [1] 0.04068321

Wow, imagine specifying the wrong outcome model, but the right treatment model will bring our ATE to closer to the true ATE! Imagine our wrongly specified outcoem model would have produced ATE of -0.009 here.of Not too shabby!

Step 6. Estimate Standard Error

updated_outcome <- ifelse(A == 1, updated_outcome_1, updated_outcome_0)
se <- sqrt(var((Y-updated_outcome)*clever_covariate+updated_outcome_1-updated_outcome_0-ate)/n)
pval <- 2*(1-pnorm(abs(ate/se)))
print(paste0("ATE: ",round(ate,3), " [95%CI ", round(ate-1.96*se,3),"-",round(ate+1.96*se,3),", p=",round(pval,3),"]"))

## [1] "ATE: 0.041 [95%CI 0.021-0.06, p=0]"

There you have it! Our final estimates, standard error, and pval. Thanks to khstats for step by step guidance. Very helpful to reproduce the framework.

Comparing Models

Now, let’s resample 1000 times with n = 6000 (after sample size calculation of the effect we have with 80% power and alpha 5%) of 1) correctly specified logistic regression outcome model. 2) an inverse probability weighting (IPW) approach with correctly specified treatment assignment probabilities . 3) incorrectly specific logistic regression outcome model. 4) Hyperparameter-tuned xgboost outcome model and see what how their biases and variances differ.

My messy code

n_sample <- 1000
df_ate <- tibble(model=character(),bias=numeric(),variance=numeric())

### correct outcome model specification, logistic regression
predicted_ate <- vector(mode = "numeric", length = n_sample)
for (i in 1:n_sample) {
  set.seed(i)
  data <- slice_sample(df, n = 6000, replace = T)
  model <- glm(Y ~ A + W1 + I(W2^2) + W3 + W1:W2 + W4, data = data, family = "binomial")
  ate <- g_comp(model,data)
  predicted_ate[i] <- ate
}

df_ate <- df_ate |>
  bind_rows(tibble(model="logreg_correct_outcome",bias=bias(predicted_ate,true_ATE),variance=variance(predicted_ate)))

### correct treatment model specification, logistic regression ipw
predicted_ate <- vector(mode = "numeric", length = n_sample)
for (i in 1:n_sample) {
  set.seed(i)
  data <- slice_sample(df, n = 6000, replace = T)
  ps_model <- glm(A ~ W1 + I(W2^2) + W3 + W1:W2 + W4, data=data, family = "binomial")  #-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4

  ps <- ps_model$fitted.values
  ps_final <- pmax(pmin(ps, 0.95), 0.05)
  weights <- ifelse(data$A == 1, 1/ps_final, 1/(1-ps_final))

  model <- glm(Y ~ A, data=data, family = "binomial", weights = weights)
  ate <- g_comp(model,data)
  predicted_ate[i] <- ate
}

df_ate <- df_ate |>
  bind_rows(tibble(model="logreg_treatment_outcome",bias=bias(predicted_ate,true_ATE),variance=variance(predicted_ate)))

### no interaction or quadratic relationship outcome model
predicted_ate <- vector(mode = "numeric", length = n_sample)
for (i in 1:n_sample) {
  set.seed(i)
  data <- slice_sample(df, n = 6000, replace = T)
  model <- glm(Y ~ A + W1 + W2 + W3 + W4, data = data, family = "binomial")
  ate <- g_comp(model,data)
  predicted_ate[i] <- ate
}

df_ate <- df_ate |>
  bind_rows(tibble(model="logreg_wrong_outcome",bias=bias(predicted_ate,true_ATE),variance=variance(predicted_ate)))


### xgboost
library(tidymodels)
library(future)

plan(multisession, workers = 6)

predicted_ate <- vector(mode = "numeric", length = n_sample)
for (i in 1:n_sample) {
set.seed(i)
data <- slice_sample(df, n = 6000, replace = T) |> select(Y,A,W1:W4) |> mutate(Y = as.factor(Y), A = as.factor(A))
train <- data # you really don't need to do this, but i was lazy to change the oother ML codes

xgb_spec <- boost_tree(
  trees = tune(),
  tree_depth = tune(),
  min_n = tune(),
  loss_reduction = tune(),
  mtry = tune(),
  learn_rate = tune()
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")  

# Create workflow
xgb_wf <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(Y ~ .)

# Tuning grid
xgb_grid <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train),
  learn_rate(),
  size = 5
)

# Cross-validation and tuning
folds <- vfold_cv(train, v = 5)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE,
                         verbose = T)
)

# Select best model
best_xgb <- select_best(xgb_res, metric = "roc_auc")

# Finalize and fit
final_xgb <- finalize_workflow(xgb_wf, best_xgb)
final_fit <- fit(final_xgb, data = train)

# g-comp
ate <- g_comp(final_fit, train, T)

predict_ate[i] <- ate
}

df_ate <- df_ate |>
  bind_rows(tibble(model="xgboost_outcome_model",bias=bias(predicted_ate,true_ATE),variance=variance(predicted_ate)))

model	bias	variance
logreg_correct_outcome	-0.0009778	0.0001410
logreg_treatment_outcome	0.0019444	0.0001581
logreg_wrong_outcome	-0.0464683	0.0001354
xgboost_outcome_model	-0.0164066	0.0000459

Wow, look at that! When outcome or treatment models were correctly specified, logistic regression is still the best with the lowest bias and low variance. When the outcome model was incorrectly specified, it became more biased and variance didn’t really change much. When we used xgboost for outcome model only, it’s less biased than misspecified logistic regression outcome model and interestingly, it has the lowest variance. Very interesting! This I think is helpful because it seems like tree based model is able to tease out quadratic and interaction relationship without us having to specify it. Now, what if we use xgboost models for both outcome and treatment models and then use TMLE framework to see if they are any better!

Using TMLE procedures with Xgboost

We’ll do the same as above by resampling 1000 times with n of 6000 with replacement. Then assess the bias and variance of the ATE. We will use xghboost model for both treatment and outcome models. Then use the TMLE procedure for the test as shown above. As for tuning, we will use grid search with space filling (grid_space_filling with size of 5).

My messy code

library(tidymodels)
library(tidyverse)
library(future)
plan(multisession, workers = 4)
predicted_ate <- vector(mode = "numeric", length = n_sample)}

for (i in n_sample:1) {

# sample
data <- slice_sample(df, n = 6000, replace = T) |> select(Y,A,W1:W4) |> mutate(Y = as.factor(Y), A = as.factor(A))
train <- data

# outcome model
xgb_spec <- boost_tree(
  trees = tune(),
  tree_depth = tune(),
  min_n = tune(),
  loss_reduction = tune(),
  # sample_size = tune(),
  mtry = tune(),
  learn_rate = tune()
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")  

# Create workflow
xgb_wf <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(Y ~ .)

# Tuning grid
xgb_grid <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train),
  learn_rate(),
  size = 5
)

# Cross-validation and tuning
folds <- vfold_cv(train, v = 5)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE,
                         # parallel_over = "resamples", 
                         verbose = T)
)

# Select best model
best_xgb <- select_best(xgb_res, metric = "roc_auc")

# Finalize and fit
final_xgb <- finalize_workflow(xgb_wf, best_xgb)
final_fit <- fit(final_xgb, data = train)

# predict
outcome <- predict(final_fit, new_data = train, type = "prob")[,2] |> pull()
outcome_0 <- predict(final_fit, new_data = train |> mutate(A = as.factor(0)), type = "prob")[,2] |> pull()
outcome_1 <- predict(final_fit, new_data = train |> mutate(A = as.factor(1)), type = "prob")[,2] |> pull()

# -------------------------------------------------------
# treatment model 
train_tx <- train |> select(-Y)

xgb_wf_tx <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(A ~ .)


xgb_grid_tx <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train_tx),
  learn_rate(),
  size = 5
)

# Cross-validation and tuning
folds_tx <- vfold_cv(train_tx, v = 5)

xgb_res_tx <- tune_grid(
  xgb_wf_tx,
  resamples = folds_tx,
  grid = xgb_grid_tx,
  control = control_grid(save_pred = TRUE,
                         verbose = T)
)

# Select best model
best_xgb_tx <- select_best(xgb_res_tx, metric = "roc_auc")

# Finalize and fit
final_xgb_tx <- finalize_workflow(xgb_wf_tx, best_xgb)
final_fit_tx <- fit(final_xgb_tx, data = train_tx)

ps <- predict(final_fit_tx, new_data = train_tx |> select(-A), type = "prob")[,2] |> pull()
ps_final <- ps
a_1 <- 1/(predict(final_fit_tx, new_data = train_tx, type = "prob")[,2] |> pull())
a_0 <- -1/(1 - (predict(final_fit_tx, new_data = train_tx, type = "prob")[,2] |> pull()))
clever_covariate <- ifelse(train_tx$A == 1, 1/ps_final, -1/(1-ps_final))

# step 3 
epsilon_model <- glm(train$Y ~ -1 + offset(qlogis(outcome)) + clever_covariate, family = "binomial")
summary(epsilon_model)
epsilon <- epsilon_model$coefficients

#### Step 4. Update Initial Outcomes
updated_outcome_1 <- plogis(qlogis(outcome_1)+epsilon*a_1)
updated_outcome_0 <- plogis(qlogis(outcome_0)+epsilon*a_0)

#### Step 5. Compute ATE
ate <- mean(updated_outcome_1-updated_outcome_0)

predicted_ate[i] <- ate
}

df_ate <- df_ate |>
bind_rows(tibble(model="xgboost_tmle_model_size5",bias=bias(predicted_ate,true_ATE),variance=variance(predicted_ate)))

model	bias	variance
logreg_correct_outcome	-0.0009778	0.0001410
logreg_treatment_outcome	0.0019444	0.0001581
logreg_wrong_outcome	-0.0464683	0.0001354
xgboost_outcome_model	-0.0164066	0.0000459
xgboost_tmle_model_size5	0.0066270	0.0001399

Wow, how about that! Less biased than xgboost of outcome model only! Although the variance appear to be higher than pure xgboost outcome model, but it’s about the same as logistic regression. It does seem like TMLE can improve bias. Do you think we can do better? What if we increase the size to 20?

My messy code

predicted_ate <- vector(mode = "numeric", length = n_sample)

for (i in 1:n_sample) {
  set.seed(i)
data <- slice_sample(df, n = 6000, replace = T) |> select(Y,A,W1:W4) |> mutate(Y = as.factor(Y), A = as.factor(A))
train <- data
# train <- df |> select(Y,A,W1:W4) |> mutate(Y = as.factor(Y), A = as.factor(A))


# outcome model
xgb_spec <- boost_tree(
  trees = tune(),
  tree_depth = tune(),
  min_n = tune(),
  loss_reduction = tune(),
  # sample_size = tune(),
  mtry = tune(),
  learn_rate = tune()
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")  

# Create workflow
xgb_wf <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(Y ~ .)

# Tuning grid
xgb_grid <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train),
  learn_rate(),
  size = 20
)

# Cross-validation and tuning
folds <- vfold_cv(train, v = 5)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE,
                         # parallel_over = "resamples", 
                         verbose = T)
)

# Select best model
best_xgb <- select_best(xgb_res, metric = "roc_auc")

# Finalize and fit
final_xgb <- finalize_workflow(xgb_wf, best_xgb)
final_fit <- fit(final_xgb, data = train)

# predict
outcome <- predict(final_fit, new_data = train, type = "prob")[,2] |> pull()
outcome_0 <- predict(final_fit, new_data = train |> mutate(A = as.factor(0)), type = "prob")[,2] |> pull()
outcome_1 <- predict(final_fit, new_data = train |> mutate(A = as.factor(1)), type = "prob")[,2] |> pull()

# -------------------------------------------------------
# treatment model 
train_tx <- train |> select(-Y)

xgb_wf_tx <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(A ~ .)


xgb_grid_tx <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train_tx),
  learn_rate(),
  size = 20
)

# Cross-validation and tuning
folds_tx <- vfold_cv(train_tx, v = 5)

xgb_res_tx <- tune_grid(
  xgb_wf_tx,
  resamples = folds_tx,
  grid = xgb_grid_tx,
  control = control_grid(save_pred = TRUE,
                         verbose = T)
)

# Select best model
best_xgb_tx <- select_best(xgb_res_tx, metric = "roc_auc")

# Finalize and fit
final_xgb_tx <- finalize_workflow(xgb_wf_tx, best_xgb)
final_fit_tx <- fit(final_xgb_tx, data = train_tx)

ps <- predict(final_fit_tx, new_data = train_tx |> select(-A), type = "prob")[,2] |> pull()
ps_final <- ps
# ps_final <- pmax(pmin(ps, 0.95), 0.05)
a_1 <- 1/(predict(final_fit_tx, new_data = train_tx, type = "prob")[,2] |> pull())
a_0 <- -1/(1 - (predict(final_fit_tx, new_data = train_tx, type = "prob")[,2] |> pull()))
clever_covariate <- ifelse(train_tx$A == 1, 1/ps_final, -1/(1-ps_final))

# step 3 
epsilon_model <- glm(train$Y ~ -1 + offset(qlogis(outcome)) + clever_covariate, family = "binomial")
summary(epsilon_model)
epsilon <- epsilon_model$coefficients

#### Step 4. Update Initial Outcomes
updated_outcome_1 <- plogis(qlogis(outcome_1)+epsilon*a_1)
updated_outcome_0 <- plogis(qlogis(outcome_0)+epsilon*a_0)

#### Step 5. Compute ATE
ate <- mean(updated_outcome_1-updated_outcome_0)

model	bias	variance
logreg_correct_outcome	-0.0009778	0.0001410
logreg_treatment_outcome	0.0019444	0.0001581
logreg_wrong_outcome	-0.0464683	0.0001354
xgboost_outcome_model	-0.0164066	0.0000459
xgboost_tmle_model_size5	0.0066270	0.0001399
xgboost_tmle_model_size20	0.0041615	0.0001645

Look at that! Less biased than tmle size of 5, but you can see variance start to increase. This is really cool!

Is there a traditional statistical method for this?

Yes, apparently there is! Augmented IPW estimator here provides a doubly robust method for estimating causal effects that combines propensity score weighting with outcome modeling. AIPW remains consistent as long as either the propensity score model or the outcome model is correctly specified (sounds familiar? It’s like TMLE!), making it more reliable than traditional methods when model specification is uncertain. Here is AIPW R package, if need to use this in the future.

This doubly robust method also reminds me of Double Machine Learning (DML), we should compare all these methods in the future!

But Does It Really Work?

After the blog was published on 11/16/25, Frank Harrell stated “No examination of TMLE is complete without critical examination of the non-coverage probabilities in both tails of confidence intervals. Prepare to be disappointed. Be sure to estimate non-coverage separately in the two tails. Some confidence interval procedures are accurate with overall coverage despite being wrong in both tails.” It’s true that we did not assess the 95% confidence interval with our resampling. Coming from a very experienced statistician, he is most likely right. Now, let’s examine the non-coverage tails! Let’s compare 1) logistic regression (correctly specificed outcome model), 2) logistic regression w IPW (correctly specified treatment model), 3) logistic regression (misspecified outcome model), 4) TMLE with xgboost (with grid search size of 5), 5) TMLE with xgboost (with grid search size of 20). Then, we’ll assess their 95% CIs and calculate what are the proportions of non-coverage in left and right tails across the 5 comparisons above and visualize them!

For logistic regression models, we use bootstrap with 1000 resamples to estimate standard error. For TMLE models, we will use the estimated standard error from the TMLE procedure.

my messy code for logistic regression

library(dplyr)
library(future)
library(future.apply)

set.seed(1)

n <- 10000
W1 <- rnorm(n)
W2 <- rnorm(n)
W3 <- rbinom(n, 1, 0.5)
W4 <- rnorm(n)

# TRUE propensity score model
A <- rbinom(n, 1, plogis(-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4))

# TRUE outcome model
Y <- rbinom(n, 1, plogis(-1 + 0.2*A + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2))

# Calculate TRUE ATE
logit_Y1 <- -1 + 0.2 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2
logit_Y0 <- -1 + 0 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2

Y1_true <- plogis(logit_Y1)
Y0_true <- plogis(logit_Y0)
true_ATE <- mean(Y1_true - Y0_true)

df <- tibble(W1 = W1, W2 = W2, W3 = W3, W4 = W4, A = A, Y = Y)

g_comp <- function(model,data,ml=F) {
  if (ml==T) {
    y1 <- predict(model, new_data=data |> mutate(A=as.factor(1)), type = "prob")[,2] |> pull()
    y0 <- predict(model, new_data=data |> mutate(A=as.factor(0)), type = "prob")[,2] |> pull()
  } else {
    y1 <- predict(model, newdata=data |> mutate(A=1), type = "response")
    y0 <- predict(model, newdata=data |> mutate(A=0), type = "response")
  }
  return(mean(y1-y0))
}


# Set up parallel backend
plan(multisession, workers = 10)  # or plan(multisession)

n_sample <- 1000
predicted_ate <- predicted_lower <- predicted_upper <- vector(mode = "numeric", length = n_sample)
n_boot <- 1000
i_boot_seed <- runif(n_boot, 0, n_boot * 1000)  # Better seed range
n_boot_sample <- 6000

df_se <- tibble(method=character(),ate=numeric(),lower=numeric(),upper=numeric())

formula_list <- list()
formula_list[[1]] <- as.formula(Y ~ A + W1 + I(W2^2) + W3 + W1:W3 + I(W4^2))
formula_list[[2]] <- as.formula(Y ~ A + W1 + W2 + W3 + W4)
formula_list[[3]] <- as.formula(A ~ W1 + I(W2^2) + W1:W2 + I(W4^2))

model_function <- function(formula,data,method) {
  if (method=="logreg_outcome_correct") {
    model_final <- glm(formula = formula, data = data, family = "binomial")
  }
  if (method=="logreg_treatment_correct") {
  ps_model <- glm(formula=formula,data=data,family="binomial")
  ps <- ps_model$fitted.values
  ps_final <- pmax(pmin(ps, 0.95), 0.05)
  weights <- ifelse(data$A == 1, 1/ps_final, 1/(1-ps_final))
  model_final <- glm(Y~A,data=data,family="binomial",weights=weights)
  }
  if (method=="logreg_outcome_wrong") {
    model_final <- glm(formula = formula, data = data, family = "binomial")
  }
  if (is.null(method)) { stop("need method") }
  ate <- g_comp(model_final,data)
  return(ate)
}

# Create the bootstrap function
bootstrap_ate <- function(j, data, formula, n_boot_sample, i_boot_seed,method) {
  set.seed(i_boot_seed[j])
  data_boot <- slice_sample(data, n = n_boot_sample, replace = TRUE)
  ate_boot <- model_function(formula,data_boot,method=method)
  return(ate_boot)
}


# method vector 
method_vec <- c("logreg_outcome_correct","logreg_treatment_correct","logreg_outcome_wrong")

for (method in method_vec) {
  if (method=="logreg_outcome_correct") { formula <- formula_list[[1]] }
  if (method=="logreg_treatment_correct") { formula <- formula_list[[3]] }
  if (method=="logreg_outcome_wrong") { formula <- formula_list[[2]] }
for (i in 1:n_sample) {
  set.seed(i)
  data <- slice_sample(df, n = n_boot_sample, replace = TRUE)
  # model <- glm(formula = formula, data = data, family = "binomial")
  ate <- model_function(formula,data,method=method)
  predicted_ate[i] <- ate
  
  ate_vec <- future_lapply(1:n_boot, bootstrap_ate, 
                           data = data, 
                           formula = formula,
                           n_boot_sample = n_boot_sample,
                           i_boot_seed = i_boot_seed,
                           method = method,
                           future.globals = list(g_comp = g_comp, model_function=model_function),
                           future.seed = NULL,  # Use NULL since you're doing manual seeding
                           future.packages = c("dplyr"))
  
  # Convert list to numeric vector
  ate_vec <- unlist(ate_vec)
  
  # Calculate confidence intervals
  predicted_lower[i] <- quantile(ate_vec, 0.025)
  predicted_upper[i] <- quantile(ate_vec, 0.975)
  
  print(paste("Sample", i, "ATE:", round(ate, 4), 
              "CI: [", round(predicted_lower[i], 4), ",", round(predicted_upper[i], 4), "]"))
  df_se <- df_se |>
    rbind(tibble(method = method, ate=predicted_ate[i], lower=predicted_lower[i],upper=predicted_upper[i]))
}
}

# Clean up
plan(sequential)

df_se2 <- df_se
save(df_se2, file = "logreg_bootstrap_tails.rda")

my messy code for tmle

### change size 5 vs 20

library(dplyr)
library(tidymodels)
library(future)
plan(multisession, workers = 5)

set.seed(1)

n <- 10000
W1 <- rnorm(n)
W2 <- rnorm(n)
W3 <- rbinom(n, 1, 0.5)
W4 <- rnorm(n)

# TRUE propensity score model
A <- rbinom(n, 1, plogis(-0.5 + 0.8*W1 + 0.5*W2^2 + 0.3*W3 - 0.4*W1*W2 + 0.2*W4))

# TRUE outcome model
Y <- rbinom(n, 1, plogis(-1 + 0.2*A + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2))

# Calculate TRUE ATE
logit_Y1 <- -1 + 0.2 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2
logit_Y0 <- -1 + 0 + 0.6*W1 - 0.4*W2^2 + 0.5*W3 + 0.3*W1*W3 + 0.2*W4^2

Y1_true <- plogis(logit_Y1)
Y0_true <- plogis(logit_Y0)
true_ATE <- mean(Y1_true - Y0_true)

df <- tibble(W1 = W1, W2 = W2, W3 = W3, W4 = W4, A = A, Y = Y)

# sample
n_sample <- 1000
n_i <- 6000

predicted_ate <- vector(mode = "numeric", length = n_sample)
pred_se <- vector(mode = "numeric", length = n_sample)

for (i in 1:n_sample) {
  set.seed(i)
data <- slice_sample(df, n = n_i, replace = T) |> select(Y,A,W1:W4) |> mutate(Y = as.factor(Y), A = as.factor(A))
train <- data


# outcome model
xgb_spec <- boost_tree(
  trees = tune(),
  tree_depth = tune(),
  min_n = tune(),
  loss_reduction = tune(),
  # sample_size = tune(),
  mtry = tune(),
  learn_rate = tune()
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")  

# Create workflow
xgb_wf <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(Y ~ .)

# Tuning grid
xgb_grid <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train),
  learn_rate(),
  size = 5 # here <------------
)

# Cross-validation and tuning
folds <- vfold_cv(train, v = 5)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE,
                         parallel_over = "everything",
                         verbose = T)
)

# Select best model
best_xgb <- select_best(xgb_res, metric = "roc_auc")

# Finalize and fit
final_xgb <- finalize_workflow(xgb_wf, best_xgb)
final_fit <- fit(final_xgb, data = train)

# predict
outcome <- predict(final_fit, new_data = train, type = "prob")[,2] |> pull()
outcome_0 <- predict(final_fit, new_data = train |> mutate(A = as.factor(0)), type = "prob")[,2] |> pull()
outcome_1 <- predict(final_fit, new_data = train |> mutate(A = as.factor(1)), type = "prob")[,2] |> pull()

# -------------------------------------------------------
# treatment model 
train_tx <- train |> select(-Y)

xgb_wf_tx <- workflow() %>%
  add_model(xgb_spec) %>%
  add_formula(A ~ .)


xgb_grid_tx <- grid_space_filling(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  finalize(mtry(),train_tx),
  learn_rate(), 
  size = 5 # and here <-----------------
)

# Cross-validation and tuning
folds_tx <- vfold_cv(train_tx, v = 5)

xgb_res_tx <- tune_grid(
  xgb_wf_tx,
  resamples = folds_tx,
  grid = xgb_grid_tx,
  control = control_grid(save_pred = TRUE,
                         verbose = T)
)

# Select best model
best_xgb_tx <- select_best(xgb_res_tx, metric = "roc_auc")

# Finalize and fit
final_xgb_tx <- finalize_workflow(xgb_wf_tx, best_xgb)
final_fit_tx <- fit(final_xgb_tx, data = train_tx)

ps <- predict(final_fit_tx, new_data = train_tx |> select(-A), type = "prob")[,2] |> pull()
ps_final <- ps
# ps_final <- pmax(pmin(ps, 0.95), 0.05)
a_1 <- 1/(predict(final_fit_tx, new_data = train_tx, type = "prob")[,2] |> pull())
a_0 <- -1/(1 - (predict(final_fit_tx, new_data = train_tx, type = "prob")[,2] |> pull()))
clever_covariate <- ifelse(train_tx$A == 1, 1/ps_final, -1/(1-ps_final))

# step 3 
epsilon_model <- glm(train$Y ~ -1 + offset(qlogis(outcome)) + clever_covariate, family = "binomial")
summary(epsilon_model)
epsilon <- epsilon_model$coefficients

#### Step 4. Update Initial Outcomes
updated_outcome_1 <- plogis(qlogis(outcome_1)+epsilon*a_1)
updated_outcome_0 <- plogis(qlogis(outcome_0)+epsilon*a_0)

#### Step 5. Compute ATE
ate <- mean(updated_outcome_1-updated_outcome_0)


### step 6. SE
updated_outcome <- ifelse(train$A == 1, updated_outcome_1, updated_outcome_0)
se <- sqrt(var((as.numeric(train$Y==1)-updated_outcome)*clever_covariate+updated_outcome_1-updated_outcome_0-ate)/n_i)

predicted_ate[i] <- ate
pred_se[i] <- se
print(paste0("i: ",i, " ate: ", ate, " se: ",se))
if ((i %% 2)==0) { save(predicted_ate, pred_se, file = "predicted_ate_tmle_se_5.rda") } # and make sure you change file name when saving too <--------- size 5 vs 20
}

visualization code

library(tidyverse)
load("logreg_bootstrap_tails.rda")
load("predicted_ate_tmle_se_5.rda")
xgb_tmle_5_se_df <- tibble(ate=predicted_ate,se=pred_se)
load("predicted_ate_tmle_se_20.rda")
xgb_tmle_20_se_df <- tibble(ate=predicted_ate,se=pred_se)

#### combine all
df_all_ci <- xgb_tmle_20_se_df |>
  mutate(lower_ci = ate - 1.96*se,
         upper_ci = ate + 1.96*se) |>
  mutate(
    method = "tmle_xgboost_size20"
  ) |>
  select(method, ate, lower_ci, upper_ci) |>
  rbind(xgb_tmle_5_se_df |>
          mutate(lower_ci = ate - 1.96*se,
                 upper_ci = ate + 1.96*se) |>
          mutate(
            method = "tmle_xgboost_size5"
          ) |>
          select(method,ate,lower_ci,upper_ci)) |>
  rbind(df_se2 |>
          rename(lower_ci=lower,upper_ci=upper)) |>
  mutate(coverage = case_when(
    lower_ci > true_ATE ~ "left_miss",
    upper_ci < true_ATE ~ "right_miss",
    TRUE ~ "within"
  )) 

##### calculate prop
coverage_df <- df_all_ci |>
  group_by(method,coverage) |>
  summarize(prop = n()*100/1000) |>
  ungroup(coverage) |>
  pivot_wider(id_cols = c("method"), names_from = "coverage", values_from = "prop", values_fill = 0) |>
    mutate(stat = paste0("right missed: ", right_miss,"%, covered: ",within,"%, left missed: ",left_miss,"%"))

coverage_order <- coverage_df |>
  arrange(desc(within)) |>
  pull(method)

coverage_df <- coverage_df |>
  mutate(method = factor(method, levels = coverage_order))

plot <- df_all_ci |>
  group_by(method) |>
  arrange(ate) |>
  mutate(row = row_number(),
         method = factor(method, levels = coverage_order)) |>
  ggplot(aes(x=row,y=ate,color=coverage)) +
  geom_point() +
  geom_ribbon(aes(ymin=lower_ci,ymax=upper_ci,fill=coverage),alpha=0.5) +
  geom_hline(yintercept = true_ATE, linewidth=0.5, color="blue") +
  geom_text(data=coverage_df, aes(x=500,y=-0.05,label=stat), inherit.aes = F) +
  theme_bw() +
  facet_wrap(.~method, ncol=1) +
  theme(legend.position = "bottom") +
  xlab("bootstrap no.")

Wow, Frank was right to say “prepare to be disappointed!” 😅 The correctly specified logistic regression outcome model was the clear winner with 95.0% coverage and pretty symmetric tails (1.7% left miss, 3.3% right miss) - basically exactly what you’d want to see. The correctly specified treatment model with IPW did reasonably well at 92.4% coverage, though it had some asymmetry (7.0% left miss, 0.6% right miss). But wow, the misspecified logistic regression outcome model was a disaster - only 2.8% coverage with almost everything missing on the right tail (97.2% right miss)!

Now here’s where it gets interesting: TMLE with XGBoost grid search size 5 achieved 87.6% coverage, which isn’t terrible, but it had this concerning asymmetry (11.3% left miss, 1.1% right miss). When I cranked up the grid search to size 20, thinking it would get better, it actually got worse - dropped to 71.1% coverage with misses on both sides (21.9% left miss, 7.0% right miss). So Frank’s warning was spot on! While TMLE definitely saved us from the catastrophic failure of misspecified parametric models, those confidence intervals just don’t behave properly. The machine learning component does great at capturing complex relationships without us having to specify all those weird interactions, but the price is wonky uncertainty estimates. Seems like TMLE’s real strength is getting better point estimates, not reliable confidence intervals. 🤔

Acknowledgements

Thanks to Frank Harrell for the pointers! We can see the non-coverage tails much clearer for all methods!

Opportunities for improvement

learn to use future_lapply with distributed computing
test out different ML models for TMLE
does it matter if we use all data (like above) or does ATE change with train/test split?

Lessons learnt

learnt to include anchor
learnt from offset does in glm
learnt TMLE’s procedure
learnt to use future parallel computing

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

#IDWeek2025 Posts/Tweets Analysis

Sun, 26 Oct 2025 00:00:00 +0000

IDWeek2025 had the lowest post count since 2022 (1,272 posts). While top posters shifted to Bluesky, X remained on par—the key difference was engagement rates favoring Bluesky. Grateful to learn so much from our SoMe community! 📊💙🙏

Wordcloud of all the IDweek2025, idweek25 and idweek tweets/posts.

If you want to look at the specific tweets, I have created a shiny app that helps me to glance through essential topics. Here is the link

Thought Process:

This year is a fun challenge because there are 2 platforms that ID community have been posting. Our old friend X/Twitter and now Bluesky. As we’ve monitored throughout the year, it does seem like there has been a divided community. Hence, #IDWeek is a great experiment to assess our ID community’s network and engagement. And we’ll be monitor both platform and see how many cool things people have been up to! As usual, we will list the top 50 users contributed to #IDweek posts, top liked posts, top bookmarked posts. Our goal here is to learn ID related information and also focus on the positives! ❤️

Disclaimers: All these were obtained from Bluesky and X API. Pictures shown here are directly linked to the source. Except for the ones from Grok but I’ve linked to source

Post counts (Bluesky and X combined) by days

We had the least post and tweet counts combined this year when compared to 2024, 2023 and 2022!

Very interesting. When compared to IDweek 2022 and 2023, and 2024 and the post peaks appear to be similar to 2024. This year it also appeared to have the least posts when compared to 2022, 2023, and 2024. We had a total of 1272 (it might actually be 1234 see this) posts this year, whereas in 2024, we had 1674 posts, in 2023 we had 2627 posts, and in 2022 it was ~2188. It is clear that ID community and SoMe has decreased engagement this year.

Top 50 Users (Both Bluesky and X) Post Counts

Thanks to all who have contributed sairabt.bsky.social, LordAlirezaF, sidpharm.bsky.social, josephmarcusid.medsky.social, uwidfellowship.bsky.social, IDWeekmtg, idweek.bsky.social, iuidfellowship.bsky.social, InfectDiseaseAd, WebsEdge_Med, boghuma.bsky.social, patrickching.bsky.social, jschaenmanmd.bsky.social, pRxcisionAI, CUP_med_health, ccf_idfellows, websedgemedicine.bsky.social, Contagion_Live, contagionlive.bsky.social, HMS_MI leading the top 20 posts combined. Can you find your handle here?

This year is also very interesting to see that the top posters comprise of more bluesky users than X users. But you do see some familiar usernames who traditionally have been top posters on X such as LordAlirezaF. An easy way to know whether it’s Bluesky or X is that Bluesky username usually has a domain such as bsky.social or medsky.social etc.

Posts frequency separated by dates

date	username	text	like_count
2025-10-18	mmpharmd.bsky.social	As per tradition, the bracelets were counted this morning in the hotel room with @ebhirsch.bsky.social . Last year we came in at 169. Any guesses how many were made this year?? #IDWeek2025	14
2025-10-18	dralicehan.bsky.social	#IDsky Just arrived in Atlanta! Excited to see everyone at #IDweek. I’ll discuss any questions or advice for fellows interested in private practice in ID. Hope to see you tomorrow at Fellow’s Day!	12
2025-10-18	TakaMatsuo_ID	Arrived in Atlanta!! Looking forward to connecting with everyone at #IDWeek2025! @IDWeekmtg @MDAndersonNews @MayoClinicINFD @UT_Infectious @BCMIDFellowship https://t.co/t75aEsrlM2	12
2025-10-18	darcy-id-doc.bsky.social	Great Program Director’s Meeting at #IDWeek2025	11
2025-10-18	brianchowmd.bsky.social	Welcome to #IDWeek2025	10
2025-10-18	pascalisid.bsky.social	Please join us this Monday 8-9 am at IDWeek. Difficult-to-treat mold infections. Dimitrios Farmakiotis will be discussing treatment of mucormycosis. I will be discussing aspergillosis.	9
2025-10-18	ebhirsch.bsky.social	Absolutely phenomenal @sidpharm.bsky.social keynote 🔑 from Dr. Mati Hlatshwayo Davis @matih-id.bsky.social today: Reducing Barriers Toward Health Equity: Advocating for Change in the Healthcare Industry and Beyond. I laughed, I cried. All the things. Just wow 👏👏👏 #IDWeek2025 #IDSky	9
2025-10-18	mmpharmd.bsky.social	Look what I found! @idsainfo.bsky.social @idweek.bsky.social @idweekoutbreak.bsky.social @sidpharm.bsky.social #IDWeek2025	9
2025-10-18	josephmarcusid.medsky.social	See you tomorrow! #IDSky #IDWeek2025	7
2025-10-18	sidpharm.bsky.social	Who's excited for the Annual Meeting today?! If you're in ATL for IDweek, and unable to attend SIDP's Annual meeting, check out these SIDP members pre-meeting workshops! #sidp #idweek2025	6

date	username	text	like_count
2025-10-19	uwidfellowship.bsky.social	Prolonged applause for Dr Demetri Daskalakis, formerly of the CDC, winner of the HIV Medical Association Transformative Leader Award… #IDSky #IDWeek #IDStrong	118
2025-10-19	boghuma.bsky.social	Mandatory meeting selfie ##IDweek2025	58
2025-10-19	patrickching.bsky.social	IDWeek2025 Social Media Meetup @jonathanrydermd.bsky.social @josephmarcusid.medsky.social #IDWeek2025 #IDSky	48
2025-10-19	boghuma.bsky.social	Who is in Atlanta for #IDweek2025? If you see me at the convention center please say hi ✋. It's always better to see/meet people IRL. #IDSky	36
2025-10-19	jonathanrydermd.bsky.social	Let’s go!!! Hope to meet many of you at tonight’s social media meet-up! #IDWeek2025 @idweek.bsky.social	34
2025-10-19	jschaenmanmd.bsky.social	Huge turn out for #IDWeek2025 @idweek.bsky.social Plenary Session with Javier Muñoz ! 🤩	24
2025-10-19	davidvanduin.bsky.social	Dr Tamma mentions the ongoing GOAT trial (PI Tamma & Cosgrove) This will be a most needed and important study. clinicaltrials.gov/study/NCT060... #IDweek2025 #IDsky	19
2025-10-19	docdelrio.bsky.social	#IDWeek2025 kicks off today, & @emorydeptofmed.bsky.social is well represented with a total of 96 Emory-affiliated presentation. Don't miss talks by @colleenkelly.bsky.social & @gradydoctor.bsky.social Full list of Emory sessions: bit.ly/EmoryIDWeek2025	19
2025-10-19	umn-idim.bsky.social	We’re heading to #IDWeek2025! Along with our colleagues at the Minnesota Department of Health and across the Twin Cities, we will be sharing: 📰 26 posters 🎤 12 symposiums 🗣️ 4 oral abstracts 🏆 1 plenary We’re excited to showcase the incredible work coming out of Minnesota. See you there! #IDSky	19
2025-10-19	davidzd.bsky.social	This is what leadership looks like. #VaccinesSaveLives #IDWeek2025 #IDSky	17

date	username	text	like_count
2025-10-20	boghuma.bsky.social	Easily my favorite session at #IDWEEK #IDSky	60
2025-10-20	DrIanWeissman	CDC researchers are being forced to skip a pivotal conference on infectious disease this week due to the government shutdown, missing out on high-level discussions not long after surges in measles and whooping cough hit the U.S. https://t.co/mij0HnHywI	22
2025-10-20	boghuma.bsky.social	Afternoon delight. Challenging cases HIV and STI cases. First up a serological standoff RPR 1:4--> 1:8, patient with ocular and otic symptoms. Does not meet the 4 -fold increase threshold for new infection. So do you treat for syphilis now or not? #IDweek #IDSky	21
2025-10-20	hectorjoselora	Recap 10/20 of @IDWeekmtg @IDSAInfo #IDWEEK2025 -Proudest day ever! poster (1/2) led by Isabel Cintron and medical students. First time advising/mentoring a project from medical students. #MedEd -With the ID Docs😎🧫🦠 @mobrito05 @PaulinoRobert Dr. Bisonó https://t.co/f9LzQpn5hn	17
2025-10-20	courtharrismd.bsky.social	#IDWeek2025 off to a 🔥start! first in person Women in ID Book Club reading the Rainfall Market! Thankful for these women who continue to come out to support and enjoy each others company! @idweek.bsky.social @jennmpd.bsky.social @sairabt.bsky.social @docwoc71.bsky.social @dralicehan.bsky.social	14
2025-10-20	drrossanarosa.bsky.social	Happy International Infection Prevention Week! #IDSky #IIPW #IDWeek2025	12
2025-10-20	rachelalter007.bsky.social	It's pretty freaking awesome that the same people the keynote speakers is thanking for being her mentors may be mine too in a few short months 🤞🏻🤞🏻🤞🏻 #idweek2025	12
2025-10-20	cidrap.bsky.social	C difficile deaths more common among Whites, people in large urban areas White Americans accounted for 84% of the 216,311 C difficile-associated deaths reported from 1999 through 2023, researchers reported at IDWeek 2025. www.cidrap.umn.edu/c…	11
2025-10-20	boghuma.bsky.social	DoxyPEP can alter serological titers for RPR with slower rise in titers. Since suspicion of otic and ocular syphilis high. Treatment is started. #idweek #idsky	11
2025-10-20	idweek.bsky.social	Vaccination against herpes zoster, or shingles, is linked to lower risks of heart disease, dementia and death in people age 50 and older, according to new research presented at #IDWeek2025. https://bit.ly/471biNp	10

date	username	text	like_count
2025-10-21	boghuma.bsky.social	The absence of our CDC and NIH colleagues is profoundly felt at this year's #IDweek2025 meeting happening in Atlanta the city where the agency is head-quartered. www.medpagetoday.com/infectiousdi...	84
2025-10-21	cidrap.bsky.social	Drugmakers announce encouraging new antibiotic data at IDWeek Shionogi presents real-world data on cefiderocol’s effectiveness against tough-to-treat gram-negative infections, while GSK releases promising phase 3 data for tebipenem HBr. www.cidrap.umn.edu/a…	16
2025-10-21	OslerResidency	Much #Oslerpride at IDWeek! What a stellar group 😍💪🏽👏🏽 https://t.co/82ZJozdkro	13
2025-10-21	michaelisonmd.bsky.social	Due to the US Government Shutdown, I will not be able to atted @IDWeek.bsky.social #IDWeek2025. I had worked on my 2 invited talks and so will share them. My first talk was going to be about the epidemiology and clinical course of respiratory viral infections in the immunocompromised.	12
2025-10-21	takamatsuo-id.bsky.social	Ready for 2 oral presentations today! (same session) Session Title: Bad to the Bone: News From BJI Session Date: Tuesday October 21, 2025 Session Time: 10:30 AM - 11:45 AM Location: B401-402 #IDWeek2025 #MayoClinicINFD @idweek.bsky.social #OrthoID #SepticArthritis #NVO	10
2025-10-21	jonathanrydermd.bsky.social	@nkusnikmd.bsky.social presenting our blood culture shortage experience during an oral abstract session appropriately titled “A Bloody Mess!” @idweek.bsky.social #IDWeek2025 @unmc-id.bsky.social	10
2025-10-21	jeremytigh.bsky.social	Increasing NDM across the U.S.😭 #IDWeek2025	9
2025-10-21	healioid.bsky.social	There is more evidence that #shingles vaccination significantly decreases the risk for heart disease, dementia and death among people aged 50 years or older with herpes zoster infection, according to data presented at #IDWeek2025. 💉 #IDSky 🥼 #MedSky www.healio.com/news/infecti…	9
2025-10-21	dricks.bsky.social	CDC experts—what's left of them—now forced to skip a pivotal infectious diseases meeting because of the gov't shutdown. Their conference appearances have been postponed unless funded outside of government budgets. IDWeek is the largest meeting of infectious disease experts in the US👇	9
2025-10-21	jonathanrydermd.bsky.social	@takamatsuo-id.bsky.social presenting back-to-back oral abstracts on bone and joint infections @idweek.bsky.social! #IDWeek2025	9

date	username	text	like_count
2025-10-22	boghuma.bsky.social	This year's #IDweek is now over. Our community has taken so many hits since the pandemic and now the assaults on public health, science, vaccines etc. Yet the infectious disease community has some of the most dedicated, resilient and thoughtful people I know. Here's to hope & staying with the fight.	80
2025-10-22	joffirphd.bsky.social	This is good news. “The New England Journal of Medicine and the Center for Infectious Disease Research and Policy will begin publishing “public health alerts” in the coming month, CIDRAP Director Michael Osterholm announced at the IDWeek conference on Sunday.” www.statnews.com/2025/10/21/c…	41
2025-10-22	sairabt.bsky.social	#idweek2025 new in #UTI IDSA (GRADE methodology: clinical cure critical based on pt feedback) vs wikiguidelines (clear recommendation vs clinical review) 1/	24
2025-10-22	docwoc71.bsky.social	Getting ready for #IDBugBowl @idweek.bsky.social Hope to see y’alll this afternoon. Come and cheer ur team UAB CCF ThomasJefferson and our international team Calcutta Troo Med #IDWeek2025 #IDSky	12
2025-10-22	kemarbarrettmd	First #IDWeek2025 was great! Happy to share our work with the broader 🆔 community! Always a great time with the @MayoClinicINFD family. See you next year in DC! 🥳 https://t.co/Q0zGVu6NIF	12
2025-10-22	democratswin.bsky.social	The New England Journal of Medicine and the Center for Infectious Disease Research and Policy will begin publishing “public health alerts” in the coming month, CIDRAP Director Michael Osterholm announced at the IDWeek conference on Sunday. www.statnews.com/2025/10/21/c…	10
2025-10-22	Medscape	It’s possible to produce a generic version of lenacapavir, a twice-yearly antiretroviral injection that both prevents and treats HIV, for as little as $25 per patient per year, according to a study presented at the Infectious Disease Week (IDWeek) 2025 Annual Meeting in Atlanta. https://t.co/lUTq58OijU	10
2025-10-22	WebsEdge_Med	"They're waging psychological warfare on our young scientists". At IDWeek 2025, we sat down with @PeterHotez to discuss the state of vaccines in the US, and what the future holds for experts in infectious disease. Watch the full conversation on WebsEdge Medicine YouTube, out https://t.co/7y0pRBI8YB	10
2025-10-22	idweek.bsky.social	Vaccines cause adults. #IDWeek2025	8
2025-10-22	docwoc71.bsky.social	About last night: on the 3rd day of #IDWeek2025 we had a jam Pack nightly activities from #TID get together to the cultural dance party @idweek.bsky.social @idsainfo.bsky.social	8

date	username	text	bookmark_count
2025-10-20	boghuma.bsky.social	Easily my favorite session at #IDWEEK #IDSky	3
2025-10-20	boghuma.bsky.social	Afternoon delight. Challenging cases HIV and STI cases. First up a serological standoff RPR 1:4--> 1:8, patient with ocular and otic symptoms. Does not meet the 4 -fold increase threshold for new infection. So do you treat for syphilis now or not? #IDweek #IDSky	3
2025-10-21	michaelisonmd.bsky.social	Due to the US Government Shutdown, I will not be able to atted @IDWeek.bsky.social #IDWeek2025. I had worked on my 2 invited talks and so will share them. My first talk was going to be about the epidemiology and clinical course of respiratory viral infections in the immunocompromised.	3
2025-10-19	idstewardship.bsky.social	🤩 Great talks in the APP bootcamp session at #IDweek2025 Back to basics sure, but contextualized by high quality presenters = 🙌	3
2025-10-22	WebsEdge_Med	"They're waging psychological warfare on our young scientists". At IDWeek 2025, we sat down with @PeterHotez to discuss the state of vaccines in the US, and what the future holds for experts in infectious disease. Watch the full conversation on WebsEdge Medicine YouTube, out https://t.co/7y0pRBI8YB	3
2025-10-19	patrickching.bsky.social	IDWeek2025 Social Media Meetup @jonathanrydermd.bsky.social @josephmarcusid.medsky.social #IDWeek2025 #IDSky	2
2025-10-19	uwidfellowship.bsky.social	Prolonged applause for Dr Demetri Daskalakis, formerly of the CDC, winner of the HIV Medical Association Transformative Leader Award… #IDSky #IDWeek #IDStrong	2
2025-10-22	sairabt.bsky.social	#idweek2025 new in #UTI IDSA (GRADE methodology: clinical cure critical based on pt feedback) vs wikiguidelines (clear recommendation vs clinical review) 1/	2
2025-10-20	idweek.bsky.social	Vaccination against herpes zoster, or shingles, is linked to lower risks of heart disease, dementia and death in people age 50 and older, according to new research presented at #IDWeek2025. https://bit.ly/471biNp	2
2025-10-22	joffirphd.bsky.social	This is good news. “The New England Journal of Medicine and the Center for Infectious Disease Research and Policy will begin publishing “public health alerts” in the coming month, CIDRAP Director Michael Osterholm announced at the IDWeek conference on Sunday.” www.statnews.com/2025/10/21/c…	2
2025-10-19	sairabt.bsky.social	#idweek2025 #idsky what’s hot in ID clinical science Dr Wright #BSI #BALANCEtrial	2
2025-10-21	patrickching.bsky.social	Big Beasts of #ClinicalMycology #IDWeek2025 @idweek.bsky.social #IDSky Rare mold infections	2
2025-10-22	Medscape	It’s possible to produce a generic version of lenacapavir, a twice-yearly antiretroviral injection that both prevents and treats HIV, for as little as $25 per patient per year, according to a study presented at the Infectious Disease Week (IDWeek) 2025 Annual Meeting in Atlanta. https://t.co/lUTq58OijU	2
2025-10-20	ABsteward	@AlastairMcA30 @BradSpellberg @DrToddLee The tyranny of experts! I love @BradSpellberg Ed commentary Opinion-Based Recommendations: Beware the Tyranny of Experts #IDWeek2025 https://t.co/k7rNeoKVN8	2
2025-10-20	ABsteward	Any late-breaking abstracts or practice-changing RCTs being presented at #IDWeek2025 — thinking SNAP, MERINO, OVIVA, POET, CAMERA2 etc? Please tag presenters/teams if you know them #IDWeek2025	2
2025-10-19	AnciraBecky	Shingles Vaccination Tied to Drops in Cardiovascular Events, Dementia, Death https://t.co/A6TdjI9k0i	2
2025-10-20	cidrap.bsky.social	C difficile deaths more common among Whites, people in large urban areas White Americans accounted for 84% of the 216,311 C difficile-associated deaths reported from 1999 through 2023, researchers reported at IDWeek 2025. www.cidrap.umn.edu/c…	1
2025-10-19	davidvanduin.bsky.social	Dr Tamma mentions the ongoing GOAT trial (PI Tamma & Cosgrove) This will be a most needed and important study. clinicaltrials.gov/study/NCT060... #IDweek2025 #IDsky	1
2025-10-21	jeremytigh.bsky.social	Increasing NDM across the U.S.😭 #IDWeek2025	1
2025-10-20	uwidfellowship.bsky.social	New from IDSA, thanks to Dr William Werbel, resp virus vax in immunocompromised population: vax 2 weeks before or 3-6 months after immunocompromise expected expect blunted response if given within that window defer during acute rejection, illness adjust for viral circulation #IDSky #IDWeek	1

date_factor	metric	coef	pval_adj
2025-10-18	quote_count	19.2115426	0.9988609
2025-10-18	like_count	-1.2536129	0.0111716
2025-10-18	reply_count	-2.2155737	0.1240385
2025-10-18	repost_count	-1.0116009	0.2703430
2025-10-18	bookmark_count	-0.6061358	0.9009762
2025-10-19	quote_count	-1.2872035	0.2045081
2025-10-19	like_count	-1.7996101	0.0000000
2025-10-19	reply_count	-1.4764455	0.0002229
2025-10-19	repost_count	-1.6381804	0.0002229
2025-10-19	bookmark_count	-0.3709127	0.8569110
2025-10-20	quote_count	-0.9022669	0.1240385
2025-10-20	like_count	-1.4247822	0.0000000
2025-10-20	reply_count	-0.2529024	0.2624342
2025-10-20	repost_count	-0.4804749	0.2229932
2025-10-20	bookmark_count	-0.6623755	0.2229932
2025-10-21	quote_count	-2.4923102	0.0544660
2025-10-21	like_count	-1.5109780	0.0000000
2025-10-21	reply_count	-0.7904070	0.0028636
2025-10-21	repost_count	-1.1225999	0.0050867
2025-10-21	bookmark_count	-1.8732710	0.0579333
2025-10-22	quote_count	-1.7408394	0.0685566
2025-10-22	like_count	-0.8979284	0.0006327
2025-10-22	reply_count	-1.2430010	0.0000656
2025-10-22	repost_count	-0.6104784	0.2275125
2025-10-22	bookmark_count	-0.2675336	0.9227407

I especially want to thank Jonathan Ryder and Joseph Marcus for their feedback on tweet/post analysis! They’ve been really helpful in giving me feedback I can incorporate on this blog. Thank you!

Lessons Learnt

Did not know that |> does not pass . whereas %>% does see code
learnt about delayed RPR rise with DoxyPEP
Watch for GOAT trial after July 2027
Watch out for Welder’s anthrax
Association of shingle vaccine & lower ASCVD
and many more
negative binomial & BH correction

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

My Attempt To Reproduce Stanford HIVdb Sequence and Mutation Analysis From Scratch

Fri, 10 Oct 2025 00:00:00 +0000

Ever wondered what M184V, K65R actually mean? I learnt it from rebuilding Stanford’s HIV resistance algorithm from scratch to find out. Spoiler: it took tons of code to match their 3-line tool. But the lesson was worth it. We went from agreement of 89% to 99.8% after different methods of alignment

Motivations:

We’ve all learnt and memorize what those letters and numbers mean when it comes to antiretroviral resistance. Since we’ve been exploring genomics lately, let’s take another look at HIV genotype. Stanford University HIVdb is an amazing resource! I’ve always been confused with all these letters and have difficulty understanding how to even check for genotype resistance because all these numbers and letters are quite confusing and intimidating. Let’s put on our bioconductor hat and revisit this topic and see if we can at least get a better understanding on what these letters and numbers mean. Better yet, use this opportunity to try to reproduce the algorithm that tells us the susceptibility of the ART! Hang tight on this one, it’s going to be a bumpy road!

Objectives

Find HIV Reference Gene

From most of the searching, the reference gene appears to be HXB2. We know that pol gene encodes protease (PR), reverse transcriptase (RT) and integrase (IN). Below is directly from NCBI. source. You can click on it and hover over those regions to see what they are.

Take note that all these genes reside in specific position. So the trick is to use a reference, in our case HXB2, locate these 3 genes (RT, PR, IN), then extract them and make them into a database. Some reference is pretty good at letting you know where these positions are, some don’t! As for our reference, it didn’t really say either! We’ll have to look around reference and see if we can get those position.

library(Biostrings)
library(DECIPHER)
library(tidyverse)

## We downloaded a bunch of HIV genomes, including the reference known as K03455 (aka HXB2)
(all_hiv_genome <- readDNAStringSet("all_hiv_whole_genome.fasta"))

Wow, look at that. HIV genome is only around 9000bp! Whereas bacteria such as Ecoli it was about 4 Mb.

## load reference
hxb2_idx <- grep("K03455", names(all_hiv_genome), ignore.case = TRUE)
hxb2_genome <- all_hiv_genome[hxb2_idx]  

## locate the genes
rt_sequence <- subseq(hxb2_genome, start = 2550, end = 4229)
pi_sequence <- subseq(hxb2_genome, start = 2253, end = 2549)
int_sequence <- subseq(hxb2_genome, start = 4230, end = 5093)

# Rename sequences with informative names
names(pi_sequence) <- "HIV_PR"
names(rt_sequence) <- "HIV_RT"
names(int_sequence) <- "HIV_INT"

# Combine all three into one DNAStringSet
pol_regions <- c(pi_sequence, rt_sequence, int_sequence)

# Write to a single FASTA file
writeXStringSet(pol_regions, "hiv_pol_regions.fasta")

# make it into blast database
system("makeblastdb -in hiv_pol_regions.fasta -dbtype nucl -out /path/to/hiv/hiv_pol_db -parse_seqids")

With the above we’re basically setting up a databse for the reference pol gene of PR, RT, and IN. We will then find a genome of interest and use blast to identify where these genes are located on the sample sequence like so.

## use blast to find where these genes positions are
system('blastn -query all_hiv_whole_genome.fasta -db /path/to/hiv/hiv_pol_db -word_size 7 -evalue 0.0000001 -outfmt 6 -out hiv_sample_blast_results.txt')

## read it
colnames <- c("qseqid", "sseqid", "pident", "length", "mismatch", "gapopen", "qstart", "qend", "sstart", "send", "evalue", "bitscore")

(all_hiv_sample <- read_tsv("hiv_sample_blast_results.txt", col_names = colnames))

Notice sseqid section, we have HIV_RT, HIV_INT, HIV_PR. We just need to filter these genes, extract the genes via their positions qstart and qend. Let’s take a look at U63632.1

sample1 <- all_hiv_sample |>
  filter(str_detect(qseqid, "U63632.1")) |> 
  filter(sseqid == "HIV_RT") |> 
  select(qseqid, qstart, qend)

OK, how do we go from here to knowing what’s mutated?

Find The Resistance

All those letters, M184V, K65R etc, the letters and numbers must mean something right? You’re right! The numbers are position, but what about the letters? They don’t really look like ATCG, do they? They’re amino acids! For example, the M on M184 stands for Methionine, the V stands for Valine. So M184V means at position 184, Methionine has mutated to Valine. Similarly, K65R means at position 65, Lysine has mutated to Arginine.

Amino acids and their letters:
A: Alanine, C: Cysteine, D: Aspartic Acid, E: Glutamic Acid, F: Phenylalanine, G: Glycine, H: Histidine, I: Isoleucine, K: Lysine, L: Leucine, M: Methionine, N: Asparagine, P: Proline, Q: Glutamine, R: Arginine, S: Serine, T: Threonine, V: Valine, W: Tryptophan, Y: Tyrosine

his also means that our translated RT reference HIV gene HXB2 at position 184, we should expect the amino acid to be M. Let’s take a look

(rt_t <- translate(rt_sequence))

Wow! We’re used to seeing DNA sequence colors but now take a look at the different amino acid colors! How pretty! Now let’s look at position 184.

subseq(rt_t, 184,184)

Alright! M indeed! Now, let’s go through the workflow of using this information to run through our sample

Workflow

TL;DR Extract region -> Align Translation of AA with Reference & Assess Mutation -> Calculate Mutation Score

Identify/Extract Regions

sample1 <- all_hiv_sample |>
  filter(str_detect(qseqid, "U63632.1")) |> 
  filter(sseqid == "HIV_RT") |> 
  select(qseqid, qstart, qend)

sample_rt <- subseq(
  all_hiv_genome[str_detect(names(all_hiv_genome), sample1$qseqid)],
  start = sample1$qstart,
  end = sample1$qend
)

We’ve done this process above, but for other genes, we’d need to write a function to change HIV_RT to the others.

Translate

Just for demonstration purposes:

#### Take note, this entire code chunk is not needed !!! 
seq_length <- sample1$qend - sample1$qstart + 1
adjusted_length <- seq_length - (seq_length %% 3)

sample_rt <- subseq(
  all_hiv_genome[str_detect(names(all_hiv_genome), sample1$qseqid)],
  start = sample1$qstart,
  end = sample1$qstart + adjusted_length - 1
)

(sample_rt_t <- translate(sample_rt, if.fuzzy.codon = "solve"))

The reason we had to adjust length, sometimes, is that the sequence may not be perfectly divisible by 3. Since codons are groups of 3 nucleotides, any extra nucleotides that don’t form a complete codon would lead to an incomplete translation. By adjusting the length to be divisible by 3, we ensure that the translation process can proceed without any issues. During translation process, we could also use solve to handle any fuzzy codons that may arise due to sequencing errors or ambiguities in the nucleotide sequence. This ensures that the translation process can still proceed even if there are some uncertainties in the input sequence.

But in reality, we can align them directly from our DNA sequence with the help of DECIPHER, it will align the translated AA!

Align Translation & Assess Mutation

# this automatically translate aligned seq into aligned AA, sweet !!! 
alignseq <- AlignTranslation(c(rt_sequence,sample_rt), type="AAStringSet")

# turn alignment into matrix
align_matrix <- as.matrix(alignseq)

# extract alignment on both ref and sample
ref_seq <- align_matrix[1,]
sample_seq <- align_matrix[2,]

# find position where there is mutation
mutation_positions <- which(ref_seq != sample_seq & ref_seq != "-" & sample_seq != "-")

# load into dataframe
mutations <- data.frame(
  position = mutation_positions,
  reference = ref_seq[mutation_positions],
  sample = sample_seq[mutation_positions],
  mutation = paste0(ref_seq[mutation_positions], mutation_positions, sample_seq[mutation_positions])
) |>
  mutate(position_replace = paste0(position,sample))

mutations$mutation

Lots of mutations. HIV viruses are notorious for SNPs which may or may not be clinically significant. And with just a single nucleotide mutation, as you can see the translated amino acid could be different from reference. OK, since we know how to change for mutations, how do we know if this is the same as Stanford HIVdb? Let’s copy and paste the entire genome of this sample and paste it here

## easy way of copying to system so we can paste on Stanford website (link above)
all_hiv_genome[str_detect(names(all_hiv_genome),"U63632.1")] |> as.character() |> clipr::write_clip()

Not too shabby! The one mutation that is significant is M348I. We were able to capture that, not too shabby! Now, how do we go from here to the inferred susceptibility of NRTIs and NNRTIs? In come the mutation score algorithm!

Calculate Mutation Score

This part is very interesting. My initial trial was using their [genotype-phenotype DRMcv model](( https://hivdb.stanford.edu/download/GenoPhenoDatasets/DRMcv.R) but I couldn’t reproduce most of the results. And realized that Stanford HIVdb Sequance Analysis uses another algorithm. And this algorithm, at least for the final product, is more straight forward than trying to use a model to reproduce a prediction, which was what the DRMcv was using glmnet and lasso. There is also extensive documentation. All of the csv files below were obtained from the links provided from the documentation. Let’s code!

code

load_hivdb <- function(dataset, mutations){
  
if (dataset=="NRTI") {  
mut_score <- read_csv("hivdb_nrti_single.csv")
mut_score_combo <- read_csv("hivdb_nrti_combo.csv")
n <- 2
m <- 4
}

if (dataset=="NNRTI") {
  mut_score <- read_csv("hivdb_nnrti_single.csv")
  mut_score_combo <- read_csv("hivdb_nnrti_combo.csv")
  n <- 2
  m <- 2
}  
  
if (dataset=="PI") {
    mut_score <- read_csv("hivdb_pi_single.csv")
    mut_score_combo <- read_csv("hivdb_pi_combo.csv")
    n <- 2
    m <- 3
}  
  
if (dataset=="INSTI") {
  mut_score <- read_csv("hivdb_insti_single.csv")
  mut_score_combo <- read_csv("hivdb_insti_combo.csv")
  n <- 2
  m <- 3
  
}

mut_interest <- c()
for (mut_i in mut_score |> pull(Rule)) { 
    add_mut <- F
    add_mut <-  mut_i %in% (mutations |> pull(mutation))
    if (add_mut) {
      mut_interest <- c(mut_interest, mut_i)
    }
    
}

if (length(mut_interest)==0) {
  return(mut_score |> 
           slice_sample(n = 0) |>  # Get 0 rows but keep structure
           select(-1) |> 
           summarise(across(everything(), ~0)) |>
            pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
            mutate(levels = case_when(
              score <= 9 ~ 1,
              score >= 10 & score <= 14 ~ 2,
              score >= 15 & score <= 29 ~ 3,
              score >= 30 & score <= 59 ~ 4,
              score >= 60 ~ 5
            )) |>
            mutate(interpretation = case_when(
              levels == 1 ~ "susceptible",
              levels == 2 ~ "potential low-level resistance",
              levels == 3 ~ "low-level resistance",
              levels == 4 ~ "intermediate resistance",
              levels == 5 ~ "high-level resistance"
            )))
}

mut_combo_vec <- mut_score_combo |> 
  pull(combination_rule) |>
  paste(collapse = " + ") |>
  str_split(" \\+ ") |> 
  unlist() |>
  unique()

mut_combo_idx <- mut_combo_vec %in% (mutations |> pull(mutation))

# Function to sort mutations by position number
sort_mutations <- function(mutation_string) {
  # Split the string by " + "
  positions <- str_extract(mutation_string, "\\d+") |> as.numeric()
  
  # Sort mutations by their positions
  sorted_mutations <- mutation_string[order(positions)]
  
  return(sorted_mutations)
}

mut_combo_seq <- sort_mutations(mut_combo_vec[mut_combo_idx])

# Function to create combinations of a given size
create_combinations <- function(mutations_, size) {
  combn(mutations_, size, FUN = function(x) paste(x, collapse = " + "), simplify = TRUE)
}

if (length(mut_combo_seq)==1) { 
  mut_score_sum <- mut_score |>
    filter(Rule %in% mut_interest) |>
    select(-1) |>
    summarize(across(everything(), sum)) |>
    pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
    mutate(levels = case_when(
      score <= 9 ~ 1,
      score >= 10 & score <= 14 ~ 2,
      score >= 15 & score <= 29 ~ 3,
      score >= 30 & score <= 59 ~ 4,
      score >= 60 ~ 5
    )) |>
    mutate(interpretation = case_when(
      levels == 1 ~ "susceptible",
      levels == 2 ~ "potential low-level resistance",
      levels == 3 ~ "low-level resistance",
      levels == 4 ~ "intermediate resistance",
      levels == 5 ~ "high-level resistance"
    ))
  
  } else {

# Generate combinations of size 2, 3, and 4
all_combinations <- map(n:m, ~create_combinations(mut_combo_seq, .x)) |> 
  unlist()

# filter from mut_score_combo
mut_score_combo_df <- mut_score_combo |>
  filter(combination_rule %in% all_combinations) |>
  rename(Rule = combination_rule)

# sum single + combo
mut_score_sum <- mut_score |>
  filter(Rule %in% mut_interest) |>
  bind_rows(mut_score_combo_df) |>
  select(-1) |>
  summarize(across(everything(), sum)) |>
  pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
    mutate(levels = case_when(
      score <= 9 ~ 1,
      score >= 10 & score <= 14 ~ 2,
      score >= 15 & score <= 29 ~ 3,
      score >= 30 & score <= 59 ~ 4,
      score >= 60 ~ 5
    )) |>
    mutate(interpretation = case_when(
      levels == 1 ~ "susceptible",
      levels == 2 ~ "potential low-level resistance",
      levels == 3 ~ "low-level resistance",
      levels == 4 ~ "intermediate resistance",
      levels == 5 ~ "high-level resistance"
    ))
}

return(mut_score_sum)
}

(nrti <- load_hivdb("NRTI", mutations))
(nnrti <- load_hivdb("NNRTI", mutations))

Wow, long code but we were able to reproduce the same score as Stanford HIVdb! Not too shabby. Take note that if certain mutations exist together, there is another table that shows additional penalty score! For example, if our sequence contain M41L + T215FY mutation, the total mutation score for TDF is 5+10+10=25, it’s not just 5+10. see here for full table.

Now, we just need to repeat this for PR and IN, write it in a pipeline and there you have it! Let’s look at their official web service via sierrapy and then see if we can reproduce with our algorithm!

Stanford Sierrapy

Let’s explore a much simpler and expert-driven approach. Let’s try Stanford HIVdb’s SierraPy, their python equivalent. This uses their web service, hence will need internet and also need to send sequence as well. Very fast.

# install
pip install sierrapy

# write fasta of sample of interest, let's take a look at KJ849778.1
all_hiv_genome[all_hiv_genome |> names() |> str_detect("KJ849778.1")] |> writeXStringSet("hiv_test.fasta")

# run sierrapy input fasta
system("sierrapy fasta hiv_test.fasta -o hiv_test_output.json")

# read json output
jsonlite::read_json("hiv_test_output.0.json", simplifyVector = T)$drugResistance[[1]][3]$drugScores

Alright. 🤔 with 3 lines of code after you have an assembled HIV whole genome, Sierra web service via Sierrapy will provide you the susceptibility interpretation within seconds! The json also provides you with the alignments as well! You do need internet for this thought, if you’re looking for local interpretation then can look into Sierra Local. There are lots of ways to get to this without having the have heavy codes like we did! lol, but it’s great to know how it works under the hood!

Now, since we know what Stanford HIVdb shows, let’s see if our algorithm will return the same result!

code

extract_align <- function(sample,class) {
  
if (!exists("hxb2_genome")) { stop("you need load/enter hxb2_genome") } 
  
sample1 <- all_hiv_sample |>
  filter(str_detect(qseqid, sample)) |> 
  filter(sseqid == class) |> 
  select(qseqid, qstart, qend)

sample_rt <- subseq(
  all_hiv_genome[str_detect(names(all_hiv_genome), sample1$qseqid)],
  start = sample1$qstart,
  end = sample1$qend
)


## locate the genes
if (class == "HIV_RT") { rt_sequence <- subseq(hxb2_genome, start = 2550, end = 4229) }
if (class == "HIV_PR") { rt_sequence <- subseq(hxb2_genome, start = 2253, end = 2549) }
if (class == "HIV_INT") { rt_sequence <- subseq(hxb2_genome, start = 4230, end = 5093) }

# this automatically translate aligned seq into aligned AA, sweet !!! 
# alignseq <- AlignTranslation(c(rt_sequence,sample_rt), type="AAStringSet", verbose = F)

alignseq_nt <- AlignSeqs(c(rt_sequence,sample_rt),verbose=F)
ref_pos <- c()
align_ref_seq <- as.matrix(alignseq_nt) |> _[1,] 

for (i in 1:length(align_ref_seq)) {
  if (align_ref_seq[i] %in% LETTERS) { ref_pos <- c(ref_pos, i) }
}

align_ref_seq2 <- align_ref_seq[ref_pos] |> paste(collapse="") |> DNAStringSet() 
align_sample_seq <- as.matrix(alignseq_nt) |> _[2, ref_pos] |> str_replace("-","G") |> paste(collapse="") |> DNAStringSet() 

alignseq <- AlignTranslation(c(align_ref_seq2,align_sample_seq), verbose=F, type = "AAStringSet")

# which(align_ref_seq[ref_pos] != align_sample_seq)


# turn alignment into matrix
align_matrix <- as.matrix(alignseq)

# extract alignment on both ref and sample
for (i in 1:length(align_matrix[1,])) {
  if (align_matrix[1,][i] %in% LETTERS) {
    start_seq <- i
    break
  }
}

ref_seq <- align_matrix[1,start_seq:length(align_matrix[1,])]
sample_seq <- align_matrix[2,start_seq:length(align_matrix[1,])]

# find position where there is mutation
mutation_positions <- which(ref_seq != sample_seq & ref_seq != "-" & sample_seq != "-")

# load into dataframe
mutations <- data.frame(
  position = mutation_positions,
  reference = ref_seq[mutation_positions],
  sample = sample_seq[mutation_positions],
  mutation = paste0(ref_seq[mutation_positions], mutation_positions, sample_seq[mutation_positions])
) |>
  mutate(position_replace = paste0(position,sample))

return(mutations)
}

load_hivdb <- function(dataset, mutations){
  
if (dataset=="NRTI") {  
mut_score <- read_csv("hivdb_nrti_single.csv")
mut_score_combo <- read_csv("hivdb_nrti_combo.csv")
n <- 2
m <- 4
}

if (dataset=="NNRTI") {
  mut_score <- read_csv("hivdb_nnrti_single.csv",show_col_types = FALSE)
  mut_score_combo <- read_csv("hivdb_nnrti_combo.csv",show_col_types = FALSE)
  n <- 2
  m <- 2
}  
  
if (dataset=="PI") {
    mut_score <- read_csv("hivdb_pi_single.csv",show_col_types = FALSE)
    mut_score_combo <- read_csv("hivdb_pi_combo.csv",show_col_types = FALSE)
    n <- 2
    m <- 3
}  
  
if (dataset=="INSTI") {
  mut_score <- read_csv("hivdb_insti_single.csv",show_col_types = FALSE)
  mut_score_combo <- read_csv("hivdb_insti_combo.csv",show_col_types = FALSE)
  n <- 2
  m <- 3
  
}

mut_interest <- c()
for (mut_i in mut_score |> pull(Rule)) { 
    add_mut <- F
    add_mut <-  mut_i %in% (mutations |> pull(mutation))
    if (add_mut) {
      mut_interest <- c(mut_interest, mut_i)
    }
    
}

if (length(mut_interest)==0) {
  return(mut_score |> 
           slice_sample(n = 0) |>  # Get 0 rows but keep structure
           select(-1) |> 
           summarise(across(everything(), ~0)) |>
            pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
            mutate(levels = case_when(
              score <= 9 ~ 1,
              score >= 10 & score <= 14 ~ 2,
              score >= 15 & score <= 29 ~ 3,
              score >= 30 & score <= 59 ~ 4,
              score >= 60 ~ 5
            )) |>
            mutate(interpretation = case_when(
              levels == 1 ~ "susceptible",
              levels == 2 ~ "potential low-level resistance",
              levels == 3 ~ "low-level resistance",
              levels == 4 ~ "intermediate resistance",
              levels == 5 ~ "high-level resistance"
            )))
}

mut_combo_vec <- mut_score_combo |> 
  pull(combination_rule) |>
  paste(collapse = " + ") |>
  str_split(" \\+ ") |> 
  unlist() |>
  unique()

mut_combo_idx <- mut_combo_vec %in% (mutations |> pull(mutation))

# Function to sort mutations by position number
sort_mutations <- function(mutation_string) {
  # Split the string by " + "
  positions <- str_extract(mutation_string, "\\d+") |> as.numeric()
  
  # Sort mutations by their positions
  sorted_mutations <- mutation_string[order(positions)]
  
  return(sorted_mutations)
}

mut_combo_seq <- sort_mutations(mut_combo_vec[mut_combo_idx])

# Function to create combinations of a given size
create_combinations <- function(mutations_, size) {
  combn(mutations_, size, FUN = function(x) paste(x, collapse = " + "), simplify = TRUE)
}

if (length(mut_combo_seq)==1) { 
  mut_score_sum <- mut_score |>
    filter(Rule %in% mut_interest) |>
    select(-1) |>
    summarize(across(everything(), sum)) |>
    pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
    mutate(ART = case_when(
      ART == "ATV_r" ~ "ATV/r",
      ART == "DRV_r" ~ "DRV/r",
      ART == "LPV_r" ~ "LPV/r",
      TRUE ~ ART
    )) |>
    mutate(levels = case_when(
      score <= 9 ~ 1,
      score >= 10 & score <= 14 ~ 2,
      score >= 15 & score <= 29 ~ 3,
      score >= 30 & score <= 59 ~ 4,
      score >= 60 ~ 5
    )) |>
    mutate(interpretation = case_when(
      levels == 1 ~ "susceptible",
      levels == 2 ~ "potential low-level resistance",
      levels == 3 ~ "low-level resistance",
      levels == 4 ~ "intermediate resistance",
      levels == 5 ~ "high-level resistance"
    ))
  
  } else {

# Generate combinations of size 2, 3, and 4
all_combinations <- map(n:m, ~create_combinations(mut_combo_seq, .x)) |> 
  unlist()

# filter from mut_score_combo
mut_score_combo_df <- mut_score_combo |>
  filter(combination_rule %in% all_combinations) |>
  rename(Rule = combination_rule)

# sum single + combo
mut_score_sum <- mut_score |>
  filter(Rule %in% mut_interest) |>
  bind_rows(mut_score_combo_df) |>
  select(-1) |>
  summarize(across(everything(), sum)) |>
  pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
    mutate(levels = case_when(
      score <= 9 ~ 1,
      score >= 10 & score <= 14 ~ 2,
      score >= 15 & score <= 29 ~ 3,
      score >= 30 & score <= 59 ~ 4,
      score >= 60 ~ 5
    )) |>
    mutate(interpretation = case_when(
      levels == 1 ~ "susceptible",
      levels == 2 ~ "potential low-level resistance",
      levels == 3 ~ "low-level resistance",
      levels == 4 ~ "intermediate resistance",
      levels == 5 ~ "high-level resistance"
    ))
}

return(mut_score_sum)
}

hiv_genotype <- function(sample="KJ849778.1") {
class_group <- c("HIV_RT","HIV_PR","HIV_INT")
for (class in class_group) {
  mutations <- extract_align(sample, class)
  if (class == "HIV_RT") {
    print(load_hivdb("NRTI",mutations))
    print(load_hivdb("NNRTI",mutations))
  }
  if (class == "HIV_PR") {
    print(load_hivdb("PI",mutations))
  }
  if (class == "HIV_INT") {
    print(load_hivdb("INSTI",mutations))
  } 
}
}

WHAT !?!?! My algorithm failed 💔 !!! ❌❌❌ Noooo…!!! Ths iis very odd. Let’s inspect!

Let’s pick RT and inspect.

sample <- "KJ849778.1"
mutations <- extract_align(class = "HIV_RT", sample = sample)
mutations |> pull(mutation)

Let’s look at Stanford’s

Do you see what i’m seeing? Our aligned AA has a lot of X’s and these X’s coincide with Stanford’s. For example M184X on ours is Stanford’s M184MI. Our G190X is their G190EKR. 🤔 And some of the mutations are the same, so it’s not a frame issue. Oh wait !!! All X’s because we cannot assess what exactly the amino acid is, we can’t tell if there is mutation at all, hence we assume it could be any !?! That total makes sense! That means we’ll have to incorporate this into our algorithm! And also, not shown here, if there is missing, algorithm should also choose the max mutation score as penalty. Now let’s implement that!

code

load_hivdb <- function(dataset, mutations){
  
if (dataset=="NRTI") {  
mut_score <- read_csv("hivdb_nrti_single.csv")
mut_score_combo <- read_csv("hivdb_nrti_combo.csv")
n <- 2
m <- 4
}

if (dataset=="NNRTI") {
  mut_score <- read_csv("hivdb_nnrti_single.csv",show_col_types = FALSE)
  mut_score_combo <- read_csv("hivdb_nnrti_combo.csv",show_col_types = FALSE)
  n <- 2
  m <- 2
}  
  
if (dataset=="PI") {
    mut_score <- read_csv("hivdb_pi_single.csv",show_col_types = FALSE)
    mut_score_combo <- read_csv("hivdb_pi_combo.csv",show_col_types = FALSE) |>
      rename(`ATV/r`=ATV_r,`DRV/r`=DRV_r,`LPV/r`=LPV_r)
    n <- 2
    m <- 3
}  
  
if (dataset=="INSTI") {
  mut_score <- read_csv("hivdb_insti_single.csv",show_col_types = FALSE) 
  l74 <- mut_score |>
    filter(str_detect(Rule,"L74")) |>
    select(-Rule) 
  l74_2 <- tibble(Rule = c("L74M","L74F")) |>
    bind_cols(l74)
  mut_score <- mut_score |> 
    filter(!str_detect(Rule, "L74")) |>
    bind_rows(l74_2)
    
  mut_score_combo <- read_csv("hivdb_insti_combo.csv",show_col_types = FALSE)
  n <- 2
  m <- 3
  
}

mut_interest <- c()

# check if there is X
if (sum(mutations |> pull(mutation) |> str_detect("X$")) > 0) {
  mutations_vec <- str_replace(mutations |> pull(mutation), pattern = "X", replacement = "")
} else { 
  mutations_vec <- mutations |> pull(mutation)}

for (mut_i in mut_score |> pull(Rule)) { 
    add_mut <- F
    add_mut <-  str_detect(mut_i, paste(mutations_vec,collapse="|"))
    if (add_mut) {
      mut_interest <- c(mut_interest, mut_i)
    }
    
}

if (length(mut_interest)==0) {
  return(mut_score |> 
           slice_sample(n = 0) |>  # Get 0 rows but keep structure
           select(-1) |> 
           summarise(across(everything(), ~0)) |>
            pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
                   mutate(ART = case_when(
      ART == "ATV_r" ~ "ATV/r",
      ART == "DRV_r" ~ "DRV/r",
      ART == "LPV_r" ~ "LPV/r",
      TRUE ~ ART
    )) |>
            mutate(levels = case_when(
              score <= 9 ~ 1,
              score >= 10 & score <= 14 ~ 2,
              score >= 15 & score <= 29 ~ 3,
              score >= 30 & score <= 59 ~ 4,
              score >= 60 ~ 5
            )) |>
            mutate(interpretation = case_when(
              levels == 1 ~ "susceptible",
              levels == 2 ~ "potential low-level resistance",
              levels == 3 ~ "low-level resistance",
              levels == 4 ~ "intermediate resistance",
              levels == 5 ~ "high-level resistance"
            )))
}

mut_combo_vec <- mut_score_combo |> 
  pull(combination_rule) |>
  paste(collapse = " + ") |>
  str_split(" \\+ ") |> 
  unlist() |>
  unique()

mut_combo_idx <- mut_combo_vec %in% (mutations |> pull(mutation))

# Function to sort mutations by position number
sort_mutations <- function(mutation_string) {
  # Split the string by " + "
  positions <- str_extract(mutation_string, "\\d+") |> as.numeric()
  
  # Sort mutations by their positions
  sorted_mutations <- mutation_string[order(positions)]
  
  return(sorted_mutations)
}

mut_combo_seq <- sort_mutations(mut_combo_vec[mut_combo_idx])


# Function to create combinations of a given size
create_combinations <- function(mutations_, size) {
  combn(mutations_, size, FUN = function(x) paste(x, collapse = " + "), simplify = TRUE)
}

#sum(mutations |> pull(mutation) |> str_detect("X$")) > 0
if (length(mut_combo_seq)==1) { 
  mut_score_sum <- mut_score |>
    filter(Rule %in% mut_interest) |>
    mutate(Rule_x = str_extract(Rule, "^[A-Z]{1}[0-9]+")) |>
    # distinct(Rule_x, .keep_all = T) |>
    group_by(Rule_x) |>
    summarize(across(everything(),max)) |>
    select(-Rule,-Rule_x) |>
    summarize(across(everything(), sum)) |>
    pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
        mutate(ART = case_when(
      ART == "ATV_r" ~ "ATV/r",
      ART == "DRV_r" ~ "DRV/r",
      ART == "LPV_r" ~ "LPV/r",
      TRUE ~ ART
    )) |>
    mutate(levels = case_when(
      score <= 9 ~ 1,
      score >= 10 & score <= 14 ~ 2,
      score >= 15 & score <= 29 ~ 3,
      score >= 30 & score <= 59 ~ 4,
      score >= 60 ~ 5
    )) |>
    mutate(interpretation = case_when(
      levels == 1 ~ "susceptible",
      levels == 2 ~ "potential low-level resistance",
      levels == 3 ~ "low-level resistance",
      levels == 4 ~ "intermediate resistance",
      levels == 5 ~ "high-level resistance"
    ))
  
  } else {

# Generate combinations of size 2, 3, and 4
if (m > length(mut_combo_seq)) { m <- length(mut_combo_seq) }
if (n > length(mut_combo_seq)) { n <- length(mut_combo_seq) }  
all_combinations <- map(n:m, ~create_combinations(mut_combo_seq, .x)) |> 
  unlist()

# filter from mut_score_combo
mut_score_combo_df <- mut_score_combo |>
  filter(combination_rule %in% all_combinations) |>
  rename(Rule = combination_rule)

# sum single + combo
mut_score_sum <- mut_score |>
  filter(Rule %in% mut_interest) |>
  bind_rows(mut_score_combo_df) |>
  select(-1) |>
  summarize(across(everything(), sum)) |>
  pivot_longer(cols = everything(), names_to = "ART", values_to = "score") |>
  mutate(ART = case_when(
      ART == "ATV_r" ~ "ATV/r",
      ART == "DRV_r" ~ "DRV/r",
      ART == "LPV_r" ~ "LPV/r",
      TRUE ~ ART
    )) |>
    mutate(levels = case_when(
      score <= 9 ~ 1,
      score >= 10 & score <= 14 ~ 2,
      score >= 15 & score <= 29 ~ 3,
      score >= 30 & score <= 59 ~ 4,
      score >= 60 ~ 5
    )) |>
    mutate(interpretation = case_when(
      levels == 1 ~ "susceptible",
      levels == 2 ~ "potential low-level resistance",
      levels == 3 ~ "low-level resistance",
      levels == 4 ~ "intermediate resistance",
      levels == 5 ~ "high-level resistance"
    ))
}

return(mut_score_sum)
}

hiv_genotype()

Not too shabby! Now our NNRTI and PI look exactly the same! But our INSTI is not great! Mainly because there are a quite a few deletions that our alignment and their alignments don’t agree.

Let’s try another genome and see if our algorithm agrees with Stanford’s

Trial 1 ✅

Our code

sample <- sample(all_hiv_genome,1) |> names() |> str_split(" ") |> unlist() |> _[1]
hiv_genotype(sample = sample)

Stanford’s

all_hiv_genome[all_hiv_genome |> names() |> str_detect(sample)] |> writeXStringSet("hiv_test.fasta")

# run sierrapy input fasta
system("sierrapy fasta hiv_test.fasta -o hiv_test_output.json")

# read json output
jsonlite::read_json("hiv_test_output.0.json", simplifyVector = T)$drugResistance[[1]][3]$drugScores

Alright! Not too shabby! That was AY900571.2 accession.

Trial 2 ✅

Let’s try another one.

Our code

code

sample <- sample(all_hiv_genome,1) |> names() |> str_split(" ") |> unlist() |> _[1]
hiv_genotype(sample = sample)

Stanford’s

code

all_hiv_genome[all_hiv_genome |> names() |> str_detect(sample)] |> writeXStringSet("hiv_test.fasta")

# run sierrapy input fasta
system("sierrapy fasta hiv_test.fasta -o hiv_test_output.json")

# read json output
jsonlite::read_json("hiv_test_output.0.json", simplifyVector = T)$drugResistance[[1]][3]$drugScores

Awesome! No resistance at all! That was FM877777.1. Let’s give another a go!

Trial 3 ✅

Our code

code

sample <- sample(all_hiv_genome,1) |> names() |> str_split(" ") |> unlist() |> _[1]
hiv_genotype(sample = sample)

Stanford’s

code

all_hiv_genome[all_hiv_genome |> names() |> str_detect(sample)] |> writeXStringSet("hiv_test.fasta")

# run sierrapy input fasta
system("sierrapy fasta hiv_test.fasta -o hiv_test_output.json")

# read json output
jsonlite::read_json("hiv_test_output.0.json", simplifyVector = T)$drugResistance[[1]][3]$drugScores

There you go! Our algorithm works! That was EU448295.1. Let’s do another one!

Trial 4 ✅

Our code

code

sample <- sample(all_hiv_genome,1) |> names() |> str_split(" ") |> unlist() |> _[1]
hiv_genotype(sample = sample)

Stanford’s

code

all_hiv_genome[all_hiv_genome |> names() |> str_detect(sample)] |> writeXStringSet("hiv_test.fasta")

# run sierrapy input fasta
system("sierrapy fasta hiv_test.fasta -o hiv_test_output.json")

# read json output
jsonlite::read_json("hiv_test_output.0.json", simplifyVector = T)$drugResistance[[1]][3]$drugScores

There you go! Our algorithm works again! That was EU735539.1. Let’s do our last one.

Trial 5 ✅

Our code

code

sample <- sample(all_hiv_genome,1) |> names() |> str_split(" ") |> unlist() |> _[1]
hiv_genotype(sample = sample)

Stanford’s

code

all_hiv_genome[all_hiv_genome |> names() |> str_detect(sample)] |> writeXStringSet("hiv_test.fasta")

# run sierrapy input fasta
system("sierrapy fasta hiv_test.fasta -o hiv_test_output.json")

# read json output
jsonlite::read_json("hiv_test_output.0.json", simplifyVector = T)$drugResistance[[1]][3]$drugScores

That was AF443091.1. And 5 of 5 correct ✅ ! Hurray !!!!

Assess All

We did rewrite some of the functions (not shown here), compared our algorithm and Sierra’s of all the downaloded HIV genome fastas with complete RT, PR, INT positions from blast (n=494). Found 96.2% full agreement (n=475), meaning 0 deviation of level of any ART from both algorithm on the same genome sample. Not too shabby at all! I suspect the 3.4% is mainly alignment issues. I had initially used AlignTranslation prior to sequence alignemtn and it only gave me 89% agreement. Found out that I had to create my own function to align it properly (align DNA sequence first, then use reference sequence repositioning and extract sample sequence, then aligntranslate). I also found out that INSTI mutation score table is missing something.

Investigation

Writing a Pipeline with Nucamino

Install nucamino

# Clone the repository
git clone https://github.com/hivdb/nucamino.git
cd nucamino

# Initialize Go modules (if needed)
go mod init github.com/hivdb/nucamino 2>/dev/null || true
go mod tidy

# Build the binary
go build -o nucamino ./cmd/nucamino

After using nucamino for alignment, we were able to get reproducibility up to 99.8% (n=493)!!! Alright! I found out that I’ve been missing del as part of NRTI mutation penalty. And the last one DQ167215.1, I couldn’t really get it to work. I wonder if that has something to do with frameshift, which I haven’t figured out how nucamino handles that.

Final Thoughts

Hands down using SierraPy or Sierra-type app is the way to go, if we want reproducibility. There are options for local apps out there (see below). But learning to reproduce this really helps me understand the labeling of mutation and the way to get to susceptibility scoring better! It was a bumpy road, lots of trials, and lots more error and failure, but it ultimately it was a great learning experience. My respect for all these developers and researchers who have worked on this for years, really goes up! ❤️ It’s not easy at all! Even with the help of LLM!

Opportunities for Improvement

Need to rewrite the interpretation code into a function so that we don’t have to paste 3 different times or modify 3 different times on the load_hivdb function.
Learn the exact algorithm sierra uses for alignment, especially when it comes to deletion/insertion
Look at sierra-local to see how they use nucamino to align and find mutations/indels
prettify the results with gt
include more ARTs
look into Stanford HIVdb NGS analysis

Lessons Learnt

We did use genotype-phenotype DRMcv but found the results not reproducible and also does not match the mutation interpretation results, probably user error.
After multiple attempts to align seq, map to reference, then translate, just found out that DECIPHER::AlignTranslation() does a better job at this! Don’t use AlignSeq for aligning amino acids!
learnt that the position of M184V, K65R etc are RT, PR, IN gene specific!
learnt that Stanford HIVdb assumes mutation of different variants if X. For example, if M184X then it could be M184I or M184V, assume the worst case scenario and assign the max mutation score for that position.

If you like this article:

please feel free to send me a comment or visit my other blogs
please feel free to follow me on BlueSky, twitter, GitHub or Mastodon
if you would like collaborate please feel free to contact me

My Digital Library on Everyday Is A School Day

Learning Carbapenemase Producing Genes

Motivations:

Objectives:

Which Are Carbapenemase Producing Genes?

How Are We Going To Do This?

Results

The Proportion of Carbapenemase producing Genes in Meropenem Resistant Organism?

The Frequency of Carbapanemase Genes

Visualize Carbapanemase Gene Frequency By Year

Do MBLs Frequently Have Co-resistance Of Other Carbapenamase?

Let’s Take a Look At Avibactam-KPC and Avibactam-NDM Molecular Dynamic Simulation

Installation

Write mmpbsa.in

To Run MM/PBSA or MM/GBSA

KPC181-Avibactam

NDM1-Avibactam

Opportunities for improvement

Lessons Learnt

Assessing TEM, CTX-M, and KPC-2 With Molecular Docking and Molecular Dynamic Simulation

Motivations

Objectives:

Get Our Proteins

Protein Prediction With AlphaFold

Using DiffDock to predict binding sites

Install

Assess Results

Create function to visualize all

TEM-5

CTX-M-15

TEM-30

KPC2

Final Thought

Opportunities for improvement

Lessons Learnt

Exploring Molecular Docking & Molecular Dynamic Simulations - A Note To Myself

Motivations:

Disclaimer:

Objectives:

What Is Molecular Docking & Molecular Dynamic Simulations?

Molecular Docking

Installation

Download

Convert Protein and Ligand Structures

Run Vina

Molecular Dynamic Simulation

Install Gromacs

Prepare Protein For Gromac

Prepare Ligand

Create Position Restraints For The Ligand

Edit topol.top

Create The Complex

Convert Oringally Docked Pose To gro

Define Simulation Box

Solvate The System

Add Ions

ion.mdp

Energy Minimization

em.mdp

NVT Equilibration

nvt.mdp

NPT Equilibration

npt.mdp

Run Production

md.mdp

Asessment

RMSD — Root Mean Square Deviation

RMSF — Root Mean Square Fluctuation

Radius of Gyration (Rg)

Ligand-Protein Interaction Energy

Hydrogen Bond Analysis

Binding Pocket Distance Analysis

Visual Inspection

Opportunities for Improvement

Lessons Learnt

Setting Up A Cluster of Tiny PCs For Parallel Computing - A Note To Myself

Motivations

Objectives

Which PCs to Get?

Install Ubuntu

Write `mmpbsa.in`

Comparing Our NNLS to `nnls` package