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