Exercise 6. Diet data: tabulating incidence rates and modelling with Poisson regression

You may have to install the required packages the first time you use them. You can install a package by install.packages("package_of_interest") for each package you require.

library(biostat3)
library(dplyr)    # for data manipulation

Load the diet data using time-on-study as the timescale.

head(diet)
##    id chd         y hieng  energy       job month   height   weight        doe        dox
## 1 127   0 16.791239   low 2023.25 conductor     2 173.9900 61.46280 1960-02-16 1976-12-01
## 2 200   0 19.958933   low 2448.68      bank    12 177.8000 73.48320 1956-12-16 1976-12-01
## 3 198   0 19.958933   low 2281.38      bank    12       NA       NA 1956-12-16 1976-12-01
## 4 222   0 15.394935   low 2467.95      bank     2 158.7500 58.24224 1957-02-16 1972-07-10
## 5 305   1  1.494866   low 2362.93      bank     1       NA       NA 1960-01-16 1961-07-15
## 6 173   0 15.958932   low 2380.11 conductor    12 164.4904 79.01712 1960-12-16 1976-12-01
##          dob         y1k      bmi jobNumber
## 1 1910-09-27 0.016791239 20.30316         1
## 2 1909-06-18 0.019958933 23.24473         2
## 3 1910-06-30 0.019958933       NA         2
## 4 1902-07-11 0.015394935 23.11057         2
## 5 1913-06-30 0.001494866       NA         2
## 6 1915-06-28 0.015958932 29.20385         1
summary(diet)
##        id           chd               y            hieng         energy    
##  Min.   :  1   Min.   :0.0000   Min.   : 0.2875   low :155   Min.   :1748  
##  1st Qu.: 85   1st Qu.:0.0000   1st Qu.:10.7762   high:182   1st Qu.:2537  
##  Median :169   Median :0.0000   Median :15.4606              Median :2803  
##  Mean   :169   Mean   :0.1365   Mean   :13.6607              Mean   :2829  
##  3rd Qu.:253   3rd Qu.:0.0000   3rd Qu.:17.0431              3rd Qu.:3110  
##  Max.   :337   Max.   :1.0000   Max.   :20.0411              Max.   :4396  
##                                                                            
##         job          month            height          weight            doe            
##  driver   :102   Min.   : 1.000   Min.   :152.4   Min.   : 46.72   Min.   :1956-11-16  
##  conductor: 84   1st Qu.: 3.000   1st Qu.:168.9   1st Qu.: 64.64   1st Qu.:1959-01-16  
##  bank     :151   Median : 6.000   Median :173.0   Median : 72.80   Median :1960-02-16  
##                  Mean   : 6.231   Mean   :173.4   Mean   : 72.54   Mean   :1960-06-22  
##                  3rd Qu.:10.000   3rd Qu.:177.8   3rd Qu.: 79.83   3rd Qu.:1961-06-16  
##                  Max.   :12.000   Max.   :190.5   Max.   :106.14   Max.   :1966-09-16  
##                                   NA's   :5       NA's   :4                            
##       dox                  dob                  y1k                 bmi       
##  Min.   :1958-08-29   Min.   :1892-01-10   Min.   :0.0002875   Min.   :15.88  
##  1st Qu.:1972-09-29   1st Qu.:1906-01-18   1st Qu.:0.0107762   1st Qu.:21.59  
##  Median :1976-12-01   Median :1911-02-25   Median :0.0154606   Median :24.11  
##  Mean   :1974-02-19   Mean   :1911-01-04   Mean   :0.0136607   Mean   :24.12  
##  3rd Qu.:1976-12-01   3rd Qu.:1915-01-30   3rd Qu.:0.0170431   3rd Qu.:26.50  
##  Max.   :1976-12-01   Max.   :1930-09-19   Max.   :0.0200411   Max.   :33.29  
##                                                                NA's   :5      
##    jobNumber    
##  Min.   :0.000  
##  1st Qu.:0.000  
##  Median :1.000  
##  Mean   :1.145  
##  3rd Qu.:2.000  
##  Max.   :2.000  
## 

(a)

diet <- biostat3::diet
diet$y1k <- diet$y/1000

diet.ir6a <- survRate(Surv(y/1000,chd) ~ hieng, data=diet)
## or
diet %>%
    group_by(hieng) %>%
    summarise(Event = sum(chd), Time = sum(y1k), Rate = Event/Time,      # group sums
              CI_low = poisson.test(Event,Time)$conf.int[1],
              CI_high = poisson.test(Event,Time)$conf.int[2]) 
## # A tibble: 2 x 6
##   hieng Event  Time  Rate CI_low CI_high
##   <fct> <int> <dbl> <dbl>  <dbl>   <dbl>
## 1 low      28  2.06 13.6    9.03    19.6
## 2 high     18  2.54  7.07   4.19    11.2
## IRR
with(diet.ir6a, poisson.test(event,tstop)) 
## 
##  Comparison of Poisson rates
## 
## data:  event time base: tstop
## count1 = 28, expected count1 = 20.578, p-value = 0.03681
## alternative hypothesis: true rate ratio is not equal to 1
## 95 percent confidence interval:
##  1.026173 3.688904
## sample estimates:
## rate ratio 
##   1.921747
with(diet.ir6a, poisson.test(rev(event),rev(tstop)))
## 
##  Comparison of Poisson rates
## 
## data:  rev(event) time base: rev(tstop)
## count1 = 18, expected count1 = 25.422, p-value = 0.03681
## alternative hypothesis: true rate ratio is not equal to 1
## 95 percent confidence interval:
##  0.2710832 0.9744943
## sample estimates:
## rate ratio 
##  0.5203599

We see that individuals with a high energy intake have a lower CHD incidence rate. The estimated crude incidence rate ratio is 0.52 (95% CI: 0.27, 0.97).

(b)

poisson6b <- glm( chd ~ hieng + offset( log( y1k ) ), family=poisson, data=diet)
summary(poisson6b)
## 
## Call:
## glm(formula = chd ~ hieng + offset(log(y1k)), family = poisson, 
##     data = diet)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7382  -0.6337  -0.4899  -0.3891   3.0161  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   2.6098     0.1890  13.811   <2e-16 ***
## hienghigh    -0.6532     0.3021  -2.162   0.0306 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 262.82  on 336  degrees of freedom
## Residual deviance: 258.00  on 335  degrees of freedom
## AIC: 354
## 
## Number of Fisher Scoring iterations: 6
eform(poisson6b)
##              exp(beta)     2.5 %     97.5 %
## (Intercept) 13.5959916 9.3877130 19.6907371
## hienghigh    0.5203599 0.2878432  0.9407012
eform(poisson6b, method="Profile")
## Waiting for profiling to be done...
##              exp(beta)     2.5 %     97.5 %
## (Intercept) 13.5959916 9.1614552 19.2715805
## hienghigh    0.5203599 0.2829171  0.9328392

The point estimate for the IRR calculated by the Poisson regression is the same as the IRR calculated in 6(a). A theoretical observation: if we consider the data as being cross-classified solely by hieng then the Poisson regression model with one parameter is a saturated model so the IRR estimated from the model will be identical to the ‘observed’ IRR. That is, the model is a perfect fit.

(c)

hist6c <- hist(diet$energy, breaks=25, probability=TRUE, xlab="Energy (units)")
curve(dnorm(x, mean=mean(diet$energy), sd=sd(diet$energy)), col = "red", add=TRUE)

quantile(diet$energy, probs=c(0.01,0.05,0.1,0.25,0.5,0.75,0.90,0.95,0.99))
##       1%       5%      10%      25%      50%      75%      90%      95%      99% 
## 1887.268 2177.276 2314.114 2536.690 2802.980 3109.660 3365.644 3588.178 4046.820
# For kurtosis and skewness, see package e1071

The histogram gives us an idea of the distribution of energy intake. We can also tabulate moments and percentiles of the distribution.

(d)

diet$eng3 <- cut(diet$energy, breaks=c(1500,2500,3000,4500),labels=c("low","medium","high"), 
                 right = FALSE)
cbind(Freq=table(diet$eng3),
      Prop=table(diet$eng3)/nrow(diet))
##        Freq      Prop
## low      75 0.2225519
## medium  150 0.4451039
## high    112 0.3323442

(e)

## rates and IRRs
diet.ir6e <- survRate(Surv(y/1000,chd) ~ eng3, data=diet)
print(diet.ir6e)
##               eng3     tstop event      rate    lower     upper
## eng3=low       low 0.9466338    16 16.901995 9.660951 27.447781
## eng3=medium medium 2.0172621    22 10.905871 6.834651 16.511619
## eng3=high     high 1.6397728     8  4.878725 2.106287  9.613033
# calculate IRR and confidence intervals
with(diet.ir6e, rate[eng3=="medium"] / rate[eng3=="low"])
## [1] 0.6452416
with(diet.ir6e[c(2,1),], { # compare second row with first row
  poisson.test(event, tstop)
})
## 
##  Comparison of Poisson rates
## 
## data:  event time base: tstop
## count1 = 22, expected count1 = 25.863, p-value = 0.2221
## alternative hypothesis: true rate ratio is not equal to 1
## 95 percent confidence interval:
##  0.3237007 1.3143509
## sample estimates:
## rate ratio 
##  0.6452416
with(diet.ir6e, rate[eng3=="high"] / rate[eng3=="low"])
## [1] 0.2886479
with(diet.ir6e[c(3,1),], { # compare third row with first row
  poisson.test(event, tstop)
})
## 
##  Comparison of Poisson rates
## 
## data:  event time base: tstop
## count1 = 8, expected count1 = 15.216, p-value = 0.004579
## alternative hypothesis: true rate ratio is not equal to 1
## 95 percent confidence interval:
##  0.1069490 0.7148284
## sample estimates:
## rate ratio 
##  0.2886479

We see that the CHD incidence rate decreases as the level of total energy intake increases.

(f)

diet <- mutate(diet, 
               X1 = as.numeric(eng3 == "low"),
               X2 = as.numeric(eng3 == "medium"),
               X3 = as.numeric(eng3 == "high"))
# or
diet <- biostat3::addIndicators(diet, ~eng3+0) %>%
    mutate(X1 = eng3low, X2 = eng3medium, X3 = eng3high)
colSums(diet[c("X1","X2","X3")])
##  X1  X2  X3 
##  75 150 112

(g)

filter(diet, eng3=="low")    %>% select(c(energy,eng3,X1,X2,X3)) %>% head
##    energy eng3 X1 X2 X3
## 1 2023.25  low  1  0  0
## 2 2448.68  low  1  0  0
## 3 2281.38  low  1  0  0
## 4 2467.95  low  1  0  0
## 5 2362.93  low  1  0  0
## 6 2380.11  low  1  0  0
filter(diet, eng3=="medium") %>% select(c(energy,eng3,X1,X2,X3)) %>% head
##    energy   eng3 X1 X2 X3
## 1 2664.64 medium  0  1  0
## 2 2533.33 medium  0  1  0
## 3 2854.08 medium  0  1  0
## 4 2673.77 medium  0  1  0
## 5 2766.88 medium  0  1  0
## 6 2586.69 medium  0  1  0
filter(diet, eng3=="high")   %>% select(c(energy,eng3,X1,X2,X3)) %>% head
##    energy eng3 X1 X2 X3
## 1 3067.36 high  0  0  1
## 2 3298.95 high  0  0  1
## 3 3147.60 high  0  0  1
## 4 3180.47 high  0  0  1
## 5 3045.81 high  0  0  1
## 6 3060.03 high  0  0  1

(h)

poisson6h <- glm( chd ~ X2 + X3 + offset( log( y1k ) ), family=poisson, data=diet )
summary(poisson6h)
## 
## Call:
## glm(formula = chd ~ X2 + X3 + offset(log(y1k)), family = poisson, 
##     data = diet)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.8231  -0.6052  -0.4532  -0.3650   2.9434  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   2.8274     0.2500  11.312  < 2e-16 ***
## X2           -0.4381     0.3285  -1.334  0.18233    
## X3           -1.2425     0.4330  -2.870  0.00411 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 262.82  on 336  degrees of freedom
## Residual deviance: 253.62  on 334  degrees of freedom
## AIC: 351.62
## 
## Number of Fisher Scoring iterations: 6
eform(poisson6h)
##              exp(beta)      2.5 %     97.5 %
## (Intercept) 16.9019960 10.3556032 27.5867534
## X2           0.6452416  0.3389050  1.2284761
## X3           0.2886478  0.1235407  0.6744143

Level 1 of the categorized total energy is the reference category. The estimated rate ratio comparing level 2 to level 1 is 0.6452 and the estimated rate ratio comparing level 3 to level 1 is 0.2886.

(i)

poisson6i <- glm( chd ~ X1 + X3 + offset( log( y1k ) ), family=poisson, data=diet )
# or 
poisson6i <- glm( chd ~ I(eng3=="low") + I(eng3=="high") + offset( log( y1k ) ), family=poisson, data=diet )

summary( poisson6i )
## 
## Call:
## glm(formula = chd ~ I(eng3 == "low") + I(eng3 == "high") + offset(log(y1k)), 
##     family = poisson, data = diet)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.8231  -0.6052  -0.4532  -0.3650   2.9434  
## 
## Coefficients:
##                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)             2.3893     0.2132  11.207   <2e-16 ***
## I(eng3 == "low")TRUE    0.4381     0.3285   1.334   0.1823    
## I(eng3 == "high")TRUE  -0.8044     0.4129  -1.948   0.0514 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 262.82  on 336  degrees of freedom
## Residual deviance: 253.62  on 334  degrees of freedom
## AIC: 351.62
## 
## Number of Fisher Scoring iterations: 6
eform( poisson6i )
##                        exp(beta)     2.5 %    97.5 %
## (Intercept)           10.9058706 7.1810131 16.562846
## I(eng3 == "low")TRUE   1.5498071 0.8140167  2.950679
## I(eng3 == "high")TRUE  0.4473485 0.1991681  1.004783

Now use level 2 as the reference (by omitting X2 but including X1 and X3). The estimated rate ratio comparing level 1 to level 2 is 1.5498 and the estimated rate ratio comparing level 3 to level 2 is 0.4473.

(j)

poisson6j <- glm( chd ~ eng3 + offset( log( y1k ) ), family=poisson, data=diet )
summary( poisson6j )
## 
## Call:
## glm(formula = chd ~ eng3 + offset(log(y1k)), family = poisson, 
##     data = diet)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.8231  -0.6052  -0.4532  -0.3650   2.9434  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   2.8274     0.2500  11.312  < 2e-16 ***
## eng3medium   -0.4381     0.3285  -1.334  0.18233    
## eng3high     -1.2425     0.4330  -2.870  0.00411 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 262.82  on 336  degrees of freedom
## Residual deviance: 253.62  on 334  degrees of freedom
## AIC: 351.62
## 
## Number of Fisher Scoring iterations: 6
eform( poisson6j )
##              exp(beta)      2.5 %     97.5 %
## (Intercept) 16.9019960 10.3556032 27.5867534
## eng3medium   0.6452416  0.3389050  1.2284761
## eng3high     0.2886478  0.1235407  0.6744143

The estimates are identical (as we would hope) when we have R create indicator variables for us.

(k)

Somehow (there are many different alternatives) you’ll need to calculate the total number of events and the total person-time at risk and then calculate the incidence rate as events/person-time. For example,

summarise(diet, rate = sum(chd) / sum(y))
##          rate
## 1 0.009992031

The estimated incidence rate is 0.00999 events per person-year.