require(pacose)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency(omega,mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- pacose.pls(x,gr)$invcov
omega
omega.hat
require(mvtnorm)
require(igraph)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency(omega,mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- pacose.pls(x,gr)$invcov
omega
omega.hat
require(mvtnorm)
require(igraph)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency(omega,mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- pacose.pls(x,gr,Ncomp=10)$invcov
omega
omega.hat
require(mvtnorm)
require(igraph)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency(omega,mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- pacose.ridge(x,gr,cv.method="HKB")$invcov
omega
omega.hat
pacose.ridge(x,gr,cv.method="HKB")
solve(cov(x))
sigma
solv(omega)
solve(omega)
cov(x)
omega
solve(cov(x))
omega.hat <- pacose.pls(x,gr,verbose=TRUE)$invcov
gr
print(gr)
gr <- graph.adjacency((omega!=0),mode="undirected",diag=FALSE)
gr
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- pacose.pls(x,gr,verbose=TRUE)$invcov
omega
omega.hat
require(mvtnorm)
require(igraph)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency((omega!=0),mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- omegaMVUE(x,gr)
omega
omega.hat
omega
round(omega.hat,3)
omega
round(omega.hat,3)
require(mvtnorm)
require(igraph)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency(omega!=0,mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
omega.hat <- pacose.ridge(x,gr,cv.method="HKB")$invcov
omega
round(omega.hat,3)
require(mvtnorm)
require(igraph)
omega <- matrix(c(1     , -0.477, 0.304, 0.478, -0.591, 0    ,
-0.477, 2     , 0.206, 0    , 0.382 , 0    ,
0.304 , 0.206 , 1    , 0    , 0.181 , 0.242,
0.478 , 0     , 0    , 3    , 0.141 , 0    ,
-0.591, 0.382 , 0.181, 0.141, 1     , 0    ,
0     , 0     , 0.242, 0    , 0     , 2    ),
nrow = 6, ncol = 6)
gr <- graph.adjacency((omega!=0),mode="undirected",diag=FALSE)
x <- rmvnorm(n=100,sigma=solve(omega))
# First estimation with ridge.net, the threshold is arbitrarily
# set to 0.05
pcor0.0 <- ridge.net(x,)
pcor0 <- (pcor > 0.05)+0
# Use iPACOSE to estimate iteratively the partial correlation
# matrix
pcor1 <- ipacose(x=x,pc=pc,method="pacose.ridge",
cutoff=0.05,cv.method="HKB")
# Use iPACOSE to estimate iteratively the partial correlation
# matrix
pcor1 <- ipacose(x=x,pc=pcor0,method="pacose.ridge",
cutoff=0.05,cv.method="HKB")
pcor0.0 <- ridge.net(x,)$pcor
pcor0 <- (pcor > 0.05)+0
pcor0.0 <- ridge.net(x,)$pcor
pcor0 <- (pcor > 0.05)+0
ridge.net
ridge.net(x)$pcor
pcor > 0.05
pcor0 <- (abs(pcor0.0) > 0.05)+0
# Use iPACOSE to estimate iteratively the partial correlation
# matrix
pcor1 <- ipacose(x=x,pc=pcor0,method="pacose.ridge",
cutoff=0.05,cv.method="HKB")
pcor1 <- ipacose(x=x,pc=pcor0,method="pacose.ridge",
cutoff=0.05,gr=NULL,cv.method="HKB")
pcor1
pcor1
pcor1 <- ipacose(x=x,pc=pcor0,method="pacose.ridge",
cutoff=0.05,gr=NULL,cv.method="HKB")
cat("Number of ietrations: ", pcor1$Niter)
invcov2pcor(omega)
pcor1$pcor_it
glmnet
adalasso
?adalasso
?parcor:adalasso
?"parcor:adalasso""
""
?"parcor:adalasso"
??adalasso
######################################
# Real data: dataset from Segal et al. #
######################################
rm(list=ls())
library(pacose)
require(irr)
setwd("/volatile/PACOSE_Final")
x <- read.table("segal_et_al_2001_property.dat",header=TRUE,sep=",")[,-(1:2)]
######################################
# Real data: dataset from Segal et al. #
######################################
rm(list=ls())
library(pacose)
require(irr)
setwd("/volatile/PACOSE_Final")
x <- read.table("segal_et_al_2001_property.dat",header=TRUE,sep=",")[,-(1:2)]
p <- ncol(x) ; n <- nrow(x)
nfold <- 10
# partial correlation matrix estimated with ridge.net
pcor0 <- matrix(NA,nfold,p*(p-1)/2)
# partial correlation matrix re-estimated with iPACOSE
pcor1 <- matrix(NA,nfold,p*(p-1)/2)
folds <- split(sample(1:n), rep(1:nfold, length = n))
pb <- txtProgressBar(style=3)
for (j in 1:nfold) {
cat("Fold", j, ":")
index  <- folds[[j]]
temp <- pcor.ridge.net <- ridge.net(x[-index,],k=k,lambda=10**seq(-3,3,l=20))$pcor
cutoff <- fdrtool(temp[upper.tri(temp)], statistic = "correlation", plot = F,verbose=F)$param[1]
temp[abs(temp) < cutoff] <- 0
pcor[j,] <- temp[upper.tri(temp)]
temp2 <- iterativeGraphEstimation(x=x,pc=pcor.ridge.net,method="ridge.net2",cutoff=cutoff,gr=NULL,k=5)$pcor_it
pacose[j,] <- temp2[upper.tri(temp2)]
setTxtProgressBar(pb, j/nfold)
}
close(pb)
ipacose
######################################
# Real data: dataset from Segal et al. #
######################################
rm(list=ls())
library(pacose)
require(irr)
setwd("/volatile/PACOSE_Final")
x <- read.table("segal_et_al_2001_property.dat",header=TRUE,sep=",")[,-(1:2)]
p <- ncol(x) ; n <- nrow(x)
nfold <- 10
# partial correlation matrix estimated with ridge.net
pcor0 <- matrix(NA,nfold,p*(p-1)/2)
# partial correlation matrix re-estimated with iPACOSE
pcor1 <- matrix(NA,nfold,p*(p-1)/2)
folds <- split(sample(1:n), rep(1:nfold, length = n))
pb <- txtProgressBar(style=3)
for (j in 1:nfold) {
index  <- folds[[j]]
temp <- pcor.ridge.net <- ridge.net(x[-index,],k=k,lambda=10**seq(-3,3,l=20))$pcor
cutoff <- fdrtool(temp[upper.tri(temp)], statistic = "correlation", plot = F,verbose=F)$param[1]
temp[abs(temp) < cutoff] <- 0
pcor0[j,] <- temp[upper.tri(temp)]
temp2 <- ipacose(x=x,pc=pcor.ridge.net,method="pacose.ridge",cutoff=cutoff,gr=NULL,cv.method="HKB")$pcor_it
pcor1[j,] <- temp2[upper.tri(temp2)]
setTxtProgressBar(pb, j/nfold)
}
close(pb)
c(ridge.net = kappam.fleiss(t(pcor  !=0)+0)$value,
iPACOSE   = kappam.fleiss(t(pacose!=0)+0)$value)
??fdrtool
######################################
# Real data: dataset from Segal et al. #
######################################
rm(list=ls())
require(pacose)
require(irr)
require(fdrtool)
setwd("/volatile/PACOSE_Final")
x <- read.table("segal_et_al_2001_property.dat",header=TRUE,sep=",")[,-(1:2)]
p <- ncol(x) ; n <- nrow(x)
nfold <- 10
# partial correlation matrix estimated with ridge.net
pcor0 <- matrix(NA,nfold,p*(p-1)/2)
# partial correlation matrix re-estimated with iPACOSE
pcor1 <- matrix(NA,nfold,p*(p-1)/2)
folds <- split(sample(1:n), rep(1:nfold, length = n))
pb <- txtProgressBar(style=3)
for (j in 1:nfold) {
index  <- folds[[j]]
temp <- pcor.ridge.net <- ridge.net(x[-index,],k=k,lambda=10**seq(-3,3,l=20))$pcor
cutoff <- fdrtool(temp[upper.tri(temp)], statistic = "correlation", plot = F,verbose=F)$param[1]
temp[abs(temp) < cutoff] <- 0
pcor0[j,] <- temp[upper.tri(temp)]
temp2 <- ipacose(x=x,pc=pcor.ridge.net,method="pacose.ridge",cutoff=cutoff,gr=NULL,cv.method="HKB")$pcor_it
pcor1[j,] <- temp2[upper.tri(temp2)]
setTxtProgressBar(pb, j/nfold)
}
close(pb)
c(ridge.net = kappam.fleiss(t(pcor  !=0)+0)$value,
iPACOSE   = kappam.fleiss(t(pacose!=0)+0)$value)
# ridge.net   iPACOSE
# 0.6969134 0.8538269
c(ridge.net = kappam.fleiss(t(pcor0!=0)+0)$value,
iPACOSE   = kappam.fleiss(t(pcor1!=0)+0)$value)
require(PMA)
?PMA
?CCA
require(PMA)
# Generate 3 data sets so that first 25 features are correlated across
# the data sets...
u <- matrix(rnorm(50),ncol=1)
v1 <- matrix(c(rep(.5,25),rep(0,75)),ncol=1)
v2 <- matrix(c(rep(1,25),rep(0,25)),ncol=1)
v3 <- matrix(c(rep(.5,25),rep(0,175)),ncol=1)
x1 <- u%*%t(v1) + matrix(rnorm(50*100),ncol=100)
x2 <- u%*%t(v2) + matrix(rnorm(50*50),ncol=50)
x3 <- u%*%t(v3) + matrix(rnorm(50*200),ncol=200)
xlist <- list(x1, x2, x3)
perm.out <- MultiCCA.permute(xlist, type=c("standard", "ordered",
"standard"))
print(perm.out)
plot(perm.out)
out <- MultiCCA(xlist, type=c("standard", "ordered", "standard"),
penalty=perm.out$bestpenalties, ncomponents=2, ws=perm.out$ws.init)
print(out)
perm.out <- MultiCCA.permute(xlist, type="standard",
penalties=cbind(c(1.1,1.1,1.1),c(2,3,4),c(5,7,10)), ws=perm.out$ws.init)
print(perm.out)
plot(perm.out)
# Making use of the fact that the features are ordered:
out <- MultiCCA(xlist, type="ordered", penalty=.6)
par(mfrow=c(3,1))
PlotCGH(out$ws[[1]], chrom=rep(1,ncol(x1)))
PlotCGH(out$ws[[2]], chrom=rep(2,ncol(x2)))
PlotCGH(out$ws[[3]], chrom=rep(3,ncol(x3)))
?CCA
MultiCCA
?
MultiCCA
