Commit 07948be3 authored by Gilles Kratzer's avatar Gilles Kratzer
Browse files

query + vignette

parent 7faaf5ff
Pipeline #1544 passed with stage
in 2 seconds
image: alpine:latest
pages:
stage: deploy
script:
- mkdir public
- mv docs/* public
artifacts:
paths:
- public
only:
- master
\ No newline at end of file
export(mcmc,
query
export(mcmcabn,
query,
plot.mcmcabn
)
importFrom(gRbase, topoSortMAT)
importFrom(stats,rbinom)
importFrom(ggplot2,ggplot)
importFrom(coda,effectiveSize)
import(abn)
import(ggpubr)
import(cowplot)
......@@ -12,4 +14,6 @@ query
#methods for class mcmcabn
S3method(plot, mcmcabn)
S3method(summary, mcmcabn)
S3method(plot, mcmcabn)
\ No newline at end of file
## mcmcabn 0.0.900:
* first release on CRAN
################################################################################
## mcmc.R ---
## mcmcabn.R ---
## Author : Gilles Kratzer
## Document created: 22/10/2018
## Document created: 22/10/2019
## -
################################################################################
......@@ -10,7 +10,7 @@
##
##-------------------------------------------------------------------------
mcmc <- function(score.cache = NULL,
mcmcabn <- function(score.cache = NULL,
score = "mlik",
data.dists = NULL,
max.parents = 1,
......@@ -201,8 +201,10 @@ switch (method.choice, "MC3" = {
alpha = out.alpha,
method = out.method,
rejection = out.rejection,
iterations = mcmc.scheme[1]*mcmc.scheme[2],
thinning = mcmc.scheme[2]
iterations = mcmc.scheme[1]*(mcmc.scheme[2]+1),
thinning = mcmc.scheme[2],
burnin = mcmc.scheme[3],
dist = data.dists
)
class(out) <- "mcmcabn"
......
......@@ -37,8 +37,6 @@ formula.mcmcabn<-function(f, name){
f<-as.character(f)
##tests for consistence ----------------------------------------------------------------------
##start as a formula
if(!grepl('~',f[1],fixed = T)){stop("DAG specifications should start with a ~")}
##transformation name + or | or : or . or name to name_name
if(sum((c("+", "|", ":", ".") %in% unlist(strsplit(name,split = c("")))))!=0){
......@@ -69,7 +67,7 @@ formula.mcmcabn<-function(f, name){
##nothing more than name variable in the dag formula
tmp.test<-strsplits(x = f[[2]],splits = c("+", "|", ":", "."), fixed=TRUE)
if(sum(!(tmp.test %in% name))!=0){stop("DAG formulation contains some variables not in provided names")}
if(sum(!(tmp.test %in% name))!=0){stop("Formula contains some variables not used in the mcmcabn search")}
##End of tests for consistence ----------------------------------------------------------------
##creat the void matrix
......
......@@ -14,11 +14,13 @@ plot.mcmcabn <- function(x,
if(!max.score){
original_plot <- ggplot(data = dta, aes(x = X,y = scores)) +
geom_line(alpha = 0.25) +
geom_hline(yintercept = max.score., linetype="dashed", color = "red")+
geom_point(aes(color=as.factor(method)))+
labs(x = "DAG index", y = "DAG scores",colour="Methods") + theme_pubr() +
scale_color_manual(values = c("#F2C500","#37454B", "#56B4E9"))
geom_line(alpha = 0.5) +
geom_hline(yintercept = max.score., linetype="dashed", color = "red", alpha = 0.8) +
geom_text(aes(0,max.score.,label = round(max.score., digits = 2), vjust = -.5),color="red")+
geom_point(data = dta[dta$method %in% c("REV", "MBR"),],aes(color = factor(method)))+
#geom_point(aes(color=as.factor(method)))+
labs(x = "DAG index", y = "DAG scores",colour="Methods",title = "Trace plot") + theme_pubr() +
scale_color_manual(values = c("#F2C500", "#56B4E9"))
y_density <- axis_canvas(original_plot, axis = "y", coord_flip = TRUE) +
geom_density(data = dta, aes(x=scores,fill = factor(method)), color = NA, alpha = 0.5) +
......@@ -39,10 +41,12 @@ plot.mcmcabn <- function(x,
}
p<-ggplot(data = dta,aes(x = X,y = cummax))+
geom_line() +
geom_hline(yintercept = max.score., linetype="dashed", color = "red", alpha = 0.8) +
geom_text(aes(0,max.score.,label = round(max.score., digits = 2), vjust = -.5),color="red") +
geom_point(data = dta[dta$method %in% c("REV", "MBR"),],aes(color = factor(method)))+
theme_pubr() +
scale_colour_manual(values = c("#F2C500", "#56B4E9")) +
labs(x = "DAG index", y = "DAG scores",color="Methods")
labs(x = "DAG index", y = "DAG scores",color="Methods",title = "Trace plot")
return(plot(p))
invisible()
}
......
###############################################################################
## print.mcmcabn.R ---
## Author : Gilles Kratzer
## Last modified : 05/02/2018
## Last modified : 05/02/2019
## :
###############################################################################
print.varrank <- function(x, digits=5, ...){
out <- as.matrix(round(t(diag(x[[2]])),digits = digits))
if(!is.null(rownames(out))) {
rownames(out)<-c("Scores")
cat("Ordered variables (decreasing importance):\n \n")
print(out, ...)
}else{
print(x[[1]], ...)
}
print.mcmcabn <- function(x, ...){
cat("Posterior Bayesian network score estimated using MCMC:")
cat("Number of Burn in steps: ",(x$burnin),"\n",sep = "")
cat("Number of MCMC steps: ",(x$iterations),"\n",sep = "")
cat("Thinning: ",(x$thinning),"\n\n",sep = "")
invisible(x)
......
################################################################################
## query.R ---
## Author : Gilles Kratzer
## Document created: 13/02/2018
## Document created: 13/02/2019
## -
################################################################################
......@@ -10,8 +10,73 @@
##
##-------------------------------------------------------------------------
query <- function(mcmc = NULL,
formula = NULL,
dist = NULL){
query <- function(mcmcabn = NULL,
formula = NULL){
if(is.null(formula)){
out <- apply(mcmcabn$dags,1:2, mean)
colnames(out)<-rownames(out)<-names(mcmcabn$dist)
return(out)
}else{
f<-as.character(formula)
##start as a formula
if(!grepl('~',f[1],fixed = TRUE)){stop("DAG specifications should start with a ~")}
if(grepl('-',f[2],fixed = TRUE)){
formula <- sapply(strsplit(f[2], "[-]"), function(x)
if(length(x) >1) paste(x[1], paste(x[-1], collapse="+"), sep="-") else x)
f<-strsplit(x = formula,split = "-", fixed=TRUE)
f.1<-paste0("~",f[[1]][1])
f.2<-paste0("~",f[[1]][2])
m.1 <- formula.mcmcabn(f = as.formula(gsub(" ", "", unlist(f.1), fixed = TRUE)),name = names(mcmcabn$dist))
m.2 <- formula.mcmcabn(f = as.formula(gsub(" ", "", unlist(f.2), fixed = TRUE)),name = names(mcmcabn$dist))
n <- length(mcmcabn$scores)
n.var <- length(mcmcabn$dist)
m.array <- array(data = 0,dim = c(n.var,n.var,n))
for(i in 1:n.var){
for(j in 1:n.var){
if(m.1[i,j]==1){m.array[i,j,]<-1}
if(m.2[i,j]==1){m.array[i,j,]<- -1}
}
}
prob.1 <- which(x = m.array==1,arr.ind = TRUE)
prob.2 <- which(x = m.array==-1,arr.ind = TRUE)
res.1 <- apply(matrix(data = mcmcabn$dags[prob.1],ncol = sum(m.1),byrow = TRUE), 1, prod)
res.2 <- apply(matrix(data = mcmcabn$dags[prob.2],ncol = sum(m.2),byrow = TRUE), 1, prod)
out <- sum(res.1*res.2)/n
return(out)
}else{
m <- formula.mcmcabn(f = formula,name = names(mcmcabn$dist))
#creat array
n <- length(mcmcabn$scores)
n.var <- length(dist)
m.array <- array(data = 0,dim = c(n.var,n.var,n))
for(i in 1:n.var){
for(j in 1:n.var){
if(m[i,j]==1){m.array[i,j,]<-1}
}
}
prob <- which(x = m.array==1,arr.ind = TRUE)
out <- sum(apply(matrix(data = mcmcabn$dags[prob],ncol = sum(m),byrow = TRUE), 1, prod))/n
return(out)
}
}
}#eof
......@@ -5,31 +5,27 @@
## :
###############################################################################
summary.mcmcabn <- function(object, ...){
summary.mcmcabn <- function(object, quantiles = c(0.025, 0.25, 0.5, 0.75, 0.975), ...){
cat("Number of MCMC steps: ",length(object$scores),"\n",sep = "")
cat("MCMC summary:\n",sep = "")
cat("Number of Burn in steps: ",(object$burnin),"\n",sep = "")
cat("Number of MCMC steps: ",(object$iterations),"\n",sep = "")
cat("Thinning: ",(object$thinning),"\n\n",sep = "")
cat("Maximum score: ", max(object$scores),"\n",sep = "")
cat("Empirical mean: ", mean(object$scores),"\n",sep = "")
cat("Empirical standard deviation: ", sd(object$scores),"\n",sep = "")
#cat("Standard error of the mean: ", sd(object$scores)/sqrt(object$iterations),"\n\n",sep = "")
if(object$algorithm=="forward") out1 <- as.matrix(round(t(diag(object$distance.m)),digits = digits))
if(object$algorithm=="backward") out1 <- as.matrix(round(t(diag(object$distance.m[dim(object$distance.m)[2]:1,])),digits = digits))
cat("Quantiles of the posterior network score:\n")
out2<-as.matrix(round(object$distance.m,digits = digits))
out2[!is.finite(out2)] <- " "
out2 <- as.data.frame(out2)
rownames(out1)<-c("Scores")
out2<-matrix(data = quantile(x = object$scores,probs = quantiles),nrow = 1,ncol = length(quantiles),dimnames = list("BN score", quantiles))
cat("Number of variables ranked: ",dim(out1)[2],"\n",sep = "")
cat(object[[3]], " search using ", object[[4]]," method \n",sep = "")
cat("(",object[[5]]," scheme) \n \n",sep = "")
if(object[[3]]=="forward") cat("Ordered variables (decreasing importance):\n")
if(object[[3]]=="backward") cat("Ordered variables (increasing importance):\n")
print(out2, ...)
print(out1, ...)
cat("\n ---")
cat("\n \n Matrix of scores: \n")
cat("\n\nAcceptance rate: ", 1-mean(object$rejection),"\n",sep = "")
cat("Sample size adjusted for autocorrelation: ", unname(effectiveSize(mcmc.out$scores)),"\n",sep = "")
print(out2, ...)
}#EOF
title: mcmcabn
url:
authors:
Gilles Kratzer:
href: "https://gilleskratzer.netlify.com/"
navbar:
type: inverse
left:
- icon: fa-home
href: index.html
- icon: fa-newspaper-o
text: "news"
href: news/index.html
- icon: fa-file-code-o
text: "functions"
href: reference/index.html
- icon: fa-gitlab fa-lg
text: "gitlab"
href: https://git.math.uzh.ch/gkratz/mcmcabn
<!-- Generated by pkgdown: do not edit by hand -->
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<title>Articles • mcmcabn</title>
<!-- jquery -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
<!-- Bootstrap -->
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha256-916EbMg70RQy9LHiGkXzG8hSg9EdNy97GazNG/aiY1w=" crossorigin="anonymous" />
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script>
<!-- Font Awesome icons -->
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css" integrity="sha256-eZrrJcwDc/3uDhsdt61sL2oOBY362qM3lon1gyExkL0=" crossorigin="anonymous" />
<!-- clipboard.js -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script>
<!-- sticky kit -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/sticky-kit/1.1.3/sticky-kit.min.js" integrity="sha256-c4Rlo1ZozqTPE2RLuvbusY3+SU1pQaJC0TjuhygMipw=" crossorigin="anonymous"></script>
<!-- pkgdown -->
<link href="../pkgdown.css" rel="stylesheet">
<script src="../pkgdown.js"></script>
<meta property="og:title" content="Articles" />
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
<!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]-->
</head>
<body>
<div class="container template-article-index">
<header>
<div class="navbar navbar-inverse navbar-fixed-top" role="navigation">
<div class="container">
<div class="navbar-header">
<button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false">
<span class="sr-only">Toggle navigation</span>
<span class="icon-bar"></span>
<span class="icon-bar"></span>
<span class="icon-bar"></span>
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">mcmcabn</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.0.0.9000</span>
</span>
</div>
<div id="navbar" class="navbar-collapse collapse">
<ul class="nav navbar-nav">
<li>
<a href="../index.html">
<span class="fa fa-home"></span>
</a>
</li>
<li>
<a href="../news/index.html">
<span class="fa fa-newspaper-o"></span>
news
</a>
</li>
<li>
<a href="../reference/index.html">
<span class="fa fa-file-code-o"></span>
functions
</a>
</li>
<li>
<a href="https://git.math.uzh.ch/gkratz/varrank">
<span class="fa fa-gitlab fa-lg"></span>
gitlab
</a>
</li>
</ul>
<ul class="nav navbar-nav navbar-right">
</ul>
</div><!--/.nav-collapse -->
</div><!--/.container -->
</div><!--/.navbar -->
</header>
<div class="row">
<div class="col-md-9 contents">
<div class="page-header">
<h1>Articles</h1>
</div>
<div class="section ">
<h3>All vignettes</h3>
<p class="section-desc"></p>
<ul>
<li><a href="mcmcabn.html">mcmcabn: a structural MCMC sampler for DAGs learned from observed systemic datasets</a></li>
</ul>
</div>
</div>
</div>
<footer>
<div class="copyright">
<p>Developed by <a href='https://gilleskratzer.netlify.com/'>Gilles Kratzer</a>.</p>
</div>
<div class="pkgdown">
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.3.0.</p>
</div>
</footer>
</div>
</body>
</html>
This diff is collapsed.
<!-- Generated by pkgdown: do not edit by hand -->
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<title>Citation and Authors • mcmcabn</title>
<!-- jquery -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
<!-- Bootstrap -->
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha256-916EbMg70RQy9LHiGkXzG8hSg9EdNy97GazNG/aiY1w=" crossorigin="anonymous" />
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script>
<!-- Font Awesome icons -->
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css" integrity="sha256-eZrrJcwDc/3uDhsdt61sL2oOBY362qM3lon1gyExkL0=" crossorigin="anonymous" />
<!-- clipboard.js -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script>
<!-- sticky kit -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/sticky-kit/1.1.3/sticky-kit.min.js" integrity="sha256-c4Rlo1ZozqTPE2RLuvbusY3+SU1pQaJC0TjuhygMipw=" crossorigin="anonymous"></script>
<!-- pkgdown -->
<link href="pkgdown.css" rel="stylesheet">
<script src="pkgdown.js"></script>
<meta property="og:title" content="Citation and Authors" />
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
<!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]-->
</head>
<body>
<div class="container template-citation-authors">
<header>
<div class="navbar navbar-inverse navbar-fixed-top" role="navigation">
<div class="container">
<div class="navbar-header">
<button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false">
<span class="sr-only">Toggle navigation</span>
<span class="icon-bar"></span>
<span class="icon-bar"></span>
<span class="icon-bar"></span>
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">mcmcabn</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.0.0.9000</span>
</span>
</div>
<div id="navbar" class="navbar-collapse collapse">
<ul class="nav navbar-nav">
<li>
<a href="index.html">
<span class="fa fa-home"></span>
</a>
</li>
<li>
<a href="news/index.html">
<span class="fa fa-newspaper-o"></span>
news
</a>
</li>
<li>
<a href="reference/index.html">
<span class="fa fa-file-code-o"></span>
functions
</a>
</li>
<li>
<a href="https://git.math.uzh.ch/gkratz/varrank">
<span class="fa fa-gitlab fa-lg"></span>
gitlab
</a>
</li>
</ul>
<ul class="nav navbar-nav navbar-right">
</ul>
</div><!--/.nav-collapse -->
</div><!--/.container -->
</div><!--/.navbar -->
</header>
<div class="row">
<div class="contents col-md-9">
<div class="page-header">
<h1>Citation</h1>
</div>
<p>Kratzer G, Furrer R (2018).
&ldquo;Is a single unique Bayesian network enough to accurately represent your data?&rdquo;
<em>arXiv preprint arXiv:1902.06641</em>.
</p>
<pre>@Article{,
title = {Is a single unique Bayesian network enough to accurately represent your data?},
author = {Gilles Kratzer and Reinhard Furrer},
year = {2018},
journal = {arXiv preprint arXiv:1902.06641},
}</pre>
<p>Kratzer G, Furrer R (2019).
<em>mcmcabn: an R package for structural MCMC sampler for DAGs learned from observed systemic datasets</em>.
R package version 0.0.0.9000, <a href="https://CRAN.R-project.org/package=mcmcabn">https://CRAN.R-project.org/package=mcmcabn</a>.
</p>
<pre>@Manual{,
title = {mcmcabn: an R package for structural MCMC sampler for DAGs learned from observed systemic datasets},
author = {Gilles Kratzer and Reinhard Furrer},
year = {2019},
note = {R package version 0.0.0.9000},
url = {https://CRAN.R-project.org/package=mcmcabn},
}</pre>
<div class="page-header">
<h1>Authors</h1>
</div>
<ul class="list-unstyled">
<li>
<p><strong><a href='https://gilleskratzer.netlify.com/'>Gilles Kratzer</a></strong>. Author, maintainer. <a href='https://orcid.org/0000-0002-5929-8935' target='orcid.widget'><img src='https://members.orcid.org/sites/default/files/vector_iD_icon.svg' class='orcid' alt='ORCID' height='16'></a>
</p>
</li>
<li>
<p><strong>Reinhard Furrer</strong>. Contributor. <a href='https://orcid.org/0000-0002-6319-2332' target='orcid.widget'><img src='https://members.orcid.org/sites/default/files/vector_iD_icon.svg' class='orcid' alt='ORCID' height='16'></a>
</p>