Christopher Steven Marcum's Eloquent Moose Collaborative Project : ResearchGraphsForGrafton

EloquentMoose :: Categories :: PageIndex :: RecentChanges :: RecentlyCommented :: Login/Register

Graphs for Grafton

Here are some graphs for my son, Grafton.

Grafton's 17-18mo Teething

Grafton had a prettty big rough patch with some serious teething going on. For him, this translated into general pain (he rubbed his jaw and ear a lot), fussiness, runny nose, lack of appetite, fever, and worse of all, waking up at night. Here's a figure that plots observations of his wake-up time in the middle of the night over the period of a week in the first week of February, 2016. I think regressed (OLS) these data to a simple linear fit and projected the next three days. Fortunately, this teething episode effectively ended on the day that I conducted this analysis and Grafton is back to sleeping through the night (i.e., those projections were never realized).

text

There is actually considerable debate in the literature about whether teething causes these symptoms or, alternatively, is simply the result of misattributed underlying viral infection or other sickness. We're very confident that this was the result of teething though
as we could see the progress of the teeth poking through his gums over the course of the week. Here is some information that may help distinguish teething symptoms from sickness symptoms: [http://www.webmd.com/oral-health/news/20000410/babies-teething-illness "Teething vs. Illness"]].

What is a Tocograph?

At some point in a pregnancy, you might find yourself or your partner connected to a machine the nurses will tell you is measuring your contractions called a tocographer. During non-stress tests, this is usually done externally with two sensors attached by a band to the woman's bump for about twenty minutes while prostrate. Tocography, or Cardiotocography, is the tandem reocording of the fetal heart rate and uterine tone (a measure of tightness associated with the extent of muscle contractions). Sometimes the nurses are a bit flippant about explaining things (as was our first couple of experiences with this device during Grafton's gestation). Here's a simple breakdown with a figure (which is, I think, easier to read than the wikipedia example).

The top line is the instantaneous heart rate. This is pretty much self-explanatory
it's an estimate of the number of heart beats the baby has every minute. Normal range is quite wide, from about 110 to 160, with each baby having a different baseline. That baseline, or the flatish part of the graphed line, is a big focus of the tococardiograph. Climbing spikes upward from that baseline should correlate with the fetal movement marks (those little [-shaped marks right below the heart rate line); they are made by mom, who presses a button every time the she feels a uterine or fetal movement. The spikes, however, should return to baseline rather than fall precipitously toward bradycardia, or low heart rate, which might indicate that the baby is not tolerating his environment well (an indication of fetal distress). And that's where the lower line comes in (and the really cool part, in my opinion): it's the tocograph telemetry, which measures how contracted the uterine muscle is at any point in time. The baseline tocograph is called the resting tone and is usually around 0-15 when the muscle is relaxed. The uterine muscle contracts in a pretty amazing way, starting high and back and spreading toward the centerline and then down toward the pelvis, in an almost uniform matter. The sensor picks up its signal, however, from a single spot on the uterus and the shows contractions in classic "bell curve" rises from the resting tone. In our graph here, evidence of a low grade contraction is visible to the right side of the tocograph. Progressing contractions, which one would see on a tocograph during labor, especially during induction, will be steeper, rise higher, and stay at the peak for longer.

text

When is the Baby Due?

8-22-14
As of today, 8-22-14, my son is two days past his due date. So many people have a narrow view on the question of when the baby is due. They typically mean what day is the birth going to happen on. When I ask, when is the baby due I mean what time is the baby going to arrive on the day that it does arrive. To address this, I acquired some data from the CDC on every single birth reported by hospitals in 2012 (minus about 16% that had missing data). Here are some results:

text
First, we consider the effect of parity on the moment of arrival. Along the x-axis, we have each minute of the day starting at 0 (i.e., 12:00 am) and ending at 1440 (i.e., 11:59pm). Inter-minute intervals are collapsed into the next earliest minute for consistency. The mid-point represents noon (i.e., minute 700). Along the y-axis we have the number of births associated with each minute. The different factors here represent the number of viable lifetime births the mother experienced right up to moment after her latest baby was born. A value of 1 means that this baby is her first baby. It's clear that first time mothers have a greater likelihood of laboring into the night than mothers with greater birth parity.

text
Second, we consider the mode of delivery. The orientation to the graph is the same. Spontaneous deliveries mean that a cephalic birth without any of the other listed interventions occurred. The effect of scheduled cesarean sections is clearly evident; spontaneous labors tend to result in births later in the day.

text
Next, we consider a measure of the relative expected arrival date. The orientation to the graph is the same. The arrival date is a categorical variable that was estimated in the following way: first, we draw a proposal date of birth (dobs are not included in the public files, just the day of week and month and time of birth) with a probability proportional to the frequency of having a baby on a particular day of the week in a particular month. Within a month, we then sample uniformly from the distribution of proposal dates. This date is then subtracted from the number of weeks in gestation (a variable contained in the data) to obtain the expected days of gestation. An on-time baby is classified if it falls within plus or minus 1 standard deviations (roughly 17 days) of the mean of this number (roughly 280) and early and late are respectively outside that interval.

text
Finally, based on a recommendation by my friend and colleague Becky Tippet, we consider the cumulative probability of being born up to a certain point in the day (i.e., the failure of the gestation, S(x) ). On the y-axis, we have the probability of being born up to a particular moment (on the x-axis). When y is 0 at time 0, then 0 births have occurred and when y is 1 then all births have occurred by time 1440. The vertical dotted lines represent the fraction of births up to that time in the day. That is, vertical lines represent the 25, 50, and 75th percentiles. Interestingly, the uniform prior would have given 12 noon as the 50th pctile, but the effect of business hours, diurnal cycles, and planned births, push that up such that 50% of babies are born almost an hour later, by 12:54pm.

So When is the Baby Due?
That requires a bit more finesse to answer than these crude estimates allow. Using a simple linear regression that incorporates information about the baby and Kate I draw a single prediction based on our particular case. This prediction is that Grafton will be due at precisely 1:11pm.

R Code to Generate These Plots
#Graphs for Grafton
#Created by Chris Marcum <chris.marcum@nih.gov>
#Last modified on: 22 August 2014
system("wget ftp://ftp.cdc.gov/pub/Health_Statistics/NCHS/Datasets/DVS/natality/Nat2012us.zip")
system("gunzip Nat2012us.zip")
system("mv Nat2012PublicUS.r20131217 nat2012")
system("cut -c 15-18,19-20,25-28,29,89-90,139-140,217,393,436,438-439,442-445,451-452 --output-delimiter=, nat2012 > nat2012sub.csv")

library(lubridate)
EoD2011<-c(wday(paste("2012-01",1:31,sep="-")),wday(paste("2012-02",1:28,sep="-")),wday(paste("2012-03",1:31,sep="-")),wday(paste("2012-04",1:30,sep="-")),wday(paste("2012-05",1:31,sep="-")),wday(paste("2012-06",1:30,sep="-")),wday(paste("2012-07",1:31,sep="-")),wday(paste("2012-08",1:31,sep="-")),wday(paste("2012-09",1:30,sep="-")),wday(paste("2012-10",1:31,sep="-")),wday(paste("2012-11",1:30,sep="-")),wday(paste("2012-12",1:31,sep="-")))

EoD2012<-list(wday(paste("2012-01",1:31,sep="-")),wday(paste("2012-02",1:29,sep="-")),wday(paste("2012-03",1:31,sep="-")),wday(paste("2012-04",1:30,sep="-")),wday(paste("2012-05",1:31,sep="-")),wday(paste("2012-06",1:30,sep="-")),wday(paste("2012-07",1:31,sep="-")),wday(paste("2012-08",1:31,sep="-")),wday(paste("2012-09",1:30,sep="-")),wday(paste("2012-10",1:31,sep="-")),wday(paste("2012-11",1:30,sep="-")),wday(paste("2012-12",1:31,sep="-")))

 natdata<-read.csv("nat2012sub.csv",h=FALSE)
 colnames(natdata)<-c("Year","Month","Time","WD","MAge","MRace","Parity","Del","BSex","MensM","MensY","Gestation")
natdata$MRace<-as.numeric(natdata[,"MRace"]==1)
natdata$MensY[which(natdata$MensY==9999)]<-NA
natdata$MensM[which(natdata$MensM==99)]<-NA
natdata$Gestation[which(natdata$Gestation==99)]<-NA
natdata$Time[which(natdata$Time==9999)]<-NA
length(na.action(na.omit(natdata)))/nrow(natdata)
natdata<-na.omit(natdata)
natdata<-natdata[order(natdata$Month,natdata$WD,natdata$Mod),]

#Convert time to ordered minutes of the day
# and estimate new gestation times
b1<-as.character(natdata$Time)
b1.nc<-nchar(b1)
b1.st<-strsplit(b1,"")
ptab<-prop.table(table(natdata$Month,natdata$WD),1)
samp.unif.day<-function(x) {
   sample(1:length(EoD2012[[x]]),1,prob=ptab[x,EoD2012[[x]]])
}

natdata$DOM<-sapply(natdata$Month,samp.unif.day)
natdata$SDOB<-as.Date(paste(natdata$Year,natdata$Month,natdata$DOM,sep="-"))
natdata$NewGest<-difftime(as.Date(natdata$SDOB),as.Date(natdata$SDOB-weeks(natdata$Gestation)))
natdata$SDOC<-natdata$SDOB-weeks(natdata$Gestation)
nht<-lapply(b1.st,function(x){ if(length(x)==4){return(paste(x[1],x[2],sep=""))};if(length(x)==3){return(x[1])};if(length(x)<3){return(0)}})
nhm<-lapply(b1.st,function(x) paste(rev(na.omit(rev(x)[1:2])),collapse=""))
nht<-as.numeric(unlist(nht))
nhm<-as.numeric(unlist(nhm))
natdata$Mod<-((nht*60)+nhm)
natdata$Arrival<-ifelse(as.numeric(natdata$NewGest)>mean(as.numeric(natdata$NewGest))+sd(as.numeric(natdata$NewGest)),"Late",ifelse(as.numeric(natdata$NewGest)<mean(as.numeric(natdata$NewGest))-sd(as.numeric(natdata$NewGest)),"Early","On-Time"))
augpar<-natdata[which(natdata$Month==8 & natdata$Parity==1),]
png("ModXPar.png",800,800)
matplot(table(natdata$Mod,natdata$Parity),col=c(rainbow(length(unique(natdata$Parity)))),pch=19,cex=.5,ylab="f(x)",xlab="Minute of the Day",main=paste("Aggregate Timing of Births in a Day \n by  Parity, 2012 (n=",nrow(natdata),")",sep=""))
legend("topright",legend=sort(unique(natdata$Parity)),text.col=c(rainbow(length(unique(natdata$Parity)))),pch=19,col=c(rainbow(length(unique(natdata$Parity)))),title="Birth #")
dev.off()
png("ModXDel.png",800,800)
matplot(table(natdata$Mod,natdata$Del),col=c(rainbow(length(unique(natdata$Del)))),pch=19,cex=.5,ylab="f(x)",xlab="Minute of the Day",main=paste("Aggregate Timing of Births in a Day \n by Mode of Delivery, 2012 (n=",nrow(natdata),")",sep=""))
legend("topright",legend=c("Spontaneous","Forceps","Vacuum","Cesarean","DK"),text.col=c(rainbow(length(unique(natdata$Del)))),pch=19,col=c(rainbow(length(unique(natdata$Del)))),title="Mode")
dev.off()
png("ModXArr.png",800,800)
matplot(table(natdata$Mod,natdata$Arrival),col=c(rainbow(length(unique(natdata$Arrival)))),pch=19,cex=.5,ylab="f(x)",xlab="Minute of the Day",main=paste("Aggregate Timing of Births in a Day \n by Estimated Due Date, 2012 (n=",nrow(natdata),")",sep=""))
legend("topright",legend=sort(unique(natdata$Arrival)),text.col=c(rainbow(length(unique(natdata$Arrival)))),pch=19,col=c(rainbow(length(unique(natdata$Arrival)))),title="Born")
dev.off()
#Cum.Freq. as recommended by B. Tippet
clp<-apply(table(natdata$Mod,natdata$Arrival),2,cumsum)
clp.m<-mean(apply(apply(clp,2,function(x) x/x[1440]),2,function(x) min(which(x>=.5))))
clp.l<-mean(apply(apply(clp,2,function(x) x/x[1440]),2,function(x) min(which(x>=.25))))
clp.u<-mean(apply(apply(clp,2,function(x) x/x[1440]),2,function(x) min(which(x>=.75))))
png("CFXArr.png",800,800)
matplot(apply(clp,2,function(x) x/x[1440]),col=c(rainbow(length(unique(natdata$Arrival)))),type="l",lty=1,lwd=2,ylab="S(x)",xlab="Minute of the Day",main=paste("Cumulative `Survival` of Gestation \n by Estimated Due Date, 2012 (n=",nrow(natdata),")",sep=""))
legend("topleft",legend=sort(unique(natdata$Arrival)),text.col=c(rainbow(length(unique(natdata$Arrival)))),title.col="black",col=c(rainbow(length(unique(natdata$Arrival)))),title="Born")
text(y=c(.25,.5,.75),x=c(clp.l,clp.m,clp.u),label=c("8:05am","12:54pm","5:45pm"),col="black",pos=2)
segments(y0=c(0,0,0),y1=c(.25,.5,.75),x0=c(clp.l,clp.m,clp.u),x1=c(clp.l,clp.m,clp.u),lty="dotted",col="black")
dev.off()
pm1<-lm(Mod~as.factor(Del)+I(Parity==1)+as.factor(MRace)+BSex+MAge+relevel(as.factor(Arrival),ref="On-Time")+as.factor(Month),data=natdata)
save.image("NatData.Rdata")


Files Associated With this Page

  Attachment Size Date Added
      20140902_124235.jpg   688.65 KB   9/02/2014 7:56 pm
      ModXArr.png   67.68 KB   8/22/2014 11:05 am
      ModXDel.png   91.04 KB   8/22/2014 11:06 am
      ModXPar.png   185.4 KB   8/22/2014 11:04 am
      GraftonWakes.png   140.86 KB   2/16/2016 11:13 am
      CFXArr.png   44.26 KB   8/22/2014 11:06 am
 

There are no comments on this page. [Add comment]

Valid XHTML 1.0 Transitional :: Valid CSS :: Powered by WikkaWiki
Page was generated in 0.0929 seconds