Example 1. Smoking and lung cancer. This example is motivated by the effect of smoking on lung cancer as mediated by radon. I heard this example in a seminar but have no direct knowledge of supporting studies, etc. But its a useful example for working with dags and the dagitty package.

library(dagitty)

smokingRadon <- dagitty( "dag {
    Smoking->SmokeInHouse
    Smoking-> LC
    SmokeInHouse -> Radon
    Radon -> LC
}")
plot(graphLayout(smokingRadon))

coordinates( smokingRadon ) <-  list(
  x=c(Smoking=1, LC=2, Radon=3, SmokeInHouse=2),
  y=c(Smoking=3, LC=1, Radon=2, SmokeInHouse=3) )
plot( smokingRadon )

exposures(smokingRadon) <- c("Smoking")
outcomes(smokingRadon) <- c("LC")
paths( smokingRadon, "Smoking", "LC",directed=TRUE )
$paths
[1] "Smoking -> LC"                          "Smoking -> SmokeInHouse -> Radon -> LC"

$open
[1] TRUE TRUE
adjustmentSets(smokingRadon,effect=c('direct'))
{ Radon }
{ SmokeInHouse }
isCollider(smokingRadon,'Smoking','LC','Radon')
[1] TRUE

Example 2. Screen time and literacy in children. Screen time is indicative of poor literacy but is confounded with family home life. Poor home life can lead to more screen time. So controlling for family home life can change the relationship between sceen time and literacy.

library(dagitty)

literacy <- dagitty( "dag {
    screenTime->literacy
    screenTime<-familyDisruption
    familyDisruption->literacy
    }")
plot(graphLayout(literacy))

exposures(literacy) <- c("screenTime")
outcomes(literacy) <- c("literacy")
paths( literacy, "screenTime","literacy", directed=TRUE )
$paths
[1] "screenTime -> literacy"

$open
[1] TRUE
adjustmentSets(literacy,effect=c('total','direct'))
{ familyDisruption }
isCollider(literacy,'screenTime','literacy','familyDisruption')
[1] TRUE

Example 3. Low birthweight and infant mortality and smoking. Smoking appears to be protective of low birth weight infants but this is because of confounding.

library(dagitty)

birthweight <- dagitty( "dag {
    lbw->mortality
    c1->smoking
    c2->mortality
    c3->lbw
    smoking->lbw
    lbw<-U->mortality
    U [unobserved]
    }")
plot(graphLayout(birthweight))

exposures(birthweight) <- c("lbw")
outcomes(birthweight) <- c("mortality")
paths( birthweight, "lbw","mortality", directed=FALSE )
$paths
[1] "lbw -> mortality"      "lbw <- U -> mortality"

$open
[1] TRUE TRUE
adjustmentSets(birthweight,effect=c('total','direct'))

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Cmd+Shift+Enter.

plot(cars)

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Cmd+Option+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Cmd+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKCkV4YW1wbGUgMS4gIFNtb2tpbmcgYW5kIGx1bmcgY2FuY2VyLiBUaGlzIGV4YW1wbGUgaXMgbW90aXZhdGVkIGJ5IHRoZSBlZmZlY3Qgb2Ygc21va2luZyBvbiBsdW5nCmNhbmNlciBhcyBtZWRpYXRlZCBieSByYWRvbi4gIEkgaGVhcmQgdGhpcyBleGFtcGxlIGluIGEgc2VtaW5hciBidXQgaGF2ZSBubyBkaXJlY3Qga25vd2xlZGdlIG9mCnN1cHBvcnRpbmcgc3R1ZGllcywgZXRjLiAgQnV0IGl0cyBhIHVzZWZ1bCBleGFtcGxlIGZvciB3b3JraW5nIHdpdGggZGFncyBhbmQgdGhlIGRhZ2l0dHkgcGFja2FnZS4KCgpgYGB7cn0KbGlicmFyeShkYWdpdHR5KQoKc21va2luZ1JhZG9uIDwtIGRhZ2l0dHkoICJkYWcgewogICAgU21va2luZy0+U21va2VJbkhvdXNlCiAgICBTbW9raW5nLT4gTEMKICAgIFNtb2tlSW5Ib3VzZSAtPiBSYWRvbgogICAgUmFkb24gLT4gTEMKfSIpCnBsb3QoZ3JhcGhMYXlvdXQoc21va2luZ1JhZG9uKSkKYGBgCgoKYGBge3J9CmNvb3JkaW5hdGVzKCBzbW9raW5nUmFkb24gKSA8LSAgbGlzdCgKICB4PWMoU21va2luZz0xLCBMQz0yLCBSYWRvbj0zLCBTbW9rZUluSG91c2U9MiksCiAgeT1jKFNtb2tpbmc9MywgTEM9MSwgUmFkb249MiwgU21va2VJbkhvdXNlPTMpICkKcGxvdCggc21va2luZ1JhZG9uICkKYGBgCgoKYGBge3J9CmV4cG9zdXJlcyhzbW9raW5nUmFkb24pIDwtIGMoIlNtb2tpbmciKQpvdXRjb21lcyhzbW9raW5nUmFkb24pIDwtIGMoIkxDIikKcGF0aHMoIHNtb2tpbmdSYWRvbiwgIlNtb2tpbmciLCAiTEMiLGRpcmVjdGVkPVRSVUUgKQoKYGBgCmBgYHtyfQphZGp1c3RtZW50U2V0cyhzbW9raW5nUmFkb24sZWZmZWN0PWMoJ2RpcmVjdCcpKQpgYGAKCmBgYHtyfQppc0NvbGxpZGVyKHNtb2tpbmdSYWRvbiwnU21va2luZycsJ0xDJywnUmFkb24nKQpgYGAKCgpFeGFtcGxlIDIuICBTY3JlZW4gdGltZSBhbmQgbGl0ZXJhY3kgaW4gY2hpbGRyZW4uIFNjcmVlbiB0aW1lIGlzIGluZGljYXRpdmUgb2YgcG9vciBsaXRlcmFjeSBidXQgaXMgY29uZm91bmRlZCB3aXRoCmZhbWlseSBob21lIGxpZmUuICBQb29yIGhvbWUgbGlmZSBjYW4gbGVhZCB0byBtb3JlIHNjcmVlbiB0aW1lLiAgU28gY29udHJvbGxpbmcgZm9yIGZhbWlseSBob21lIGxpZmUgY2FuIGNoYW5nZSB0aGUgcmVsYXRpb25zaGlwCmJldHdlZW4gc2NlZW4gdGltZSBhbmQgbGl0ZXJhY3kuCgpgYGB7cn0KbGlicmFyeShkYWdpdHR5KQoKbGl0ZXJhY3kgPC0gZGFnaXR0eSggImRhZyB7CiAgICBzY3JlZW5UaW1lLT5saXRlcmFjeQogICAgc2NyZWVuVGltZTwtZmFtaWx5RGlzcnVwdGlvbgogICAgZmFtaWx5RGlzcnVwdGlvbi0+bGl0ZXJhY3kKICAgIH0iKQpwbG90KGdyYXBoTGF5b3V0KGxpdGVyYWN5KSkKCmBgYAoKYGBge3J9CmV4cG9zdXJlcyhsaXRlcmFjeSkgPC0gYygic2NyZWVuVGltZSIpCm91dGNvbWVzKGxpdGVyYWN5KSA8LSBjKCJsaXRlcmFjeSIpCnBhdGhzKCBsaXRlcmFjeSwgInNjcmVlblRpbWUiLCJsaXRlcmFjeSIsIGRpcmVjdGVkPVRSVUUgKQpgYGAKCmBgYHtyfQphZGp1c3RtZW50U2V0cyhsaXRlcmFjeSxlZmZlY3Q9YygndG90YWwnLCdkaXJlY3QnKSkKYGBgCgpgYGB7cn0KaXNDb2xsaWRlcihsaXRlcmFjeSwnc2NyZWVuVGltZScsJ2xpdGVyYWN5JywnZmFtaWx5RGlzcnVwdGlvbicpCmBgYAoKCgpFeGFtcGxlIDMuICBMb3cgYmlydGh3ZWlnaHQgYW5kIGluZmFudCBtb3J0YWxpdHkgYW5kIHNtb2tpbmcuICBTbW9raW5nIGFwcGVhcnMgdG8gCmJlIHByb3RlY3RpdmUgb2YgbG93IGJpcnRoIHdlaWdodCBpbmZhbnRzIGJ1dCB0aGlzIGlzIGJlY2F1c2Ugb2YgY29uZm91bmRpbmcuCgpgYGB7cn0KbGlicmFyeShkYWdpdHR5KQoKYmlydGh3ZWlnaHQgPC0gZGFnaXR0eSggImRhZyB7CiAgICBsYnctPm1vcnRhbGl0eQogICAgYzEtPnNtb2tpbmcKICAgIGMyLT5tb3J0YWxpdHkKICAgIGMzLT5sYncKICAgIHNtb2tpbmctPmxidwogICAgbGJ3PC1VLT5tb3J0YWxpdHkKICAgIFUgW3Vub2JzZXJ2ZWRdCiAgICB9IikKcGxvdChncmFwaExheW91dChiaXJ0aHdlaWdodCkpCmBgYAoKCmBgYHtyfQpleHBvc3VyZXMoYmlydGh3ZWlnaHQpIDwtIGMoImxidyIpCm91dGNvbWVzKGJpcnRod2VpZ2h0KSA8LSBjKCJtb3J0YWxpdHkiKQpwYXRocyggYmlydGh3ZWlnaHQsICJsYnciLCJtb3J0YWxpdHkiLCBkaXJlY3RlZD1GQUxTRSApCmBgYAoKYGBge3J9CmFkanVzdG1lbnRTZXRzKGJpcnRod2VpZ2h0LGVmZmVjdD1jKCd0b3RhbCcsJ2RpcmVjdCcpKQpgYGAKCgoKCgoKCgoKCgoKCgoKClRoaXMgaXMgYW4gW1IgTWFya2Rvd25dKGh0dHA6Ly9ybWFya2Rvd24ucnN0dWRpby5jb20pIE5vdGVib29rLiBXaGVuIHlvdSBleGVjdXRlIGNvZGUgd2l0aGluIHRoZSBub3RlYm9vaywgdGhlIHJlc3VsdHMgYXBwZWFyIGJlbmVhdGggdGhlIGNvZGUuIAoKVHJ5IGV4ZWN1dGluZyB0aGlzIGNodW5rIGJ5IGNsaWNraW5nIHRoZSAqUnVuKiBidXR0b24gd2l0aGluIHRoZSBjaHVuayBvciBieSBwbGFjaW5nIHlvdXIgY3Vyc29yIGluc2lkZSBpdCBhbmQgcHJlc3NpbmcgKkNtZCtTaGlmdCtFbnRlciouIAoKYGBge3J9CnBsb3QoY2FycykKYGBgCgpBZGQgYSBuZXcgY2h1bmsgYnkgY2xpY2tpbmcgdGhlICpJbnNlcnQgQ2h1bmsqIGJ1dHRvbiBvbiB0aGUgdG9vbGJhciBvciBieSBwcmVzc2luZyAqQ21kK09wdGlvbitJKi4KCldoZW4geW91IHNhdmUgdGhlIG5vdGVib29rLCBhbiBIVE1MIGZpbGUgY29udGFpbmluZyB0aGUgY29kZSBhbmQgb3V0cHV0IHdpbGwgYmUgc2F2ZWQgYWxvbmdzaWRlIGl0IChjbGljayB0aGUgKlByZXZpZXcqIGJ1dHRvbiBvciBwcmVzcyAqQ21kK1NoaWZ0K0sqIHRvIHByZXZpZXcgdGhlIEhUTUwgZmlsZSkuIAoKVGhlIHByZXZpZXcgc2hvd3MgeW91IGEgcmVuZGVyZWQgSFRNTCBjb3B5IG9mIHRoZSBjb250ZW50cyBvZiB0aGUgZWRpdG9yLiBDb25zZXF1ZW50bHksIHVubGlrZSAqS25pdCosICpQcmV2aWV3KiBkb2VzIG5vdCBydW4gYW55IFIgY29kZSBjaHVua3MuIEluc3RlYWQsIHRoZSBvdXRwdXQgb2YgdGhlIGNodW5rIHdoZW4gaXQgd2FzIGxhc3QgcnVuIGluIHRoZSBlZGl0b3IgaXMgZGlzcGxheWVkLgoK