Skip to content

Commit

Permalink
version 2.6-12
Browse files Browse the repository at this point in the history
  • Loading branch information
@mk314199 @cran-robot
mk314199 authored and cran-robot committed Sep 22, 2020
1 parent 629ea2a commit ac97de7
Show file tree
Hide file tree
Showing 6 changed files with 106 additions and 65 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: pcalg
Version: 2.6-11
Date: 2020-08-12
Version: 2.6-12
Date: 2020-09-22
Title: Methods for Graphical Models and Causal Inference
Description: Functions for causal structure
learning and causal inference using graphical models. The main algorithms
Expand Down Expand Up @@ -51,6 +51,6 @@ Encoding: UTF-8
License: GPL (>= 2)
URL: http://pcalg.r-forge.r-project.org/
RoxygenNote: 6.1.1
Packaged: 2020-08-12 12:36:11 UTC; kalischm
Packaged: 2020-09-22 10:30:34 UTC; kalischm
Repository: CRAN
Date/Publication: 2020-08-16 16:00:02 UTC
Date/Publication: 2020-09-22 15:30:03 UTC
10 changes: 5 additions & 5 deletions MD5
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
1c213fc1c5a5ec68e7a5ba9293440dc3 *ChangeLog
ae6a1555639ce7d21db187bdd7482215 *DESCRIPTION
813d0b69690dd00cf195f309fa45f486 *DESCRIPTION
f9c1992369a6565cdfb3fdf5e8d8ebd1 *NAMESPACE
66963591a11cfdb002f5da9070f1500b *R/Aaux.R
83c288d2212114e54bfe624e0edecaaa *R/AllClasses.R
Expand All @@ -13,7 +13,7 @@ aca17dcd6f37ce1136086a8bc285046e *R/isValidGraph.R
b363657f7e2c52dc0f2aa083780fa0f7 *R/jointIda.R
f28cf0b020d974238796d27cfde61bf4 *R/lingamFuns.R
ace998420ba6145fe7fe3c75c5892e66 *R/optAdjSet.R
37f26524d577b5e73c98060c9eb6a057 *R/pcalg.R
a22386351b642ae12f57859393c232a3 *R/pcalg.R
67ec62ad56d7cffaba4bee8f88797136 *R/pcalg2dagitty.R
f84d95dd282c42c32595a27ca98f9a3d *R/possDeAn.R
0db1ba6d57801a4d8fc6cdf996384a4d *R/zzz.R
Expand All @@ -27,15 +27,15 @@ f832779eae511757a99906c7670fc0ad *cleanup
6d96fac64134a91ecf0c244b4679ec0f *data/gmI.rda
385d41164301819ce274673db8743fc9 *data/gmInt.rda
1b3a78b432a5e46b991f5ae5eb4b77f3 *data/gmL.rda
7207fa41fa9372e94d6799af40bd4aa1 *inst/CITATION
da7142ac6e00dbcdef7bfe60f1cd5c66 *inst/CITATION
2f13a20f69511d72dd63f9212308bc80 *inst/NEWS.Rd
4e33425acbef8bf36705d8a75622baa8 *inst/doc/mkVignettes.R
ea230ec4a19260aa9a751cef43965296 *inst/doc/pcalgDoc.R
6581d4416f174d4d6f07a2a2d4b9d3cb *inst/doc/pcalgDoc.Rnw
14ab89a1cd46bbaaa76ee71af0f84bc4 *inst/doc/pcalgDoc.pdf
55d00311cc3e3be430a31b65cec4586a *inst/doc/pcalgDoc.pdf
c7e3ec8f056bcb4ffedf8f38e06e1692 *inst/doc/vignette2018.R
e2e81e4c1014989c895e5764846e7a3e *inst/doc/vignette2018.Rnw
e4cb288353e02f194bd8a1a984ca0192 *inst/doc/vignette2018.pdf
c90fc6647190375520a6f3a897d243ea *inst/doc/vignette2018.pdf
cee0b4475c720bf58c466e1495451b22 *inst/external/N_6_1000.rds
0d84fdc119d76d992b72f9bdbd0e613d *inst/external/gac-pags.rds
e7a2a9117d97986b2ab6afc6b4f77478 *inst/external/test_conservative_pc_data1.rda
Expand Down
151 changes: 96 additions & 55 deletions R/pcalg.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3990,60 +3990,85 @@ minUncovPdPath <- function(p, pag, a,b,c, unfVect, verbose = FALSE)
## - a,b,c : nodes under interest
## - unfVect: vector containing the ambiguous triples
## ----------------------------------------------------------------------
## Author: Diego Colombo, Date: 19 Oct 2011; small changes: Martin Maechler

visited <- rep(FALSE, p)
visited[c(a,b,c)] <- TRUE
## Author: Diego Colombo, Date: 19 Oct 2011; small changes: Martin Maechler, Joris Mooij

## first check whether a,b,c is already a upd path
stopifnot( (pag[a,b] == 1 | pag[a,b] == 2) &
(pag[b,a] == 1 | pag[b,a] == 3) )
min.upd.path <- NA
## find all neighbours of b not visited yet
indD <- which((pag[b,] == 1 | pag[b,] == 2) &
(pag[,b] == 1 | pag[,b] == 3) &
(pag[,a] == 0) & !visited)
if (length(indD) > 0) {
path.list <- updateList(b, indD, NULL)
done <- FALSE
while ((length(path.list) > 0) && (!done)) {
## next element in the queue
mpath <- path.list[[1]]
m <- length(mpath)
d <- mpath[m]
path.list[[1]] <- NULL
visited[d] <- TRUE
if (any(pag[d,c] == 1:2) && any(pag[c,d] == c(1,3))) {
## pd path found
mpath <- c(a, mpath, c)
n <- length(mpath)
## check the path to be uncovered
uncov <- TRUE
for (l in seq_len(n - 2)) {
if (!(pag[mpath[l], mpath[l + 2]] == 0 &&
pag[mpath[l + 2], mpath[l]] == 0)) {

uncov <- FALSE
break ## speed up!
}
}
## if it is uncovered
if (uncov)
if (length(unfVect) == 0 || ## <<- normal version: just save
## conservative version, check the path to be faithful:
faith.check(mpath, unfVect, p)) {
## save the path to be returned
min.upd.path <- mpath
done <- TRUE
done <- FALSE
if( (pag[b,c] == 1 | pag[b,c] == 2) &
(pag[c,b] == 1 | pag[c,b] == 3) &
(pag[c,a] == 0) ) {
mpath = c(a,b,c)
if (length(unfVect) == 0 || ## <<- normal version: just save
## conservative version, check the path to be faithful:
faith.check(mpath, unfVect, p)) {
## save the path to be returned
min.upd.path <- mpath
if( verbose )
cat(' minUncovPdPath: path found: ',mpath,', uncovered: ',TRUE,'\n')
done <- TRUE
}
}

## now check paths of 4 or more nodes of the form <a,b,...,c>
if( !done ) {
visited <- rep(FALSE, p)
visited[c(a,b,c)] <- TRUE
min.upd.path <- NA
## find all neighbours of b not visited yet
indD <- which((pag[b,] == 1 | pag[b,] == 2) &
(pag[,b] == 1 | pag[,b] == 3) &
(pag[,a] == 0) & !visited)
if (length(indD) > 0) {
path.list <- updateList(b, indD, NULL)
done <- FALSE
while ((length(path.list) > 0) && (!done)) {
## next element in the queue
mpath <- path.list[[1]]
m <- length(mpath)
d <- mpath[m]
path.list[[1]] <- NULL
visited[d] <- TRUE
if (any(pag[d,c] == 1:2) && any(pag[c,d] == c(1,3))) {
## pd path found
mpath <- c(a, mpath, c)
n <- length(mpath)
## check the path to be uncovered
uncov <- TRUE
for (l in seq_len(n - 2)) {
if (!(pag[mpath[l], mpath[l + 2]] == 0 &&
pag[mpath[l + 2], mpath[l]] == 0)) {

uncov <- FALSE
break ## speed up!
}
}
}
else {
## d and c are either not connected or connected with a "wrong" edge -----> search iteratively
## find all neighbours of d not visited yet
indR <- which((pag[d,] == 1 | pag[d,] == 2) &
(pag[,d] == 1 | pag[,d] == 3) & !visited)
if (length(indR) > 0) {
## update the queues
path.list <- updateList(mpath, indR, path.list)
if( verbose )
cat(' minUncovPdPath: path found: ',mpath,', uncovered: ',uncov,'\n')
## if it is uncovered
if (uncov)
if (length(unfVect) == 0 || ## <<- normal version: just save
## conservative version, check the path to be faithful:
faith.check(mpath, unfVect, p)) {
## save the path to be returned
min.upd.path <- mpath
done <- TRUE
}
}
}
} ## {while}
else {
## d and c are either not connected or connected with a "wrong" edge -----> search iteratively
## find all neighbours of d not visited yet
indR <- which((pag[d,] == 1 | pag[d,] == 2) &
(pag[,d] == 1 | pag[,d] == 3) & !visited)
if (length(indR) > 0) {
## update the queues
path.list <- updateList(mpath, indR, path.list)
}
}
} ## {while}
}
}
min.upd.path
} ## {minUncovPdPath}
Expand Down Expand Up @@ -5967,6 +5992,7 @@ udag2apag <- function (apag, suffStat, indepTest, alpha, sepset,
b <- indB[1]
indB <- indB[-1]
## find a minimal uncovered pd path from initial (a, b, c) :
## cat("R9: a=", a, ", b=", b, ", c=", c,"\n")
upd <- minUncovPdPath(p, apag, a, b, c,
unfVect = unfVect, verbose = verbose)
## there is a path ---> orient it
Expand Down Expand Up @@ -6030,14 +6056,17 @@ udag2apag <- function (apag, suffStat, indepTest, alpha, sepset,
i1 <- 0
while (i1 < length(indX) && apag[c, a] == 1) {
i1 <- i1 + 1
pos.1 <- indA[i1]
# pos.1 <- indA[i1]
pos.1 <- indX[i1]
indX2 <- setdiff(indX, pos.1)
i2 <- 0
while (i2 < length(indX2) && apag[c, a] == 1) {
i2 <- i2 + 1
pos.2 <- indX2[i2]
## cat("R10.1: a=", a, ", b=", b, ", c=", c,"\n")
tmp1 <- minUncovPdPath(p, apag, a, pos.1, b,
unfVect = unfVect, verbose = verbose)
## cat("R10.2: a=", a, ", b=", b, ", c=", c,"\n")
tmp2 <- minUncovPdPath(p, apag, a, pos.2, d,
unfVect = unfVect, verbose = verbose)
## we found 2 uncovered pd paths
Expand Down Expand Up @@ -6469,7 +6498,13 @@ pag2magAM <- function(amat.pag, x, max.chordal = 10, verbose = FALSE)
## - valid.DAG.mat: adjacency matrix corresponding to the valid MAG
## ----------------------------------------------------------------------
## Author: Diego Colombo, Date: 12 Apr 2013, 14:24;
## Tweaks by Martin Maechler
## Tweaks by Martin Maechler, bug fix by Joris Mooij

## deal with indexing issues
rn<-rownames(amat.pag)
cn<-colnames(amat.pag)
rownames(amat.pag)<-c(1:dim(amat.pag)[1])
colnames(amat.pag)<-c(1:dim(amat.pag)[1])

## 1. step: arrowhead augmentation
## find all o-> edges in the PAG
Expand Down Expand Up @@ -6523,10 +6558,15 @@ pag2magAM <- function(amat.pag, x, max.chordal = 10, verbose = FALSE)
} # if() ..end for

## add directed edges and return "valid.DAG.mat":
valid.DAG.mat + amat.dir
amat.mag <- valid.DAG.mat + amat.dir
rownames(amat.mag)<-rn
colnames(amat.mag)<-cn

## return mag
amat.mag
} ## {pag2magAM}


##' Auxiliary for pag2magAM()
my.SpecialDag <- function (gm, a, X, verbose = FALSE)
{
Expand Down Expand Up @@ -7110,8 +7150,9 @@ fciPlus <- function(suffStat, indepTest, alpha, labels, p, verbose=TRUE)
fit1 <- udag2pdagRelaxed(gInput = skel, orientCollider = FALSE)
fcip <- fciplus.intern(pc.fit = fit1, alpha=alpha, suffStat=suffStat,
indepTest=indepTest, verbose=verbose)
fcip$mat <- (fcip$mat != 0) + 0 # forget orientations in augmented graph: FCI orientation rules seem more accurate
fciplus.amat <- udag2pag(pag = fcip$mat, sepset = fcip$sepset,
orientCollider = FALSE)
orientCollider = TRUE, verbose = verbose)
colnames(fciplus.amat) <- rownames(fciplus.amat) <- labels
new("fciAlgo", amat = fciplus.amat, call = cl, n = integer(0),
max.ord = integer(0),
Expand Down
2 changes: 1 addition & 1 deletion inst/CITATION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ citEntry(entry = "Article",
year = "2012",
volume = "13",
pages = "2409--2464",
url = "http://jmlr.org/papers/v13/hauser12a.html",
url = "https://jmlr.org/papers/v13/hauser12a.html",

textVersion =
paste("Alain Hauser, Peter Buehlmann (2012).",
Expand Down
Binary file modified inst/doc/pcalgDoc.pdf
View file
Binary file not shown.
Binary file modified inst/doc/vignette2018.pdf
View file
Binary file not shown.

0 comments on commit ac97de7

Please sign in to comment.