inst/doc/AMOUNTAIN.R

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)

## -----------------------------------------------------------------------------
library(AMOUNTAIN)
n = 100
k = 20
theta = 0.5
pp <- networkSimulation(n, k, theta)
moduleid <- pp[[3]]
netid <- 1:100
restp <- netid[-moduleid]
groupdesign <- list(moduleid,restp)
names(groupdesign) <- c('module','background')

## -----------------------------------------------------------------------------
require(qgraph)
pg <- qgraph(pp[[1]],groups=groupdesign,legend=TRUE)

## -----------------------------------------------------------------------------
n1 = 100
k1 = 20
theta1 = 0.5
n2 = 80
k2 = 10
theta2 = 0.5
ppresult <- twolayernetworkSimulation(n1,k1,theta1,n2,k2,theta2)
A <- ppresult[[3]]
pp <- ppresult[[1]]
moduleid <- pp[[3]]
netid <- 1:n1
restp <- netid[-moduleid]
pp2 <- ppresult[[2]]
moduleid2 <- pp2[[3]]
netid2 <- 1:n2
restp2 <- netid2[-moduleid2]

library(qgraph)
## labelling the groups
groupdesign <- list(moduleid,restp,(moduleid2+n1),(restp2+n1))
names(groupdesign) <- c('module1','background1','module2',
                     'background2')
twolayernet <- matrix(0,nrow=(n1+n2),ncol=(n1+n2))
twolayernet[1:n1,1:n1] <- pp[[1]]
twolayernet[(n1+1):(n1+n2),(n1+1):(n1+n2)] <- pp2[[1]]
twolayernet[1:n1,(n1+1):(n1+n2)] <- A
twolayernet[(n1+1):(n1+n2),1:n1] <- t(A)

## -----------------------------------------------------------------------------
g <- qgraph(twolayernet,groups=groupdesign,legend=TRUE)

## -----------------------------------------------------------------------------
n = 100
k = 20
theta = 0.5
pp <- networkSimulation(n,k,theta)
moduleid <- pp[[3]]
alphaset <- seq(0.1,0.9,by=0.1)
lambdaset <- 2^seq(-5,5)
## using a grid search to select lambda and alpha
Fscores <- matrix(0,nrow = length(alphaset),ncol = length(lambdaset))
for (j in 1:length(alphaset)) {
	for (k in 1:length(lambdaset)) {
		x <- moduleIdentificationGPFixSS(pp[[1]],pp[[2]],rep(1/n,n),maxiter = 500,
		                                 a=alphaset[j],lambda = lambdaset[k])
		predictedid<-which(x[[2]]!=0)
	    recall <- length(intersect(predictedid,moduleid))/length(moduleid)
		precise <- length(intersect(predictedid,moduleid))/length(predictedid)
		Fscores[j,k] <- 2*precise*recall/(precise+recall)
	}
}

## -----------------------------------------------------------------------------
persp(Fscores,theta = 45,phi = 30,col = "gray",scale = FALSE,xlab = 'alpha',ylab = 'lambda',
      zlab = 'F-score',main = 'Fscores of identified module',box = TRUE)

## -----------------------------------------------------------------------------
## network simulation is the same as before
modres <- moduleIdentificationGPFixSSTwolayer(pp[[1]],pp[[2]],rep(1/n1,n1),pp2[[1]],pp2[[2]],rep(1/n2,n2),A)
predictedid <- which(modres[[1]]!=0)
recall <- length(intersect(predictedid,moduleid))/length(moduleid)
precise <- length(intersect(predictedid,moduleid))/length(predictedid)
F1 <- 2*precise*recall/(precise+recall)
predictedid2 <- which(modres[[2]]!=0)
recall2 <- length(intersect(predictedid2,moduleid2))/length(moduleid2)
precise2 <- length(intersect(predictedid2,moduleid2))/length(predictedid2)
F2 <- 2*precise2*recall2/(precise2+recall2)

## -----------------------------------------------------------------------------
## network simulation
n = 100
k = 20
L = 5
theta = 0.5
cpl <- multilayernetworkSimulation(n,k,theta,L)
listz <- list()
for (i in 1:L){
listz[[i]] <- cpl[[i+2]]
}
moduleid <- cpl[[2]]
## use default parameters here
x <- moduleIdentificationGPFixSSMultilayer(cpl[[1]],listz,rep(1/n,n))
predictedid <- which(x[[2]]!=0)
recall <- length(intersect(predictedid,moduleid))/length(moduleid)
precise <- length(intersect(predictedid,moduleid))/length(predictedid)
Fscore <- (2*precise*recall/(precise+recall))

## ----eval=FALSE---------------------------------------------------------------
#  ## binary search parameter to fix module size to 100~200
#  abegin = 0.01
#  aend = 0.9
#  maxsize = 200
#  minsize = 100
#  for (i in 1:100) {
#  	x <- moduleIdentificationGPFixSS(W,z,rep(1/n,n),a=(abegin+aend)/2,lambda = 0.001,maxiter = 500)
#  	predictedid <- which(x[[2]]!=0)	
#  	if(length(predictedid) > maxsize){
#  		abegin <- (abegin+aend)/2
#  	}else if (length(predictedid) < minsize){
#  		aend <- (abegin+aend)/2
#  	}else
#  		break
#  }

## ----echo=FALSE---------------------------------------------------------------
sessionInfo()

Try the AMOUNTAIN package in your browser

Any scripts or data that you put into this service are public.

AMOUNTAIN documentation built on Nov. 8, 2020, 5:28 p.m.