################################################################################ ################################################################################ ### ### ### R CODE USED IN ANALYSIS ### ### ### ### THIS FILE USES THE FOLLOWING DATA FILES: ### ### PublicData.csv all data for individual participants except for ### ### pollution exposure and PHI ### ### Exposure.csv pollution exposure data for individual samples ### ### AQbySensor.csv daily averages of air quality measurements from which ### ### values in Exposure.csv were obtained ### ### ### ### FOR ANY ANALYSIS: Run all of blocks of code labeled PREAMBLE and also ### ### first block of code in section labeled READ AND MASSAGE PUBLIC DATA ### ### FILES. ### ### ### ### Blocks labeled with NEED_RAW_AQ need the file AQbySensor.csv to be read, ### ### which is done in the second block of code in section labeled READ AND ### ### MASSAGE PUBLIC DATA FILES. ### ### ### ### The code in this file is NOT in the order in which the analyses are ### ### discussed in the paper and supplement. ### ### TABLE OF CONTENTS OF THIS FILE: ### ### 1. PREAMBLE: miscellaneous small definitions ### ### 2. READ AND MASSAGE PUBLIC DATA FILES ### ### 3. PRELIMINARIES: a few results and figures that describe the data ### ### 4. METHYLATION: analysis with methylation as response ### ### 5. LOCATIONS: all code that would require the subjects' locations and ### ### date of visit ### ### 6. ARCHIVAL CODE: the code used to create PublicData.csv from the data ### ### originally provided to the analysts ### ### ### ################################################################################ ################################################################################ ### ### PREAMBLE ### ### This file run on R version 3.2.5. ### All R packages (and their version numbers) used in this file. library(plyr) library(reshape2) library(lattice) library(latticeExtra) library(nlme) library(grid) library(gridExtra) # Running the part of the code labeled LOCATIONS below requires the subjects' # locations (which are not publicly available) and the following packages. #library(zoo) # (smoothing pollution data) #library(gstat) # (computing IDW) #library(sp) # (plotting example of IDW output) ### ### DATE FORMATS FOR READING DATA FILES ### setClass('myDate') setAs('character','myDate', function(from) as.Date(from, format='%m/%d/%Y')) setClass('myAltDate2') setAs('character','myAltDate2', function(from) as.Date(from, format='%d-%b-%y')) ### ### SOME DEFINITIONS RELATED TO GENES AND METHYLATION ### genes <- c("Foxp3","Il10") gene.strs <- c(Foxp3="Foxp3",Il10="IL10") foxp3Upstream <- paste('Foxp3', c('CpG.4506','CpG.4500','CpG.4494','CpG.4484'), sep='.') foxp3PromA <- paste('Foxp3', c('CpG.138','CpG.126'), sep='.') foxp3PromB <- paste('Foxp3', c('CpG.77','CpG.65','CpG.58'), sep='.') foxp3PromC <- paste('Foxp3', 'CpG.15', sep='.') foxp3Promoter <- c(foxp3PromA, foxp3PromB, foxp3PromC) foxp3All <- c(foxp3Upstream, foxp3Promoter) il10In1 <- paste('Il10', c('CpG.2888','CpG.2907','CpG.2921'), sep='.') il10In3 <- paste('Il10', c('CpG.3261','CpG.3265','CpG.3281'), sep='.') il10Intron <- c(il10In1,il10In3) il10All <- il10Intron col.sa <- c("pink3","pink","blue","lightskyblue") ### ### SOME DEFINITIONS RELATED TO POLLUTION DATA ### aq.rng <- data.frame(pollutant=c("CO","NO2","O3","PM2.5"), value=c(0.56497826, 20.80450593, 0.05095454, 34.84416667), row.names=1) # Units for pollution data: # CO - ppm, O3 - ppm, NO2 - ppb, PM2.5 - micrograms/cubic meter pal <- colorRampPalette(c("white", "firebrick4")) colors <- pal(4) cvec <- colors[2] pal <- colorRampPalette(c("white", "goldenrod3")) colors <- pal(4) cvec <- c(cvec, colors[2], "gray82") pal <- colorRampPalette(c("white", "cadetblue3")) colors <- pal(4) cvec <- c(cvec, colors[2]) POLLUTANTS <- data.frame(pollutant=c("CO","NO2","O3","PM2.5"), colLine=c('firebrick4','goldenrod3','gray52', 'cadetblue3'), colStrip=cvec) POLLUTANTS <- transform(POLLUTANTS, colLine=as.character(colLine), colStrip=as.character(colStrip)) rownames(POLLUTANTS) <- POLLUTANTS$pollutant aq.labels <- c("CO", expression(NO[2]), expression(O[3]), expression(PM[2.5])) aq.units <- c("CO (ppm)", expression(paste(NO[2], " (ppm)")), expression(paste(O[3], " (ppb)")), expression(paste(PM[2.5], " (", mu, g/m^3, ")"))) COORD.ORIGIN <- c(x=241000, y=4065000) SENSORS <- data.frame(sensor=c("X0007", "X0008", "X0011", "X5001", "X0242"), x=c(255066, 252520, 252445, 257623, 243595), y=c(4065709, 4074203, 4074648, 4078252, 4081131), pch=c(15,16,16,17,18), cex=c(1.5,1.5,1.5,1.5,2)) SENSORS <- transform(SENSORS, x=x-COORD.ORIGIN["x"], y=y-COORD.ORIGIN["y"]) rownames(SENSORS) <- SENSORS$sensor loc <- NULL ### ### SOME FUNCTIONS USED IN THIS FILE ### myStripStyle <- function(which.panel, factor.levels, ...) { chem <- factor.levels[which.panel] clr <- POLLUTANTS[chem, "colStrip"] ind <- which(rownames(POLLUTANTS) == chem) panel.rect(0, 0, 1, 1, col=clr, border=1) panel.text(x=0.5, y=0.5, lab=aq.units[ind], col="black", cex=0.9) } cpgPretty <- function(cpgNames) { dotLocs <- regexpr(".", cpgNames, fixed=T) gene <- substr(cpgNames, 1, dotLocs-1) gene <- setdiff(gene, "") gene <- unique(gene) if (length(gene) > 1) stop("cpgPretty: all sites must be in same gene") cpgNames <- substr(cpgNames, dotLocs+1, 100) if (gene == "Foxp3") { x <- sub("CpG.", "CpG -", cpgNames) } else if (gene == "Il10") { x <- sub("CpG.", "CpG +", cpgNames) x <- sub("region", "region ", x) } else { stop("cpgPretty: unknown gene") } x } ################################################################################ ################################################################################ ### ### ### READ AND MASSAGE PUBLIC DATA FILES ### ### ### ################################################################################ ################################################################################ data.pub <- read.csv(file="PublicData.csv") #data.pub <- data.cmb # version of data including dates; search for data.cmb cat(sprintf("Number of participants in public data: %d\n", length(unique(data.pub$subject)))) aggr <- subset(data.pub, isUsed) cat(sprintf("Number of participants with required data and in study area: %d\n", length(unique(aggr$subject)))) aggr[,"asthma.allergy"] <- NULL aggr[,"date.conversion"] <- NULL aggr <- subset(aggr, foxp3.good) #### DISCARD SAMPLES WITH OUTLIERS cat(sprintf("Number of participants after discarding foxp3 outliers: %d\n", length(unique(aggr$subject)))) aq.wdw <- read.csv(file="Exposure.csv") aq.wdw <- transform(aq.wdw, window=factor(window, levels=c(1,15,30,90,180,365))) ### Choose one visit for each subject # NOTE: The existence of IgE measurements are used in selecting one visit per # subject despite the fact that the analysis of IgE did not give clear results # and is not included in the manuscript. chooseVisit <- function(data) { ddply(data, .(subject), function(x) { if (nrow(x) == 1) return(x) y <- x[ order(x$id.visit), ] z <- rowSums(y[,c("allIl10","allIgE")]) z <- which(z == 2) if (length(z) > 0) return(y[z[1],]) z <- which(y$allIl10) if (length(z) > 0) return(y[z[1],]) return(y[1,]) }) } aggr.1 <- chooseVisit(aggr) aggr.foxp3 <- aggr.1 cat(sprintf("Number of participants for foxp3: %d\n", nrow(aggr.foxp3))) aggr.il10 <- subset(aggr.1, allIl10) cat(sprintf("Number of participants for il10: %d\n", nrow(aggr.il10))) ### This block of code reads AQbySensor.csv. The data frame aq.sensor that is ### created is only used a few times in this file; search for NEED_RAW_AQ aq.sensor <- read.csv(file="AQbySensor.csv", colClasses=c("factor","myAltDate2","factor", "numeric","NULL")) names(aq.sensor) <- c("pollutant", "date", "sensor", "value") aq.sensor <- transform(aq.sensor, sensor=factor(paste("X", substr(sensor, start=7, stop=10), sep=""))) ddply(aq.sensor, .(sensor), colwise(range,"date")) ### aq.rng is created directly in the first block of this file. ### This code is for documentation purposes only. #aq.rng <- ddply(aq.sensor, .(pollutant), # colwise(quantile,"value"), probs=0.9) #rownames(aq.rng) <- aq.rng$pollutant ################################################################################ ################################################################################ ### ### ### PRELIMINARIES ### ### Code to obtain numbers and plots used in description of data ### ### ### ################################################################################ ################################################################################ ### ASTHMA IN FAMILIES fam.mult <- ddply(aggr.1, .(family), function(x) { c(asthma=sum(x$asthma=="yes"), non=sum(x$asthma=="no")) }) cat("ASTHMA IN FAMILIES\n") print(xtabs(~ asthma + non, fam.mult)) nrow(fam.mult) fam.count <- rowSums(fam.mult[,2:3]) sum(fam.count > 1) sum(fam.count[fam.count > 1]) ### PLOTS OF POLLUTION # NEED_RAW_AQ # The data frame aq.tmp created in this block of code from aq.sensor is used in # both the succeeding blocks of code. The data frame aq.sensor is also used # directly several times in the remainder of this section of code. aq.tmp <- subset(aq.sensor, date >= "2010-01-01" & date < "2015-01-01" & (sensor != "X0008" | date >= "2012-01-01" | pollutant != "PM2.5")) # Combine sensors X0008 and X0011 aq.tmp <- transform(aq.tmp, sensor=ifelse(sensor=="X0011", "X0008", as.character(sensor))) aq.tmp <- ddply(aq.tmp, .(pollutant,sensor,date), function(x) { n <- sample(nrow(x), 1) x[n,] }) aq.tmp <- transform(aq.tmp, t.grp=format(date, "%Y")) aq.tmp <- ddply(aq.tmp, .(pollutant,sensor,t.grp), colwise(mean,"value")) aq.tmp <- transform(aq.tmp, sensor=factor(substr(sensor, 2, 100))) chem.mean <- ddply(aq.tmp, .(pollutant), colwise(mean,"value")) rownames(chem.mean) <- chem.mean$pollutant names(chem.mean)[2] <- "mean" ### FIGURE 2 # NEED_RAW_AQ # Including subjects' locations in Panel A requires obtaining them from the # authors and then reading them with the code in the section LOCATIONS below. # This block of code also requires the version of aggr.1 that has the date of # the visit. ttl.line <- 0.5 ttl.cex <- 1 x11(height=6,width=6.3) #pdf(file="fig2.pdf", height=6,width=6.3) opar <- par(mfrow=c(2,2), mar=c(3,3.2,2.5,1)) # Locations and sensors if (is.null(loc)) { xl <- c(0.552, 22.732) yl <- c(1.026874, 25.658943) } else { tmp <- merge(loc[,c("subject","date.visit","x","y")], subset(aggr.1, loc.good, select=c("subject","date.visit"))) xl <- range(tmp$x)/1000 yl <- range(tmp$y)/1000 } plot(SENSORS$x/1000, SENSORS$y/1000, xlim=xl, ylim=yl, asp=1, pch=SENSORS$pch, cex=SENSORS$cex, col="deeppink", xlab=NA, ylab=NA) if (!is.null(loc)) points(tmp$x/1000, tmp$y/1000, col="black", cex=0.8) title(main="A. Locations", line=ttl.line, cex.main=ttl.cex) title(xlab="east/west (km)", ylab="north/south (km)", line=2) # Annual pollution averages tmp <- ddply(aq.tmp, .(pollutant,sensor), function(x) { z <- c(mean=mean(x$value), min=min(x$value), max=max(x$value)) z / chem.mean[x$pollutant[1],"mean"] }) tmp <- transform(tmp, sensor=as.character(sensor), x=(as.numeric(pollutant) + 0.2*(as.numeric(sensor)-2.5))) tmp <- merge(tmp, POLLUTANTS) tmp <- merge(tmp, transform(SENSORS[,c("sensor","pch","cex")], sensor=sub("X","",sensor))) plot(tmp$x, tmp$mean, col=tmp$colLine, pch=tmp$pch, cex=tmp$cex, ylim=range(c(tmp$min-0.01,tmp$max+0.01)), axes=F, xlab=NA, ylab=NA) axis(side=1, at=1:4, labels=aq.labels) axis(side=2) box() segments(tmp$x, tmp$min, tmp$x, tmp$max, col=tmp$colLine) title(main="B. Monitoring station variation", line=ttl.line, cex.main=ttl.cex) title(xlab="pollutant", ylab="yearly average", line=2) legend("bottomright", legend=paste("S", 1:4, sep=""), ncol=2, col="deeppink", pch=SENSORS$pch[-2], pt.cex=c(rep(1.6,3),1.8)) # Distributions by month tmp <- aggr.1 hist(as.numeric(tmp$month), breaks=seq_len(13)-0.5, axes=F, main=NA, xlab=NA, ylab=NA) axis(side=1, at=c(1,4,7,10), labels=c("Jan","Apr","Jul","Oct")) axis(side=2) box() title(main="C. Month of sample", line=ttl.line, cex.main=ttl.cex) title(ylab="count", line=2) tmp <- transform(ddply(aq.sensor, .(date,pollutant), colwise(mean,"value")), month=format(date, "%m"), year=format(date, "%Y")) tmp <- subset(tmp, date >= "2010-01-01" & date < "2015-01-01") tmp.yr <- ddply(tmp, .(pollutant,month,year), colwise(mean,"value")) tmp.yr <- ddply(tmp.yr, .(pollutant,month), function(x) { z <- c(mean=mean(x$value), min=min(x$value), max=max(x$value)) z / chem.mean[x$pollutant[1],"mean"] }) tmp.yr <- merge(tmp.yr, POLLUTANTS) tmp <- ddply(tmp, .(pollutant,month), colwise(mean,"value")) tmp <- merge(tmp, chem.mean) tmp <- transform(tmp, value=(value / mean)) plot(as.numeric(tmp$month), tmp$value, type="n", axes=F, xlab=NA, ylab=NA) for (chem in levels(tmp$pollutant)) { chem.tmp <- subset(tmp, pollutant == chem) lines(as.numeric(chem.tmp$month), chem.tmp$value, col=POLLUTANTS[chem,"colLine"]) points(as.numeric(chem.tmp$month), chem.tmp$value, pch=19, col=POLLUTANTS[chem,"colLine"]) } axis(side=1, at=c(1,4,7,10), labels=c("Jan","Apr","Jul","Oct")) axis(side=2) box() arrows(as.numeric(tmp.yr$month), tmp.yr$min, as.numeric(tmp.yr$month), tmp.yr$max, length=0.04, angle=90, code=3, col=tmp.yr$colLine) title(main="D. Seasonal variation", line=ttl.line, cex.main=ttl.cex) title(ylab=expression(paste(monthly~average,"**")), line=2) legend("top", legend=aq.labels, ncol=2, col=POLLUTANTS$colLine, pch=19) par(opar) #dev.off() # SUPPLEMENTARY FIGURE E1 # NEED_RAW_AQ fn.prepanel <- function(x, y, ...) { tmp <- prepanel.default.bwplot(x, y, ...) tmp$ylim[1] <- 0 # panel.number not available in prepanel # Egregious hack instead if (tmp$ylim[2] < 0.1) { tmp$ylim[2] <- aq.rng["O3","value"] } else if (tmp$ylim[2] < 1) { tmp$ylim[2] <- aq.rng["CO","value"] } else if (tmp$ylim[2] < 18) { tmp$ylim[2] <- aq.rng["NO2","value"] } else { tmp$ylim[2] <- aq.rng["PM2.5","value"] } tmp } pal <- colorRampPalette(c("white", "wheat4")) colors <- pal(6) x11(height=4.8,width=7.5) print(barchart(value ~ sensor | pollutant, data=rbind(aq.tmp, data.frame(pollutant="PM2.5", sensor=c("0007","0242"), t.grp=NA, value=NA)), group=t.grp, auto.key=list(columns=5, size=4, between=1), horizontal=F, as.table=T, par.settings=list(superpose.polygon=list(col=colors[2:6]), layout.heights=list(strip=1.3)), scales=list(x=list(rot=90,relation='free',labels=rep("",4)), y=list(relation='free')), xlab="monitoring station", ylab="yearly average", strip=myStripStyle, prepanel=fn.prepanel)) # SUPPLEMENTARY FIGURE E3 x11(height=3,width=6.3) print(bwplot(value ~ window | pollutant, data=melt(aq.wdw, measure.vars=rownames(POLLUTANTS), variable.name="pollutant"), horizontal=F, scales=list(x=list(rot=90), y=list(relation='free')), strip=myStripStyle, xlab="exposure duration (days)", ylab="", layout=c(4,1))) # SUPPLEMENTARY FIGURE E7 panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...) { usr <- par("usr"); on.exit(par(usr)) par(usr = c(0, 1, 0, 1)) r <- cor(x, y) txt <- format(c(r, 0.123456789), digits = digits)[1] txt <- paste0(prefix, txt) if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt) text(0.5, 0.5, txt, cex = cex.cor * abs(r)) } x11(height=6,width=6) #pdf(file="figE7.pdf", height=6,width=6) pairs(merge(subset(aq.wdw, window=="90"), aggr.1[,1:2])[,rownames(POLLUTANTS)], labels=aq.units, upper.panel = panel.cor) #dev.off() # Check correlations of methylation tmp <- foxp3.adj[,foxp3Promoter] x11(height=6,width=6) pairs(tmp, labels=cpgPretty(foxp3Promoter), upper.panel = panel.cor) ################################################################################ ################################################################################ ### ### ### METHYLATION ### ### All analysis with methylation as response ### ### ### ### Uses one sample per subject until REPEAT MEASUREMENTS ### ### ### ################################################################################ ################################################################################ ### MELT METHYLATION ### Put methylation data in long format with one row for each CpG site from each ### visit. cols <- c("subject","id.visit","season","sex","age","BMI","family","asthma") for (gene in genes) { if (gene == "Foxp3") { sites <- foxp3All tmp <- aggr.foxp3 } else if (gene == "Il10") { sites <- il10All tmp <- aggr.il10 } tmp <- tmp[,c(cols,sites)] tmp <- melt(tmp, measure.vars=sites, variable.name="site", value.name="pctg") if (gene == "Foxp3") { foxp3.long <- tmp } else if (gene == "Il10") { il10.long <- tmp } } # FIGURE 3 # Plot of methylation versus age ... including Foxp3 outliers ccc <- 3 vars.id <- c("subject","id.visit","sex","age","asthma") otlr <- melt(subset(data.pub, isUsed, select=c(vars.id, foxp3All,il10All)), id.vars=vars.id) otlr <- ddply(otlr, .(variable,sex), function(x) { z <- boxplot.stats(x$value, coef=ccc) transform(x, isOutlier=(value < z$stats[1] | value > z$stats[5])) }) otlr <- transform(otlr, status=factor(paste(sex, c(yes="asthma", no="non")[as.character(asthma)]), levels=c("F asthma","F non", "M asthma","M non"))) h <- NULL for (gene in genes) { if (gene == "Foxp3") { methyl.long <- droplevels(subset(otlr, !isOutlier & grepl("^Foxp3", variable))) lyt <- c(5,2) ttl <- expression(paste("A. ", italic("Foxp3"))) #x11(height=5, width=8) otlrPanel <- function(x, y, ...) { panel.xyplot(x, y, ...) cpg <- foxp3All[panel.number()] tmp <- subset(otlr, variable == cpg & isOutlier) panel.xyplot(tmp$age, tmp$value, col=col.sa[as.numeric(tmp$status)], pch=c(19,1,15,0)[as.numeric(tmp$status)]) panel.xyplot(tmp$age, tmp$value, col="black", cex=1.3, pch=ifelse(tmp$sex=="F",1,0)) } } else if (gene == "Il10") { methyl.long <- droplevels(subset(otlr, grepl("^Il10", variable))) if (any(methyl.long$isOutlier, na.rm=T)) cat("HUGE ERROR\n") lyt <- c(3,2) ttl <- expression(paste("B. ", italic("IL10"))) #x11(height=5, width=7) otlrPanel <- function(x, y, ...) { panel.xyplot(x, y, ...) } } htmp <- xyplot(value ~ age | variable, methyl.long, as.table=T, type=c("p","r"), groups=factor(paste(sex, c(yes="asthma", no="non")[as.character(asthma)]), levels=c("F asthma","F non", "M asthma","M non")), auto.key=list(columns=4), par.settings=list(superpose.symbol=list(col=col.sa, pch=c(19,1,15,0)), superpose.line=list(col=col.sa)), layout=lyt, main=ttl, xlab="age (years)", ylab="percent methylation", strip=strip.custom(factor.levels=cpgPretty( levels(methyl.long$variable))), panel=otlrPanel) #print(htmp) h <- append(h, list(htmp)) } x11(height=11,width=8.5) #pdf(file="fig3.pdf", height=11,width=8.5) do.call(grid.arrange, append(h, list(ncol=1))) #dev.off() # SUPPLEMENTARY FIGURE E4 # Foxp3 and X inactivation table(aggr.foxp3$sex) ave.F <- ddply(subset(foxp3.long, sex=="F"), .(site), colwise(mean,"pctg")) ave.M <- ddply(subset(foxp3.long, sex=="M"), .(site), colwise(mean,"pctg")) ave.cpg <- merge(ave.F, ave.M, by="site", suffixes=c(".F",".M")) summary(xinac.fit <- lm(pctg.F ~ pctg.M, ave.cpg)) ave.cpg <- transform(ave.cpg, res=resid(xinac.fit)) x11(height=4,width=4) print(xyplot(pctg.F ~ pctg.M, ave.cpg, col="black", xlab="mean percent methylation for males", ylab="mean percent methylation for females") + layer(panel.abline(xinac.fit, col="black")) + layer(panel.text(ave.cpg[2,"pctg.M"], ave.cpg[2,"pctg.F"], cpgPretty(ave.cpg[2,"site"]), pos=4, cex=0.8))) ### ### MODEL METHYLATION AS FUNCTION OF SEX, AGE, ASTHMA ### ### TABLE E3 # Choose formula for (gene in genes) { cat(gene,"\n") if (gene == "Foxp3") { methyl.long <- foxp3.long } else if (gene == "Il10") { methyl.long <- il10.long } fit.gls <- NULL for (nm in 1:6) { cat("MODEL",nm,"\n") fmla <- (if (nm==1) "pctg ~ site - 1" else if (nm==2) "pctg ~ site + site:sex - 1" #else if (nm==2) "pctg ~ site + site:age - 1" else if (nm==3) "pctg ~ site + site:(sex+age) - 1" else if (nm==4) "pctg ~ site + site:(sex*age) - 1" else if (nm==5) "pctg ~ site + site:(sex*age + BMI) - 1" else if (nm==6) "pctg ~ site + site:(sex*(age + BMI)) - 1") fmla <- formula(fmla) fit.gls[[nm]] <- gls(fmla, data=methyl.long, method="ML", weights=varIdent(form=(~ 1 | site*sex))) } print(anova(fit.gls[[1]], fit.gls[[2]], fit.gls[[3]], fit.gls[[4]], fit.gls[[5]], fit.gls[[6]])) print(anova(fit.gls[[4]], fit.gls[[6]])) #print(anova(fit.gls[[1]], fit.gls[[2]])) } # Check error variance model for selected formula for (gene in genes) { cat(gene,"\n") # Run this block twice to establish that variance depends upon BOTH sex and # site for Foxp3 and NEITHER for Il10. for (nnn in 1:2) { if (gene == "Foxp3") { methyl.long <- foxp3.long #fmla <- formula("pctg ~ site + site:(sex*age + BMI) - 1") #fmla <- formula("pctg ~ site + site:(sex*(age + BMI)) - 1") } else if (gene == "Il10") { methyl.long <- il10.long #fmla <- formula("pctg ~ site + site:(sex*age) - 1") } fmla <- formula("pctg ~ site + site:(sex*age + BMI) - 1") f1 <- gls(fmla, data=methyl.long, method="ML") if (nnn == 1) { f2 <- gls(fmla, data=methyl.long, weights=varIdent(form=(~ 1 | sex)), method="ML") cat("Constant variance vs sex-dependent vs depends on both sex & site\n") } else { f2 <- gls(fmla, data=methyl.long, weights=varIdent(form=(~ 1 | site)), method="ML") cat("Constant variance vs site-dependent vs depends on both sex & site\n") } f3 <- gls(fmla, data=methyl.long, weights=varIdent(form=(~ 1 | site*sex)), method="ML") print(anova(f1, f2, f3)) } cat("\n") } ### ### COMPUTE RESIDUALS ### ### FIRST TIME ### ONLY RUN THIS BLOCK WITHOUT OUTLIERS # Foxp3 foxp3.sav <- foxp3.long foxp3.fit <- gls(pctg ~ site + site:(sex*age + BMI) - 1, foxp3.long, weights=varIdent(form=(~ 1 | site*sex)), method="ML") foxp3.adj <- transform(foxp3.long, res=resid(foxp3.fit, type="normal")) foxp3.adj <- foxp3.adj[,setdiff(names(foxp3.adj), "pctg")] foxp3.adj.long <- foxp3.adj foxp3.adj <- dcast(foxp3.adj, ... ~ site, value.var="res") foxp3.adj <- cbind(foxp3.adj, promoter=rowMeans(foxp3.adj[,foxp3Promoter]), all=rowMeans(foxp3.adj[,c(foxp3Upstream,foxp3Promoter)])) # IL10 il10.sav <- il10.long il10.fit <- gls(pctg ~ site + site:(sex*age + BMI) - 1, il10.long, weights=varIdent(form=(~ 1 | site*sex)), method="ML") il10.adj <- transform(il10.long, res=resid(il10.fit, type="normal")) #il10.fit <- lm(pctg ~ site + site:(sex*age) - 1, il10.long) #il10.sd <- sqrt(deviance(il10.fit)/df.residual(il10.fit)) #il10.adj <- transform(il10.long, res=resid(il10.fit)/il10.sd) il10.adj <- il10.adj[,setdiff(names(il10.adj), "pctg")] il10.adj.long <- il10.adj il10.adj <- dcast(il10.adj, ... ~ site, value.var="res") il10.adj <- cbind(il10.adj, region3=rowMeans(il10.adj[,il10In3]), all=rowMeans(il10.adj[,il10All])) ### ANY RECOMPUTATION OF RESIDUALS WITH OR WITHOUT OUTLIERS ### THIS DOES NOT CHANGE FIT!! # Foxp3 sd.est <- cbind(foxp3.sav[,c("sex","site")], std=attr(foxp3.fit$residuals, "std")) sd.est <- unique(sd.est) print(dcast(sd.est, ... ~ sex, value.var="std"), digits=3) tmp <- transform(foxp3.long, res=(pctg - predict(foxp3.fit, foxp3.long))) tmp <- merge(tmp, sd.est) tmp <- transform(tmp, res=res/std) tmp[,"pctg"] <- NULL tmp[,"std"] <- NULL tmp <- dcast(tmp, ... ~ site, value.var="res") tmp <- cbind(tmp[, c(setdiff(names(foxp3.adj), c(foxp3All,"promoter","all")), foxp3All)], promoter=rowMeans(tmp[,foxp3Promoter]), all=rowMeans(tmp[,foxp3All])) foxp3.adj <- tmp # IL10 sd.est <- cbind(il10.sav[,c("sex","site")], std=attr(il10.fit$residuals, "std")) sd.est <- unique(sd.est) print(dcast(sd.est, ... ~ sex, value.var="std"), digits=3) tmp <- transform(il10.long, res=(pctg - predict(il10.fit, il10.long))) tmp <- merge(tmp, sd.est) tmp <- transform(tmp, res=res/std) tmp[,"pctg"] <- NULL tmp[,"std"] <- NULL tmp <- dcast(tmp, ... ~ site, value.var="res") tmp <- cbind(tmp[, c(setdiff(names(il10.adj), c(il10All,"region3","all")), il10All)], region3=rowMeans(tmp[,il10In3]), all=rowMeans(tmp[,il10All])) il10.adj <- tmp # Coefficients from fits print(summary(foxp3.fit)$tTable) print(summary(il10.fit)$tTable) ### Check normality of residuals h <- NULL for (gene in genes) { if (gene == "Foxp3") { #methyl.long <- droplevels(subset(foxp3.adj.long, site %in% foxp3Promoter)) #lyt <- c(3,2) methyl.long <- foxp3.adj.long lyt <- c(5,2) ttl <- "A. Foxp3" x11(height=5, width=8) } else if (gene == "Il10") { methyl.long <- il10.adj.long lyt <- c(3,2) #methyl.long <- droplevels(subset(il10.adj.long, site %in% il10In3)) #lyt <- c(3,1) ttl <- "B. IL10" x11(height=5, width=7) } htmp <- qqmath(~ res | site, methyl.long, as.table=T, panel=function(x, ...) { panel.qqmath(x, ...) panel.abline(a=0,b=1) }, #htmp <- ecdfplot(~ res | site, methyl.long, as.table=T, groups=sex, auto.key=list(columns=2), layout=lyt, main=ttl, xlab="Quantiles of standard normal", ylab="Standardized residuals", strip=strip.custom(factor.levels=cpgPretty( levels(methyl.long$site)))) print(htmp) #h <- append(h, list(htmp)) } #x11(height=8,width=8.5) #do.call(grid.arrange, append(h, list(ncol=1))) ### ### ASSOCIATION BETWEEN METHYLATION AND ASTHMA ### # SUPPLEMENTARY TABLE E4 # Definition of computePVals() at beginning of block determines whether random # family effects are included. Switching between data sets with and without # outliers requires rerunning not only READ AND MASSAGE PUBLIC DATA FILES but # also MELT METHYLATION and then ANY RECOMPUTATION OF RESIDUALS WITH OR WITHOUT # OUTLIERS. pvals <- NULL for (ef in c("fixed","mixed")) { if (ef == "fixed") { computePVals <- function(formula, data) { lm.fit <- lm(formula, data) cx <- coef(summary(lm.fit))[-1,,drop=F] tx <- rownames(cx) z <- data.frame(variable=tx, p=cx[,4], beta=cx[,1]) z } } else { computePVals <- function(formula, data) { gls.fit <- gls(formula, data, correlation=corCompSymm(form=(~ 1 | family)), method="ML") cx <- summary(gls.fit)$tTable[-1,,drop=F] tx <- rownames(cx) z <- data.frame(variable=tx, p=cx[,4], beta=cx[,1]) z } } for (gene in genes) { if (gene == "Foxp3") { RESPONSES <- c(foxp3All, "promoter", "all") methyl.adj <- foxp3.adj[,c("subject","id.visit","asthma","family", RESPONSES)] } else if (gene == "Il10") { RESPONSES <- c(il10All, "region3", "all") methyl.adj <- il10.adj[,c("subject","id.visit","asthma","family", RESPONSES)] } for (response in RESPONSES) { pvals <- rbind(pvals, cbind(gene=gene, effect=ef, response=response, computePVals(formula(sprintf("%s ~ asthma", response)), methyl.adj))) } } } pvals <- transform(pvals, response=factor(response, levels=c(foxp3All,"promoter", il10All,"region3","all"))) pvals.asthma <- pvals print(pvals.asthma, digits=4) # FIGURE 4 brng <- range(c(foxp3.asthma$beta, il10.asthma$beta)) prng <- range(c(-log10(foxp3.asthma$p), -log10(il10.asthma$p))) fn.prepanel <- function(x, y, ...) { tmp <- prepanel.default.xyplot(x, y, ...) tmp$ylim <- if (max(y) < 1) brng else prng tmp } h <- NULL for (nn in 1:2) { ggg <- genes[nn] pvals <- droplevels(subset(pvals.asthma, gene == ggg & effect == "fixed")) htmp <- (xyplot(-log10(p) + beta ~ response | ggg, data=data.frame(pvals, row.names=rownames(pvals)), outer=T, as.table=T, xlab="", ylab="", layout=c(1,2), scales=list(x=list(rot=90, labels=cpgPretty(levels(pvals$response))), y=list(relation="free")), prepanel=fn.prepanel, panel=function(x,y,...) { panel.xyplot(x,y,...) if (max(y) < 1) { panel.abline(h=0, lty=2, col="gray") } else { panel.abline(h=-log10(0.05), lty=2, col="gray") } })) ttl.strip <- (if (ggg == "Foxp3") expression(paste("A. ", italic("Foxp3"))) else expression(paste("B. ", italic("IL10")))) htmp <- useOuterStrips(htmp, strip=strip.custom(bg="transparent", factor.levels=ttl.strip), strip.left=strip.custom(factor.levels=c("-log10(p)", "effect size"), bg="transparent")) h[[ggg]] <- htmp } x11(height=3.7,width=6.3) #pdf(file="fig4.pdf", height=3.7,width=6.3) do.call(grid.arrange, append(h, list(ncol=2))) #dev.off() # Is family effect significant? pvals <- NULL for (gene in genes) { if (gene == "Foxp3") { RESPONSES <- c(foxp3All, "promoter", "all") methyl.adj <- foxp3.adj[,c("subject","id.visit","asthma","family", RESPONSES)] } else if (gene == "Il10") { RESPONSES <- c(il10All, "region3", "all") methyl.adj <- il10.adj[,c("subject","id.visit","asthma","family", RESPONSES)] } for (response in RESPONSES) { fmla <- formula(sprintf("%s ~ asthma", response)) fit.fix <- gls(fmla, methyl.adj, method="ML") fit.fam <- gls(fmla, methyl.adj, method="ML", correlation=corCompSymm(form=(~ 1 | family))) pvals <- rbind(pvals, data.frame(gene=gene, response=response, p.family=anova(fit.fix, fit.fam)[2,9])) } } pvals <- transform(pvals, isSig=(p.family < 0.05)) ### ### ASSOCIATION BETWEEN METHYLATION AND POLLUTION ### # Regression of adjusted methylation on ... # Model A: asthma + pollutant # B: asthma + pollutant; random family effect # C: asthma + pollutant + season # D: asthma + pollutant + season; random family effect mdls <- c("Model A","Model B","Selected","Model C") N.vals <- NULL for (gene in genes) { if (gene == "Foxp3") { methyl.huge <- foxp3.adj rsvp <- "promoter" } else if (gene == "Il10") { methyl.huge <- il10.adj rsvp <- "region3" } aq.pvals <- NULL for (wdw in setdiff(levels(aq.wdw$window), "365")) { methyl.wdw <- merge(methyl.huge, subset(aq.wdw, window == wdw)) for (chem in rownames(POLLUTANTS)) { tmp <- methyl.wdw[,c(chem,rsvp,"asthma","season","family")] names(tmp)[1:2] <- c("plnt","response") tmp <- transform(tmp, plnt=plnt/aq.rng[chem,"value"]) N.vals <- rbind(N.vals, data.frame(gene=gene, window=wdw, pollutant=chem, nrow=nrow(tmp), cc=sum(complete.cases(tmp)))) aq.fit <- NULL aq.fit[[1]] <- gls(response ~ asthma + plnt, tmp, method="ML") aq.fit[[2]] <- gls(response ~ asthma + plnt, tmp, method="ML", correlation=corCompSymm(form=(~ 1 | family))) aq.fit[[3]] <- gls(response ~ asthma + plnt + season, tmp, method="ML") aq.fit[[4]] <- gls(response ~ asthma + plnt + season, tmp, method="ML", correlation=corCompSymm(form=(~ 1 | family))) for (nm in seq_along(aq.fit)) { # p-values for variables in model cx <- summary(aq.fit[[nm]])$tTable[-1,,drop=F] tx <- rownames(cx) aq.pvals <- rbind(aq.pvals, data.frame(model=nm, pollutant=chem, window=wdw, variable=tx, p=cx[,4], beta=cx[,1])) # nm=1: 1 vs 2 # nm=2: 2 vs 4 # nm=3: 1 vs 3 # nm=4: 3 vs 4 nm1 <- c(1,2,1,3)[nm]; nm2 <- c(2,4,3,4)[nm] aq.anova <- anova(aq.fit[[nm1]], aq.fit[[nm2]]) aq.pvals <- rbind(aq.pvals, data.frame(model=c(2,4,3,4)[nm], pollutant=chem, window=wdw, variable=c("family","season", "season","family")[nm], p=aq.anova[2,9], beta=NA)) } } } aq.pvals <- transform(aq.pvals, model=factor(mdls[model], levels=mdls[c(3,1,2,4)])) if (gene == "Foxp3") { foxp3.promoter <- aq.pvals } else if (gene == "Il10") { il10.region3 <- aq.pvals } } print(transform(subset(aq.pvals, variable == "family"), isSig=(p<0.05)), digits=2) # FIGURE 5 # SUPPLEMENTARY FIGURES E8 AND E9 # SUPPLEMENTARY FIGURE E10 ... Switching between data sets with and without # outliers requires rerunning not only READ AND MASSAGE PUBLIC DATA FILES but # also MELT METHYLATION and then ANY RECOMPUTATION OF RESIDUALS WITH OR WITHOUT # OUTLIERS. aq.join <- rbind(cbind(gene="Foxp3", foxp3.promoter), cbind(gene="Il10", il10.region3)) aq.join <- subset(aq.join, variable %in% c("asthmayes","plnt","season","family")) aq.join <- transform(aq.join, variable=factor(c(asthmayes="asthma", plnt="pollutant", season="season", family="family")[as.character(variable)], levels=c("pollutant","asthma", "season","family"))) p.base <- c(subset(foxp3.asthma, response=="promoter")$p, subset(il10.asthma, response=="region3")$p) for (pubMode in c("main","supplement")) { nplt <- if (pubMode == "main") 1 else 2 for (nn in seq_len(nplt)) { if (pubMode == "main") { tmp <- subset(aq.join, model == "Selected" & variable == "pollutant") fmla <- formula("beta + -log10(p) ~ window | gene") y.scales <- list(relation="free") brng <- range(tmp$beta) prng <- range(-log10(tmp$p)) fn.prepanel <- function(x, y, ...) { tmp <- prepanel.default.xyplot(x, y, ...) tmp$ylim <- if (min(y) < 0) brng else prng tmp } x11(height=4,width=5) #pdf(file="fig5.pdf", height=4,width=5) #pdf(file="figE10.pdf", height=4,width=5) } else if (pubMode == "supplement") { tmp <- subset(aq.join, gene == genes[nn]) fmla <- formula("-log10(p) ~ window | model * variable") y.scales <- list(alternating=3) fn.prepanel <- prepanel.default.xyplot x11(height=6.3, width=6.3) #pdf(file=sprintf("figE%d.pdf", nn+7), height=6.3, width=6.3) } clrs <- c(POLLUTANTS[levels(tmp$pollutant), "colLine"]) clrs[5] <- "black" h <- (xyplot(fmla, tmp, type="b", outer=T, groups=pollutant, auto.key=list(columns=length(aq.labels), text=aq.labels), par.settings=list(superpose.symbol=list(pch=19, col=clrs), superpose.line=list(col=clrs)), xlab="exposure duration (days)", scales=list(x=list(alternating=1), y=y.scales), prepanel=fn.prepanel, panel=function(x,y,...) { panel.xyplot(x,y,...) if (pubMode == "main") { if (min(y) < 0) { panel.abline(h=0, lty=2, col="gray") } else { panel.abline(h=-log10(0.05), lty=2, col="gray") } } else { panel.abline(h=-log10(0.05), lty=2, col="gray") if (panel.number() > length(levels(tmp$model)) & panel.number() <= 2*length(levels(tmp$model))) { panel.abline(h=-log10(p.base[nn]), lty=2, col="magenta") } } })) if (pubMode == "main") { h$ylab <- "" strip.left <- strip.custom(factor.levels=c("effect size", "-log10(p)"), bg="transparent") strips <- c(expression(paste("A. ", italic("Foxp3"))), expression(paste("B. ", italic("IL10")))) } else { strip.left <- strip.custom(bg="transparent") strips <- levels(tmp$model) } h <- useOuterStrips(h, strip.left=strip.left, strip=strip.custom(strip.levels=c(T,T), strip.names=c(F,F), factor.levels=strips, fg="transparent", bg="transparent")) print(h) #dev.off() } } # Interaction between asthma and pollutant? methyl.cross <- NULL wdw <- "90" for (gene in genes) { if (gene == "Foxp3") { methyl.wdw <- foxp3.adj rsvp <- "promoter" } else if (gene == "Il10") { methyl.wdw <- il10.adj rsvp <- "region3" } methyl.wdw <- merge(methyl.wdw, subset(aq.wdw, window == wdw)) methyl.wdw <- methyl.wdw[,c(rsvp,"asthma","season",rownames(POLLUTANTS))] for (chem in rownames(POLLUTANTS)) { tmp <- methyl.wdw[,c(chem,rsvp,"asthma","season")] names(tmp)[1:2] <- c("plnt","response") tmp <- transform(tmp, plnt=plnt/aq.rng[chem,"value"]) aq.fit <- lm(response ~ asthma * plnt + season, tmp) cx <- coef(summary(aq.fit))[-1,,drop=F] tx <- rownames(cx) methyl.cross <- rbind(methyl.cross, data.frame(gene=gene, pollutant=chem, variable=tx, p=cx[,4], beta=cx[,1])) } } print(subset(methyl.cross, variable == "asthmayes:plnt")) ### TABLE 2 tmp <- subset(foxp3.promoter, #tmp <- subset(il10.region3, model == "Selected" & window == wdw & variable %in% c("asthmayes","plnt","season"), select=c("pollutant","variable","p","beta")) tmp <- tmp[ order(tmp$variable), ] print(tmp) # Regression coefficients of seasons gene <- "Foxp3" wdw <- "90" rsvp <- "promoter" methyl.wdw <- merge(foxp3.adj, subset(aq.wdw, window == wdw)) tmp.coef <- NULL for (chem in rownames(POLLUTANTS)) { tmp <- methyl.wdw[,c(chem,rsvp,"asthma","season","family")] names(tmp)[1:2] <- c("plnt","response") tmp <- transform(tmp, plnt=plnt/aq.rng[chem,"value"]) tmp.fit <- gls(response ~ season + asthma + plnt - 1, tmp, method="ML") cx <- summary(tmp.fit)$tTable tx <- rownames(cx) tmp.coef <- rbind(tmp.coef, data.frame(pollutant=chem, variable=tx, p=cx[,4], beta=cx[,1])) } tmp.coef <- transform(tmp.coef, variable=factor(variable, levels=c("asthmayes", "plnt", "seasonspring", "seasonsummer", "seasonautumn", "seasonwinter"))) tmp.coef <- tmp.coef[ with(tmp.coef, order(pollutant,variable)), ] ### PCA tmp <- merge(subset(aq.wdw, window=="90"), aggr.1[,1:2]) rownames(tmp) <- tmp$subject tmp <- as.matrix(tmp[,rownames(POLLUTANTS)]) res.pca <- prcomp(tmp, scale=TRUE) x11(height=3,width=4) plot(res.pca, main="") cat(sprintf("First PC contains %.1f%% of variance\n", 100 * res.pca$sdev[1]^2 / sum(res.pca$sdev^2))) # How is PC1 distributed over pollutants? res.pca$rotation[,1] foo <- abs(res.pca$rotation[,1]) (max(foo) - min(foo)) / min(foo) tmp <- cbind(subject=rownames(tmp), as.data.frame(tmp), PC1=res.pca$x[,1]) tmp <- melt(tmp, id.vars="subject") tmp <- transform(tmp, scale=rbind(aq.rng, PC1=1)[variable,"value"]) tmp <- transform(tmp, value=value/scale) x11(height=3,width=4) print(bwplot(value ~ variable, tmp, horizontal=F, scales=list(x=list(rot=90), y=list(relation='free')), #strip=myStripStyle, xlab="", ylab="")) gene <- "Foxp3" wdw <- "90" methyl.huge <- foxp3.adj rsvp <- "promoter" methyl.wdw <- merge(foxp3.adj, subset(tmp, variable == "PC1")) tmp.fit <- gls(promoter ~ season + asthma + value - 1, methyl.wdw, method="ML") alt.fit <- gls(promoter ~ asthma + value - 1, methyl.wdw, method="ML") anova(tmp.fit, alt.fit) summary(lm(value ~ asthma, methyl.wdw)) ### ### REPEAT MEASUREMENTS ### aggr.rep <- NULL for (gene in genes) { tmp <- subset(aggr, foxp3.good) if (gene == "Foxp3") { sites <- foxp3All } else if (gene == "Il10") { sites <- il10All tmp <- subset(tmp, allIl10) } tmp <- ddply(tmp, .(subject), function(x) { if (nrow(x) == 1) return(NULL) z <- x[ order(x$id.visit), ] # 2 very special cases if (x$subject[1] == 2665) { # aggr.1 has 1st visit but 2nd is less than 5 months later z <- z[c(1,3),] } else if (x$subject[1] == 2865 & gene == "Foxp3") { # aggr.1 has second visit z <- z[2:3,] } z <- cbind(z, visit=paste("visit", seq_len(nrow(z)), sep="")) }) aggr.rep <- rbind(aggr.rep, cbind(gene=gene, tmp)) } print(xtabs(~ gene + freq, count(aggr.rep, vars=c("gene","subject")))) # Time between two visits # WARNING: This block of code requires the dates of visits, which is not # publicly available. dvis <- ddply(aggr.rep, .(gene,subject), function(x) { y <- x[ order(x$date.visit), ] deltat <- y$date.visit deltat <- deltat[-1] - deltat[1] data.frame(visit=y$visit[-1], diff=deltat) }) dvis <- unique(dvis[,-1]) print(summary(as.numeric(dvis$diff))) cat("standard deviation", sd(dvis$diff), "\n") ### STEP 1: Adjust for sex, age, BMI ### MUST USE ALL CpG SITES, AT LEAST FOR predict.gls cols <- c("subject","id.visit","visit","season","sex","age","BMI","asthma") res.rep <- NULL for (ggg in genes) { if (ggg == "Foxp3") { sites <- foxp3All sites.loc <- foxp3Promoter fit.orig <- foxp3.fit sd.est <- cbind(foxp3.long[,c("sex","site")], std=attr(foxp3.fit$residuals, "std")) } else if (ggg == "Il10") { sites <- il10All sites.loc <- il10In3 fit.orig <- il10.fit sd.est <- cbind(il10.long[,c("sex","site")], std=attr(il10.fit$residuals, "std")) } sd.est <- unique(sd.est) tmp <- subset(aggr.rep, gene == ggg, select=c(cols,sites)) tmp <- melt(tmp, measure.vars=sites, variable.name="site", value.name="pctg") tmp <- transform(tmp, r=(pctg - predict(fit.orig, tmp))) tmp <- merge(tmp, sd.est) tmp <- transform(tmp, r=r/std) tmp <- dcast(tmp[,c(cols,"site","r")], ... ~ site, value.var="r") tmp <- transform(tmp, r=rowMeans(tmp[,sites.loc])) res.rep <- rbind(res.rep, cbind(gene=ggg, tmp[,c(cols,"r")])) } ### STEP 2: Compute predicted change based on season and pollution level wdw <- "90" res.rep <- split(res.rep, res.rep$gene) rep.out <- NULL for (nnn in seq_along(res.rep)) { ggg <- names(res.rep)[nnn] if (ggg == "Foxp3") { fit.wdw <- foxp3.adj rsvp <- "promoter" } else if (ggg == "Il10") { fit.wdw <- il10.adj rsvp <- "region3" } fit.wdw <- merge(fit.wdw, subset(aq.wdw, window == wdw)) rep.wdw <- res.rep[[nnn]] rep.wdw <- merge(rep.wdw, subset(aq.wdw, window == wdw)) for (chem in rownames(POLLUTANTS)) { # Recreate original fit; no need to scale pollutants this time tmp <- fit.wdw[,c(rsvp,chem,"asthma","season")] names(tmp)[1] <- "r" fmla <- sprintf("r ~ asthma + %s + season", chem) aq.fit <- gls(formula(fmla), tmp, method="ML") # Compute predicted change in r tmp <- ddply(rep.wdw, .(subject), function(x) { r.hat <- predict(aq.fit, x[,c("r","asthma",chem,"season")]) delta.actual <- c(NA, x$r[-1] - x$r[1]) delta.pred <- c(NA, r.hat[-1] - r.hat[1]) r.hat <- x$r[1] + delta.pred cbind(x[,c(cols,"r")], delta.actual, delta.pred, r.hat, r0=x$r[1]) }) rep.out <- rbind(rep.out, cbind(gene=ggg, chem=chem, tmp)) } } rep.out <- transform(rep.out, r0=ifelse(visit=="visit1", NA, r0)) res.rep <- rbind(res.rep[[1]], res.rep[[2]]) # How often is the DIRECTION of change predicted correctly? foo <- subset(rep.out, visit == "visit2") sum(foo$delta.actual * foo$delta.pred == 0) mean(foo$delta.actual * foo$delta.pred > 0) ddply(foo, .(gene), function(x) { mean(x$delta.actual * x$delta.pred > 0) }) ddply(foo, .(gene,chem), function(x) { mean(x$delta.actual * x$delta.pred > 0) }) # Check reduction in RMS error tmp <- rep.out # Uncomment following line to discard third visits. tmp <- subset(rep.out, visit == "visit2") rep.err <- ddply(tmp, .(gene,chem), function(x) { c(err.base=sqrt(mean(x$delta.actual^2, na.rm=T)), err.pred=sqrt(mean((x$r - x$r.hat)^2, na.rm=T))) }) rep.err <- transform(rep.err, rel.improve=(err.pred-err.base)/err.base) print(rep.err, digits=4) # SUPPLEMENTARY FIGURE E5 h <- NULL for (ggg in genes) { tmp <- subset(rep.out, gene == ggg & visit != "visit1") tmp <- melt(tmp[,c("subject","chem","visit","r0","r","r.hat")], measure.vars=c("r","r.hat")) ttl <- (if (ggg == "Foxp3") expression(paste("A. ", italic("Foxp3"))) else expression(paste("B. ", italic("IL10")))) htmp <- xyplot(value ~ r0 | chem, tmp, groups=variable, auto.key=list(columns=2, text=c("actual","predicted")), xlab="first visit", ylab="later visit", main=ttl, layout=c(4,1), scales=list(x=list(alternating=1)), par.settings=list(superpose.symbol=list(pch=c(1,2), col=c("black", "pink3"))), strip=myStripStyle, panel=function(x, y, groups, subscripts, ...) { panel.xyplot(x, y, groups=groups, subscripts=subscripts, ...) gg <- groups[subscripts] xx <- x[gg == "r"] y1 <- y[gg == "r"] y2 <- y[gg == "r.hat"] panel.segments(xx, y1, xx, y2, ...) panel.abline(a=0,b=1, lty=2, col="gray") }) h <- append(h, list(htmp)) } x11(height=7,width=8.5) #pdf(file="figE5.pdf", height=7,width=8.5) do.call(grid.arrange, append(h, list(ncol=1))) #dev.off() ### ### SMOKING DATA ### df.plot <- NULL for (gene in genes) { if (gene == "Foxp3") { tmp <- foxp3.adj[,c("subject","id.visit","promoter")] } else if (gene == "Il10") { tmp <- il10.adj[,c("subject","id.visit","region3")] } tmp <- cbind(gene=gene, tmp) names(tmp)[4] <- "y" df.plot <- rbind(df.plot, tmp) } df.plot <- merge(df.plot, data.pub[,c("subject","id.visit","asthma","shs","smokes")]) df.plot <- transform(df.plot, x=(ifelse(shs == "unknown", 3, ifelse(smokes == "yes", 2, ifelse(shs == "yes", 2, 1)))), grp=ifelse(asthma == "yes", 2, 1)) df.plot <- transform(df.plot, x=x + 0.2 * ifelse(asthma == "yes", 1, -1)) df.plot[which(df.plot$smokes == "yes"), "grp"] <- 3 mdns <- ddply(df.plot, .(gene,x), function(z) { if (nrow(z) < 2) return(NULL) tmp <- quantile(z$y, probs=0.25*(1:3)) if (nrow(z) < 5) tmp[c(1,3)] <- NA data.frame(q1=tmp[1], median=tmp[2], q3=tmp[3]) }) x11(height=4,width=7) print(xyplot(y ~ x | gene, df.plot, groups=grp, auto.key=list(column=3, text=c("healthy control","asthmatic","smoker")), jitter.x=T, grid=list(h=-1,v=0), xlab="smoke exposure", ylab="average normalized methylation", scales=list(x=list(alternating=1, at=1:3, labels=c("no","yes","unknown"))), par.settings=list(superpose.symbol=list(pch=19, col=c("lightblue", "burlywood", "black"))), strip=strip.custom(factor.levels=c(Foxp3="A. Foxp3", Il10="B. IL10")[levels(df.plot$gene)]), panel=function(x,y,...) { panel.xyplot(x,y,...) tmp <- subset(mdns, gene == genes[panel.number()]) panel.segments(x1=tmp$x-0.07, y1=tmp$median, x2=tmp$x+0.07, y2=tmp$median, col="mediumorchid", lwd=2) panel.arrows(x1=tmp$x, y1=tmp$q1, x2=tmp$x, y2=tmp$q3, length=0.04, angle=90, code=3, col="mediumorchid") #panel.xyplot(tmp$x, tmp$median, col="red") })) ################################################################################ ################################################################################ ### ### ### LOCATIONS ### ### All the code that requires the subjects' locations, which is not ### ### publicly available. The code in this section also requires the ### ### version of aggr.1 containing dates of visits instead of visit IDs. ### ### ### ################################################################################ ################################################################################ # This block is all that is necessary to reproduce FIGURE 2 PANEL A. loc <- read.csv(file="locations.csv", colClasses=c("character","NULL","myDate","numeric","numeric")) names(loc) <- c("subject","date.visit","x","y") loc <- transform(loc, subject=as.numeric(sub("-?[CFV].*", "", subject))) loc <- merge(loc, aggr.1[,1:2]) #loc <- merge(loc, data.cmb[,1:2]) loc <- transform(loc, x=x-COORD.ORIGIN["x"], y=y-COORD.ORIGIN["y"]) Xpairs <- expand.grid(loc=loc$x, sensor=SENSORS$x) Ypairs <- expand.grid(loc=loc$y, sensor=SENSORS$y) dist <- sqrt((Xpairs[,1]-Xpairs[,2])^2 + (Ypairs[,1]-Ypairs[,2])^2) dist <- matrix(dist, ncol=nrow(SENSORS)) colnames(dist) <- rownames(SENSORS) mindist <- aaply(dist, 1, min) loc <- cbind(loc, dist, mindist) ### Compute IDW ### NEED_RAW_AQ # Takes a bit less than 2 minutes on iMac with 3.4 GHz processor # Smooth air quality data aq.smth <- ddply(aq.sensor, .(sensor), function(x) { s <- x$sensor[1] z <- dcast(x[,c("date","pollutant","value")], ... ~ pollutant) z <- zoo(z[,-1], order.by=z[,1]) z <- merge(z, zoo(, seq(start(z), end(z), "day"))) z <- rollapply(z, 7, mean, na.rm=TRUE, fill=NA) z <- data.frame(date=time(z), z, check.names=FALSE, row.names=NULL) z <- melt(z, id.vars="date", variable.name="pollutant") }) aq.smth <- aq.smth[ complete.cases(aq.smth), ] aq.smth <- merge(SENSORS, aq.smth) # Identify the dates that I need. I need to go back 365 dates for one plot. date.loc <- ddply(subset(data.pub, loc.good)[,1:2], .(subject,date.visit), function(x) { cbind(x, aq.date=(x$date.visit - seq_len(365))) }) date.loc <- merge(date.loc, loc[,c("subject","date.visit","x","y")]) ds <- unique(date.loc$aq.date) t0 <- Sys.time() pb <- txtProgressBar(min=0, max=length(ds), style = 3) aq.idw <- NULL # Apparently, one cannot use a date as a loop index. for (nn in seq_along(ds)) { g <- NULL for (chem in rownames(POLLUTANTS)) { obs <- subset(aq.smth, date == ds[nn] & pollutant == chem, select=c("sensor","x","y","value")) g <- gstat(g=g, id=chem, formula=value~1, locations=~x+y, data=obs) } nd <- subset(date.loc, aq.date == ds[nn]) tmp <- predict(g, nd, debug.level=0) aq.idw <- rbind(aq.idw, cbind(nd[,1:3], tmp[,paste(rownames(POLLUTANTS), "pred", sep=".")])) setTxtProgressBar(pb, nn) } close(pb) names(aq.idw) <- sub(".pred", "", names(aq.idw)) print(Sys.time() - t0) # Now compute averages over windows. ### NEED_RAW_AQ indirectly ... Uses aq.idw created in preceding block wdws <- c(1,15,30,90,180,365) aq.wdw <- ddply(aq.idw, .(subject,date.visit), function(x) { dv <- x$date.visit[1] z <- NULL for (win in wdws) { tmp <- subset(x, aq.date >= dv - win, select=rownames(POLLUTANTS)) tmp <- as.matrix(tmp) z <- rbind(z, c(window=win, colMeans(tmp))) } z }) aq.wdw <- transform(aq.wdw, window=factor(window, levels=wdws)) # Code to replace date of visit with visit ID at end of file # SUPPLEMENTARY FIGURE E2 # Example plots of IDW function theme.reducepad <- list(layout.heights = list(top.padding = 3, main.key.padding = 0, key.axis.padding = 0, axis.xlab.padding = 0, xlab.key.padding = 0, key.sub.padding = 0, bottom.padding = 0.5), layout.widths = list(#left.padding = 0, #key.ylab.padding = 0, ylab.right = 2, ylab.axis.padding = 0, axis.key.padding = 0, right.padding = 0)) NX <- 100; NY <- 100 loc.ex <- merge(loc, aggr.1[,1:2]) Xpts <- seq(from=0, to=max(loc.ex$x), length.out=NX) Ypts <- seq(from=0, to=max(loc.ex$y), length.out=NY) grd <- expand.grid(x=Xpts, y=Ypts) d <- as.Date("2014-01-01") g <- NULL h <- list() for (nn in seq_len(nrow(POLLUTANTS))) { chem <- rownames(POLLUTANTS)[nn] ttl <- aq.labels[nn] obs <- subset(aq.smth, date == d & pollutant == chem, select=c("sensor","x","y","value")) tmp <- idw(value ~ 1, locations=~x+y, data=obs, newdata=grd) tmp <- transform(tmp, x=x/1000, y=y/1000) h <- append(h, list(levelplot(var1.pred ~ x * y, tmp, aspect="iso", col.regions=bpy.colors(), par.settings=theme.reducepad, xlab="east/west (km)", ylab="north/south (km)", ylab.right=aq.units[nn], main=list(ttl, lineheight=0.5)) + layer(panel.xyplot(xobs, yobs, pch=21, col="turquoise", fill="transparent"), data=list(xobs=obs$x/1000, yobs=obs$y/1000)) + layer(panel.xyplot(loc.ex$x/1000, loc.ex$y/1000, pch=20, cex=0.4, col="turquoise")))) } x11(height=7,width=8) do.call(grid.arrange, append(h, list(ncol=2))) ################################################################################ ################################################################################ ### ### ### ARCHIVAL CODE ### ### ### ################################################################################ ################################################################################ # This code documents the process to create PublicData.csv from the original # Excel file provided to the analysts. dir <- FILL IN HERE MIN_DIST_THRESHOLD <- 10000 setClass('myAltDate') setAs('character','myAltDate', function(from) as.Date(from, format='%m/%d/%y')) season <- function(m) { s <- cut(as.numeric(m), breaks=c(0,3,6,9,12,13), labels=F, right=F) s <- c("winter","spring","summer","autumn","winter")[s] s <- factor(s, levels=c("spring","summer","autumn","winter")) s } ### Data from master spreadsheet tblDefs <- list( list(name='subjects', classes=c('character',rep('factor',2),rep('NULL',2),'myDate', 'factor','NULL'), naStr=c('')), list(name='visits', classes=c('character','factor','myDate', rep('NULL',3),rep('numeric',2),'NULL')), list(name='locations', classes=c('character','NULL','myDate','numeric','numeric')), list(name='Foxp3', classes=c('character','factor',rep('NULL',2),'myDate', rep('numeric',4),rep('NULL',2), rep('numeric',2),rep('NULL',2), rep('numeric',3),rep('NULL',2), 'numeric',rep('NULL',2))), list(name='Il10', classes=c('character','numeric','NULL', rep('numeric',3),rep('NULL',2), rep('numeric',3),rep('NULL',2))), list(name='IgE', classes=c('character','myAltDate','numeric'), naStr=c('<2','<2.00')), list(name='allergy', classes=c('character','NULL','myDate',rep('NULL',4), rep('character',2),rep('NULL',2), 'character',rep('NULL',2)), naStr=c(''))) data <- NULL for (nn in seq_along(tblDefs)) { tbl <- tblDefs[[nn]]$name print(tbl) tmp <- read.csv(file=sprintf('%s/%s.csv', dir, tbl), colClasses=tblDefs[[nn]]$classes, na.strings=(if (is.null(tblDefs[[nn]]$naStr)) "NA" else tblDefs[[nn]]$naStr)) if (tbl == "subjects") { names(tmp) <- c('subject','sex','asthma','DOB','family') levels(tmp$asthma) <- c(n='no', y='yes')[levels(tmp$asthma)] } else if (tbl == "Foxp3") { names(tmp) <- c('subject','visit','date.conversion', foxp3Upstream,foxp3PromA,foxp3PromB,foxp3PromC) } else if (tbl == "Il10") { names(tmp) <- c('subject','visit',il10In1,il10In3) } else if (tbl == "visits") { names(tmp) <- c('subject','visit','date.visit','BMI','age') } else if (tbl == "locations") { names(tmp) <- c('subject','date.visit','x','y') } else if (tbl == "IgE") { names(tmp) <- c('subject','date.visit','IgE') } else if (tbl == "allergy") { names(tmp) <- c('subject','date.visit','rhinitis','eczema','asthma') } tmp <- transform(tmp, subject=as.numeric(sub("-?[CFV].*", "", subject))) cat(nrow(tmp), "rows\n") data[[tbl]] <- tmp } levels(data$subjects$sex) <- c(m="M",f="F")[as.character(levels(data$subjects$sex))] data.cmb <- merge(data$subjects, data$visits, all=T) age.calc <- difftime(data.cmb$date.visit, data.cmb$DOB, units="days") data.cmb <- transform(data.cmb, age=as.numeric(age.calc)/365.25) data.cmb <- transform(data.cmb, month=format(date.visit, "%m")) data.cmb <- transform(data.cmb, season=season(month)) # Convert negative methylation values to NA for (cpg in foxp3All) { data$Foxp3[,cpg] <- ifelse(data$Foxp3[,cpg] < 0, NA, data$Foxp3[,cpg]) } data.cmb <- merge(data.cmb, data$Foxp3, all.y=T) for (cpg in il10All) { data$Il10[,cpg] <- ifelse(data$Il10[,cpg] < 0, NA, data$Il10[,cpg]) } data.cmb <- merge(data.cmb, data$Il10) # Standardize allergy info cat("CHECKING ALLERGY TABLE\n") data$allergy <- llply(data$allergy, function(x) { if (is.character(x)) { x <- ifelse(is.na(x), "unknown", tolower(x)) } x }) data$allergy <- do.call(cbind.data.frame, data$allergy) data$allergy <- ddply(data$allergy, .(subject), function(x) { for (ccc in c("asthma","rhinitis","eczema")) { if (any(!is.na(x[,ccc])) && any(x[,ccc] == "yes") && any(x[,ccc] != "yes")) { cat(sprintf("Changing %s for %d\n", ccc, x$subject[1])) x[,ccc] = "yes" } } x }) data$allergy <- transform(data$allergy, asthma=factor(asthma, levels=c("no","yes","unknown")), rhinitis=factor(rhinitis, levels=c("no","yes","unknown")), eczema=factor(eczema, levels=c("no","yes","unknown"))) data.cmb <- merge(data.cmb, data$allergy, by=c("subject","date.visit"), all.x=T, suffixes=c("",".allergy")) # There are simpler ways to do the following, but I want to print the subjects # that are changed. cat("CHECKING ASTHMA STATUS AGAINST ALLERGY TABLE\n") data.cmb <- ddply(data.cmb, .(subject), function(x) { if (any(is.finite(x$asthma.allergy)) && any(x$asthma.allergy == "yes", na.rm=T) && any(x$asthma != "yes", na.rm=T)) { cat(sprintf("Changing asthma for %d\n", x$subject[1])) x$asthma = "yes" } x }) data.cmb <- transform(data.cmb, asthma=factor(asthma)) # At this point, the missing values in data$IgE were recorded as "<2". Set them # equal to zero. data$IgE <- transform(data$IgE, IgE=ifelse(is.na(IgE), 0, IgE)) # IgE has multiple measurements for some visits. I'll just take the first one # to avoid screwing up the variance. #table(count(data$IgE, vars=c("subject","date.visit"))$freq) #foo <- ddply(data$IgE, .(subject,date.visit), # function(x) { # if (nrow(x) > 1) { # (max(x$IgE)-min(x$IgE))/mean(x$IgE) # } else { # NULL # }) #foo <- foo[ order(foo$V1,decreasing=T), ] #subset(data$IgE, subject %in% c(2050,2998)) data$IgE <- ddply(data$IgE, .(subject,date.visit), function(x) { x[1,] }) data.cmb <- merge(data.cmb, data$IgE, all.x=T) data.cmb[,"visit"] <- NULL ### AT THIS POINT, CREATE loc, USING CODE IN LOCATIONS SECTION ABOVE # NEED TO SEE WHO HAS LOCATION BEFORE FLAGGING OUTLIERS data.cmb <- merge(data.cmb, cbind(loc[,1:2], loc.good=(loc$mindist <= MIN_DIST_THRESHOLD)), all=T) data.cmb <- transform(data.cmb, loc.good=ifelse(is.na(loc.good), FALSE, loc.good)) tmp <- laply(data.cmb[,c("rhinitis","eczema")], function(x) { x %in% c("yes","no") }) tmp <- t(tmp) tmp <- ((rowSums(tmp) == 2) & is.finite(data.cmb$IgE)) data.cmb <- cbind(data.cmb, allFoxp3=complete.cases(data.cmb[,foxp3All]), allIl10=complete.cases(data.cmb[,il10All]), allIgE=tmp) data.cmb <- transform(data.cmb, isUsed=(is.finite(BMI) & allFoxp3 & loc.good)) ### DETAILS OF OUTLIERS # I tried ccc=4, but it left in 5 points that are clearly separated from the # gray blobs and that are removed when ccc=3. for (ccc in c(2:3)) { chk <- melt(subset(data.cmb, isUsed, select=c("subject","date.visit","sex",foxp3All)), measure.vars=foxp3All) chk <- ddply(chk, .(variable,sex), function(x) { z <- boxplot.stats(x$value, coef=ccc) x <- transform(x, isOutlier=(value < z$stats[1] | value > z$stats[5])) }) x11(height=4,width=7) print(xyplot(value ~ sex | variable, chk, groups=isOutlier, layout=c(5,2), as.table=T, jitter.x=T, xlab="sex", ylab="percent methylation", par.settings=list(superpose.symbol=list(col=c("gray","red"), pch=19, cex=0.5)), main=sprintf("coef = %.1f", ccc), scales=list(y=list(relation="free")), strip=strip.custom(factor.levels=cpgPretty(foxp3All)))) } chk <- ddply(chk, .(subject,date.visit), function(x) { x <- transform(x, status=ifelse(isOutlier, "outlier", "okay")) x <- transform(x, status=as.character(status)) if (any(x$isOutlier)) { x[x$status=="okay", "status"] <- "badAssoc" } x }) chk <- transform(chk, status=factor(status, levels=c("okay","outlier","badAssoc"))) x11(height=4,width=7) print(xyplot(value ~ sex | variable, chk, groups=status, layout=c(5,2), as.table=T, jitter.x=T, xlab="sex", ylab="percent methylation", par.settings=list(superpose.symbol=list(col=c("gray","red","pink"), pch=19, cex=0.5)), scales=list(y=list(relation="free")), strip=strip.custom(factor.levels=cpgPretty(foxp3All)))) # Flag outliers foxp3.good <- transform(chk, foxp3.good=(status == "okay")) foxp3.good <- unique(foxp3.good[,c("subject","date.visit","foxp3.good")]) data.cmb <- merge(data.cmb, foxp3.good, all.x=T) data.cmb <- data.cmb[ order(data.cmb$subject,data.cmb$date.visit), ] ### SMOKING DATA smoke <- read.csv(file=sprintf('%s/smoke.csv', dir, tbl), colClasses=c("numeric", "myDate", "NULL", "character", "NULL")) names(smoke) <- c("subject","date.visit","shs") smoke <- transform(smoke, shs=tolower(shs)) smoke <- transform(smoke, shs=ifelse(!is.na(shs) & shs != "yes", "no", shs), smokes=ifelse(is.na(shs), NA, ifelse(subject == 2073, "yes", "no"))) smoke <- transform(smoke, shs=ifelse(is.na(shs), "unknown", shs), smokes=ifelse(is.na(smokes), "unknown", as.character(smokes))) smoke <- transform(smoke, shs=factor(shs, levels=c("no","yes","unknown")), smokes=factor(smokes, levels=c("no","yes","unknown"))) data.cmb <- merge(data.cmb, smoke, all.x=T) # REMOVE PHI. # I saved files with dates of visits in them in PrivateData.csv and # Exposure.csv.sav just in case. data.cmb <- read.csv(file="PrivateData.csv") data.cmb <- transform(data.cmb, date.visit=as.Date(date.visit)) data.cmb[,"DOB"] <- NULL data.cmb <- ddply(data.cmb, .(subject), function(x) { x <- transform(x, id.visit=seq_len(nrow(x))) }) aq.wdw <- read.csv(file="Exposure.csv.sav") aq.wdw <- transform(aq.wdw, date.visit=as.Date(date.visit)) aq.wdw <- merge(aq.wdw, data.cmb[,c("subject","date.visit","id.visit")]) aq.wdw <- aq.wdw[ with(aq.wdw, order(subject,id.visit)), ] tmp <- data.cmb #tmp <- aq.wdw names.tmp <- names(tmp) names.tmp[2] <- "id.visit" tmp <- tmp[,names.tmp[-length(names.tmp)]] data.cmb <- tmp #aq.wdw <- tmp # Create files for distribution; names changed to prevent annoying accidents write.table(data.cmb, file="PublicData.new", quote=F, row.names=F, sep=",") write.table(aq.wdw, file="Exposure.new", quote=F, row.names=F, sep=",")