Author: Code by Bénédicte Delcoigne and Mark Clements

# Biostatistics III in R

#### Code by Bénédicte Delcoigne and Mark Clements

# Exercise 25. Localised melanoma : generating and analysing a nested case-control (NCC) study

    library(biostat3) # cox and conditional logistic analyses
    library(Epi)      # sample a nested case-control study from a cohort

    ## Get the data for exercise 25 and have a look at it
    data(melanoma)
    mel <- subset(melanoma, stage=="Localised")           # restrict the cohort to stage==1
    mel <- transform(mel,
                     dc = (mel$status=="Dead: cancer" & surv_mm<120)+0,
                     surv_10y = pmin(120, surv_mm))
    table(mel$dc , mel$status)                            # check

    str(mel$sex) ; str(mel$year8594) ; str(mel$agegrp)    #Check structure of risk factors/confounders

    ##  Factor w/ 2 levels "Male","Female": 2 2 2 2 2 2 2 1 2 2 ...

    ##  Factor w/ 2 levels "Diagnosed 75-84",..: 1 1 1 1 1 1 1 1 1 1 ...

    ##  Factor w/ 4 levels "0-44","45-59",..: 4 4 4 4 4 4 4 4 4 4 ...

    out_coh <- coxph(Surv(surv_10y,dc) ~ sex + year8594 + agegrp, data = mel)
    summary(out_coh)

    ## Call:
    ## coxph(formula = Surv(surv_10y, dc) ~ sex + year8594 + agegrp,
    ##     data = mel)
    ##
    ##   n= 5318, number of events= 960
    ##
    ##                             coef exp(coef) se(coef)      z Pr(>|z|)
    ## sexFemale               -0.53061   0.58825  0.06545 -8.107 5.19e-16 ***
    ## year8594Diagnosed 85-94 -0.33339   0.71649  0.06618 -5.037 4.72e-07 ***
    ## agegrp45-59              0.28283   1.32688  0.09417  3.003  0.00267 **
    ## agegrp60-74              0.62006   1.85904  0.09088  6.823 8.90e-12 ***
    ## agegrp75+                1.21801   3.38045  0.10443 11.663  < 2e-16 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ##
    ##                         exp(coef) exp(-coef) lower .95 upper .95
    ## sexFemale                  0.5882     1.7000    0.5174    0.6688
    ## year8594Diagnosed 85-94    0.7165     1.3957    0.6293    0.8157
    ## agegrp45-59                1.3269     0.7536    1.1032    1.5959
    ## agegrp60-74                1.8590     0.5379    1.5557    2.2215
    ## agegrp75+                  3.3804     0.2958    2.7547    4.1483
    ##
    ## Concordance= 0.646  (se = 0.009 )
    ## Likelihood ratio test= 212.7  on 5 df,   p=<2e-16
    ## Wald test            = 217.9  on 5 df,   p=<2e-16
    ## Score (logrank) test = 226.8  on 5 df,   p=<2e-16

## (a)

There are 5318 individuals in the study that we would need to collect data for if we were to use the complete cohort of patients.

    n_ind <- length(mel$id)
    n_ind

    ## [1] 5318

## (b)

960 cancer patients die from melanoma during the first 10 years of follow-up.

    table(mel$dc, useNA="always")

    ##
    ##    0    1 <NA>
    ## 4358  960    0

    ncase <-  table (mel$dc, useNA="always")[2]
    ncase

    ##   1
    ## 960

## (c1)

    nccdata <-ccwc( entry=0, exit=surv_10y , fail=dc, origin=0, controls=1, include=list(sex,year8594,agegrp,dc,id), data=mel )

    ##
    ## Sampling risk sets: .....................................................................................................................

    tail(nccdata, 8)

    ##      Set  Map  Time Fail    sex        year8594 agegrp dc   id
    ## 1913 114 2674  87.5    1 Female Diagnosed 85-94   0-44  1 3784
    ## 1914 114 2097  87.5    0   Male Diagnosed 75-84  45-59  0 2937
    ## 1915 115 4275  98.5    1   Male Diagnosed 85-94  60-74  1 6168
    ## 1916 115 2694  98.5    0 Female Diagnosed 85-94   0-44  0 3816
    ## 1917 116 5287   2.5    1   Male Diagnosed 85-94  45-59  1 7713
    ## 1918 116 3013   2.5    0   Male Diagnosed 85-94   0-44  0 4279
    ## 1919 117 5314 119.5    1   Male Diagnosed 85-94  60-74  1 7753
    ## 1920 117  609 119.5    0   Male Diagnosed 75-84  45-59  0  868

## (c2)

    out_ncc <- clogit(Fail ~ sex + year8594 + agegrp + strata(Set), data=nccdata)
    summary(out_ncc)

    ## Call:
    ## coxph(formula = Surv(rep(1, 1920L), Fail) ~ sex + year8594 +
    ##     agegrp + strata(Set), data = nccdata, method = "exact")
    ##
    ##   n= 1920, number of events= 960
    ##
    ##                             coef exp(coef) se(coef)      z Pr(>|z|)
    ## sexFemale               -0.51826   0.59556  0.09452 -5.483 4.18e-08 ***
    ## year8594Diagnosed 85-94 -0.40636   0.66607  0.09611 -4.228 2.36e-05 ***
    ## agegrp45-59              0.16839   1.18340  0.12815  1.314    0.189
    ## agegrp60-74              0.63602   1.88895  0.12902  4.930 8.24e-07 ***
    ## agegrp75+                1.11502   3.04962  0.16348  6.821 9.06e-12 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ##
    ##                         exp(coef) exp(-coef) lower .95 upper .95
    ## sexFemale                  0.5956     1.6791    0.4948    0.7168
    ## year8594Diagnosed 85-94    0.6661     1.5013    0.5517    0.8041
    ## agegrp45-59                1.1834     0.8450    0.9206    1.5213
    ## agegrp60-74                1.8890     0.5294    1.4669    2.4324
    ## agegrp75+                  3.0496     0.3279    2.2136    4.2014
    ##
    ## Concordance= 0.64  (se = 0.015 )
    ## Likelihood ratio test= 96.12  on 5 df,   p=<2e-16
    ## Wald test            = 89.64  on 5 df,   p=<2e-16
    ## Score (logrank) test = 93.9  on 5 df,   p=<2e-16

## (d)

    n_uni <- length(unique(nccdata$id))
    n_uni

    ## [1] 1731

## (e)

Note that, since every nested case-control study is different, the parameter estimates you obtain will not be identical to those above. However, the hazard ratios from the two models should be very similar. The standard errors are slightly larger for the nested case-control study since the estimates are based on a sample from the full cohort. Loss of precision is the trade-off we have to make when designing a nested case-control study. The precision can be improved by adding more controls to each case.

    comp <- exp(data.frame(coef(out_coh),coef(out_ncc)))
    colnames(comp) <- c("cohort HR", "NCC HR")
    comp                           # print the HR estimates from the cohort and the NCC

    ##                         cohort HR    NCC HR
    ## sexFemale               0.5882470 0.5955570
    ## year8594Diagnosed 85-94 0.7164882 0.6660677
    ## agegrp45-59             1.3268817 1.1834004
    ## agegrp60-74             1.8590433 1.8889544
    ## agegrp75+               3.3804475 3.0496221

    var <- data.frame(diag(vcov(out_coh)), diag(vcov(out_ncc)), diag(vcov(out_coh))/diag(vcov(out_ncc)))
    colnames(var) <- c("cohort var", "NCC var", "ratio coh/ncc" )
    var                            # print the variances of estimates from the cohort and the NCC and their ratio

    ##                          cohort var     NCC var ratio coh/ncc
    ## sexFemale               0.004283749 0.008933339     0.4795238
    ## year8594Diagnosed 85-94 0.004380163 0.009238029     0.4741447
    ## agegrp45-59             0.008868630 0.016422877     0.5400168
    ## agegrp60-74             0.008258394 0.016646103     0.4961158
    ## agegrp75+               0.010906329 0.026724461     0.4081029

## (f)

We see that there is sampling variation in the parameter estimates from the five nested case-control studies but they are centered on the full cohort estimate. We see that the standard errors of the estimates from the nested case-control studies are larger than for the full cohort but there is some sampling variation.

    M <- 20                   # Number of loops: change the M value to change the number of loops
    param   <- matrix(0,M,5)  # Define the matrice of the coefficients
    for (i in 1:M)  {         # Start of the loop, create NCC data and analyse it
        nccdata <-ccwc( entry=0, exit=surv_10y , fail=dc, origin=0, controls=1, include=list(sex,year8594,agegrp), data=mel )
        out_ncc <- clogit(Fail ~ sex + year8594 + agegrp + strata(Set), data=nccdata)
        param [ i , 1:5] <- coef(out_ncc)   # store the 5 coefficients M times
    }                  # End of the loop

    param <- as.data.frame(param)        # data frame with the coefficients
    param <- exp(param)                  # data frame with the HR
    param <- rbind (summary(out_coh)$coef[c(1:5),2], param)
    colnames(param) <- names(coef(out_coh))
    rownames(param) <- c("cohort", c(1:M))
    param

    ##        sexFemale year8594Diagnosed 85-94 agegrp45-59 agegrp60-74 agegrp75+
    ## cohort 0.5882470               0.7164882    1.326882    1.859043  3.380448
    ## 1      0.5486474               0.6381542    1.497273    1.772094  4.122505
    ## 2      0.5328482               0.7181448    1.313150    2.073535  3.868298
    ## 3      0.5464003               0.7443230    1.413770    1.953145  4.337926
    ## 4      0.5839390               0.7573494    1.409873    1.907685  2.761936
    ## 5      0.5598362               0.7143165    1.419559    1.928466  3.554149
    ## 6      0.5603335               0.7141989    1.268408    1.814712  3.287115
    ## 7      0.5875319               0.7264022    1.512866    1.993000  3.649585
    ## 8      0.5606054               0.7206263    1.449527    1.828567  3.958375
    ## 9      0.5680247               0.6848129    1.261659    1.883825  3.504086
    ## 10     0.5381000               0.6972992    1.282885    2.059576  3.631084
    ## 11     0.5505851               0.6923363    1.535384    2.189954  4.108926
    ## 12     0.5476165               0.6629938    1.430209    2.027819  4.652872
    ## 13     0.5452970               0.6431432    1.163497    1.879994  3.914656
    ## 14     0.5616197               0.5961417    1.357514    1.807640  4.055455
    ## 15     0.5346850               0.6160208    1.415101    2.057579  4.236180
    ## 16     0.5021241               0.6733884    1.241578    1.550081  3.709983
    ## 17     0.5703349               0.6609033    1.447120    2.014933  4.560851
    ## 18     0.5522950               0.7516153    1.389732    1.957561  3.632394
    ## 19     0.5539184               0.7861786    1.190621    1.737093  2.939583
    ## 20     0.5134505               0.6675301    1.261959    1.890939  3.498083

    mean_param <- apply(param[c(2:M),], 2, mean)  # compute the mean of the log HR for the M loops
    sd_param <-  apply(param[c(2:M),], 2, sd)     # compute the sd of the log HR for the M loops
    par_sum <- rbind (summary(out_coh)$coef[c(1:5),1], mean_param, sd_param)
    rownames(par_sum) <- c("cohort log HR","mean log HR NCC","sd log HR NCC")
    colnames(par_sum) <- names(coef(out_coh))
    par_sum

    ##                   sexFemale year8594Diagnosed 85-94 agegrp45-59 agegrp60-74 agegrp75+
    ## cohort log HR   -0.53060828             -0.33339352   0.2828316   0.6200620 1.2180081
    ## mean log HR NCC  0.55288118              0.69464993   1.3684067   1.9177506 3.8150506
    ## sd log HR NCC    0.01917491              0.05025401   0.1086644   0.1473112 0.4947221

    par(mfrow=c(2,3) )                                   # allow 2*3 graphs on the same page
    for (i in 1:5) {
        hist(param[,i], main=colnames(par_sum)[i], xlab="log HR value")  # histogram of HR for variable sex (female vs male)
        abline(v=summary(out_coh)$coef[i,2], col="green")
        abline(v=mean_param[i], col="red")
    }
    plot.new()
    legend(0, 0.5, c("Cox","Mean NCC"),lty=1,col=c("green","red"),bty="n")