This is a demo of our adaptMT package. adaptMT has two main components: an API that allows users to specify the working model and algorithms to fit them, as well as a pool of easy-to-use end-to-end wrappers. The former is captured by function adapt. The latter includes adapt_glm, adapt_gam and adapt_glmnet in current version (0.1.3.9000) for using GLM, GAM and L1-regularized GLM.

# install the "adaptMT" package from github.
# will be submitted to CRAN very soon.
devtools::install_github("lihualei71/adaptMT")
library("adaptMT")

We illustrate one of the main function adapt_glm, for AdaPT with logistic-Gamma GLM as the working model, on estrogen dataset, a gene/drug response dataset from NCBI Gene Expression Omnibus (GEO). estrogen dataset consists of gene expression measurements for \(n = 22283\) genes, in response to estrogen treatments in breast cancer cells for five groups of patients, with different dosage levels and 5 trials in each. The task is to identify the genes responding to a low dosage. The p-values pi for gene i is obtained by a one-sided permutation test which evaluates evidence for a change in gene expression level between the control group (placebo) and the low-dose group. \(\{p_i : i \in [n]\}\) are then ordered according to permutation t-statistics comparing the control and low-dose data, pooled, against data from a higher dosage (with genes that appear to have a strong response at higher dosages placed earlier in the list). The code to compute p-values and the ordering can be found in Rina Barber’s website.

In this demo, we subsample the top 5000 genes for illustration.

# load the data.
data("estrogen")
# Take the first 5000 genes 
library("dplyr")
estrogen <- select(estrogen, pvals, ord) %>% 
  filter(ord <= 5000)
rownames(estrogen) <- NULL
head(estrogen, 5)
summary(estrogen)
     pvals               ord      
 Min.   :0.000011   Min.   :   1  
 1st Qu.:0.076082   1st Qu.:1251  
 Median :0.238279   Median :2500  
 Mean   :0.315094   Mean   :2500  
 3rd Qu.:0.501009   3rd Qu.:3750  
 Max.   :0.999289   Max.   :5000  

Now we execute adapt_glm on this dataset. adapt_glm assumes a conditional logistic-Gamma GLM as the working model. Specifically, it models the p-values as \[H_i \mid x_i \sim \pi(x_i), \quad \mathrm{logit}(\pi(x_i))= \phi(x_i)^{T}\beta\] \[-\log p_i \mid H_i, x_i\sim \left\{\begin{array}{ll} \mathrm{Exp(1)} & H_i = 0\\ \mathrm{Exp(\mu(x))} & H_i = 1\end{array}\right., \quad \frac{1}{\mu(x_i)} = \phi(x_i)^{T}\gamma\] where \(\phi(x)\) is a featurization of \(x\). In this example, we use the spline bases, given by ns function from splines package. For illustration, we choose our candidate models as the above GLMs with \(\phi(x)\) being the spline bases with equal-spaced knots and the number of knots ranging from 6-10. We use BIC to select the best model at the initial stage and use the selected model for the following model fitting.

# prepare the inputs of AdaPT
# need "splines" package to construct the formula for glm
library("splines")
pvals <- as.numeric(estrogen$pvals)
x <- data.frame(x = as.numeric(estrogen$ord))
formulas <- paste0("ns(x, df = ", 6:10, ")")
formulas
[1] "ns(x, df = 6)"  "ns(x, df = 7)"  "ns(x, df = 8)"  "ns(x, df = 9)"  "ns(x, df = 10)"

adapt_glm function provides several user-friendly tools to monitor the progress. For model selection, a progress bar will, by default, be shown in the console that indicates how much proportion of models have been fitted. This can be turned off by setting verbose$ms = FALSE. Similarly for model fitting, a progress bar can be shown in the console, though not by default, by setting verbose$fit = TRUE. Also, by default, the progress of the main process will be shown in the console that indicates (1) which target FDR level has been achieved; (2) FDPhat for each target FDR level; (3) number of rejections for each target FDR level.

# run AdaPT
res <- adapt_glm(x = x, pvals = pvals, pi_formulas = formulas, mu_formulas = formulas)
Model selection starts!
Shrink the set of candidate models if it is too time-consuming.

  |                                                        
  |                                                  |   0%
  |                                                        
  |==========                                        |  20%
  |                                                        
  |====================                              |  40%
  |                                                        
  |==============================                    |  60%
  |                                                        
  |========================================          |  80%
  |                                                        
  |==================================================| 100%
alpha = 0.29: FDPhat 0.2899, Number of Rej. 3450
alpha = 0.28: FDPhat 0.28, Number of Rej. 3347
alpha = 0.27: FDPhat 0.2699, Number of Rej. 3227
alpha = 0.26: FDPhat 0.26, Number of Rej. 3104
alpha = 0.25: FDPhat 0.2498, Number of Rej. 3022
alpha = 0.24: FDPhat 0.2397, Number of Rej. 2937
alpha = 0.23: FDPhat 0.2297, Number of Rej. 2891
alpha = 0.22: FDPhat 0.2199, Number of Rej. 2760
alpha = 0.21: FDPhat 0.21, Number of Rej. 2700
alpha = 0.2: FDPhat 0.1999, Number of Rej. 2586
alpha = 0.19: FDPhat 0.1899, Number of Rej. 2501
alpha = 0.18: FDPhat 0.1798, Number of Rej. 2381
alpha = 0.17: FDPhat 0.1699, Number of Rej. 2272
alpha = 0.16: FDPhat 0.1598, Number of Rej. 2165
alpha = 0.15: FDPhat 0.1497, Number of Rej. 2064
alpha = 0.14: FDPhat 0.1397, Number of Rej. 1954
alpha = 0.13: FDPhat 0.1297, Number of Rej. 1889
alpha = 0.12: FDPhat 0.1196, Number of Rej. 1781
alpha = 0.11: FDPhat 0.1099, Number of Rej. 1720
alpha = 0.1: FDPhat 0.0996, Number of Rej. 1586
alpha = 0.09: FDPhat 0.0897, Number of Rej. 1405
alpha = 0.08: FDPhat 0.0798, Number of Rej. 1241
alpha = 0.07: FDPhat 0.0698, Number of Rej. 1074
alpha = 0.06: FDPhat 0.0598, Number of Rej. 937
alpha = 0.05: FDPhat 0.0498, Number of Rej. 884
alpha = 0.04: FDPhat 0.0399, Number of Rej. 777
alpha = 0.03: FDPhat 0.0289, Number of Rej. 519
alpha = 0.02: FDPhat 0.0179, Number of Rej. 224

plot_thresh_1d gives the plot for the rejection threshold as a function of x (must be univariate without repeated value) for given \(\alpha\). We display the plots for \(\alpha \in \{0.3, 0.25, 0.2, 0.15, 0.1, 0.05\}\).

plot_lfdr_1d gives the plot for the estimated local FDR as a function of x (must be univariate without repeated value) for given \(\alpha\). We display the plots for \(\alpha \in \{0.3, 0.25, 0.2, 0.15, 0.1, 0.05\}\). It is clear that the estimated local FDR almost remains the same, indicating that the information loss caused by partial masking is small.

par(mfrow = c(2, 3))
for (alpha in seq(0.3, 0.05, -0.05)){
  nrejs <- res$nrejs[floor(alpha * 100)]
  title <- paste0("alpha = ", alpha, ", nrejs = ", nrejs)
  plot_lfdr_1d(res, alpha, title, disp_ymax = 0.25, xlab = "order")
}

LS0tCnRpdGxlOiAiSW50cm9kdWN0aW9uIHRvIGBhZGFwdE1UYCBwYWNrYWdlOiBkZW1vMSIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKVGhpcyBpcyBhIGRlbW8gb2Ygb3VyIGBhZGFwdE1UYCBwYWNrYWdlLiBgYWRhcHRNVGAgaGFzIHR3byBtYWluIGNvbXBvbmVudHM6IGFuIEFQSSB0aGF0IGFsbG93cyB1c2VycyB0byBzcGVjaWZ5IHRoZSB3b3JraW5nIG1vZGVsIGFuZCBhbGdvcml0aG1zIHRvIGZpdCB0aGVtLCBhcyB3ZWxsIGFzIGEgcG9vbCBvZiBlYXN5LXRvLXVzZSBlbmQtdG8tZW5kIHdyYXBwZXJzLiBUaGUgZm9ybWVyIGlzIGNhcHR1cmVkIGJ5IGZ1bmN0aW9uIGBhZGFwdGAuIFRoZSBsYXR0ZXIgaW5jbHVkZXMgYGFkYXB0X2dsbWAsIGBhZGFwdF9nYW1gIGFuZCBgYWRhcHRfZ2xtbmV0YCBpbiBjdXJyZW50IHZlcnNpb24gKDAuMS4zLjkwMDApIGZvciB1c2luZyBHTE0sIEdBTSBhbmQgTDEtcmVndWxhcml6ZWQgR0xNLgoKYGBge3IsIHJlc3VsdHM9J2hpZGUnfQojIGluc3RhbGwgdGhlICJhZGFwdE1UIiBwYWNrYWdlIGZyb20gZ2l0aHViLgojIHdpbGwgYmUgc3VibWl0dGVkIHRvIENSQU4gdmVyeSBzb29uLgpkZXZ0b29sczo6aW5zdGFsbF9naXRodWIoImxpaHVhbGVpNzEvYWRhcHRNVCIpCmxpYnJhcnkoImFkYXB0TVQiKQpgYGAKCldlIGlsbHVzdHJhdGUgb25lIG9mIHRoZSBtYWluIGZ1bmN0aW9uIGBhZGFwdF9nbG1gLCBmb3IgQWRhUFQgd2l0aCBsb2dpc3RpYy1HYW1tYSBHTE0gYXMgdGhlIHdvcmtpbmcgbW9kZWwsIG9uIGBlc3Ryb2dlbmAgZGF0YXNldCwgYSBnZW5lL2RydWcgcmVzcG9uc2UgZGF0YXNldCBmcm9tIE5DQkkgR2VuZSBFeHByZXNzaW9uIE9tbmlidXMgKEdFTykuIGBlc3Ryb2dlbmAgZGF0YXNldCBjb25zaXN0cyBvZiBnZW5lIGV4cHJlc3Npb24gbWVhc3VyZW1lbnRzIGZvciAkbiA9IDIyMjgzJCBnZW5lcywgaW4gcmVzcG9uc2UgdG8gZXN0cm9nZW4gdHJlYXRtZW50cyBpbiBicmVhc3QgY2FuY2VyIGNlbGxzIGZvciBmaXZlIGdyb3VwcyBvZiBwYXRpZW50cywgd2l0aCBkaWZmZXJlbnQgZG9zYWdlIGxldmVscyBhbmQgNSB0cmlhbHMgaW4gZWFjaC4gVGhlIHRhc2sgaXMgdG8gaWRlbnRpZnkgdGhlIGdlbmVzIHJlc3BvbmRpbmcgdG8gYSBsb3cgZG9zYWdlLiBUaGUgcC12YWx1ZXMgcGkgZm9yIGdlbmUgaSBpcyBvYnRhaW5lZCBieSBhIG9uZS1zaWRlZCBwZXJtdXRhdGlvbiB0ZXN0IHdoaWNoIGV2YWx1YXRlcyBldmlkZW5jZSBmb3IgYSBjaGFuZ2UgaW4gZ2VuZSBleHByZXNzaW9uIGxldmVsIGJldHdlZW4gdGhlIGNvbnRyb2wgZ3JvdXAgKHBsYWNlYm8pIGFuZCB0aGUgbG93LWRvc2UgZ3JvdXAuICRce3BfaSA6IGkgXGluIFtuXVx9JCBhcmUgdGhlbiBvcmRlcmVkIGFjY29yZGluZyB0byBwZXJtdXRhdGlvbiB0LXN0YXRpc3RpY3MgY29tcGFyaW5nIHRoZSBjb250cm9sIGFuZCBsb3ctZG9zZSBkYXRhLCBwb29sZWQsIGFnYWluc3QgZGF0YSBmcm9tIGEgaGlnaGVyIGRvc2FnZSAod2l0aCBnZW5lcyB0aGF0IGFwcGVhciB0byBoYXZlIGEgc3Ryb25nIHJlc3BvbnNlIGF0IGhpZ2hlciBkb3NhZ2VzIHBsYWNlZCBlYXJsaWVyIGluIHRoZSBsaXN0KS4gVGhlIGNvZGUgdG8gY29tcHV0ZSBwLXZhbHVlcyBhbmQgdGhlIG9yZGVyaW5nIGNhbiBiZSBmb3VuZCBpbiBbUmluYSBCYXJiZXIncyB3ZWJzaXRlXShodHRwOi8vd3d3LnN0YXQudWNoaWNhZ28uZWR1L35yaW5hL3NhYmhhL2dlbmVfZHJ1Z19kYXRhX2V4YW1wbGUuUikuCgpJbiB0aGlzIGRlbW8sIHdlIHN1YnNhbXBsZSB0aGUgdG9wIDUwMDAgZ2VuZXMgZm9yIGlsbHVzdHJhdGlvbi4KCmBgYHtyLHJlc3VsdHM9J2hpZGUnfQojIGxvYWQgdGhlIGRhdGEuCmRhdGEoImVzdHJvZ2VuIikKIyBUYWtlIHRoZSBmaXJzdCA1MDAwIGdlbmVzIApsaWJyYXJ5KCJkcGx5ciIpCmVzdHJvZ2VuIDwtIHNlbGVjdChlc3Ryb2dlbiwgcHZhbHMsIG9yZCkgJT4lIAogIGZpbHRlcihvcmQgPD0gNTAwMCkKcm93bmFtZXMoZXN0cm9nZW4pIDwtIE5VTEwKYGBgCgpgYGB7cn0KaGVhZChlc3Ryb2dlbiwgNSkKYGBgCgpgYGB7cn0Kc3VtbWFyeShlc3Ryb2dlbikKYGBgCgpgYGB7ciwgZWNobz1GQUxTRX0KICBwbG90KGVzdHJvZ2VuJG9yZCwgZXN0cm9nZW4kcHZhbHMsIHBjaCA9ICIuIiwgeGxhYiA9ICJvcmRlciIsIHlsYWIgPSAicC12YWx1ZXMiLCB4YXhzID0gImkiLCB5YXhzID0gImkiLCBtYWluID0gIlNjYXR0ZXIgcGxvdCBvZiBwLXZhbHVlcyBpbiB0aGUgKHN1Yi1zYW1wbGVkKSBlc3Ryb2dlbiBkYXRhc2V0IikKYGBgCgpOb3cgd2UgZXhlY3V0ZSBgYWRhcHRfZ2xtYCBvbiB0aGlzIGRhdGFzZXQuIGBhZGFwdF9nbG1gIGFzc3VtZXMgYSBjb25kaXRpb25hbCBsb2dpc3RpYy1HYW1tYSBHTE0gYXMgdGhlIHdvcmtpbmcgbW9kZWwuIFNwZWNpZmljYWxseSwgaXQgbW9kZWxzIHRoZSBwLXZhbHVlcyBhcwokJEhfaSBcbWlkIHhfaSBcc2ltIFxwaSh4X2kpLCBccXVhZCBcbWF0aHJte2xvZ2l0fShccGkoeF9pKSk9IFxwaGkoeF9pKV57VH1cYmV0YSQkCiQkLVxsb2cgcF9pIFxtaWQgSF9pLCB4X2lcc2ltIFxsZWZ0XHtcYmVnaW57YXJyYXl9e2xsfSBcbWF0aHJte0V4cCgxKX0gJiBIX2kgPSAwXFwgXG1hdGhybXtFeHAoXG11KHgpKX0gJiBIX2kgPSAxXGVuZHthcnJheX1ccmlnaHQuLCBccXVhZCBcZnJhY3sxfXtcbXUoeF9pKX0gPSBccGhpKHhfaSlee1R9XGdhbW1hJCQKd2hlcmUgJFxwaGkoeCkkIGlzIGEgZmVhdHVyaXphdGlvbiBvZiAkeCQuIEluIHRoaXMgZXhhbXBsZSwgd2UgdXNlIHRoZSBzcGxpbmUgYmFzZXMsIGdpdmVuIGJ5IGBuc2AgZnVuY3Rpb24gZnJvbSBgc3BsaW5lc2AgcGFja2FnZS4gRm9yIGlsbHVzdHJhdGlvbiwgd2UgY2hvb3NlIG91ciBjYW5kaWRhdGUgbW9kZWxzIGFzIHRoZSBhYm92ZSBHTE1zIHdpdGggJFxwaGkoeCkkIGJlaW5nIHRoZSBzcGxpbmUgYmFzZXMgd2l0aCBlcXVhbC1zcGFjZWQga25vdHMgYW5kIHRoZSBudW1iZXIgb2Yga25vdHMgcmFuZ2luZyBmcm9tIDYtMTAuIFdlIHVzZSBCSUMgdG8gc2VsZWN0IHRoZSBiZXN0IG1vZGVsIGF0IHRoZSBpbml0aWFsIHN0YWdlIGFuZCB1c2UgdGhlIHNlbGVjdGVkIG1vZGVsIGZvciB0aGUgZm9sbG93aW5nIG1vZGVsIGZpdHRpbmcuCgpgYGB7cn0KIyBwcmVwYXJlIHRoZSBpbnB1dHMgb2YgQWRhUFQKIyBuZWVkICJzcGxpbmVzIiBwYWNrYWdlIHRvIGNvbnN0cnVjdCB0aGUgZm9ybXVsYSBmb3IgZ2xtCmxpYnJhcnkoInNwbGluZXMiKQpwdmFscyA8LSBhcy5udW1lcmljKGVzdHJvZ2VuJHB2YWxzKQp4IDwtIGRhdGEuZnJhbWUoeCA9IGFzLm51bWVyaWMoZXN0cm9nZW4kb3JkKSkKZm9ybXVsYXMgPC0gcGFzdGUwKCJucyh4LCBkZiA9ICIsIDY6MTAsICIpIikKZm9ybXVsYXMKYGBgCgpgYWRhcHRfZ2xtYCBmdW5jdGlvbiBwcm92aWRlcyBzZXZlcmFsIHVzZXItZnJpZW5kbHkgdG9vbHMgdG8gbW9uaXRvciB0aGUgcHJvZ3Jlc3MuIEZvciBtb2RlbCBzZWxlY3Rpb24sIGEgcHJvZ3Jlc3MgYmFyIHdpbGwsIGJ5IGRlZmF1bHQsIGJlIHNob3duIGluIHRoZSBjb25zb2xlIHRoYXQgaW5kaWNhdGVzIGhvdyBtdWNoIHByb3BvcnRpb24gb2YgbW9kZWxzIGhhdmUgYmVlbiBmaXR0ZWQuIFRoaXMgY2FuIGJlIHR1cm5lZCBvZmYgYnkgc2V0dGluZyB2ZXJib3NlXCRtcyA9IEZBTFNFLiBTaW1pbGFybHkgZm9yIG1vZGVsIGZpdHRpbmcsIGEgcHJvZ3Jlc3MgYmFyIGNhbiBiZSBzaG93biBpbiB0aGUgY29uc29sZSwgdGhvdWdoIG5vdCBieSBkZWZhdWx0LCBieSBzZXR0aW5nIHZlcmJvc2VcJGZpdCA9IFRSVUUuIEFsc28sIGJ5IGRlZmF1bHQsIHRoZSBwcm9ncmVzcyBvZiB0aGUgbWFpbiBwcm9jZXNzIHdpbGwgYmUgc2hvd24gaW4gdGhlIGNvbnNvbGUgdGhhdCBpbmRpY2F0ZXMgKDEpIHdoaWNoIHRhcmdldCBGRFIgbGV2ZWwgaGFzIGJlZW4gYWNoaWV2ZWQ7ICgyKSBGRFBoYXQgZm9yIGVhY2ggdGFyZ2V0IEZEUiBsZXZlbDsgKDMpIG51bWJlciBvZiByZWplY3Rpb25zIGZvciBlYWNoIHRhcmdldCBGRFIgbGV2ZWwuCgpgYGB7ciwgd2FybmluZz1GQUxTRX0KIyBydW4gQWRhUFQKcmVzIDwtIGFkYXB0X2dsbSh4ID0geCwgcHZhbHMgPSBwdmFscywgcGlfZm9ybXVsYXMgPSBmb3JtdWxhcywgbXVfZm9ybXVsYXMgPSBmb3JtdWxhcykKYGBgCgpgcGxvdF90aHJlc2hfMWRgIGdpdmVzIHRoZSBwbG90IGZvciB0aGUgcmVqZWN0aW9uIHRocmVzaG9sZCBhcyBhIGZ1bmN0aW9uIG9mIHggKG11c3QgYmUgdW5pdmFyaWF0ZSB3aXRob3V0IHJlcGVhdGVkIHZhbHVlKSBmb3IgZ2l2ZW4gJFxhbHBoYSQuIFdlIGRpc3BsYXkgdGhlIHBsb3RzIGZvciAkXGFscGhhIFxpbiBcezAuMywgMC4yNSwgMC4yLCAwLjE1LCAwLjEsIDAuMDVcfSQuCgpgYGB7ciwgZWNobz1GQUxTRX0KcGFyKG1mcm93ID0gYygyLCAzKSkKZm9yIChhbHBoYSBpbiBzZXEoMC4zLCAwLjA1LCAtMC4wNSkpewogIG5yZWpzIDwtIHJlcyRucmVqc1tmbG9vcihhbHBoYSAqIDEwMCldCiAgdGl0bGUgPC0gcGFzdGUwKCJhbHBoYSA9ICIsIGFscGhhLCAiLCBucmVqcyA9ICIsIG5yZWpzKQogIHBsb3RfdGhyZXNoXzFkKHJlcywgYWxwaGEsIHRpdGxlLCBkaXNwX3ltYXggPSAxLCB4bGFiID0gIm9yZGVyIikKfQpgYGAKCmBwbG90X2xmZHJfMWRgIGdpdmVzIHRoZSBwbG90IGZvciB0aGUgZXN0aW1hdGVkIGxvY2FsIEZEUiBhcyBhIGZ1bmN0aW9uIG9mIHggKG11c3QgYmUgdW5pdmFyaWF0ZSB3aXRob3V0IHJlcGVhdGVkIHZhbHVlKSBmb3IgZ2l2ZW4gJFxhbHBoYSQuIFdlIGRpc3BsYXkgdGhlIHBsb3RzIGZvciAkXGFscGhhIFxpbiBcezAuMywgMC4yNSwgMC4yLCAwLjE1LCAwLjEsIDAuMDVcfSQuIEl0IGlzIGNsZWFyIHRoYXQgdGhlIGVzdGltYXRlZCBsb2NhbCBGRFIgYWxtb3N0IHJlbWFpbnMgdGhlIHNhbWUsIGluZGljYXRpbmcgdGhhdCB0aGUgaW5mb3JtYXRpb24gbG9zcyBjYXVzZWQgYnkgcGFydGlhbCBtYXNraW5nIGlzIHNtYWxsLgoKYGBge3J9CnBhcihtZnJvdyA9IGMoMiwgMykpCmZvciAoYWxwaGEgaW4gc2VxKDAuMywgMC4wNSwgLTAuMDUpKXsKICBucmVqcyA8LSByZXMkbnJlanNbZmxvb3IoYWxwaGEgKiAxMDApXQogIHRpdGxlIDwtIHBhc3RlMCgiYWxwaGEgPSAiLCBhbHBoYSwgIiwgbnJlanMgPSAiLCBucmVqcykKICBwbG90X2xmZHJfMWQocmVzLCBhbHBoYSwgdGl0bGUsIGRpc3BfeW1heCA9IDAuMjUsIHhsYWIgPSAib3JkZXIiKQp9CmBgYAoKCg==