inst/doc/knowledge.R

In causalDisco: Tools for Causal Discovery on Observational Data

## -----------------------------------------------------------------------------
#| label: setup
library(causalDisco)


## -----------------------------------------------------------------------------
#| label: required and forbidden knowledge
kn_1 <- knowledge(
  A %-->% c(B, C), # Require edges from A to B and A to C
  B %!-->% C # Forbid edge from B to C
)


## -----------------------------------------------------------------------------
#| label: plot required and forbidden knowledge
plot(kn_1)


## -----------------------------------------------------------------------------
#| label: remove required edge
kn_1_removed <- remove_edge(kn_1, from = A, to = B)
plot(kn_1_removed)


## -----------------------------------------------------------------------------
#| label: dataset required and forbidden knowledge
data(tpc_example)
head(tpc_example)


## -----------------------------------------------------------------------------
#| label: required and forbidden knowledge with data
kn_2 <- knowledge(
  tpc_example,
  child_x1 %-->% youth_x3, # Require edge from child_x1 to youth_x3
  child_x2 %!-->% oldage_x5 # Forbid edge from child_x2 to oldage_x5
)


## -----------------------------------------------------------------------------
#| label: plot required and forbidden knowledge with data
cg <- knowledge_to_caugi(kn_2)$caugi
layout <- caugi::caugi_layout_sugiyama(cg)
layout[6, 2] <- layout[4, 2]

plot(kn_2, layout = layout)


## -----------------------------------------------------------------------------
#| label: required and forbidden knowledge with tidyselect
kn_3 <- knowledge(
  tpc_example,
  starts_with("child") %-->% starts_with("youth"),
  starts_with("oldage") %!-->% starts_with("youth")
)


## -----------------------------------------------------------------------------
#| label: plot required and forbidden knowledge with tidyselect
plot(kn_3)


## -----------------------------------------------------------------------------
#| label: tier knowledge
kn <- knowledge(
  tier(
    1 ~ c(A1, A2),
    2 ~ c(B1, B2),
    3 ~ c(C1, C2)
  )
)

# Same object, since tiers are ordered numerically
kn_same <- knowledge(
  tier(
    1 ~ c(A1, A2),
    3 ~ c(C1, C2),
    2 ~ c(B1, B2)
  )
)

# Functionally equivalent, though not identical
kn_almost <- knowledge(
  tier(
    10 ~ c(A1, A2),
    30 ~ c(C1, C2),
    20 ~ c(B1, B2)
  )
)

# Again functionally equivalent
kn_also_almost <- knowledge(
  tier(
    A ~ c(A1, A2),
    B ~ c(B1, B2),
    C ~ c(C1, C2)
  )
)

# Has a letter, so tiers are ordered by appearance, thus functionally equivalent
kn_mixed <- knowledge(
  tier(
    3 ~ c(A1, A2),
    B ~ c(B1, B2),
    1 ~ c(C1, C2)
  )
)


## -----------------------------------------------------------------------------
#| label: plot tier knowledge
plot(kn)


## -----------------------------------------------------------------------------
#| label: convert tiers to forbidden
kn_converted <- convert_tiers_to_forbidden(kn)
print(kn_converted)
plot(kn_converted)


## -----------------------------------------------------------------------------
#| label: tier knowledge with tidyselect
kn_tier_tidyselect <- knowledge(
  tpc_example,
  tier(
    young ~ starts_with("child") + ends_with(c("3", "4")),
    old ~ starts_with("old")
  )
)
plot(kn_tier_tidyselect)


## -----------------------------------------------------------------------------
#| label: exogenous knowledge
kn_exo_1 <- knowledge(
  tpc_example,
  exogenous("child_x1")
)


## -----------------------------------------------------------------------------
#| label: plot exogenous knowledge
plot(kn_exo_1)


## -----------------------------------------------------------------------------
#| label: exogenous knowledge with tidyselect
kn_exo_2 <- knowledge(
  tpc_example,
  exo(starts_with("child"))
)
plot(kn_exo_2, layout = "bipartite", orientation = "columns")


## -----------------------------------------------------------------------------
#| label: combined knowledge
kn_combined <- knowledge(
  tpc_example,
  tier(
    1 ~ starts_with("child"),
    2 ~ starts_with("youth"),
    3 ~ starts_with("oldage")
  ),
  child_x1 %-->% youth_x3,
  child_x1 %!-->% child_x2
)

plot(kn_combined)


## -----------------------------------------------------------------------------
#| label: causal discovery with tier knowledge
kn <- knowledge(
  tpc_example,
  tier(
    1 ~ starts_with("child"),
    2 ~ starts_with("youth"),
    3 ~ starts_with("oldage")
  )
)

cd_tges <- tges(engine = "causalDisco", score = "tbic")
disco_cd_tges <- disco(data = tpc_example, method = cd_tges, knowledge = kn)


## -----------------------------------------------------------------------------
#| label: plot causal discovery with tier knowledge
plot(disco_cd_tges)


## -----------------------------------------------------------------------------
#| label: bnlearn
data(tpc_example)

kn <- knowledge(
  tpc_example,
  child_x1 %-->% youth_x3
)

bnlearn_pc <- pc(engine = "bnlearn", test = "fisher_z", alpha = 0.05)
output <- disco(data = tpc_example, method = bnlearn_pc, knowledge = kn)


## -----------------------------------------------------------------------------
#| label: plot bnlearn
plot(output)


## -----------------------------------------------------------------------------
#| label: pcalg
data(tpc_example)
kn <- knowledge(
  tpc_example,
  child_x1 %!-->% youth_x3,
  youth_x3 %!-->% child_x1
)
pc_pcalg <- pc(engine = "pcalg", test = "fisher_z", alpha = 0.05)
output <- disco(data = tpc_example, method = pc_pcalg, knowledge = kn)