library(CausalQueries)
library(tidyverse)a hoop test
Examples of learning probative value of a clue from three models, varying in how strong their assumptions are.
model <- make_model("X -> M -> Y")
model |> plot(x_coord = c(1,2,1), y_coord = 3:1) 
givens <- c("X ==1 & Y==1", "X ==1 & Y==1 & M==0", "X ==1 & Y==1 & M==1")
data <- data.frame(X = 0:1, M = 0:1, Y=0:1) |> uncount(10)
model |> query_model("Y[X=1] - Y[X=0]", given = "X ==1 & Y==1", using = c("priors"))
Causal queries generated by query_model (all at population level)
|label |using | mean| sd| cred.low| cred.high|
|:----------------------------------|:------|-----:|-----:|--------:|---------:|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 |priors | 0.268| 0.197| 0.019| 0.739|updated_model <- update_model(model, data, refresh = 0, iter = 3000)
updated_model |> query_model("Y[X=1] - Y[X=0]",
given = givens,
using = c("posteriors"))
Causal queries generated by query_model (all at population level)
|label |using | mean| sd| cred.low| cred.high|
|:-----------------------------------------|:----------|-----:|-----:|--------:|---------:|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 |posteriors | 0.812| 0.118| 0.525| 0.973|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 & M==0 |posteriors | 0.151| 0.173| 0.001| 0.648|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 & M==1 |posteriors | 0.825| 0.113| 0.552| 0.978|updated_model |> grab("posterior_distribution") |> ggplot(aes(M.01, M.10)) + geom_point(alpha = .15) + theme_bw()
model_2 <- make_model("X -> M -> Y <- X")
model_2 |> plot(x_coord = c(1,2,1), y_coord = 3:1) 
model_2 |> query_model("Y[X=1] - Y[X=0]", given = "X ==1 & Y==1", using = c("priors"))
Causal queries generated by query_model (all at population level)
|label |using | mean| sd| cred.low| cred.high|
|:----------------------------------|:------|-----:|-----:|--------:|---------:|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 |priors | 0.503| 0.119| 0.279| 0.738|updated_model_2 <- update_model(model_2, data, refresh = 0, iter = 3000)
updated_model_2 |> query_model("Y[X=1] - Y[X=0]",
given = givens,
using = c("posteriors"))
Causal queries generated by query_model (all at population level)
|label |using | mean| sd| cred.low| cred.high|
|:-----------------------------------------|:----------|-----:|-----:|--------:|---------:|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 |posteriors | 0.706| 0.104| 0.482| 0.881|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 & M==0 |posteriors | 0.617| 0.139| 0.315| 0.861|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 & M==1 |posteriors | 0.714| 0.108| 0.482| 0.897|model_3 <- make_model("X -> M -> Y <- X ; M <->Y")
model_3 |> plot(x_coord = c(1,2,1), y_coord = 3:1) 
model_3 |> query_model("Y[X=1] - Y[X=0]", given = "X ==1 & Y==1", using = c("priors"))
Causal queries generated by query_model (all at population level)
|label |using | mean| sd| cred.low| cred.high|
|:----------------------------------|:------|-----:|-----:|--------:|---------:|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 |priors | 0.501| 0.106| 0.294| 0.7|updated_model_3 <- update_model(model_3, data, refresh = 0, iter = 3000)
updated_model_3 |> query_model("Y[X=1] - Y[X=0]", given = givens,
using = c("posteriors"))
Causal queries generated by query_model (all at population level)
|label |using | mean| sd| cred.low| cred.high|
|:-----------------------------------------|:----------|-----:|-----:|--------:|---------:|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 |posteriors | 0.695| 0.106| 0.462| 0.877|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 & M==0 |posteriors | 0.512| 0.137| 0.249| 0.775|
|Y[X=1] - Y[X=0] given X ==1 & Y==1 & M==1 |posteriors | 0.711| 0.115| 0.453| 0.901|