R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # 1. vdp.mixt: moodien loytyminen eri dimensiolla, naytemaarilla ja komponenteilla
> #   -> ainakin nopea check
> 
> #######################################################################
> 
> # Generate random data from five Gaussians. 
> # Detect modes with vdp-gm. 
> # Plot data points and detected clusters with variance ellipses
> 
> #######################################################################
> 
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> #source("~/Rpackages/netresponse/netresponse/R/detect.responses.R")
> #source("~/Rpackages/netresponse/netresponse/R/internals.R")
> #source("~/Rpackages/netresponse/netresponse/R/vdp.mixt.R")
> #dyn.load("/home/tuli/Rpackages/netresponse/netresponse/src/netresponse.so")
> 
> #########  Generate DATA #############################################
> 
> # Generate Nc components from normal-inverseGamma prior
> 
> set.seed(12346)
> 
> dd <- 3   # Dimensionality of data
> Nc <- 5   # Number of components
> Ns <- 200 # Number of data points
> sd0 <- 3  # component spread
> rgam.shape = 2 # parameters for Gamma distribution 
> rgam.scale = 2 # parameters for Gamma distribution to define precisions
> 
> 
> # Generate means and variances (covariance diagonals) for the components 
> component.means <- matrix(rnorm(Nc*dd, mean = 0, sd = sd0), nrow = Nc, ncol = dd)
> component.vars <- matrix(1/rgamma(Nc*dd, shape = rgam.shape, scale = rgam.scale), 
+ 	                 nrow = Nc, ncol = dd)
> component.sds <- sqrt(component.vars)
> 
> 
> # Size for each component -> sample randomly for each data point from uniform distr.
> # i.e. cluster assignments
> sample2comp <- sample.int(Nc, Ns, replace = TRUE)
> 
> D <- array(NA, dim = c(Ns, dd))
> for (i in 1:Ns)  {
+     # component identity of this sample
+     ci <- sample2comp[[i]]
+     cm <- component.means[ci,]
+     csd <- component.sds[ci,]
+     D[i,] <- rnorm(dd, mean = cm, sd = csd)
+ }
> 
> 
> ######################################################################
> 
> # Fit mixture model
> out <- mixture.model(D, mixture.method = "bic")
> 
> # FIXME rowmeans(qofz) is constant but not 1
> #qofz <- P.r.s(t(D), list(mu = out$mu, sd = out$sd, w = out$w), log = FALSE)
> 
> ############################################################
> 
> # Compare input data and results
> 
> ord.out <- order(out$mu[,1])
> ord.in <- order(component.means[,1])
> 
> means.out <- out$mu[ord.out,]
> means.in <- component.means[ord.in,]
> 
> # Cluster stds and variances
> sds.out <- out$sd[ord.out,]
> sds.in  <- sqrt(component.vars[ord.in,])
> 
> # -----------------------------------------------------------
> 
> vars.out <- sds.out^2
> vars.in <- sds.in^2
> 
> # Check correspondence between input and output
> if (length(means.in) == length(means.out)) {
+    cm <- cor(as.vector(means.in), as.vector(means.out))
+    csd <- cor(as.vector(sds.in), as.vector(sds.out))
+ }
> 
> # Plot results (assuming 2D)
> 
> ran <- range(c(as.vector(means.in - 2*vars.in), 
+                as.vector(means.in + 2*vars.in), 
+ 	       as.vector(means.out + 2*vars.out), 
+ 	       as.vector(means.out - 2*vars.out)))
> 
> plot(D, pch = 20, main = paste("Cor.means:", round(cm,3), "/ Cor.sds:", round(csd,3)), xlim = ran, ylim = ran) 
> for (ci in 1:nrow(means.out))  { add.ellipse(centroid = means.out[ci,], covmat = diag(vars.out[ci,]), col = "red") }
> for (ci in 1:nrow(means.in))  { add.ellipse(centroid = means.in[ci,], covmat = diag(vars.in[ci,]), col = "blue") }
> 
> ######################################################
> 
> #for (ci in 1:nrow(means.out))  {
> #    points(means.out[ci,1], means.out[ci,2], col = "red", pch = 19)
> #    el <- ellipse(matrix(c(vars.out[ci,1],0,0,vars.out[ci,2]),2), centre = means.out[ci,])
> #    lines(el, col = "red") 						  
> #}
> 
> #for (ci in 1:nrow(means.in))  {
> #    points(means.in[ci,1], means.in[ci,2], col = "blue", pch = 19)
> #    el <- ellipse(matrix(c(vars.in[ci,1],0,0,vars.in[ci,2]),2), centre = means.in[ci,])
> #    lines(el, col = "blue") 						  
> #}
> 
> 
> 
> 
> 
> 
> proc.time()
   user  system elapsed 
   2.64    0.21    2.82 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # 1. vdp.mixt: moodien loytyminen eri dimensiolla, naytemaarilla ja komponenteilla
> #   -> ainakin nopea check
> 
> #######################################################################
> 
> # Generate random data from five Gaussians. 
> # Detect modes with vdp-gm. 
> # Plot data points and detected clusters with variance ellipses
> 
> #######################################################################
> 
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> #source("~/Rpackages/netresponse/netresponse/R/detect.responses.R")
> #source("~/Rpackages/netresponse/netresponse/R/internals.R")
> #source("~/Rpackages/netresponse/netresponse/R/vdp.mixt.R")
> #dyn.load("/home/tuli/Rpackages/netresponse/netresponse/src/netresponse.so")
> 
> #########  Generate DATA #############################################
> 
> # Generate Nc components from normal-inverseGamma prior
> 
> set.seed(12346)
> 
> dd <- 3   # Dimensionality of data
> Nc <- 5   # Number of components
> Ns <- 200 # Number of data points
> sd0 <- 3  # component spread
> rgam.shape = 2 # parameters for Gamma distribution 
> rgam.scale = 2 # parameters for Gamma distribution to define precisions
> 
> 
> # Generate means and variances (covariance diagonals) for the components 
> component.means <- matrix(rnorm(Nc*dd, mean = 0, sd = sd0), nrow = Nc, ncol = dd)
> component.vars <- matrix(1/rgamma(Nc*dd, shape = rgam.shape, scale = rgam.scale), 
+ 	                 nrow = Nc, ncol = dd)
> component.sds <- sqrt(component.vars)
> 
> 
> # Size for each component -> sample randomly for each data point from uniform distr.
> # i.e. cluster assignments
> sample2comp <- sample.int(Nc, Ns, replace = TRUE)
> 
> D <- array(NA, dim = c(Ns, dd))
> for (i in 1:Ns)  {
+     # component identity of this sample
+     ci <- sample2comp[[i]]
+     cm <- component.means[ci,]
+     csd <- component.sds[ci,]
+     D[i,] <- rnorm(dd, mean = cm, sd = csd)
+ }
> 
> 
> ######################################################################
> 
> # Fit mixture model
> out <- mixture.model(D, mixture.method = "bic")
> 
> # FIXME rowmeans(qofz) is constant but not 1
> #qofz <- P.r.s(t(D), list(mu = out$mu, sd = out$sd, w = out$w), log = FALSE)
> 
> ############################################################
> 
> # Compare input data and results
> 
> ord.out <- order(out$mu[,1])
> ord.in <- order(component.means[,1])
> 
> means.out <- out$mu[ord.out,]
> means.in <- component.means[ord.in,]
> 
> # Cluster stds and variances
> sds.out <- out$sd[ord.out,]
> sds.in  <- sqrt(component.vars[ord.in,])
> 
> # -----------------------------------------------------------
> 
> vars.out <- sds.out^2
> vars.in <- sds.in^2
> 
> # Check correspondence between input and output
> if (length(means.in) == length(means.out)) {
+    cm <- cor(as.vector(means.in), as.vector(means.out))
+    csd <- cor(as.vector(sds.in), as.vector(sds.out))
+ }
> 
> # Plot results (assuming 2D)
> 
> ran <- range(c(as.vector(means.in - 2*vars.in), 
+                as.vector(means.in + 2*vars.in), 
+ 	       as.vector(means.out + 2*vars.out), 
+ 	       as.vector(means.out - 2*vars.out)))
> 
> plot(D, pch = 20, main = paste("Cor.means:", round(cm,3), "/ Cor.sds:", round(csd,3)), xlim = ran, ylim = ran) 
> for (ci in 1:nrow(means.out))  { add.ellipse(centroid = means.out[ci,], covmat = diag(vars.out[ci,]), col = "red") }
> for (ci in 1:nrow(means.in))  { add.ellipse(centroid = means.in[ci,], covmat = diag(vars.in[ci,]), col = "blue") }
> 
> ######################################################
> 
> #for (ci in 1:nrow(means.out))  {
> #    points(means.out[ci,1], means.out[ci,2], col = "red", pch = 19)
> #    el <- ellipse(matrix(c(vars.out[ci,1],0,0,vars.out[ci,2]),2), centre = means.out[ci,])
> #    lines(el, col = "red") 						  
> #}
> 
> #for (ci in 1:nrow(means.in))  {
> #    points(means.in[ci,1], means.in[ci,2], col = "blue", pch = 19)
> #    el <- ellipse(matrix(c(vars.in[ci,1],0,0,vars.in[ci,2]),2), centre = means.in[ci,])
> #    lines(el, col = "blue") 						  
> #}
> 
> 
> 
> 
> 
> 
> proc.time()
   user  system elapsed 
   3.06    0.20    3.25 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # Test script for the ICMg method
> 
> # Load the package
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> data(osmo) # Load data
> 
> # Set parameters
> C.boost = 1
> alpha = 10
> beta = 0.01
> B.num = 10
> B.size = 10
> S.num = 10  
> S.size = 10
> C = 24
> pm0 = 0
> V0 = 1               
> V = 0.1
> 
> # Run combined ICMg sampler
> res = ICMg.combined.sampler(osmo$ppi, osmo$exp, C, alpha, beta, pm0, V0, V, B.num, B.size, S.num, S.size, C.boost) 
Sampling ICMg2...

nodes:10250links:1711observations:133components:24alpha:10beta:0.01

Sampling200iterationcs

Burnin iterations:100

I: 0

n(z):429431414464415400438431470410460416417436393397418421456433418461408414

m(z):766864857084697460757472536764767875627870816769

I:10

convL:-0.457490682609969n(z):2754385454423893343214692604532854162515212245622022462062401201291371291

convN:-0.0125768875595858m(z):6644918573335975101102544767453414647401745969429563

I:20

convL:-0.410181509902109n(z):2383826025083093593384372554692483882185342188331892092047418161229364297

convN:-0.00308382495869161m(z):58559180733364779698534871464213448381765776479555

I:30

convL:-0.387126698237997n(z):2283965735532963593274222755441963651605352388992342122038395172201364268

convN:-0.00654249784462995m(z):58559481743365769696534971454213347381775576479456

I:40

convL:-0.363487261202813n(z):2473856465552953363924122734842043511994931939812122132010376175183327308

convN:-0.0057725010796156m(z):58559281733367779697534871464213247381775576489455

I:50

convL:-0.374080492726117n(z):26534172360231234336140229951621537917352020710591871951862356160202272299

convN:-0.00383202483950346m(z):58559281773670759695514771464313246381765575479257

I:60

convL:-0.365774671518645n(z):27237569757732333937940731649223437117056524110171901681848350152202299266

convN:-0.00894268573800186m(z):574785717640867797100544871464213049381725676469255

I:70

convL:-0.340031997727195n(z):26328975957931336836044833153222129220658121010671851701776350172221312245

convN:-0.00970134366582505m(z):61459368664589779392534772464112650361706776469557

I:80

convL:-0.37386969062903n(z):29526671262025636141441629857927829519955925210691761661749352169245267257

convN:-0.00349158237731185m(z):62459367674584779491534772464112550361687076509557

I:90

convL:-0.366791054076516n(z):27827476866627937341141531250922925622152123811501751451693386155226285285

convN:-0.00184827809694141m(z):61459367694584789593524772464112550371686876519157

I:100

convL:-0.3605140291112n(z):28327591864028135040439531850221522220949424611621841311698379176225289254

convN:-0.00238652001567851m(z):64469468674484779693524766464112850371716874519255

Sample iterations:100

I:110

convL:-0.356323217917773n(z):25524393663930836138839630946923419222450825911941741361639396176223333258

convN:-0.00176263653339412m(z):62449568704584779893524767464112850371726972518954

I:120

convL:-0.348476133141657n(z):25427697162628036341840033849422019719551927211082001231663417183213292228

convN:-0.00183373034191194m(z):62449767704584769893534767464112750361736873518954

I:130

convL:-0.348707240250013n(z):26128595767929737944937929845925719520147524012122131281628377176212280213

convN:-0.00143172841207282m(z):62449767694584769993534767464112650361746773519054

I:140

convL:-0.340325442938715n(z):27426998963034835145637234245523017419044927411811901301687395178190286210

convN:-0.00559354438391864m(z):624497677044847610091534767464112950361726873518954

I:150

convL:-0.330724953422023n(z):268251102067234035345237831845524518320548028311561661481649394149188253244

convN:-0.00232639059146693m(z):62449767704484769991534767464112850361736973518954

I:160

convL:-0.342645184939564n(z):276256100755234136643937534644326017219948026612411751421632395184209242252

convN:-0.00291047329436611m(z):62449667704484789893524767464112950371736871518954

I:170

convL:-0.33481464589975n(z):27127695061033338043637731645624817421045129212741641401595438192210242215

convN:-0.00103588426845547m(z):62449568704484789991534767464113050361736871518954

I:180

convL:-0.332375258999716n(z):270245106757134937140238131744724716720551426912421551341598425167209273225

convN:-0.00563642121837328m(z):62449568704484759991534767464113050361736872519154

I:190

convL:-0.341619668882249n(z):257267103062135935939440032144327516319745927812421721601594418172210253206

convN:-0.00150577356123341m(z):62449767704484779991534667464112950361736871519154

I:200

convL:-0.337028226486543n(z):25627398660133037340542034942029716519844925112601901311621436172187277203

convN:-0.000991075619073564m(z):62449767714584749991534767464112750361746873519054

DONE

> 
> # Compute component membership probabilities for the data points
> res$comp.memb <- ICMg.get.comp.memberships(osmo$ppi, res)
> 
> # Compute (hard) clustering for nodes
> res$clustering <- apply(res$comp.memb, 2, which.max)
> 
> proc.time()
   user  system elapsed 
   8.20    0.20    8.37 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # Test script for the ICMg method
> 
> # Load the package
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> data(osmo) # Load data
> 
> # Set parameters
> C.boost = 1
> alpha = 10
> beta = 0.01
> B.num = 10
> B.size = 10
> S.num = 10  
> S.size = 10
> C = 24
> pm0 = 0
> V0 = 1               
> V = 0.1
> 
> # Run combined ICMg sampler
> res = ICMg.combined.sampler(osmo$ppi, osmo$exp, C, alpha, beta, pm0, V0, V, B.num, B.size, S.num, S.size, C.boost) 
Sampling ICMg2...

nodes:10250links:1711observations:133components:24alpha:10beta:0.01

Sampling200iterationcs

Burnin iterations:100

I: 0

n(z):431421426428408454435428419432435427438432449421442422419451424401427380

m(z):648085619274737059817855686264747269766373766280

I:10

convL:-0.479146513812565n(z):2493302103734922902532414503396883532209393262237356527261490181315495256

convN:-0.00648531997703775m(z):1129232651008249606846908818493544649732570273412943

I:20

convL:-0.396481448125664n(z):2133341783244892851933064113236132722418402214293398620289469111313584198

convN:-0.00506961342552266m(z):1119235648877455769409181178114515451762474323512943

I:30

convL:-0.36938941869442n(z):1913221852745152541662684073245722182296412212321430693294457135368717219

convN:-0.00694131142808662m(z):1119035639276446065428981180116515452762565363413143

I:40

convL:-0.356387849593813n(z):2302491922664832161922863993074781952170421235337409764300479157375849261

convN:-0.00151705236385029m(z):1089036629379446064438982180115495452782564383313043

I:50

convL:-0.350665359628772n(z):2142242212494421961662314443614171922197402244339412867322410157379904260

convN:-0.000939623954618864m(z):1089036639279446064438980181115495452782565383313043

I:60

convL:-0.344261847366367n(z):2192592302313962321712635173094182082182383215297392845334406156352951284

convN:-0.00409283851788582m(z):1079036619381446065438979181113495352782567383313143

I:70

convL:-0.336346972028393n(z):21125221925241021114725046633036023121363932033413928733184001723661026291

convN:-0.00562637424913225m(z):1089036639379446064438880179117495452782565383313043

I:80

convL:-0.33126867278162n(z):23322622321939522416330344533435018721133521723303879002893781943701167296

convN:-0.00290698303111734m(z):1089036629479446064438882179114495452792564383313143

I:90

convL:-0.328395191697249n(z):23226021724238820917030948327834016720423881903273899272833672033201215304

convN:-0.00414894890411254m(z):1089036639279446064438780180118495452772565383313143

I:100

convL:-0.330630470055076n(z):23124722726736820918330144832431018319493451533313729112973861963711287354

convN:-0.00128536121348413m(z):1119036639376446064438680179118495452782565383313143

Sample iterations:100

I:110

convL:-0.325420774416914n(z):23025122825437021716731047130733118119723961643423649982883611722991216361

convN:-0.00166289364350341m(z):1119036629276446064438681180118495452782565383313143

I:120

convL:-0.320697927505163n(z):269245224219320220159314424293354180194440014033336510492813711843141268380

convN:-0.0022143767531807m(z):1119036639376446064438780180118495452772565383313043

I:130

convL:-0.316282875460195n(z):250261229218334221158317468301322176191537216933038910472733601982521341349

convN:-0.00472962088085727m(z):1089036629379446064438781180117495452772565383313143

I:140

convL:-0.326598725105972n(z):277241227223317230166334476309354174191637914631936710012703821802621338362

convN:-0.00301172135059975m(z):1089036629279446064438681179117495452782565383313244

I:150

convL:-0.314981238458431n(z):244257212260312208160360463255310191193339715432135910472654012122131365351

convN:-0.00447754528011867m(z):1089036638779446066438780182118495452772565383313243

I:160

convL:-0.30825984383434n(z):226254204248297219169362458269346183191337415532137810502863461982381380376

convN:-0.000776510565683771m(z):1099036628879446064438781184117495452772565383313143

I:170

convL:-0.306526298446817n(z):215252199261297203176363438272372178184636416832835411152713301812251468374

convN:-0.00636126153944691m(z):1089036639179446164438680182117495352782565383313143

I:180

convL:-0.304827472776178n(z):200259199275290219163334484291341189187036016734036110682463121792411460402

convN:-0.00300669394666022m(z):1099036628679446066438681183117495452782565383313243

I:190

convL:-0.306544860322741n(z):234255210270284212156320537260361191185835518633035411372453221871811384421

convN:-0.00311642509020666m(z):1089036638879446064438681184118495452782565383213143

I:200

convL:-0.309018036932583n(z):264270203277296211187294498276346183184234817832734611462453121821681433418

convN:-0.00275938766243983m(z):1099036628878446064438781183117495452772565383313244

DONE

> 
> # Compute component membership probabilities for the data points
> res$comp.memb <- ICMg.get.comp.memberships(osmo$ppi, res)
> 
> # Compute (hard) clustering for nodes
> res$clustering <- apply(res$comp.memb, 2, which.max)
> 
> proc.time()
   user  system elapsed 
   7.95    0.29    8.23 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # Validate mixture models
> 
> # Generate random data from five Gaussians. 
> # Detect modes 
> # Plot data points and detected clusters 
> 
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> #fs <- list.files("~/Rpackages/netresponse/netresponse/R/", full.names = TRUE); for (f in fs) {source(f)}; dyn.load("/home/tuli/Rpackages/netresponse/netresponse/src/netresponse.so")
> 
> #########  Generate DATA #######################
> 
> res <- generate.toydata()
> D <- res$data
> component.means <- res$means
> component.sds   <- res$sds
> sample2comp     <- res$sample2comp
> 
> ######################################################################
> 
> par(mfrow = c(2,1))
> 
> for (mm in c("vdp", "bic")) {
+ 
+   # Fit nonparametric Gaussian mixture model
+   #source("~/Rpackages/netresponse/netresponse/R/vdp.mixt.R")
+   out <- mixture.model(D, mixture.method = mm, max.responses = 10, pca.basis = FALSE)
+ 
+   ############################################################
+ 
+   # Compare input data and results
+ 
+   ord.out <- order(out$mu[,1])
+   ord.in <- order(component.means[,1])
+ 
+   means.out <- out$mu[ord.out,]
+   means.in <- component.means[ord.in,]
+ 
+   # Cluster stds and variances
+   sds.out <- out$sd[ord.out,]
+   vars.out <- sds.out^2
+ 
+   sds.in  <- component.sds[ord.in,]
+   vars.in <- sds.in^2
+ 
+   # Check correspondence between input and output
+   if (length(means.in) == length(means.out)) {
+     cm <- cor(as.vector(means.in), as.vector(means.out))
+     csd <- cor(as.vector(sds.in), as.vector(sds.out))
+   }
+ 
+   # Plot results (assuming 2D)
+   ran <- range(c(as.vector(means.in - 2*vars.in), 
+                as.vector(means.in + 2*vars.in), 
+ 	       as.vector(means.out + 2*vars.out), 
+ 	       as.vector(means.out - 2*vars.out)))
+ 
+   real.modes <- sample2comp
+   obs.modes <- apply(out$qofz, 1, which.max)
+ 
+   # plot(D, pch = 20, main = paste(mm, "/ cor.means:", round(cm,6), "/ Cor.sds:", round(csd,6)), xlim = ran, ylim = ran) 
+   plot(D, pch = real.modes, col = obs.modes, main = paste(mm, "/ cor.means:", round(cm,6), "/ Cor.sds:", round(csd,6)), xlim = ran, ylim = ran) 
+   for (ci in 1:nrow(means.out))  { add.ellipse(centroid = means.out[ci,], covmat = diag(vars.out[ci,]), col = "red") }
+   for (ci in 1:nrow(means.in))  { add.ellipse(centroid = means.in[ci,], covmat = diag(vars.in[ci,]), col = "blue") }
+ 
+ }
> 
> 
> proc.time()
   user  system elapsed 
   2.62    0.18    2.81 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # Validate mixture models
> 
> # Generate random data from five Gaussians. 
> # Detect modes 
> # Plot data points and detected clusters 
> 
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> #fs <- list.files("~/Rpackages/netresponse/netresponse/R/", full.names = TRUE); for (f in fs) {source(f)}; dyn.load("/home/tuli/Rpackages/netresponse/netresponse/src/netresponse.so")
> 
> #########  Generate DATA #######################
> 
> res <- generate.toydata()
> D <- res$data
> component.means <- res$means
> component.sds   <- res$sds
> sample2comp     <- res$sample2comp
> 
> ######################################################################
> 
> par(mfrow = c(2,1))
> 
> for (mm in c("vdp", "bic")) {
+ 
+   # Fit nonparametric Gaussian mixture model
+   #source("~/Rpackages/netresponse/netresponse/R/vdp.mixt.R")
+   out <- mixture.model(D, mixture.method = mm, max.responses = 10, pca.basis = FALSE)
+ 
+   ############################################################
+ 
+   # Compare input data and results
+ 
+   ord.out <- order(out$mu[,1])
+   ord.in <- order(component.means[,1])
+ 
+   means.out <- out$mu[ord.out,]
+   means.in <- component.means[ord.in,]
+ 
+   # Cluster stds and variances
+   sds.out <- out$sd[ord.out,]
+   vars.out <- sds.out^2
+ 
+   sds.in  <- component.sds[ord.in,]
+   vars.in <- sds.in^2
+ 
+   # Check correspondence between input and output
+   if (length(means.in) == length(means.out)) {
+     cm <- cor(as.vector(means.in), as.vector(means.out))
+     csd <- cor(as.vector(sds.in), as.vector(sds.out))
+   }
+ 
+   # Plot results (assuming 2D)
+   ran <- range(c(as.vector(means.in - 2*vars.in), 
+                as.vector(means.in + 2*vars.in), 
+ 	       as.vector(means.out + 2*vars.out), 
+ 	       as.vector(means.out - 2*vars.out)))
+ 
+   real.modes <- sample2comp
+   obs.modes <- apply(out$qofz, 1, which.max)
+ 
+   # plot(D, pch = 20, main = paste(mm, "/ cor.means:", round(cm,6), "/ Cor.sds:", round(csd,6)), xlim = ran, ylim = ran) 
+   plot(D, pch = real.modes, col = obs.modes, main = paste(mm, "/ cor.means:", round(cm,6), "/ Cor.sds:", round(csd,6)), xlim = ran, ylim = ran) 
+   for (ci in 1:nrow(means.out))  { add.ellipse(centroid = means.out[ci,], covmat = diag(vars.out[ci,]), col = "red") }
+   for (ci in 1:nrow(means.in))  { add.ellipse(centroid = means.in[ci,], covmat = diag(vars.in[ci,]), col = "blue") }
+ 
+ }
> 
> 
> proc.time()
   user  system elapsed 
   3.45    0.20    3.68 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> # Three MODES
> 
> # set.seed(34884)
> set.seed(3488400)
> 
> Ns <- 200
> Nd <- 2
> 
> D3 <- rbind(matrix(rnorm(Ns*Nd, mean = 0), ncol = Nd), 
+       	    matrix(rnorm(Ns*Nd, mean = 3), ncol = Nd),
+       	    cbind(rnorm(Ns, mean = -3), rnorm(Ns, mean = 3))
+ 	    )
> 
> #X11()
> par(mfrow = c(2,2))
> for (mm in c("vdp", "bic")) {
+   for (pp in c(FALSE, TRUE)) {
+ 
+     # Fit nonparametric Gaussian mixture model
+     out <- mixture.model(D3, mixture.method = mm, pca.basis = pp)
+     plot(D3, col = apply(out$qofz, 1, which.max), main = paste(mm, "/ pca:",  pp)) 
+ 
+   }
+ }
> 
> # VDP is less sensitive than BIC in detecting Gaussian modes (more
> # separation between the clusters needed)
> 
> # pca.basis option is less important for sensitive detection but
> # it will help to avoid overfitting to unimodal features that
> # are not parallel to the axes (unimodal distribution often becomes
> # splitted in two or more clusters in these cases)
> 
> 
> proc.time()
   user  system elapsed 
   7.82    0.40    8.21 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> # Three MODES
> 
> # set.seed(34884)
> set.seed(3488400)
> 
> Ns <- 200
> Nd <- 2
> 
> D3 <- rbind(matrix(rnorm(Ns*Nd, mean = 0), ncol = Nd), 
+       	    matrix(rnorm(Ns*Nd, mean = 3), ncol = Nd),
+       	    cbind(rnorm(Ns, mean = -3), rnorm(Ns, mean = 3))
+ 	    )
> 
> #X11()
> par(mfrow = c(2,2))
> for (mm in c("vdp", "bic")) {
+   for (pp in c(FALSE, TRUE)) {
+ 
+     # Fit nonparametric Gaussian mixture model
+     out <- mixture.model(D3, mixture.method = mm, pca.basis = pp)
+     plot(D3, col = apply(out$qofz, 1, which.max), main = paste(mm, "/ pca:",  pp)) 
+ 
+   }
+ }
> 
> # VDP is less sensitive than BIC in detecting Gaussian modes (more
> # separation between the clusters needed)
> 
> # pca.basis option is less important for sensitive detection but
> # it will help to avoid overfitting to unimodal features that
> # are not parallel to the axes (unimodal distribution often becomes
> # splitted in two or more clusters in these cases)
> 
> 
> proc.time()
   user  system elapsed 
   4.90    0.17    5.06 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> skip <- FALSE
> 
> if (!skip) {
+ 
+ library(netresponse)
+ 
+ # SINGLE MODE
+ 
+ # Produce test data that has full covariance
+ # It is expected that
+ # pca.basis = FALSE splits Gaussian with full covariance into two modes
+ # pca.basis = TRUE should detect just a single mode
+ 
+ Ns <- 200
+ Nd <- 2
+ k <- 1.5
+ 
+ D2 <- matrix(rnorm(Ns*Nd), ncol = Nd) %*% rbind(c(1,k), c(k,1))
+ 
+ par(mfrow = c(2,2))
+ for (mm in c("vdp", "bic")) {
+   for (pp in c(FALSE, TRUE)) {
+ 
+     # Fit nonparametric Gaussian mixture model
+     out <- mixture.model(D2, mixture.method = mm, pca.basis = pp)
+     plot(D2, col = apply(out$qofz, 1, which.max), main = paste("mm:" , mm, "/ pp:",  pp)) 
+ 
+   }
+ }
+ 
+ }
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> proc.time()
   user  system elapsed 
   2.93    0.29    3.21 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> skip <- FALSE
> 
> if (!skip) {
+ 
+ library(netresponse)
+ 
+ # SINGLE MODE
+ 
+ # Produce test data that has full covariance
+ # It is expected that
+ # pca.basis = FALSE splits Gaussian with full covariance into two modes
+ # pca.basis = TRUE should detect just a single mode
+ 
+ Ns <- 200
+ Nd <- 2
+ k <- 1.5
+ 
+ D2 <- matrix(rnorm(Ns*Nd), ncol = Nd) %*% rbind(c(1,k), c(k,1))
+ 
+ par(mfrow = c(2,2))
+ for (mm in c("vdp", "bic")) {
+   for (pp in c(FALSE, TRUE)) {
+ 
+     # Fit nonparametric Gaussian mixture model
+     out <- mixture.model(D2, mixture.method = mm, pca.basis = pp)
+     plot(D2, col = apply(out$qofz, 1, which.max), main = paste("mm:" , mm, "/ pp:",  pp)) 
+ 
+   }
+ }
+ 
+ }
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> 
> proc.time()
   user  system elapsed 
   3.84    0.26    4.09 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> # Play with different options and check their effect on  running times for bic and vdp 
> 
> skip <- TRUE
> 
> if (!skip) {
+ 
+   Ns <- 100
+   Nd <- 2
+ 
+   set.seed(3488400)
+ 
+   D <- cbind(
+ 
+      	rbind(matrix(rnorm(Ns*Nd, mean = 0), ncol = Nd), 
+        	      matrix(rnorm(Ns*Nd, mean = 2), ncol = Nd),
+       	      cbind(rnorm(Ns, mean = -1), rnorm(Ns, mean = 3))
+  	    ), 
+ 
+      	rbind(matrix(rnorm(Ns*Nd, mean = 0), ncol = Nd), 
+        	      matrix(rnorm(Ns*Nd, mean = 2), ncol = Nd),
+       	      cbind(rnorm(Ns, mean = -1), rnorm(Ns, mean = 3))
+  	    )
+ 	    )
+ 
+   rownames(D) <- paste("R", 1:nrow(D), sep = "-")
+   colnames(D) <- paste("C", 1:ncol(D), sep = "-")
+ 
+   ts <- c()
+   for (mm in c("bic", "vdp")) {
+ 
+ 
+     # NOTE: no PCA basis needed with mixture.method = "bic"
+     tt <- system.time(detect.responses(D, verbose = TRUE, max.responses = 5, 
+ 	   		       mixture.method = mm, information.criterion = "BIC", 
+ 			       merging.threshold = 0, bic.threshold = 0, pca.basis = TRUE))
+ 
+     print(paste(mm, ":", round(tt[["elapsed"]], 3)))
+     ts[[mm]] <- tt[["elapsed"]]
+   }
+ 
+    print(paste(names(ts)[[1]], "/", names(ts)[[2]], ": ", round(ts[[1]]/ts[[2]], 3)))
+ 
+ }
> 
> # -> VDP is much faster when sample sizes increase 
> # 1000 samples -> 25-fold speedup with VDP
> 
> 
> 
> proc.time()
   user  system elapsed 
   0.18    0.03    0.20 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> # Play with different options and check their effect on  running times for bic and vdp 
> 
> skip <- TRUE
> 
> if (!skip) {
+ 
+   Ns <- 100
+   Nd <- 2
+ 
+   set.seed(3488400)
+ 
+   D <- cbind(
+ 
+      	rbind(matrix(rnorm(Ns*Nd, mean = 0), ncol = Nd), 
+        	      matrix(rnorm(Ns*Nd, mean = 2), ncol = Nd),
+       	      cbind(rnorm(Ns, mean = -1), rnorm(Ns, mean = 3))
+  	    ), 
+ 
+      	rbind(matrix(rnorm(Ns*Nd, mean = 0), ncol = Nd), 
+        	      matrix(rnorm(Ns*Nd, mean = 2), ncol = Nd),
+       	      cbind(rnorm(Ns, mean = -1), rnorm(Ns, mean = 3))
+  	    )
+ 	    )
+ 
+   rownames(D) <- paste("R", 1:nrow(D), sep = "-")
+   colnames(D) <- paste("C", 1:ncol(D), sep = "-")
+ 
+   ts <- c()
+   for (mm in c("bic", "vdp")) {
+ 
+ 
+     # NOTE: no PCA basis needed with mixture.method = "bic"
+     tt <- system.time(detect.responses(D, verbose = TRUE, max.responses = 5, 
+ 	   		       mixture.method = mm, information.criterion = "BIC", 
+ 			       merging.threshold = 0, bic.threshold = 0, pca.basis = TRUE))
+ 
+     print(paste(mm, ":", round(tt[["elapsed"]], 3)))
+     ts[[mm]] <- tt[["elapsed"]]
+   }
+ 
+    print(paste(names(ts)[[1]], "/", names(ts)[[2]], ": ", round(ts[[1]]/ts[[2]], 3)))
+ 
+ }
> 
> # -> VDP is much faster when sample sizes increase 
> # 1000 samples -> 25-fold speedup with VDP
> 
> 
> 
> proc.time()
   user  system elapsed 
   0.25    0.03    0.26 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # Generate Nc components from normal-inverseGamma prior
> 
> set.seed(12346)
> 
> Ns <- 300
> Nd <- 2
> 
> # Isotropic cloud
> D1 <- matrix(rnorm(Ns*Nd), ncol = Nd) 
> 
> # Single diagonal mode
> D2 <- matrix(rnorm(Ns*Nd), ncol = Nd) %*% rbind(c(1,2), c(2,1)) 
> 
> # Two isotropic modes
> D3 <- rbind(matrix(rnorm(Ns/2*Nd), ncol = Nd), matrix(rnorm(Ns/2*Nd, mean = 3), ncol = Nd))
> D <- cbind(D1, D2, D3)
> 
> colnames(D) <- paste("Feature-",  1:ncol(D), sep = "")
> rownames(D) <- paste("Sample-", 1:nrow(D), sep = "")
> 
> 
> proc.time()
   user  system elapsed 
   0.15    0.10    0.25 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # Generate Nc components from normal-inverseGamma prior
> 
> set.seed(12346)
> 
> Ns <- 300
> Nd <- 2
> 
> # Isotropic cloud
> D1 <- matrix(rnorm(Ns*Nd), ncol = Nd) 
> 
> # Single diagonal mode
> D2 <- matrix(rnorm(Ns*Nd), ncol = Nd) %*% rbind(c(1,2), c(2,1)) 
> 
> # Two isotropic modes
> D3 <- rbind(matrix(rnorm(Ns/2*Nd), ncol = Nd), matrix(rnorm(Ns/2*Nd, mean = 3), ncol = Nd))
> D <- cbind(D1, D2, D3)
> 
> colnames(D) <- paste("Feature-",  1:ncol(D), sep = "")
> rownames(D) <- paste("Sample-", 1:nrow(D), sep = "")
> 
> 
> proc.time()
   user  system elapsed 
   0.15    0.03    0.17 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> skip <- FALSE
> 
> if (!skip) {
+ 
+ # 2. netresponse test
+ # test later with varying parameters
+ 
+ # Load the package
+ library(netresponse)
+ #load("../data/toydata.rda")
+ fs <- list.files("../R/", full.names = TRUE); for (f in fs) {source(f)};
+ 
+ data(toydata)
+ 
+ D <- toydata$emat
+ netw <- toydata$netw
+ 
+ # The toy data is random data with 10 features (genes). 
+ # The features 
+ rf <- c(4, 5, 6)
+ #form a subnetwork with coherent responses
+ # with means 
+ r1 <- c(0, 3, 0)
+ r2 <- c(-5, 0, 2)
+ r3 <- c(5, -3, -3)
+ mu.real <- rbind(r1, r2, r3)
+ # real weights
+ w.real <- c(70, 70, 60)/200
+ # and unit variances
+ rv <- 1
+ 
+ # Fit the model
+ #res <- detect.responses(D, netw, verbose = TRUE, mc.cores = 2)
+ #res <- detect.responses(D, netw, verbose = TRUE, max.responses = 4)
+ 
+ res <- detect.responses(D, netw, verbose = TRUE, max.responses = 3, mixture.method = "bic", information.criterion = "BIC", merging.threshold = 1, bic.threshold = 10, pca.basis = FALSE)
+ 
+ print("OK")
+ 
+ # Subnets (each is a list of nodes)
+ subnets <- get.subnets(res)
+ 
+ # the correct subnet is retrieved in subnet number 2:
+ #> subnet[[2]]
+ #[1] "feat4" "feat5" "feat6"
+ 
+ # how about responses
+ # Retrieve model for the subnetwork with lowest cost function value
+ # means, standard devations and weights for the components
+ if (!is.null(subnets)) {
+ m <- get.model.parameters(res, subnet.id = "Subnet-2")
+ 
+ # order retrieved and real response means by the first feature 
+ # (to ensure responses are listed in the same order)
+ # and compare deviation from correct solution
+ ord.obs <- order(m$mu[,1])
+ ord.real <- order(mu.real[,1])
+ 
+ print(paste("Correlation between real and observed responses:", cor(as.vector(m$mu[ord.obs,]), as.vector(mu.real[ord.real,]))))
+ 
+ # all real variances are 1, compare to observed ones
+ print(paste("Maximum deviation from real variances: ", max(abs(rv - range(m$sd))/rv)))
+ 
+ # weights deviate somewhat, this is likely due to relatively small sample size
+ #print("Maximum deviation from real weights: ")
+ #print( (w.real[ord.real] - m$w[ord.obs])/w.real[ord.real])
+ 
+ print("estimated and real mean matrices")
+ print(m$mu[ord.obs,])
+ print(mu.real[ord.real,])
+ 
+ }
+ 
+ }
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
convert the network into edge matrix
removing self-links
matching the features between network and datamatrix
Filter the network to only keep the edges with highest mutual information
1 / 8
2 / 8
3 / 8
4 / 8
5 / 8
6 / 8
7 / 8
8 / 8
Compute cost for each variable
Computing model for node 1 / 10
Computing model for node 2 / 10
Computing model for node 3 / 10
Computing model for node 4 / 10
Computing model for node 5 / 10
Computing model for node 6 / 10
Computing model for node 7 / 10
Computing model for node 8 / 10
Computing model for node 9 / 10
Computing model for node 10 / 10
independent models done
Computing delta values for edge  1 / 29 

Computing delta values for edge  2 / 29 

Computing delta values for edge  3 / 29 

Computing delta values for edge  4 / 29 

Computing delta values for edge  5 / 29 

Computing delta values for edge  6 / 29 

Computing delta values for edge  7 / 29 

Computing delta values for edge  8 / 29 

Computing delta values for edge  9 / 29 

Computing delta values for edge  10 / 29 

Computing delta values for edge  11 / 29 

Computing delta values for edge  12 / 29 

Computing delta values for edge  13 / 29 

Computing delta values for edge  14 / 29 

Computing delta values for edge  15 / 29 

Computing delta values for edge  16 / 29 

Computing delta values for edge  17 / 29 

Computing delta values for edge  18 / 29 

Computing delta values for edge  19 / 29 

Computing delta values for edge  20 / 29 

Computing delta values for edge  21 / 29 

Computing delta values for edge  22 / 29 

Computing delta values for edge  23 / 29 

Computing delta values for edge  24 / 29 

Computing delta values for edge  25 / 29 

Computing delta values for edge  26 / 29 

Computing delta values for edge  27 / 29 

Computing delta values for edge  28 / 29 

Computing delta values for edge  29 / 29 

Combining groups,  10  group(s) left...

Combining groups,  9  group(s) left...

Combining groups,  8  group(s) left...

Combining groups,  7  group(s) left...

Combining groups,  6  group(s) left...

Combining groups,  5  group(s) left...

Combining groups,  4  group(s) left...

[1] "OK"
[1] "Correlation between real and observed responses: 0.999117848017521"
[1] "Maximum deviation from real variances:  0.0391530538149302"
[1] "estimated and real mean matrices"
           [,1]       [,2]       [,3]
[1,] -4.9334982 -0.1575946  2.1613225
[2,] -0.1299285  3.0047767 -0.1841669
[3,]  5.0738471 -2.9334877 -3.2217492
   [,1] [,2] [,3]
r2   -5    0    2
r1    0    3    0
r3    5   -3   -3
> 
> proc.time()
   user  system elapsed 
  46.00    0.29   46.39 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> skip <- FALSE
> 
> if (!skip) {
+ 
+ # 2. netresponse test
+ # test later with varying parameters
+ 
+ # Load the package
+ library(netresponse)
+ #load("../data/toydata.rda")
+ fs <- list.files("../R/", full.names = TRUE); for (f in fs) {source(f)};
+ 
+ data(toydata)
+ 
+ D <- toydata$emat
+ netw <- toydata$netw
+ 
+ # The toy data is random data with 10 features (genes). 
+ # The features 
+ rf <- c(4, 5, 6)
+ #form a subnetwork with coherent responses
+ # with means 
+ r1 <- c(0, 3, 0)
+ r2 <- c(-5, 0, 2)
+ r3 <- c(5, -3, -3)
+ mu.real <- rbind(r1, r2, r3)
+ # real weights
+ w.real <- c(70, 70, 60)/200
+ # and unit variances
+ rv <- 1
+ 
+ # Fit the model
+ #res <- detect.responses(D, netw, verbose = TRUE, mc.cores = 2)
+ #res <- detect.responses(D, netw, verbose = TRUE, max.responses = 4)
+ 
+ res <- detect.responses(D, netw, verbose = TRUE, max.responses = 3, mixture.method = "bic", information.criterion = "BIC", merging.threshold = 1, bic.threshold = 10, pca.basis = FALSE)
+ 
+ print("OK")
+ 
+ # Subnets (each is a list of nodes)
+ subnets <- get.subnets(res)
+ 
+ # the correct subnet is retrieved in subnet number 2:
+ #> subnet[[2]]
+ #[1] "feat4" "feat5" "feat6"
+ 
+ # how about responses
+ # Retrieve model for the subnetwork with lowest cost function value
+ # means, standard devations and weights for the components
+ if (!is.null(subnets)) {
+ m <- get.model.parameters(res, subnet.id = "Subnet-2")
+ 
+ # order retrieved and real response means by the first feature 
+ # (to ensure responses are listed in the same order)
+ # and compare deviation from correct solution
+ ord.obs <- order(m$mu[,1])
+ ord.real <- order(mu.real[,1])
+ 
+ print(paste("Correlation between real and observed responses:", cor(as.vector(m$mu[ord.obs,]), as.vector(mu.real[ord.real,]))))
+ 
+ # all real variances are 1, compare to observed ones
+ print(paste("Maximum deviation from real variances: ", max(abs(rv - range(m$sd))/rv)))
+ 
+ # weights deviate somewhat, this is likely due to relatively small sample size
+ #print("Maximum deviation from real weights: ")
+ #print( (w.real[ord.real] - m$w[ord.obs])/w.real[ord.real])
+ 
+ print("estimated and real mean matrices")
+ print(m$mu[ord.obs,])
+ print(mu.real[ord.real,])
+ 
+ }
+ 
+ }
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
convert the network into edge matrix
removing self-links
matching the features between network and datamatrix
Filter the network to only keep the edges with highest mutual information
1 / 8
2 / 8
3 / 8
4 / 8
5 / 8
6 / 8
7 / 8
8 / 8
Compute cost for each variable
Computing model for node 1 / 10
Computing model for node 2 / 10
Computing model for node 3 / 10
Computing model for node 4 / 10
Computing model for node 5 / 10
Computing model for node 6 / 10
Computing model for node 7 / 10
Computing model for node 8 / 10
Computing model for node 9 / 10
Computing model for node 10 / 10
independent models done
Computing delta values for edge  1 / 29 

Computing delta values for edge  2 / 29 

Computing delta values for edge  3 / 29 

Computing delta values for edge  4 / 29 

Computing delta values for edge  5 / 29 

Computing delta values for edge  6 / 29 

Computing delta values for edge  7 / 29 

Computing delta values for edge  8 / 29 

Computing delta values for edge  9 / 29 

Computing delta values for edge  10 / 29 

Computing delta values for edge  11 / 29 

Computing delta values for edge  12 / 29 

Computing delta values for edge  13 / 29 

Computing delta values for edge  14 / 29 

Computing delta values for edge  15 / 29 

Computing delta values for edge  16 / 29 

Computing delta values for edge  17 / 29 

Computing delta values for edge  18 / 29 

Computing delta values for edge  19 / 29 

Computing delta values for edge  20 / 29 

Computing delta values for edge  21 / 29 

Computing delta values for edge  22 / 29 

Computing delta values for edge  23 / 29 

Computing delta values for edge  24 / 29 

Computing delta values for edge  25 / 29 

Computing delta values for edge  26 / 29 

Computing delta values for edge  27 / 29 

Computing delta values for edge  28 / 29 

Computing delta values for edge  29 / 29 

Combining groups,  10  group(s) left...

Combining groups,  9  group(s) left...

Combining groups,  8  group(s) left...

Combining groups,  7  group(s) left...

Combining groups,  6  group(s) left...

Combining groups,  5  group(s) left...

Combining groups,  4  group(s) left...

[1] "OK"
[1] "Correlation between real and observed responses: 0.999117848017521"
[1] "Maximum deviation from real variances:  0.0391530538149302"
[1] "estimated and real mean matrices"
           [,1]       [,2]       [,3]
[1,] -4.9334982 -0.1575946  2.1613225
[2,] -0.1299285  3.0047767 -0.1841669
[3,]  5.0738471 -2.9334877 -3.2217492
   [,1] [,2] [,3]
r2   -5    0    2
r1    0    3    0
r3    5   -3   -3
> 
> proc.time()
   user  system elapsed 
  45.60    0.28   45.89 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> skip <- FALSE
> 
> if (!skip) {
+ # Visualization
+ 
+ library(netresponse)
+ 
+ #fs <- list.files("~/Rpackages/netresponse/netresponse/R/", full.names = T); for (f in fs) {source(f)}
+ 
+ source("toydata2.R")
+ 
+ # --------------------------------------------------------------------
+ 
+ set.seed(4243)
+ mixture.method <- "bic"
+ 
+ # --------------------------------------------------------------------
+ 
+ res <- detect.responses(D, verbose = TRUE, max.responses = 10, 
+ 	   		       mixture.method = mixture.method, information.criterion = "BIC", 
+ 			       merging.threshold = 1, bic.threshold = 10, pca.basis = FALSE)
+ 
+ res.pca <- detect.responses(D, verbose = TRUE, max.responses = 10, mixture.method = mixture.method, information.criterion = "BIC", merging.threshold = 1, bic.threshold = 10, pca.basis = TRUE)
+ 
+ # --------------------------------------------------------------------
+ 
+ k <- 1
+ 
+ # Incorrect VDP: two modes detected
+ # Correct BIC: single mode detected
+ subnet.id <- names(get.subnets(res))[[k]]
+ 
+ # Correct: single mode detected (VDP & BIC)
+ subnet.id.pca <- names(get.subnets(res.pca))[[k]]
+ 
+ # --------------------------------------------------------------------------------------------------
+ 
+ vis1 <- plot_responses(res, subnet.id, plot_mode = "pca", main = paste("NoPCA; NoDM"))
+ vis2 <- plot_responses(res, subnet.id, plot_mode = "pca", datamatrix = D, main = "NoPCA, DM")
+ vis3 <- plot_responses(res.pca, subnet.id.pca, plot_mode = "pca", main = "PCA, NoDM")
+ vis4 <- plot_responses(res.pca, subnet.id.pca, plot_mode = "pca", datamatrix = D, main = "PCA, DM")
+ 
+ # With original data: VDP overlearns; BIC works; with full covariance data 
+ # With PCA basis: modes detected ok with both VDP and BIC.
+ 
+ # ------------------------------------------------------------------------
+ 
+ # TODO
+ # pca.plot(res, subnet.id)
+ # plot_subnet(res, subnet.id) 
+ }
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
convert the network into edge matrix
removing self-links
matching the features between network and datamatrix
Filter the network to only keep the edges with highest mutual information
1 / 5
2 / 5
3 / 5
4 / 5
5 / 5
Compute cost for each variable
Computing model for node 1 / 6
Computing model for node 2 / 6
Computing model for node 3 / 6
Computing model for node 4 / 6
Computing model for node 5 / 6
Computing model for node 6 / 6
independent models done
Computing delta values for edge  1 / 15 

Computing delta values for edge  2 / 15 

Computing delta values for edge  3 / 15 

Computing delta values for edge  4 / 15 

Computing delta values for edge  5 / 15 

Computing delta values for edge  6 / 15 

Computing delta values for edge  7 / 15 

Computing delta values for edge  8 / 15 

Computing delta values for edge  9 / 15 

Computing delta values for edge  10 / 15 

Computing delta values for edge  11 / 15 

Computing delta values for edge  12 / 15 

Computing delta values for edge  13 / 15 

Computing delta values for edge  14 / 15 

Computing delta values for edge  15 / 15 

Combining groups,  6  group(s) left...

Combining groups,  5  group(s) left...

Combining groups,  4  group(s) left...

Combining groups,  3  group(s) left...

convert the network into edge matrix
removing self-links
matching the features between network and datamatrix
Filter the network to only keep the edges with highest mutual information
1 / 5
2 / 5
3 / 5
4 / 5
5 / 5
Compute cost for each variable
Computing model for node 1 / 6
Computing model for node 2 / 6
Computing model for node 3 / 6
Computing model for node 4 / 6
Computing model for node 5 / 6
Computing model for node 6 / 6
independent models done
Computing delta values for edge  1 / 15 

Computing delta values for edge  2 / 15 

Computing delta values for edge  3 / 15 

Computing delta values for edge  4 / 15 

Computing delta values for edge  5 / 15 

Computing delta values for edge  6 / 15 

Computing delta values for edge  7 / 15 

Computing delta values for edge  8 / 15 

Computing delta values for edge  9 / 15 

Computing delta values for edge  10 / 15 

Computing delta values for edge  11 / 15 

Computing delta values for edge  12 / 15 

Computing delta values for edge  13 / 15 

Computing delta values for edge  14 / 15 

Computing delta values for edge  15 / 15 

Combining groups,  6  group(s) left...

Combining groups,  5  group(s) left...

Combining groups,  4  group(s) left...

Combining groups,  3  group(s) left...

Warning messages:
1: In check.network(network, datamatrix, verbose = verbose) :
  No network provided in function call: assuming fully connected nodes.
2: In check.network(network, datamatrix, verbose = verbose) :
  No network provided in function call: assuming fully connected nodes.
> 
> proc.time()
   user  system elapsed 
  31.21    0.29   31.50 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> skip <- FALSE
> 
> if (!skip) {
+ # Visualization
+ 
+ library(netresponse)
+ 
+ #fs <- list.files("~/Rpackages/netresponse/netresponse/R/", full.names = T); for (f in fs) {source(f)}
+ 
+ source("toydata2.R")
+ 
+ # --------------------------------------------------------------------
+ 
+ set.seed(4243)
+ mixture.method <- "bic"
+ 
+ # --------------------------------------------------------------------
+ 
+ res <- detect.responses(D, verbose = TRUE, max.responses = 10, 
+ 	   		       mixture.method = mixture.method, information.criterion = "BIC", 
+ 			       merging.threshold = 1, bic.threshold = 10, pca.basis = FALSE)
+ 
+ res.pca <- detect.responses(D, verbose = TRUE, max.responses = 10, mixture.method = mixture.method, information.criterion = "BIC", merging.threshold = 1, bic.threshold = 10, pca.basis = TRUE)
+ 
+ # --------------------------------------------------------------------
+ 
+ k <- 1
+ 
+ # Incorrect VDP: two modes detected
+ # Correct BIC: single mode detected
+ subnet.id <- names(get.subnets(res))[[k]]
+ 
+ # Correct: single mode detected (VDP & BIC)
+ subnet.id.pca <- names(get.subnets(res.pca))[[k]]
+ 
+ # --------------------------------------------------------------------------------------------------
+ 
+ vis1 <- plot_responses(res, subnet.id, plot_mode = "pca", main = paste("NoPCA; NoDM"))
+ vis2 <- plot_responses(res, subnet.id, plot_mode = "pca", datamatrix = D, main = "NoPCA, DM")
+ vis3 <- plot_responses(res.pca, subnet.id.pca, plot_mode = "pca", main = "PCA, NoDM")
+ vis4 <- plot_responses(res.pca, subnet.id.pca, plot_mode = "pca", datamatrix = D, main = "PCA, DM")
+ 
+ # With original data: VDP overlearns; BIC works; with full covariance data 
+ # With PCA basis: modes detected ok with both VDP and BIC.
+ 
+ # ------------------------------------------------------------------------
+ 
+ # TODO
+ # pca.plot(res, subnet.id)
+ # plot_subnet(res, subnet.id) 
+ }
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
convert the network into edge matrix
removing self-links
matching the features between network and datamatrix
Filter the network to only keep the edges with highest mutual information
1 / 5
2 / 5
3 / 5
4 / 5
5 / 5
Compute cost for each variable
Computing model for node 1 / 6
Computing model for node 2 / 6
Computing model for node 3 / 6
Computing model for node 4 / 6
Computing model for node 5 / 6
Computing model for node 6 / 6
independent models done
Computing delta values for edge  1 / 15 

Computing delta values for edge  2 / 15 

Computing delta values for edge  3 / 15 

Computing delta values for edge  4 / 15 

Computing delta values for edge  5 / 15 

Computing delta values for edge  6 / 15 

Computing delta values for edge  7 / 15 

Computing delta values for edge  8 / 15 

Computing delta values for edge  9 / 15 

Computing delta values for edge  10 / 15 

Computing delta values for edge  11 / 15 

Computing delta values for edge  12 / 15 

Computing delta values for edge  13 / 15 

Computing delta values for edge  14 / 15 

Computing delta values for edge  15 / 15 

Combining groups,  6  group(s) left...

Combining groups,  5  group(s) left...

Combining groups,  4  group(s) left...

Combining groups,  3  group(s) left...

convert the network into edge matrix
removing self-links
matching the features between network and datamatrix
Filter the network to only keep the edges with highest mutual information
1 / 5
2 / 5
3 / 5
4 / 5
5 / 5
Compute cost for each variable
Computing model for node 1 / 6
Computing model for node 2 / 6
Computing model for node 3 / 6
Computing model for node 4 / 6
Computing model for node 5 / 6
Computing model for node 6 / 6
independent models done
Computing delta values for edge  1 / 15 

Computing delta values for edge  2 / 15 

Computing delta values for edge  3 / 15 

Computing delta values for edge  4 / 15 

Computing delta values for edge  5 / 15 

Computing delta values for edge  6 / 15 

Computing delta values for edge  7 / 15 

Computing delta values for edge  8 / 15 

Computing delta values for edge  9 / 15 

Computing delta values for edge  10 / 15 

Computing delta values for edge  11 / 15 

Computing delta values for edge  12 / 15 

Computing delta values for edge  13 / 15 

Computing delta values for edge  14 / 15 

Computing delta values for edge  15 / 15 

Combining groups,  6  group(s) left...

Combining groups,  5  group(s) left...

Combining groups,  4  group(s) left...

Combining groups,  3  group(s) left...

Warning messages:
1: In check.network(network, datamatrix, verbose = verbose) :
  No network provided in function call: assuming fully connected nodes.
2: In check.network(network, datamatrix, verbose = verbose) :
  No network provided in function call: assuming fully connected nodes.
> 
> proc.time()
   user  system elapsed 
  27.78    0.25   28.01 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> # 1. vdp.mixt: moodien loytyminen eri dimensiolla, naytemaarilla ja komponenteilla
> #   -> ainakin nopea check
> 
> #######################################################################
> 
> # Generate random data from five Gaussians. 
> # Detect modes with vdp-gm. 
> # Plot data points and detected clusters with variance ellipses
> 
> #######################################################################
> 
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> #source("~/Rpackages/netresponse/netresponse/R/detect.responses.R")
> #source("~/Rpackages/netresponse/netresponse/R/internals.R")
> #source("~/Rpackages/netresponse/netresponse/R/vdp.mixt.R")
> #dyn.load("/home/tuli/Rpackages/netresponse/netresponse/src/netresponse.so")
> 
> 
> #########  Generate DATA #############################################
> 
> res <- generate.toydata()
> D <- res$data
> component.means <- res$means
> component.sds   <- res$sds
> sample2comp     <- res$sample2comp
> 
> ######################################################################
> 
> # Fit nonparametric Gaussian mixture model
> out <- vdp.mixt(D)
> # out <- vdp.mixt(D, c.max = 3) # try with limited number of components -> OK
> 
> ############################################################
> 
> # Compare input data and results
> 
> ord.out <- order(out$posterior$centroids[,1])
> ord.in <- order(component.means[,1])
> 
> means.out <- out$posterior$centroids[ord.out,]
> means.in <- component.means[ord.in,]
> 
> # Cluster stds and variances
> sds.out <- out$posterior$sds[ord.out,]
> sds.in  <- component.sds[ord.in,]
> vars.out <- sds.out^2
> vars.in <- sds.in^2
> 
> # Check correspondence between input and output
> if (length(means.in) == length(means.out)) {
+    cm <- cor(as.vector(means.in), as.vector(means.out))
+    csd <- cor(as.vector(sds.in), as.vector(sds.out))
+ }
> 
> # Plot results (assuming 2D)
> 
> ran <- range(c(as.vector(means.in - 2*vars.in), 
+                as.vector(means.in + 2*vars.in), 
+ 	       as.vector(means.out + 2*vars.out), 
+ 	       as.vector(means.out - 2*vars.out)))
> 
> plot(D, pch = 20, main = paste("Cor.means:", round(cm,3), "/ Cor.sds:", round(csd,3)), xlim = ran, ylim = ran) 
> for (ci in 1:nrow(means.out))  { add.ellipse(centroid = means.out[ci,], covmat = diag(vars.out[ci,]), col = "red") }
> for (ci in 1:nrow(means.in))  { add.ellipse(centroid = means.in[ci,], covmat = diag(vars.in[ci,]), col = "blue") }
> 
> 
> 
> proc.time()
   user  system elapsed 
   2.64    0.26    2.89 

R version 3.6.3 (2020-02-29) -- "Holding the Windsock"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 
> # 1. vdp.mixt: moodien loytyminen eri dimensiolla, naytemaarilla ja komponenteilla
> #   -> ainakin nopea check
> 
> #######################################################################
> 
> # Generate random data from five Gaussians. 
> # Detect modes with vdp-gm. 
> # Plot data points and detected clusters with variance ellipses
> 
> #######################################################################
> 
> library(netresponse)
Loading required package: Rgraphviz
Loading required package: graph
Loading required package: BiocGenerics
Loading required package: parallel

Attaching package: 'BiocGenerics'

The following objects are masked from 'package:parallel':

    clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
    clusterExport, clusterMap, parApply, parCapply, parLapply,
    parLapplyLB, parRapply, parSapply, parSapplyLB

The following objects are masked from 'package:stats':

    IQR, mad, sd, var, xtabs

The following objects are masked from 'package:base':

    Filter, Find, Map, Position, Reduce, anyDuplicated, append,
    as.data.frame, basename, cbind, colnames, dirname, do.call,
    duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
    lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
    pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
    tapply, union, unique, unsplit, which, which.max, which.min

Loading required package: grid
Loading required package: minet
Loading required package: mclust
Package 'mclust' version 5.4.6
Type 'citation("mclust")' for citing this R package in publications.
Loading required package: reshape2

netresponse (C) 2008-2016 Leo Lahti et al.

https://github.com/antagomir/netresponse
> #source("~/Rpackages/netresponse/netresponse/R/detect.responses.R")
> #source("~/Rpackages/netresponse/netresponse/R/internals.R")
> #source("~/Rpackages/netresponse/netresponse/R/vdp.mixt.R")
> #dyn.load("/home/tuli/Rpackages/netresponse/netresponse/src/netresponse.so")
> 
> 
> #########  Generate DATA #############################################
> 
> res <- generate.toydata()
> D <- res$data
> component.means <- res$means
> component.sds   <- res$sds
> sample2comp     <- res$sample2comp
> 
> ######################################################################
> 
> # Fit nonparametric Gaussian mixture model
> out <- vdp.mixt(D)
> # out <- vdp.mixt(D, c.max = 3) # try with limited number of components -> OK
> 
> ############################################################
> 
> # Compare input data and results
> 
> ord.out <- order(out$posterior$centroids[,1])
> ord.in <- order(component.means[,1])
> 
> means.out <- out$posterior$centroids[ord.out,]
> means.in <- component.means[ord.in,]
> 
> # Cluster stds and variances
> sds.out <- out$posterior$sds[ord.out,]
> sds.in  <- component.sds[ord.in,]
> vars.out <- sds.out^2
> vars.in <- sds.in^2
> 
> # Check correspondence between input and output
> if (length(means.in) == length(means.out)) {
+    cm <- cor(as.vector(means.in), as.vector(means.out))
+    csd <- cor(as.vector(sds.in), as.vector(sds.out))
+ }
> 
> # Plot results (assuming 2D)
> 
> ran <- range(c(as.vector(means.in - 2*vars.in), 
+                as.vector(means.in + 2*vars.in), 
+ 	       as.vector(means.out + 2*vars.out), 
+ 	       as.vector(means.out - 2*vars.out)))
> 
> plot(D, pch = 20, main = paste("Cor.means:", round(cm,3), "/ Cor.sds:", round(csd,3)), xlim = ran, ylim = ran) 
> for (ci in 1:nrow(means.out))  { add.ellipse(centroid = means.out[ci,], covmat = diag(vars.out[ci,]), col = "red") }
> for (ci in 1:nrow(means.in))  { add.ellipse(centroid = means.in[ci,], covmat = diag(vars.in[ci,]), col = "blue") }
> 
> 
> 
> proc.time()
   user  system elapsed 
   3.31    0.18    3.48