Lars Kaderali
| Snapshot Date: 2018-10-15 16:45:08 -0400 (Mon, 15 Oct 2018) |
| URL: https://git.bioconductor.org/packages/lpNet |
| Branch: RELEASE_3_7 |
| Last Commit: 27f4394 |
| Last Changed Date: 2018-04-30 10:35:29 -0400 (Mon, 30 Apr 2018) |
| Back to Multiple platform build/check report for BioC 3.7 |
|
This page was generated on 2018-10-17 08:51:15 -0400 (Wed, 17 Oct 2018).
| Package 804/1561 | Hostname | OS / Arch | INSTALL | BUILD | CHECK | BUILD BIN | ||||||
| lpNet 2.12.0 Lars Kaderali
| malbec2 | Linux (Ubuntu 16.04.1 LTS) / x86_64 | OK | OK | OK | | ||||||
| tokay2 | Windows Server 2012 R2 Standard / x64 | OK | OK | OK | OK | | ||||||
| merida2 | OS X 10.11.6 El Capitan / x86_64 | OK | OK | [ OK ] | OK | |
| Package: lpNet |
| Version: 2.12.0 |
| Command: /Library/Frameworks/R.framework/Versions/Current/Resources/bin/R CMD check --install=check:lpNet.install-out.txt --library=/Library/Frameworks/R.framework/Versions/Current/Resources/library --no-vignettes --timings lpNet_2.12.0.tar.gz |
| StartedAt: 2018-10-16 22:17:51 -0400 (Tue, 16 Oct 2018) |
| EndedAt: 2018-10-16 22:18:44 -0400 (Tue, 16 Oct 2018) |
| EllapsedTime: 53.0 seconds |
| RetCode: 0 |
| Status: OK |
| CheckDir: lpNet.Rcheck |
| Warnings: 0 |
##############################################################################
##############################################################################
###
### Running command:
###
### /Library/Frameworks/R.framework/Versions/Current/Resources/bin/R CMD check --install=check:lpNet.install-out.txt --library=/Library/Frameworks/R.framework/Versions/Current/Resources/library --no-vignettes --timings lpNet_2.12.0.tar.gz
###
##############################################################################
##############################################################################
* using log directory ‘/Users/biocbuild/bbs-3.7-bioc/meat/lpNet.Rcheck’
* using R version 3.5.1 Patched (2018-07-12 r74967)
* using platform: x86_64-apple-darwin15.6.0 (64-bit)
* using session charset: UTF-8
* using option ‘--no-vignettes’
* checking for file ‘lpNet/DESCRIPTION’ ... OK
* checking extension type ... Package
* this is package ‘lpNet’ version ‘2.12.0’
* checking package namespace information ... OK
* checking package dependencies ... OK
* checking if this is a source package ... OK
* checking if there is a namespace ... OK
* checking for hidden files and directories ... OK
* checking for portable file names ... OK
* checking for sufficient/correct file permissions ... OK
* checking whether package ‘lpNet’ can be installed ... OK
* checking installed package size ... OK
* checking package directory ... OK
* checking ‘build’ directory ... OK
* checking DESCRIPTION meta-information ... OK
* checking top-level files ... OK
* checking for left-over files ... OK
* checking index information ... OK
* checking package subdirectories ... OK
* checking R files for non-ASCII characters ... OK
* checking R files for syntax errors ... OK
* checking whether the package can be loaded ... OK
* checking whether the package can be loaded with stated dependencies ... OK
* checking whether the package can be unloaded cleanly ... OK
* checking whether the namespace can be loaded with stated dependencies ... OK
* checking whether the namespace can be unloaded cleanly ... OK
* checking dependencies in R code ... OK
* checking S3 generic/method consistency ... OK
* checking replacement functions ... OK
* checking foreign function calls ... OK
* checking R code for possible problems ... NOTE
.calcRangeLambda_steadyState: no visible global function definition for
‘var’
.calcRangeLambda_timeSeries: no visible global function definition for
‘var’
.calculatePredictionValue_Kfold_ts: no visible global function
definition for ‘rnorm’
.calculatePredictionValue_LOOCV_ss: no visible global function
definition for ‘rnorm’
.calculatePredictionValue_LOOCV_ts: no visible global function
definition for ‘rnorm’
.set_per_gene_exp_time_values: no visible global function definition
for ‘rnorm’
.set_per_gene_exp_values: no visible global function definition for
‘rnorm’
.set_per_gene_time_values: no visible global function definition for
‘rnorm’
.set_per_gene_values: no visible global function definition for ‘rnorm’
.set_single_values: no visible global function definition for ‘rnorm’
getSampleAdja: no visible binding for global variable ‘median’
getSampleAdjaMAD: no visible binding for global variable ‘median’
getSampleAdjaMAD: no visible binding for global variable ‘mad’
summarizeRepl: no visible binding for global variable ‘median’
Undefined global functions or variables:
mad median rnorm var
Consider adding
importFrom("stats", "mad", "median", "rnorm", "var")
to your NAMESPACE file.
* checking Rd files ... OK
* checking Rd metadata ... OK
* checking Rd cross-references ... OK
* checking for missing documentation entries ... OK
* checking for code/documentation mismatches ... OK
* checking Rd \usage sections ... OK
* checking Rd contents ... OK
* checking for unstated dependencies in examples ... OK
* checking sizes of PDF files under ‘inst/doc’ ... OK
* checking installed files from ‘inst/doc’ ... OK
* checking files in ‘vignettes’ ... OK
* checking examples ... OK
* checking for unstated dependencies in ‘tests’ ... OK
* checking tests ...
Running ‘runitCalcActivation.R’
Running ‘runitCalcPredictionKfoldCV.R’
Running ‘runitCalcPredictionKfoldCV_timeSeries.R’
Running ‘runitCalcPredictionLOOCV.R’
Running ‘runitCalcPredictionLOOCV_timeSeries.R’
Running ‘runitCalcRangeLambda.R’
Running ‘runitDoILP.R’
Running ‘runitDoILP_timeSeries.R’
Running ‘runitGenerateTimeSeriesNetStates.R’
Running ‘runitGetAdja.R’
Running ‘runitGetBaseline.R’
Running ‘runitGetEdgeAnnot.R’
Running ‘runitGetObsMat.R’
Running ‘runitGetSampleAdja.R’
Running ‘runitGetSampleAdjaMAD.R’
Running ‘runitKfoldCV.R’
Running ‘runitKfoldCV_timeSeries.R’
Running ‘runitLOOCV.R’
Running ‘runitLOOCV_timeSeries.R’
OK
* checking for unstated dependencies in vignettes ... NOTE
'library' or 'require' call not declared from: ‘KEGGgraph’
* checking package vignettes in ‘inst/doc’ ... OK
* checking running R code from vignettes ... SKIPPED
* checking re-building of vignette outputs ... SKIPPED
* checking PDF version of manual ... OK
* DONE
Status: 2 NOTEs
See
‘/Users/biocbuild/bbs-3.7-bioc/meat/lpNet.Rcheck/00check.log’
for details.
lpNet.Rcheck/00install.out
############################################################################## ############################################################################## ### ### Running command: ### ### /Library/Frameworks/R.framework/Versions/Current/Resources/bin/R CMD INSTALL lpNet ### ############################################################################## ############################################################################## * installing to library ‘/Library/Frameworks/R.framework/Versions/3.5/Resources/library’ * installing *source* package ‘lpNet’ ... ** R ** inst ** byte-compile and prepare package for lazy loading ** help *** installing help indices ** building package indices ** installing vignettes ** testing if installed package can be loaded * DONE (lpNet)
lpNet.Rcheck/tests/runitCalcActivation.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.calcActivationShortExample <- function() {
+ n <- 3
+ K <- 4
+
+ true_result <- matrix(c(0,0,0,
+ 1,0,0,
+ 1,1,0,
+ 1,1,1), nrow=n, ncol=K)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K)
+
+ checkEquals(true_result, act_mat)
+ }
>
>
> test.calcActivationShortExampleTimeSeries <- function() {
+ n <- 3
+ K <- 4
+
+ true_result <- matrix(c(0,0,0,
+ 1,0,0,
+ 1,1,0,
+ 1,1,1), nrow=n, ncol=K)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K, flag_gen_data=TRUE)
+
+ checkEquals(true_result, act_mat)
+ }
>
>
> test.calcActivation <- function() {
+ n <- 5
+ K <- 6
+
+ true_result <- matrix(c(0,0,0,0,0,
+ 1,0,1,1,1,
+ 1,1,0,0,0,
+ 1,1,1,0,0,
+ 1,1,1,0,0,
+ 1,1,1,0,0), nrow=n, ncol=K)
+
+ T_nw <- matrix(c(0,1,1,0,0,
+ 0,0,0,-1,0,
+ 0,0,0,1,0,
+ 0,0,0,0,1,
+ 0,0,0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,1,1,
+ 1,0,1,1,1,
+ 1,1,0,1,1,
+ 1,1,1,0,1,
+ 1,1,1,1,0,
+ 1,1,1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K)
+
+ checkEquals(true_result, act_mat)
+ }
>
>
> test.calcActivationTimeSeries <- function() {
+ n <- 5
+ K <- 6
+
+ true_result <- matrix(c(0,0,0,0,0,
+ 1,0,1,1,1,
+ 1,1,0,1,1,
+ 1,1,1,0,0,
+ 1,1,1,1,0,
+ 1,1,1,1,1), nrow=n, ncol=K)
+
+ T_nw <- matrix(c(0,1,1,0,0,
+ 0,0,0,-1,0,
+ 0,0,0,1,0,
+ 0,0,0,0,1,
+ 0,0,0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,1,1,
+ 1,0,1,1,1,
+ 1,1,0,1,1,
+ 1,1,1,0,1,
+ 1,1,1,1,0,
+ 1,1,1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K, flag_gen_data=TRUE)
+
+ checkEquals(true_result, act_mat)
+ }
>
>
> test.calcActivationLargeExample <- function() {
+ n <- 10
+ K <- 11
+
+ true_result <- matrix(c(0,0,0,1,1,1,1,1,1,1,
+ 1,0,0,1,1,1,1,1,1,1,
+ 1,0,0,1,1,1,1,1,1,1,
+ 1,1,1,0,0,0,0,0,0,0,
+ 1,1,1,1,0,0,0,0,0,0,
+ 1,1,1,1,1,0,0,0,0,0,
+ 1,0,0,1,1,1,0,0,0,0,
+ 1,0,0,1,1,1,1,0,0,0,
+ 1,0,0,1,1,1,1,1,0,0,
+ 1,0,0,1,1,1,1,1,1,0,
+ 1,0,0,1,1,1,1,1,1,1), nrow=n, ncol=K)
+
+ T_nw <- matrix(c(0,1,0,0,0,0,0,0,0,0,
+ 0,0,1,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,1,0,0,0,0,0,
+ 0,0,0,0,0,1,0,0,0,0,
+ 0,-1,0,0,0,0,1,0,0,0,
+ 0,0,0,0,0,0,0,1,0,0,
+ 0,0,0,0,0,0,0,0,1,0,
+ 0,0,0,0,0,0,1,0,0,1,
+ 0,0,0,0,0,0,0,0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,
+ 1,1,1,1,0,1,1,1,1,1,
+ 1,1,1,1,1,0,1,1,1,1,
+ 1,1,1,1,1,1,0,1,1,1,
+ 1,1,1,1,1,1,1,0,1,1,
+ 1,1,1,1,1,1,1,1,0,1,
+ 1,1,1,1,1,1,1,1,1,0,
+ 1,1,1,1,1,1,1,1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K)
+
+ checkEquals(true_result, act_mat)
+ }
>
>
> test.calcActivationLargeExampleTimeSeries <- function() {
+ n <- 10
+ K <- 11
+
+ true_result <- matrix(c(0,1,1,1,1,1,1,1,1,1,
+ 1,0,0,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,0,0,0,0,0,0,
+ 1,1,1,1,0,0,0,0,0,0,
+ 1,1,1,1,1,0,0,0,0,0,
+ 1,1,1,1,1,1,0,0,0,0,
+ 1,1,1,1,1,1,1,0,0,0,
+ 1,1,1,1,1,1,1,1,0,0,
+ 1,1,1,1,1,1,1,1,1,0,
+ 1,1,1,1,1,1,1,1,1,1), nrow = n, ncol=K)
+
+ T_nw <- matrix(c(0,1,0,0,0,0,0,0,0,0,
+ 0,0,1,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,1,0,0,0,0,0,
+ 0,0,0,0,0,1,0,0,0,0,
+ 0,-1,0,0,0,0,1,0,0,0,
+ 0,0,0,0,0,0,0,1,0,0,
+ 0,0,0,0,0,0,0,0,1,0,
+ 0,0,0,0,0,0,1,0,0,1,
+ 0,0,0,0,0,0,0,0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,
+ 1,1,1,1,0,1,1,1,1,1,
+ 1,1,1,1,1,0,1,1,1,1,
+ 1,1,1,1,1,1,0,1,1,1,
+ 1,1,1,1,1,1,1,0,1,1,
+ 1,1,1,1,1,1,1,1,0,1,
+ 1,1,1,1,1,1,1,1,1,0,
+ 1,1,1,1,1,1,1,1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K, flag_gen_data=TRUE)
+
+ checkEquals(true_result, act_mat)
+ }
>
> proc.time()
user system elapsed
0.238 0.050 0.259
lpNet.Rcheck/tests/runitCalcPredictionKfoldCV.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.
> .setUp <- function() {
+
+ n <<- 3
+ K <<- 4
+
+ T_nw <<- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <<- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <<- c(0.76, 0.76, 0)
+
+ mu_types <<- c("single", "perGene", "perGeneExp")
+
+ mu_list <<- list()
+ mu_list[[1]] <<- list()
+ mu_list[[2]] <<- list()
+ mu_list[[3]] <<- list()
+
+ mu_list[[1]]$active_mu <<- 0.95
+ mu_list[[1]]$active_sd <<- 0.01
+ mu_list[[1]]$inactive_mu <<- 0.56
+ mu_list[[1]]$inactive_sd <<- 0.01
+ mu_list[[1]]$delta <<- rep(0.755, n)
+
+ mu_list[[2]]$active_mu <<- rep(0.95, n)
+ mu_list[[2]]$active_sd <<- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <<- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <<- rep(0.01, n)
+ mu_list[[2]]$delta <<- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <<- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <<- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <<- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+ }
>
>
> test.runitCalcPredictionKfoldCV <- function() {
+
+ obs_modified <- obs_mat
+ obs_modified[2,4] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ ## calculate mean squared error of predicted and observed
+ predict <- calcPredictionKfoldCV(obs, delta, b, n, K, adja=T_nw, baseline, rem_entries, rem_entries_vec,
+ active_mu, active_sd, inactive_mu, inactive_sd, mu_type=mu_type)
+
+ checkEquals(obs_mat, predict, tolerance=0.05)
+ }
+ }
>
> proc.time()
user system elapsed
0.235 0.053 0.257
lpNet.Rcheck/tests/runitCalcPredictionKfoldCV_timeSeries.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.
> .setUp <- function() {
+
+ n <<- 3
+ K <<- 4
+ T_ <<- 3
+
+ T_nw <<- matrix(c(0,0,1,
+ 0,0,-1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <<- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <<- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <<- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.95, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <<- c(0.76, 0.76, 0)
+
+ mu_types <<- c("single", "perGene", "perGeneExp", "perGeneTime", "perGeneExpTime")
+
+ mu_list <<- list()
+ mu_list[[1]] <<- list()
+ mu_list[[2]] <<- list()
+ mu_list[[3]] <<- list()
+ mu_list[[4]] <<- list()
+ mu_list[[5]] <<- list()
+
+ mu_list[[1]]$active_mu <<- 0.95
+ mu_list[[1]]$active_sd <<- 0.01
+ mu_list[[1]]$inactive_mu <<- 0.56
+ mu_list[[1]]$inactive_sd <<- 0.01
+ mu_list[[1]]$delta <<- rep(0.755, n)
+
+ mu_list[[2]]$active_mu <<- rep(0.95, n)
+ mu_list[[2]]$active_sd <<- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <<- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <<- rep(0.01, n)
+ mu_list[[2]]$delta <<- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <<- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <<- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <<- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+
+ mu_list[[4]]$active_mu <<- matrix(rep(0.95, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$active_sd <<- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_mu <<- matrix(rep(0.56, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_sd <<- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$delta <<- matrix(rep(0.755, n*T_), nrow=n, ncol=T_)
+
+ mu_list[[5]]$active_mu <<- array(rep(0.95, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$active_sd <<- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_mu <<- array(rep(0.56, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_sd <<- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$delta <<- array(rep(0.755, n*K*T_), c(n,K,T_))
+ }
>
>
> test.runitCalcPredictionKfoldCV01 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.95, 0.95, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+ baseline <- c(0, 0, 0)
+
+ obs_modified <- obs_mat
+ obs_modified[2,4,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ ## calculate mean squared error of predicted and observed
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict[2,4,2], 0.56, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionKfoldCV02 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.95, 0.95, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_modified <- obs_mat
+ obs_modified[2,4,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict[2,4,2], 0.95, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionKfoldCV03 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.95, 0.95, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_modified <- obs_mat
+ obs_modified[3,4,3] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw, baseline=baseline,
+ rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict[3,4,3], 0.95, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionKfoldCV04 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,-1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_modified <- obs_mat
+ obs_modified[2,4,2] <- NA
+ obs_modified[3,4,3] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw, baseline=baseline,
+ rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkTrue(is.na(predict[3,4,3]))
+ }
+ }
>
>
> test.runitCalcPredictionKfoldCV05 <- function() {
+
+ obs_modified <- obs_mat
+ obs_modified[2,2,2] <- NA
+ obs_modified[3,2,3] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict[2,2,2], 0.56, tolerance=0.05)
+ checkEquals(predict[3,2,3], 0.95, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionKfoldCV06 <- function() {
+
+ obs_modified <- obs_mat
+ obs_modified[2,2,1] <- NA
+ obs_modified[3,2,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict[2,2,1], 0.56, tolerance=0.05)
+ checkTrue(is.na(predict[3,2,2]))
+ }
+ }
>
>
> test.runitCalcPredictionKfoldCV07 <- function() {
+
+ baseline <- c(0.76, 0.76, 0.76)
+
+ obs_modified <- obs_mat
+ obs_modified[2,2,1] <- NA
+ obs_modified[3,2,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionKfoldCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw, baseline=baseline,
+ rem_entries=rem_entries, rem_entries_vec=rem_entries_vec,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict[2,2,1], 0.56, tolerance=0.05)
+ checkEquals(predict[3,2,2], 0.95, tolerance=0.05)
+ }
+ }
>
> proc.time()
user system elapsed
0.311 0.061 0.335
lpNet.Rcheck/tests/runitCalcPredictionLOOCV.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.
> .setUp <- function() {
+
+ n <<- 3
+ K <<- 4
+ T_ <<- 3
+
+ T_nw <<- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <<- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <<- c(0.76, 0.76, 0)
+
+ mu_types <<- c("single", "perGene", "perGeneExp")
+
+ mu_list <<- list()
+ mu_list[[1]] <<- list()
+ mu_list[[2]] <<- list()
+ mu_list[[3]] <<- list()
+
+ mu_list[[1]]$active_mu <<- 0.95
+ mu_list[[1]]$active_sd <<- 0.01
+ mu_list[[1]]$inactive_mu <<- 0.56
+ mu_list[[1]]$inactive_sd <<- 0.01
+ mu_list[[1]]$delta <<- rep(0.755, n)
+
+ mu_list[[2]]$active_mu <<- rep(0.95, n)
+ mu_list[[2]]$active_sd <<- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <<- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <<- rep(0.01, n)
+ mu_list[[2]]$delta <<- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <<- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <<- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <<- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+ }
>
>
> test.runitCalcPredictionLOOCV <- function() {
+
+ obs_modified <- obs_mat
+ rem_gene <- 2
+ rem_k <- 4
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ ## calculate mean squared error of predicted and observed
+ predict <- calcPredictionLOOCV(obs=obs_mat, delta=delta, b=b, n=n ,K=K, adja=T_nw, baseline=baseline,
+ rem_gene=rem_gene, rem_k=rem_k, active_mu=active_mu, active_sd=active_sd,
+ inactive_mu=inactive_mu, inactive_sd=inactive_sd, mu_type=mu_type)
+
+ checkEquals(obs_mat[rem_gene, rem_k], predict, tolerance=0.05)
+ }
+ }
>
> proc.time()
user system elapsed
0.216 0.052 0.237
lpNet.Rcheck/tests/runitCalcPredictionLOOCV_timeSeries.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.
> .setUp <- function() {
+
+ n <<- 3
+ K <<- 4
+ T_ <<- 3
+
+ T_nw <<- matrix(c(0,0,1,
+ 0,0,-1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <<- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <<- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <<- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.95, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <<- c(0.76, 0.76, 0)
+
+ mu_types <<- c("single", "perGene", "perGeneExp", "perGeneTime", "perGeneExpTime")
+
+ mu_list <<- list()
+ mu_list[[1]] <<- list()
+ mu_list[[2]] <<- list()
+ mu_list[[3]] <<- list()
+ mu_list[[4]] <<- list()
+ mu_list[[5]] <<- list()
+
+ mu_list[[1]]$active_mu <<- 0.95
+ mu_list[[1]]$active_sd <<- 0.01
+ mu_list[[1]]$inactive_mu <<- 0.56
+ mu_list[[1]]$inactive_sd <<- 0.01
+ mu_list[[1]]$delta <<- rep(0.755, n)
+
+ mu_list[[2]]$active_mu <<- rep(0.95, n)
+ mu_list[[2]]$active_sd <<- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <<- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <<- rep(0.01, n)
+ mu_list[[2]]$delta <<- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <<- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <<- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <<- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <<- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+
+ mu_list[[4]]$active_mu <<- matrix(rep(0.95, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$active_sd <<- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_mu <<- matrix(rep(0.56, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_sd <<- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$delta <<- matrix(rep(0.755, n*T_), nrow=n, ncol=T_)
+
+ mu_list[[5]]$active_mu <<- array(rep(0.95, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$active_sd <<- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_mu <<- array(rep(0.56, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_sd <<- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$delta <<- array(rep(0.755, n*K*T_), c(n,K,T_))
+ }
>
>
> test.runitCalcPredictionLOOCV01 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.95, 0.95, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+ baseline <- c(0, 0, 0)
+
+ obs_modified <- obs_mat
+ rem_gene <- 2
+ rem_k <- 4
+ rem_t <- 2
+ obs_modified[2,4,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ ## calculate mean squared error of predicted and observed
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict, 0.56, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionLOOCV02 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.95, 0.95, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_modified <- obs_mat
+ rem_gene <- 2
+ rem_k <- 4
+ rem_t <- 2
+ obs_modified[2,4,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict, 0.95, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionLOOCV03 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.95, 0.56, 0.95, 0.95,
+ 0.95, 0.95, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_modified <- obs_mat
+ rem_gene <- 3
+ rem_k <- 4
+ rem_t <- 3
+ obs_modified[3,4,3] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict, 0.95, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionLOOCV04 <- function() {
+
+ T_nw <- matrix(c(0,0,1,
+ 0,0,-1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ obs_modified <- obs_mat
+ rem_gene <- 3
+ rem_k <- 4
+ rem_t <- 3
+ obs_modified[2,4,2] <- NA
+ obs_modified[3,4,3] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw, baseline=baseline,
+ rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkTrue(is.na(predict))
+ }
+ }
>
>
> test.runitCalcPredictionLOOCV05 <- function() {
+
+ obs_modified <- obs_mat
+ rem_gene <- 3
+ rem_k <- 2
+ rem_t <- 3
+ obs_modified[2,2,2] <- NA
+ obs_modified[3,2,3] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw, baseline=baseline,
+ rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict, 0.95, tolerance=0.05)
+ }
+ }
>
>
> test.runitCalcPredictionLOOCV06 <- function() {
+
+ obs_modified <- obs_mat
+ rem_gene <- 3
+ rem_k <- 2
+ rem_t <- 2
+ obs_modified[2,2,1] <- NA
+ obs_modified[3,2,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkTrue(is.na(predict))
+ }
+ }
>
>
> test.runitCalcPredictionLOOCV07 <- function() {
+
+ baseline <- c(0.76, 0.76, 0.76)
+
+ obs_modified <- obs_mat
+ rem_gene <- 3
+ rem_k <- 2
+ rem_t <- 2
+ obs_modified[2,2,1] <- NA
+ obs_modified[3,2,2] <- NA
+
+ rem_entries <- which(is.na(obs_modified), arr.ind=TRUE)
+ rem_entries_vec <- which(is.na(obs_modified))
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ predict <- calcPredictionLOOCV(obs=obs_modified, delta=delta, b=b, n=n, K=K, adja=T_nw,
+ baseline=baseline, rem_gene=rem_gene, rem_k=rem_k, rem_t=rem_t,
+ active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, flag_time_series=TRUE)
+
+ checkEquals(predict, 0.95, tolerance=0.05)
+ }
+ }
>
> proc.time()
user system elapsed
0.312 0.058 0.341
lpNet.Rcheck/tests/runitCalcRangeLambda.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.calcRangeLambda <- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result <- c(0.00, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09,
+ 0.10, 0.12, 0.14, 0.16, 0.18, 0.20, 0.22, 0.24, 0.25)
+
+
+ obs_mat <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ delta <- rep(0.755, n)
+ delta_type <- "perGene"
+
+ lambda <- calcRangeLambda(obs=obs_mat, delta=delta, delta_type=delta_type)
+
+ checkEquals(true_result, lambda)
+ }
>
>
> test.calcRangeLambdaPerGeneExp<- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result <- c(0.00, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09, 0.10,
+ 0.12, 0.14, 0.16, 0.18, 0.20, 0.22, 0.24, 0.26, 0.28, 0.30, 0.32, 0.33)
+
+
+ obs_mat <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ delta = matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+ delta_type <- "perGeneExp"
+
+ lambda <- calcRangeLambda(obs=obs_mat, delta=delta, delta_type=delta_type)
+
+ checkEquals(true_result, lambda)
+ }
>
>
> test.calcRangeLambdaTimeSeries <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- c(0.00, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09,
+ 0.10, 0.12, 0.14, 0.16, 0.18, 0.20, 0.22, 0.24, 0.26, 0.28,
+ 0.30, 0.32, 0.34, 0.36, 0.38, 0.40, 0.42, 0.44, 0.46, 0.48,
+ 0.50, 0.52, 0.54, 0.56, 0.58, 0.60, 0.62, 0.64, 0.66, 0.68,
+ 0.70, 0.72, 0.74, 0.76, 0.78, 0.80, 0.82, 0.84, 0.86, 0.88,
+ 0.90, 0.92, 0.94, 0.96, 0.98, 1.00, 1.05, 1.09)
+
+ obs_mat <- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ delta <- rep(0.755, n)
+ delta_type <- "perGene"
+
+ lambda <- calcRangeLambda(obs=obs_mat, delta=delta, delta_type=delta_type, flag_time_series=TRUE)
+
+ checkEquals(true_result, lambda)
+ }
>
> test.calcRangeLambdaTimeSeriesPerGeneExp <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- c(0.00, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09,
+ 0.10, 0.12, 0.14, 0.16, 0.18, 0.20, 0.22, 0.24, 0.26, 0.28,
+ 0.30, 0.32, 0.34, 0.36, 0.38, 0.40, 0.42, 0.44, 0.46, 0.48,
+ 0.50, 0.52, 0.54, 0.56, 0.58, 0.60, 0.62, 0.64, 0.66, 0.68,
+ 0.70, 0.72, 0.74, 0.76, 0.78, 0.80, 0.82, 0.84, 0.86, 0.88,
+ 0.90, 0.92, 0.94, 0.96, 0.98, 1.00, 1.05, 1.10, 1.15, 1.20,
+ 1.25, 1.28)
+
+ obs_mat <- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ delta = matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.96), nrow=n, ncol=K, byrow=TRUE)
+ delta_type <- "perGeneExp"
+
+ lambda <-calcRangeLambda(obs=obs_mat, delta=delta, delta_type=delta_type, flag_time_series=TRUE)
+
+ checkEquals(true_result, lambda)
+ }
>
>
> test.calcRangeLambdaTimeSeriesPerGeneTime <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- c(0.00, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09,
+ 0.10, 0.12, 0.14, 0.16, 0.18, 0.20, 0.22, 0.24, 0.26, 0.28,
+ 0.30, 0.32, 0.34, 0.36, 0.38, 0.40, 0.42, 0.44, 0.46, 0.48,
+ 0.50, 0.52, 0.54, 0.56, 0.58, 0.60, 0.62, 0.64, 0.66, 0.68,
+ 0.70, 0.72, 0.74, 0.76, 0.78, 0.80, 0.82, 0.84, 0.86, 0.88,
+ 0.90, 0.92, 0.94, 0.96, 0.98, 1.00, 1.05, 1.10, 1.15, 1.20,
+ 1.25)
+
+ obs_mat = array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ delta <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=T_, byrow=TRUE)
+ delta_type <- "perGeneTime"
+
+ lambda <- calcRangeLambda(obs=obs_mat, delta=delta, delta_type=delta_type, flag_time_series=TRUE)
+
+ checkEquals(true_result, lambda)
+ }
>
>
> test.calcRangeLambdaTimeSeriesperGeneExpTime <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- c(0.00, 0.01, 0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09,
+ 0.10, 0.12, 0.14, 0.16, 0.18, 0.20, 0.22, 0.24, 0.26, 0.28,
+ 0.30, 0.32, 0.34, 0.36, 0.38, 0.40, 0.42, 0.44, 0.46, 0.48,
+ 0.50, 0.52, 0.54, 0.56, 0.58, 0.60, 0.62, 0.64, 0.66, 0.68,
+ 0.70, 0.72, 0.74, 0.76, 0.78, 0.80, 0.82, 0.84, 0.86, 0.88,
+ 0.90, 0.92, 0.94, 0.96, 0.98, 1.00, 1.05, 1.10, 1.15, 1.19)
+
+ obs_mat <- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ delta <- array(NA, c(n,K,T_))
+
+ delta[,,1] <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta[,,2] <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta[,,3] <- matrix(c(0.755, 0.755, 0.755, 0.755,
+ 0.755, 0.755, 0.755, 0.755,
+ 0.755, 0.755, 0.755, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta[,,4] <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta_type <- "perGeneExpTime"
+
+ lambda <- calcRangeLambda(obs=obs_mat, delta=delta, delta_type=delta_type, flag_time_series=TRUE)
+
+ checkEquals(true_result, lambda)
+ }
>
> proc.time()
user system elapsed
0.278 0.057 0.310
lpNet.Rcheck/tests/runitDoILP.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.
> .setUp <- function(){
+
+ n <<- 3
+ K <<- 4
+
+ T_nw <<- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <<- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ lambda <<- 1/10
+ annot <<- getEdgeAnnot(n)
+ }
>
>
> test.doILPShortExamplePerGene <- function() {
+
+ true_result_objval <- 13.52785
+ true_result_solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 1.9358974,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 1.1411606,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.4450526, 0.4450526,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ delta = rep(0.755, n)
+ delta_type <- "perGene"
+
+ res <- doILP(obs_mat, delta, lambda, b, n, K, T_=NULL, annot, delta_type, prior=NULL, sourceNode=NULL, sinkNode=NULL, all.int=FALSE, all.pos=FALSE)
+
+ checkEquals(true_result_objval, res$objval, tolerance=0.00001)
+ checkEquals(true_result_solution, res$solution, tolerance=0.00001)
+ }
>
>
> test.doILPShortExamplePerGeneExp <- function() {
+
+ true_result_objval <- 19.68196
+ true_result_solution <- c(0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 1.9358974,
+ 1.9358974, 1.9358974, 0.0000000,
+ 0.0000000, 1.1411606, 1.1411606,
+ 1.9358974, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.4450526, 0.4450526,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ delta = matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta_type <- "perGeneExp"
+
+ res <- doILP(obs_mat, delta, lambda, b, n, K, T_=NULL, annot, delta_type, prior=NULL, sourceNode=NULL, sinkNode=NULL, all.int=FALSE, all.pos=FALSE)
+
+ checkEquals(true_result_objval, res$objval, tolerance=0.00001)
+ checkEquals(true_result_solution, res$solution, tolerance=0.00001)
+ }
>
>
> proc.time()
user system elapsed
0.229 0.053 0.254
lpNet.Rcheck/tests/runitDoILP_timeSeries.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.
> .setUp <- function() {
+
+ n <<- 3
+ K <<- 4
+ T_ <<- 4
+
+ T_nw <<- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <<- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <<- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <<- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <<- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ lambda <<- 1/10
+ annot <<- getEdgeAnnot(n)
+ }
>
>
> test.doILPTimeSeriesShortExamplePerGene <- function() {
+
+ true_result_objval <- 2.344474
+ true_result_solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 0.7947368,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ delta <- rep(0.755, n)
+
+ delta_type <- "perGene"
+
+ res <- doILP(obs_mat, delta, lambda, b, n, K, T_, annot, delta_type, prior=NULL,
+ sourceNode=NULL, sinkNode=NULL, all.int=FALSE, all.pos=FALSE, flag_time_series=TRUE)
+
+ checkEquals(true_result_objval, res$objval, tolerance=0.00001)
+ checkEquals(true_result_solution, res$solution, tolerance=0.00001)
+ }
>
>
> test.doILPTimeSeriesShortExamplePerGenePerExp <- function() {
+
+
+ true_result_objval <- 24.99447
+ true_result_solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 0.7947368,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ delta <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta_type <- "perGeneExp"
+
+ res <- doILP(obs_mat, delta, lambda, b, n, K, T_, annot, delta_type, prior=NULL,
+ sourceNode=NULL, sinkNode=NULL, all.int=FALSE, all.pos=FALSE, flag_time_series=TRUE)
+
+ checkEquals(true_result_objval, res$objval, tolerance=0.00001)
+ checkEquals(true_result_solution, res$solution, tolerance=0.00001)
+ }
>
>
> test.doILPTimeSeriesShortExamplePerGenePerTime <- function() {
+
+
+ true_result_objval <- 109.5545
+ true_result_solution <- c(0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.7947368, 0.7947368,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.7550000, 0.7550000,
+ 0.0000000, 0.7550000, 0.7550000,
+ 0.0000000, 0.0000000, 0.7550000,
+ 0.0000000, 0.7550000, 0.0000000,
+ 0.0000000, 0.7550000, 0.7550000,
+ 0.0000000, 0.7550000, 0.7550000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.7550000, 0.7550000,
+ 0.0000000, 0.0000000, 0.7550000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ delta <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta_type <- "perGeneTime"
+
+ res <- doILP(obs_mat, delta, lambda, b, n, K, T_, annot, delta_type, prior=NULL,
+ sourceNode=NULL, sinkNode=NULL, all.int=FALSE, all.pos=FALSE, flag_time_series=TRUE)
+
+ checkEquals(true_result_objval, res$objval, tolerance=0.00001)
+ checkEquals(true_result_solution, res$solution, tolerance=0.00001)
+ }
>
> test.doILPTimeSeriesShortExamplePerGenePerExpPerTime <- function() {
+
+ true_result_objval <- 62.70474
+ true_result_solution <- c(0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.7947368,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.7550000, 0.0000000,
+ 0.0000000, 0.7550000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.7550000, 0.0000000,
+ 0.0000000, 0.7550000, 0.0000000,
+ 0.0000000, 0.7550000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.7550000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.7550000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ delta <- array(NA, c(n,K,T_))
+
+ delta[,,1] <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta[,,2] <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta[,,3] <- matrix(c(0.755, 0.755, 0.755, 0.755,
+ 0.755, 0.755, 0.755, 0.755,
+ 0.755, 0.755, 0.755, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta[,,4] <- matrix(c(0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755,
+ 0.755, 0.755, 0.96, 0.755), nrow=n, ncol=K, byrow=TRUE)
+
+ delta_type <- "perGeneExpTime"
+
+ res <- doILP(obs_mat, delta, lambda, b, n, K, T_, annot, delta_type, prior=NULL,
+ sourceNode=NULL, sinkNode=NULL, all.int=FALSE, all.pos=FALSE, flag_time_series=TRUE)
+
+ checkEquals(true_result_objval, res$objval, tolerance=0.00001)
+ checkEquals(true_result_solution, res$solution, tolerance=0.00001)
+ }
>
>
> proc.time()
user system elapsed
0.263 0.055 0.287
lpNet.Rcheck/tests/runitGenerateTimeSeriesNetStates.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.generateTimeSeriesGeneStates <- function() {
+
+ n <- 10
+ K <- 11
+ T_ <- 6
+
+ true_result <- array(NA, c(n,K,T_))
+
+ true_result[ , , 1] <- matrix(c(0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0), nrow=n, ncol=K, byrow=TRUE)
+
+ true_result[ , , 2] <- matrix(c(0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 1,1,1,0,1,1,1,1,1,1,1,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,0,1,1,1,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0), nrow=n, ncol=K, byrow=TRUE)
+
+ true_result[ , , 3] <- matrix(c(0,1,1,0,1,1,1,1,1,1,1,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 1,1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,0,1,1,1,1,1,1,
+ 1,1,1,1,1,0,1,0,1,1,1,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,0,1,1,1,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0), nrow=n, ncol=K, byrow=TRUE)
+
+ true_result[ , , 4] <- matrix(c(0,1,1,0,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,0,1,1,1,1,1,1,
+ 1,1,1,1,1,0,1,0,1,1,1,
+ 0,0,0,1,1,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,0,1,1,1,
+ 0,0,0,0,0,1,0,1,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0), nrow=n, ncol=K, byrow=TRUE)
+
+ true_result[ , , 5] <- matrix(c(0,1,1,0,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,1,0,1,1,1,1,1,1,
+ 1,1,1,1,1,0,1,1,1,1,1,
+ 0,0,0,1,1,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,0,1,1,1,
+ 0,0,0,0,0,1,0,1,0,0,0,
+ 1,0,1,1,1,1,1,1,1,0,1), nrow=n, ncol=K, byrow=TRUE)
+
+ true_result[ , , 6] <- matrix(c(0,1,1,0,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,1,0,1,1,1,1,1,1,
+ 1,1,0,1,1,0,1,0,1,1,1,
+ 0,0,0,0,1,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,0,1,1,1,
+ 0,0,0,0,0,1,0,0,0,0,0,
+ 1,0,1,1,1,1,1,1,1,0,1), nrow=n, ncol=K, byrow=TRUE)
+
+ T_nw <- matrix(c(0,0,1,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,1,
+ 0,1,0,0,1,1,0,0,0,0,
+ 1,0,0,0,1,0,0,0,0,0,
+ 0,1,0,0,0,0,-1,0,1,0,
+ 0,1,1,0,0,0,1,0,-1,0,
+ 0,1,0,0,1,0,0,0,0,0,
+ 0,0,0,0,0,1,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,1,-1,0,0,0,0), nrow=n, ncol=n, byrow=T)
+
+ b <- c(0,1,1,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,
+ 1,1,1,1,0,1,1,1,1,1,
+ 1,1,1,1,1,0,1,1,1,1,
+ 1,1,1,1,1,1,0,1,1,1,
+ 1,1,1,1,1,1,1,0,1,1,
+ 1,1,1,1,1,1,1,1,0,1,
+ 1,1,1,1,1,1,1,1,1,0,
+ 1,1,1,1,1,1,1,1,1,1)
+
+
+ gene_states <- generateTimeSeriesNetStates(nw_und=T_nw, b=b, n=n, K=K, T_user=NULL)
+
+ checkEquals(true_result, gene_states$node_state_vec)
+ }
>
>
> test.generateTimeSeriesGeneStatesT10 <- function() {
+
+ n <- 10
+ K <- 11
+ T_ <- 6
+
+ T_nw <- matrix(c(0,0,1,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,1,
+ 0,1,0,0,1,1,0,0,0,0,
+ 1,0,0,0,1,0,0,0,0,0,
+ 0,1,0,0,0,0,-1,0,1,0,
+ 0,1,1,0,0,0,1,0,-1,0,
+ 0,1,0,0,1,0,0,0,0,0,
+ 0,0,0,0,0,1,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,1,-1,0,0,0,0), nrow=n, ncol=n, byrow=T)
+
+ b <- c(0,1,1,1,1,1,1,1,1,1,
+ 1,0,1,1,1,1,1,1,1,1,
+ 1,1,0,1,1,1,1,1,1,1,
+ 1,1,1,0,1,1,1,1,1,1,
+ 1,1,1,1,0,1,1,1,1,1,
+ 1,1,1,1,1,0,1,1,1,1,
+ 1,1,1,1,1,1,0,1,1,1,
+ 1,1,1,1,1,1,1,0,1,1,
+ 1,1,1,1,1,1,1,1,0,1,
+ 1,1,1,1,1,1,1,1,1,0,
+ 1,1,1,1,1,1,1,1,1,1)
+
+
+ gene_states <- generateTimeSeriesNetStates(nw_und=T_nw, b=b, n=n, K=K, T_user=10)
+
+ checkEquals(10, gene_states$T_)
+ }
>
>
> proc.time()
user system elapsed
0.267 0.060 0.289
lpNet.Rcheck/tests/runitGetAdja.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.getAdja <- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result <- matrix(c(0, 0.7947368, -1.1411606,
+ 0, 0.0000000, 1.9358974,
+ 0, 0.0000000, 0.000000), nrow=n, ncol=n, byrow=TRUE)
+
+ res <- list()
+
+ res$solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 1.9358974,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 1.1411606,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.4450526, 0.4450526,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ res$objective <- c(0, 1, 1, 1, 0, 1, 1, 1, 0, 0,
+ 1, 1, 1, 0, 1, 1, 1, 0, 1, 1,
+ 1, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10)
+
+ names(res$objective) <- c("w+_1_1", "w+_1_2", "w+_1_3",
+ "w+_2_1", "w+_2_2", "w+_2_3",
+ "w+_3_1", "w+_3_2", "w+_3_3",
+ "w-_1_1", "w-_1_2", "w-_1_3",
+ "w-_2_1", "w-_2_2", "w-_2_3",
+ "w-_3_1", "w-_3_2", "w-_3_3",
+ "w_1_^_0", "w_2_^_0", "w_3_^_0",
+ "s_1", "s_2", "s_3", "s_4",
+ "s_5", "s_6", "s_7", "s_8",
+ "s_9", "s_10", "s_11", "s_12")
+
+ adja = getAdja(res, n)
+
+ checkEquals(true_result, adja)
+
+ }
>
>
> test.getAdjaTimeSeries<- function() {
+
+ n <- 3
+
+ true_result = matrix(c(0, 0.7947368, 0.0000000,
+ 0, 0.0000000, 0.7947368,
+ 0, 0.0000000, 0.0000000), nrow=n, ncol=n, byrow=TRUE)
+
+ res = list()
+ res$solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 0.7947368,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ res$objective <- c(0, 1, 1, 1, 0, 1, 1, 1, 0, 0,
+ 1, 1, 1, 0, 1, 1, 1, 0, 1, 1,
+ 1, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10)
+
+ names(res$objective) <- c("w+_1_1", "w+_1_2", "w+_1_3",
+ "w+_2_1", "w+_2_2", "w+_2_3",
+ "w+_3_1", "w+_3_2", "w+_3_3",
+ "w-_1_1", "w-_1_2", "w-_1_3",
+ "w-_2_1", "w-_2_2", "w-_2_3",
+ "w-_3_1", "w-_3_2", "w-_3_3",
+ "w_1_^_0", "w_2_^_0", "w_3_^_0",
+ "s_1", "s_2", "s_3", "s_4",
+ "s_5", "s_6", "s_7", "s_8",
+ "s_9", "s_10", "s_11", "s_12",
+ "s_13", "s_14", "s_15", "s_16",
+ "s_17", "s_18", "s_19", "s_20",
+ "s_21", "s_22", "s_23", "s_24",
+ "s_25", "s_26", "s_27", "s_28",
+ "s_29", "s_30", "s_31", "s_32",
+ "s_33", "s_34", "s_35", "s_36")
+
+ adja = getAdja(res, n)
+
+ checkEquals(true_result, adja)
+ }
>
> proc.time()
user system elapsed
0.264 0.060 0.293
lpNet.Rcheck/tests/runitGetBaseline.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.getBaseline <- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result = c(0.7550000, 0.0000000, 0.0000000)
+
+ res <- list()
+
+ res$solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 1.9358974,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 1.1411606,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.4450526, 0.4450526,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ res$objective <- c(0, 1, 1, 1, 0, 1, 1, 1, 0, 0,
+ 1, 1, 1, 0, 1, 1, 1, 0, 1, 1,
+ 1, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10)
+
+ names(res$objective) <- c("w+_1_1", "w+_1_2", "w+_1_3",
+ "w+_2_1", "w+_2_2", "w+_2_3",
+ "w+_3_1", "w+_3_2", "w+_3_3",
+ "w-_1_1", "w-_1_2", "w-_1_3",
+ "w-_2_1", "w-_2_2", "w-_2_3",
+ "w-_3_1", "w-_3_2", "w-_3_3",
+ "w_1_^_0", "w_2_^_0", "w_3_^_0",
+ "s_1", "s_2", "s_3", "s_4",
+ "s_5", "s_6", "s_7", "s_8",
+ "s_9", "s_10", "s_11", "s_12")
+
+ adja = getBaseline(res, n)
+
+ checkEquals(true_result, adja)
+
+ }
>
>
> test.getBaselineTimeSeries<- function() {
+
+ n <- 3
+
+ true_result = c(0.7550000, 0.0000000, 0.0000000)
+
+ res = list()
+ res$solution <- c(0.0000000, 0.7947368, 0.0000000,
+ 0.0000000, 0.0000000, 0.7947368,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.7550000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.0000000, 0.0000000)
+
+ res$objective <- c(0, 1, 1, 1, 0, 1, 1, 1, 0, 0,
+ 1, 1, 1, 0, 1, 1, 1, 0, 1, 1,
+ 1, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10)
+
+ names(res$objective) <- c("w+_1_1", "w+_1_2", "w+_1_3",
+ "w+_2_1", "w+_2_2", "w+_2_3",
+ "w+_3_1", "w+_3_2", "w+_3_3",
+ "w-_1_1", "w-_1_2", "w-_1_3",
+ "w-_2_1", "w-_2_2", "w-_2_3",
+ "w-_3_1", "w-_3_2", "w-_3_3",
+ "w_1_^_0", "w_2_^_0", "w_3_^_0",
+ "s_1", "s_2", "s_3", "s_4",
+ "s_5", "s_6", "s_7", "s_8",
+ "s_9", "s_10", "s_11", "s_12",
+ "s_13", "s_14", "s_15", "s_16",
+ "s_17", "s_18", "s_19", "s_20",
+ "s_21", "s_22", "s_23", "s_24",
+ "s_25", "s_26", "s_27", "s_28",
+ "s_29", "s_30", "s_31", "s_32",
+ "s_33", "s_34", "s_35", "s_36")
+
+
+ adja = getBaseline(res, n)
+
+ checkEquals(true_result, adja)
+ }
>
> proc.time()
user system elapsed
0.243 0.054 0.267
lpNet.Rcheck/tests/runitGetEdgeAnnot.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.getEdgeAnnot <- function() {
+
+ true_result = c("w+_1_1", "w+_1_2", "w+_1_3", "w+_2_1", "w+_2_2", "w+_2_3", "w+_3_1", "w+_3_2", "w+_3_3",
+ "w-_1_1", "w-_1_2", "w-_1_3", "w-_2_1", "w-_2_2", "w-_2_3", "w-_3_1", "w-_3_2", "w-_3_3",
+ "w_1_^_0", "w_2_^_0", "w_3_^_0")
+
+ n <- 3
+ edge_annot <- getEdgeAnnot(n, allpos=FALSE)
+
+ checkEquals(true_result, edge_annot)
+ }
>
>
> test.getEdgeAnnotAllPos <- function() {
+
+ true_result = c("w+_1_1", "w+_1_2", "w+_1_3", "w+_2_1", "w+_2_2", "w+_2_3", "w+_3_1", "w+_3_2", "w+_3_3",
+ "w_1_^_0", "w_2_^_0", "w_3_^_0")
+
+ n <- 3
+ edge_annot <- getEdgeAnnot(n, allpos=TRUE)
+
+ checkEquals(true_result, edge_annot)
+ }
>
>
> proc.time()
user system elapsed
0.203 0.050 0.220
lpNet.Rcheck/tests/runitGetObsMat.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.getObsMatMuTypeSingle <- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K)
+
+ active_mu <- 0.95
+ active_sd <- 0.01
+ inactive_mu <- 0.56
+ inactive_sd <- 0.01
+
+ obs_mat <- getObsMat(act_mat, net_states=NULL, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="single")
+ checkEquals(true_result, obs_mat, tolerance=(active_sd + inactive_sd))
+ }
>
>
> test.getObsMatMuTypePerGene <- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.4, 0.4, 1.1, 1.1,
+ 0.2, 0.2, 0.2, 1.3), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K)
+
+
+ active_mu <- c(0.95, 1.1, 1.3)
+ active_sd <- rep(0.01, n)
+ inactive_mu <- c(0.56, 0.4, 0.2)
+ inactive_sd <- rep(0.01, n)
+
+ obs_mat <- getObsMat(act_mat, net_states=NULL, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="perGene")
+ checkEquals(true_result, obs_mat, tolerance=(max(active_sd) + max(inactive_sd)))
+ }
>
>
> test.getObsMatMuTypePerGeneExp <- function() {
+
+ n <- 3
+ K <- 4
+
+ true_result <- matrix(c(1.1, 10.3, 10.5, 10.7,
+ 2.1, 2.3, 20.5, 20.7,
+ 3.1, 3.3, 3.5, 30.7), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ act_mat <- calcActivation(T_nw, b, n, K)
+
+ active_mu <- matrix(c(10.1, 20.1, 30.1,
+ 10.3, 20.3, 30.3,
+ 10.5, 20.5, 30.5,
+ 10.7, 20.7, 30.7), nrow=n, ncol=K)
+
+ active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+
+ inactive_mu <- matrix(c(1.1, 2.1, 3.1,
+ 1.3, 2.3, 3.3,
+ 1.5, 2.5, 3.5,
+ 1.7, 2.7, 3.7), nrow=n, ncol=K)
+
+ inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+
+ obs_mat <- getObsMat(act_mat, net_states=NULL, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="perGeneExp")
+ checkEquals(true_result, obs_mat, tolerance=(max(active_sd) + max(inactive_sd)))
+ }
>
>
> test.getObsMatMuTypeSingle_nodeStates <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- array(NA, c(n, K, T_))
+
+ true_result[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ net_states <- array(NA, c(n,K,T_))
+
+ net_states[,,1] <- matrix(c(0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,2] <- matrix(c(0,1,1,1,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,3] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,4] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,1), nrow=n, ncol=K, byrow=T)
+
+ active_mu <- 0.95
+ active_sd <- 0.01
+ inactive_mu <- 0.56
+ inactive_sd <- 0.01
+
+ obs_mat <- getObsMat(act_mat=NULL, net_states, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="single")
+ checkEquals(true_result, obs_mat, tolerance=(active_sd + inactive_sd))
+ }
>
>
> test.getObsMatMuTypePerGene_nodeStates <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- array(NA, c(n,K,T_))
+
+ true_result[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.4, 0.4, 0.4, 0.4,
+ 0.2, 0.2, 0.2, 0.2), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.4, 0.4, 0.4, 0.4,
+ 0.2, 0.2, 0.2, 0.2), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.4, 0.4, 1.1, 1.1,
+ 0.2, 0.2, 0.2, 0.2), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.4, 0.4, 1.1, 1.1,
+ 0.2, 0.2, 0.2, 1.3), nrow=n, ncol=K, byrow=T)
+
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ net_states <- array(NA, c(n,K,T_))
+
+ net_states[,,1] <- matrix(c(0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,2] <- matrix(c(0,1,1,1,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,3] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,4] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,1), nrow=n, ncol=K, byrow=T)
+
+ active_mu <- c(0.95, 1.1, 1.3)
+ active_sd <- rep(0.01, n)
+ inactive_mu <- c(0.56, 0.4, 0.2)
+ inactive_sd <- rep(0.01, n)
+
+ obs_mat <- getObsMat(act_mat=NULL, net_states, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="perGene")
+ checkEquals(true_result, obs_mat, tolerance=(max(active_sd) + max(inactive_sd)))
+ }
>
>
> test.getObsMatMuTypePerGeneExp_nodeStates <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- array(NA, c(n,K,T_))
+
+ true_result[,,1] <- matrix(c(1.1, 1.3, 1.5, 1.7,
+ 2.1, 2.3, 2.5, 2.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,2] <- matrix(c(1.1, 10.3, 10.5, 10.7,
+ 2.1, 2.3, 2.5, 2.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,3] <- matrix(c(1.1, 10.3, 10.5, 10.7,
+ 2.1, 2.3, 20.5, 20.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,4] <- matrix(c(1.1, 10.3, 10.5, 10.7,
+ 2.1, 2.3, 20.5, 20.7,
+ 3.1, 3.3, 3.5, 30.7), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ net_states <- array(NA, c(n,K,T_))
+
+ net_states[,,1] <- matrix(c(0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,2] <- matrix(c(0,1,1,1,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,3] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,4] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,1), nrow=n, ncol=K, byrow=T)
+
+
+ active_mu <- matrix(c(10.1, 10.3, 10.5, 10.7,
+ 20.1, 20.3, 20.5, 20.7,
+ 30.1, 30.3, 30.5, 30.7), nrow=n, ncol=K, byrow=T)
+
+ active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+
+ inactive_mu <- matrix(c(1.1, 1.3, 1.5, 1.7,
+ 2.1, 2.3, 2.5, 2.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=K, byrow=T)
+
+ inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+
+ obs_mat <- getObsMat(act_mat=NULL, net_states, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="perGeneExp")
+ checkEquals(true_result, obs_mat, tolerance=(max(active_sd) + max(inactive_sd)))
+ }
>
>
> test.getObsMatMuTypePerGeneTime_nodeStates <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- array(NA, c(n,K,T_))
+
+ true_result[,,1] <- matrix(c(1.1, 1.1, 1.1, 1.1,
+ 2.1, 2.1, 2.1, 2.1,
+ 3.1, 3.1, 3.1, 3.1), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,2] <- matrix(c(1.3, 10.3, 10.3, 10.3,
+ 2.1, 2.3, 2.3, 2.3,
+ 3.3, 3.3, 3.3, 3.3), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,3] <- matrix(c(1.5, 10.5, 10.5, 10.5,
+ 2.5, 2.5, 20.5, 20.5,
+ 3.5, 3.5, 3.5, 3.5), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,4] <- matrix(c(1.7, 10.7, 10.7, 10.7,
+ 2.7, 2.7, 20.7, 20.7,
+ 3.7, 3.7, 3.7, 30.7), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ net_states <- array(NA, c(n,K,T_))
+
+ net_states[,,1] <- matrix(c(0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,2] <- matrix(c(0,1,1,1,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,3] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,4] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,1), nrow=n, ncol=K, byrow=T)
+
+
+ active_mu <- matrix(c(10.1, 10.3, 10.5, 10.7,
+ 20.1, 20.3, 20.5, 20.7,
+ 30.1, 30.3, 30.5, 30.7), nrow=n, ncol=T_, byrow=T)
+
+ active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=T_)
+
+ inactive_mu <- matrix(c(1.1, 1.3, 1.5, 1.7,
+ 2.1, 2.3, 2.5, 2.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=T_, byrow=T)
+
+ inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=T_)
+
+ obs_mat <- getObsMat(act_mat=NULL, net_states, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="perGeneTime")
+ checkEquals(true_result, obs_mat, tolerance=(max(active_sd) + max(inactive_sd)))
+ }
>
>
> test.getObsMatMuTypePerGeneExpTime_nodeStates <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ true_result <- array(NA, c(n,K,T_))
+
+ true_result[,,1] <- matrix(c(1.1, 1.3, 1.5, 1.7,
+ 1.1, 1.3, 1.5, 1.7,
+ 1.1, 1.3, 1.5, 1.7), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,2] <- matrix(c(2.1, 20.3, 20.5, 20.7,
+ 2.1, 2.3, 2.5, 2.7,
+ 2.1, 2.3, 2.5, 2.7), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,3] <- matrix(c(3.1, 30.3, 30.5, 30.7,
+ 3.1, 3.3, 30.5, 30.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=K, byrow=T)
+
+ true_result[,,4] <- matrix(c(4.1, 40.3, 40.5, 40.7,
+ 4.1, 4.3, 40.5, 40.7,
+ 4.1, 4.3, 4.5, 40.7), nrow=n, ncol=K, byrow=T)
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ net_states <- array(NA, c(n,K,T_))
+
+ net_states[,,1] <- matrix(c(0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,2] <- matrix(c(0,1,1,1,
+ 0,0,0,0,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,3] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,0), nrow=n, ncol=K, byrow=T)
+
+ net_states[,,4] <- matrix(c(0,1,1,1,
+ 0,0,1,1,
+ 0,0,0,1), nrow=n, ncol=K, byrow=T)
+
+ active_mu <- array(NA, c(n,K,T_))
+
+ active_mu[,,1] <- matrix(c(10.1, 10.3, 10.5, 10.7,
+ 10.1, 10.3, 10.5, 10.7,
+ 10.1, 10.3, 10.5, 10.7), nrow=n, ncol=K, byrow=T)
+
+ active_mu[,,2] <- matrix(c(20.1, 20.3, 20.5, 20.7,
+ 20.1, 20.3, 20.5, 20.7,
+ 20.1, 20.3, 20.5, 20.7), nrow=n, ncol=K, byrow=T)
+
+ active_mu[,,3] <- matrix(c(30.1, 30.3, 30.5, 30.7,
+ 30.1, 30.3, 30.5, 30.7,
+ 30.1, 30.3, 30.5, 30.7), nrow=n, ncol=K, byrow=T)
+
+ active_mu[,,4] <- matrix(c(40.1, 40.3, 40.5, 40.7,
+ 40.1, 40.3, 40.5, 40.7,
+ 40.1, 40.3, 40.5, 40.7), nrow=n, ncol=K, byrow=T)
+
+ active_sd <- array(0.01, c(n,K,T_))
+
+ inactive_mu <- array(NA, c(n,K,T_))
+ inactive_mu[,,1] <- matrix(c(1.1, 1.3, 1.5, 1.7,
+ 1.1, 1.3, 1.5, 1.7,
+ 1.1, 1.3, 1.5, 1.7), nrow=n, ncol=K, byrow=T)
+
+ inactive_mu[,,2] <- matrix(c(2.1, 2.3, 2.5, 2.7,
+ 2.1, 2.3, 2.5, 2.7,
+ 2.1, 2.3, 2.5, 2.7), nrow=n, ncol=K, byrow=T)
+
+ inactive_mu[,,3] <- matrix(c(3.1, 3.3, 3.5, 3.7,
+ 3.1, 3.3, 3.5, 3.7,
+ 3.1, 3.3, 3.5, 3.7), nrow=n, ncol=K, byrow=T)
+
+ inactive_mu[,,4] <- matrix(c(4.1, 4.3, 4.5, 4.7,
+ 4.1, 4.3, 4.5, 4.7,
+ 4.1, 4.3, 4.5, 4.7), nrow=n, ncol=K, byrow=T)
+
+ inactive_sd <- array(0.01, c(n,K,T_))
+
+ obs_mat <- getObsMat(act_mat=NULL, net_states, active_mu, active_sd, inactive_mu, inactive_sd, mu_type="perGeneExpTime")
+ checkEquals(true_result, obs_mat, tolerance=(max(active_sd) + max(inactive_sd)))
+ }
>
> proc.time()
user system elapsed
0.331 0.052 0.357
lpNet.Rcheck/tests/runitGetSampleAdja.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.getSampleAdja <- function() {
+
+ n <- 3
+ K <- 4
+ annot <- getEdgeAnnot(n)
+ annot_node = seq(1,n)
+
+ true_result <- matrix(c(0, 0.7947368, -0.3973684,
+ 0, 0.0000000, 0.7947368,
+ 0, 0.0000000, 0.0000000), nrow=n, ncol=n, byrow=TRUE)
+ colnames(true_result) <- rownames(true_result) <- annot_node
+
+ edges_all <- matrix(c(0.7947368, 0.7947368, 0, 0.0000000, 0, 0.0000000,
+ 0.0000000, -1.1411606, 0, 1.9358974, 0, 0.0000000,
+ 0.0000000, -1.1411606, 0, 1.9358974, 0, 1.3482143,
+ 0.7947368, 0.7947368, 0, 0.0000000, 0, 0.0000000,
+ 0.7947368, 0.0000000, 0, 0.7947368, 0, 0.0000000,
+ 0.7947368, 0.7947368, 0, 0.0000000, 0, 0.0000000,
+ -0.5534774, -1.1411606, 0, 1.9358974, 0, 1.3482143,
+ 0.7947368, -1.1411606, 0, 1.9358974, 0, 0.0000000,
+ 0.7947368, -1.1411606, 0, 1.9358974, 0, 0.0000000,
+ 0.3262604, -0.7947368, 0, 0.7947368, 0, 0.7947368,
+ 1.9358974, 0.0000000, 0, -1.3482143, 0, -1.9358974,
+ 1.9358974, 0.0000000, 0, 0.0000000, 0, -1.9358974), nrow=n*K, ncol=n*(n-1), byrow=TRUE)
+
+ colnames(edges_all) <- c("1->2", "1->3", "2->1", "2->3", "3->1", "3->2")
+
+ sampleAdja = getSampleAdja(edges_all, n, annot_node, method=median, septype="->")
+
+ checkEquals(true_result, sampleAdja, tolerance=0.00001)
+ }
>
> proc.time()
user system elapsed
0.222 0.053 0.243
lpNet.Rcheck/tests/runitGetSampleAdjaMAD.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.getSampleAdjaMAD <- function() {
+
+ n <- 3
+ K <- 4
+ annot <- getEdgeAnnot(n)
+ annot_node = seq(1,n)
+
+ true_result <- matrix(c(0, 0.7947368, 0.0000000,
+ 0, 0.0000000, 0.0000000,
+ 0, 0.0000000, 0.0000000), nrow=n, ncol=n, byrow=TRUE)
+ colnames(true_result) <- rownames(true_result) <- annot_node
+
+ edges_all <- matrix(c(0.7947368, 0.7947368, 0, 0.0000000, 0, 0.0000000,
+ 0.0000000, -1.1411606, 0, 1.9358974, 0, 0.0000000,
+ 0.0000000, -1.1411606, 0, 1.9358974, 0, 1.3482143,
+ 0.7947368, 0.7947368, 0, 0.0000000, 0, 0.0000000,
+ 0.7947368, 0.0000000, 0, 0.7947368, 0, 0.0000000,
+ 0.7947368, 0.7947368, 0, 0.0000000, 0, 0.0000000,
+ -0.5534774, -1.1411606, 0, 1.9358974, 0, 1.3482143,
+ 0.7947368, -1.1411606, 0, 1.9358974, 0, 0.0000000,
+ 0.7947368, -1.1411606, 0, 1.9358974, 0, 0.0000000,
+ 0.3262604, -0.7947368, 0, 0.7947368, 0, 0.7947368,
+ 1.9358974, 0.0000000, 0, -1.3482143, 0, -1.9358974,
+ 1.9358974, 0.0000000, 0, 0.0000000, 0, -1.9358974), nrow=n*K, ncol=n*(n-1), byrow=TRUE)
+
+ colnames(edges_all) <- c("1->2", "1->3", "2->1", "2->3", "3->1", "3->2")
+
+ sampleAdjaMAD = getSampleAdjaMAD(edges_all, n, annot_node, method=median, method2=mad, septype="->")
+
+ checkEquals(true_result, sampleAdjaMAD, tolerance=0.00001)
+ }
>
> proc.time()
user system elapsed
0.268 0.059 0.301
lpNet.Rcheck/tests/runitKfoldCV.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.runitKfoldCV <- function() {
+
+ n <- 3
+ K <- 4
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <- c(0.76,0.76,0)
+
+ mu_types <- c("single", "perGene", "perGeneExp")
+ delta_types <- c("perGene", "perGene", "perGeneExp")
+
+ mu_list <- list()
+ mu_list[[1]] <- list()
+ mu_list[[2]] <- list()
+ mu_list[[3]] <- list()
+
+ mu_list[[1]]$active_mu <- 0.95
+ mu_list[[1]]$active_sd <- 0.01
+ mu_list[[1]]$inactive_mu <- 0.56
+ mu_list[[1]]$inactive_sd <- 0.01
+ mu_list[[1]]$delta <- rep(0.755, n)
+
+ mu_list[[2]]$active_mu <- rep(0.95, n)
+ mu_list[[2]]$active_sd <- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <- rep(0.01, n)
+ mu_list[[2]]$delta <- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+
+ kfold <- 10
+ lambda <- 1/10
+ annot <- getEdgeAnnot(n)
+ annot_node <- seq(1,n)
+
+ true_result <- list()
+
+ true_result <- matrix(c(0, 0.7947368, -0.5,
+ 0, 0.0000000, 1.0,
+ 0, 0.0000000, 0.000000), nrow=n, ncol=n, byrow=TRUE)
+ colnames(true_result) <- rownames(true_result) <- seq(1,n)
+
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ delta_type <- delta_types[i]
+
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ res <- kfoldCV(kfold=kfold, times=1, delta=delta, lambda=lambda, obs=obs_mat, b=b, n=n, K=K, T_=NULL, annot=annot,
+ annot_node=annot_node, active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, delta_type=delta_type, prior=NULL, sourceNode=NULL,
+ sinkNode=NULL, allint=FALSE, allpos=FALSE)
+
+ adja <- getSampleAdja(res$edges_all, n, annot_node, method=median, septype="->")
+
+ checkEquals(true_result, adja, tolerance=0.6)
+ }
+ }
>
>
> proc.time()
user system elapsed
0.278 0.058 0.304
lpNet.Rcheck/tests/runitKfoldCV_timeSeries.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.runitKfoldCV_timeSeries <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <- c(0.76,0.76,0)
+
+ mu_types <- c("single", "perGene", "perGeneExp", "perGeneTime", "perGeneExpTime")
+ delta_types <- c("perGene", "perGene", "perGeneExp", "perGeneTime", "perGeneExpTime")
+
+ mu_list <- list()
+ mu_list[[1]] <- list()
+ mu_list[[2]] <- list()
+ mu_list[[3]] <- list()
+ mu_list[[4]] <- list()
+ mu_list[[5]] <- list()
+
+ mu_list[[1]]$active_mu <- 0.95
+ mu_list[[1]]$active_sd <- 0.01
+ mu_list[[1]]$inactive_mu <- 0.56
+ mu_list[[1]]$inactive_sd <- 0.01
+ mu_list[[1]]$delta <- rep(0.755, n)
+
+
+ mu_list[[2]]$active_mu <- rep(0.95, n)
+ mu_list[[2]]$active_sd <- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <- rep(0.01, n)
+ mu_list[[2]]$delta <- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+
+ mu_list[[4]]$active_mu <- matrix(rep(0.95, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$active_sd <- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_mu <- matrix(rep(0.56, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_sd <- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$delta <- matrix(rep(0.755, n*T_), nrow=n, ncol=T_)
+
+ mu_list[[5]]$active_mu <- array(rep(0.95, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$active_sd <- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_mu <- array(rep(0.56, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_sd <- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$delta <- array(rep(0.755, n*K*T_), c(n,K,T_))
+
+ kfold <- 10
+ lambda <- 1/10
+ annot <- getEdgeAnnot(n)
+ annot_node <- seq(1,n)
+
+ true_result <- matrix(c(0, 0.7947368, 0.0000000,
+ 0, 0.0000000, 0.7947368,
+ 0, 0.0000000, 0.0000000), nrow=n, ncol=n, byrow=TRUE)
+
+ colnames(true_result) <- rownames(true_result) <- seq(1,n)
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ delta_type <- delta_types[i]
+
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ res <- kfoldCV(kfold=kfold, times=1, obs=obs_mat, delta=delta, lambda=lambda, b=b, n=n, K=K, T_=T_, annot=annot,
+ annot_node=annot_node, active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, delta_type=delta_type, prior=NULL, sourceNode=NULL,
+ sinkNode=NULL, allint=FALSE, allpos=FALSE, flag_time_series=TRUE)
+
+ adja <- getSampleAdjaMAD(res$edges_all, n, annot_node, method=median, method2=mad, septype="->")
+ checkEquals(true_result, adja, tolerance=0.00001)
+ }
+ }
>
>
> proc.time()
user system elapsed
0.271 0.054 0.293
lpNet.Rcheck/tests/runitLOOCV.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.runitLOOCV <- function() {
+
+ n <- 3
+ K <- 4
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <- c(0.76,0.76,0)
+
+ mu_types <- c("single", "perGene", "perGeneExp")
+ delta_types <- c("perGene", "perGene", "perGeneExp")
+
+ mu_list <- list()
+ mu_list[[1]] <- list()
+ mu_list[[2]] <- list()
+ mu_list[[3]] <- list()
+
+ mu_list[[1]]$active_mu <- 0.95
+ mu_list[[1]]$active_sd <- 0.01
+ mu_list[[1]]$inactive_mu <- 0.56
+ mu_list[[1]]$inactive_sd <- 0.01
+ mu_list[[1]]$delta <- rep(0.755, n)
+
+ mu_list[[2]]$active_mu <- rep(0.95, n)
+ mu_list[[2]]$active_sd <- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <- rep(0.01, n)
+ mu_list[[2]]$delta <- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+
+ kfold <- 10
+ lambda <- 1/10
+ annot <- getEdgeAnnot(n)
+ annot_node <- seq(1,n)
+
+ true_result <- list()
+
+ true_result <- matrix(c(0, 0.7947368, -0.3973684,
+ 0, 0.0000000, 0.7947368,
+ 0, 0.0000000, 0.000000), nrow=n, ncol=n, byrow=TRUE)
+
+ colnames(true_result) <- rownames(true_result) <- seq(1,n)
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ delta_type <- delta_types[i]
+
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ res <- loocv(kfold=NULL, times=1, obs=obs_mat, delta=delta, lambda=lambda, b=b, n=n, K=K, T_=NULL, annot=annot,
+ annot_node=annot_node, active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, delta_type=delta_type, prior=NULL, sourceNode=NULL,
+ sinkNode=NULL, allint=FALSE, allpos=FALSE)
+
+ adja <- getSampleAdja(res$edges_all, n, annot_node, method=median, septype="->")
+
+ checkEquals(true_result, adja, tolerance=0.00001)
+ }
+ }
>
>
> proc.time()
user system elapsed
0.263 0.054 0.284
lpNet.Rcheck/tests/runitLOOCV_timeSeries.Rout
R version 3.5.1 Patched (2018-07-12 r74967) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin15.6.0 (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.runitLOOCV_timeSeries <- function() {
+
+ n <- 3
+ K <- 4
+ T_ <- 4
+
+ T_nw <- matrix(c(0,1,0,
+ 0,0,1,
+ 0,0,0), nrow=n, ncol=n, byrow=TRUE)
+
+ b <- c(0,1,1,
+ 1,0,1,
+ 1,1,0,
+ 1,1,1)
+
+ obs_mat <- array(NA, c(n,K,T_))
+
+ obs_mat[,,1] <- matrix(c(0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,2] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,3] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.56), nrow=n, ncol=K, byrow=TRUE)
+
+ obs_mat[,,4] <- matrix(c(0.56, 0.95, 0.95, 0.95,
+ 0.56, 0.56, 0.95, 0.95,
+ 0.56, 0.56, 0.56, 0.95), nrow=n, ncol=K, byrow=TRUE)
+
+ baseline <- c(0.76, 0.76, 0)
+
+ mu_types <- c("single", "perGene", "perGeneExp", "perGeneTime", "perGeneExpTime")
+ delta_types <- c("perGene", "perGene", "perGeneExp", "perGeneTime", "perGeneExpTime")
+
+ mu_list <- list()
+ mu_list[[1]] <- list()
+ mu_list[[2]] <- list()
+ mu_list[[3]] <- list()
+ mu_list[[4]] <- list()
+ mu_list[[5]] <- list()
+
+ mu_list[[1]]$active_mu <- 0.95
+ mu_list[[1]]$active_sd <- 0.01
+ mu_list[[1]]$inactive_mu <- 0.56
+ mu_list[[1]]$inactive_sd <- 0.01
+ mu_list[[1]]$delta <- rep(0.755, n)
+
+
+ mu_list[[2]]$active_mu <- rep(0.95, n)
+ mu_list[[2]]$active_sd <- rep(0.01, n)
+ mu_list[[2]]$inactive_mu <- rep(0.56, n)
+ mu_list[[2]]$inactive_sd <- rep(0.01, n)
+ mu_list[[2]]$delta <- rep(0.755, n)
+
+ mu_list[[3]]$active_mu <- matrix(rep(0.95, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$active_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_mu <- matrix(rep(0.56, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$inactive_sd <- matrix(rep(0.01, n*K), nrow=n, ncol=K)
+ mu_list[[3]]$delta <- matrix(rep(0.755, n*K), nrow=n, ncol=K)
+
+ mu_list[[4]]$active_mu <- matrix(rep(0.95, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$active_sd <- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_mu <- matrix(rep(0.56, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$inactive_sd <- matrix(rep(0.01, n*T_), nrow=n, ncol=T_)
+ mu_list[[4]]$delta <- matrix(rep(0.755, n*T_), nrow=n, ncol=T_)
+
+ mu_list[[5]]$active_mu <- array(rep(0.95, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$active_sd <- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_mu <- array(rep(0.56, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$inactive_sd <- array(rep(0.01, n*K*T_), c(n,K,T_))
+ mu_list[[5]]$delta <- array(rep(0.755, n*K*T_), c(n,K,T_))
+
+ kfold <- 10
+ lambda <- 1/10
+ annot <- getEdgeAnnot(n)
+ annot_node <- seq(1,n)
+
+ true_result <- matrix(c(0, 0.7947368, 0.0000000,
+ 0, 0.0000000, 0.7947368,
+ 0, 0.0000000, 0.0000000), nrow=n, ncol=n, byrow=TRUE)
+
+ colnames(true_result) <- rownames(true_result) <- seq(1,n)
+
+ for (i in 1:length(mu_types)) {
+ mu_type <- mu_types[i]
+ delta_type <- delta_types[i]
+
+ active_mu <- mu_list[[i]]$active_mu
+ active_sd <- mu_list[[i]]$active_sd
+ inactive_mu <- mu_list[[i]]$inactive_mu
+ inactive_sd <- mu_list[[i]]$inactive_sd
+ delta <- mu_list[[i]]$delta
+
+ res <- loocv(kfold=NULL, times=1, obs=obs_mat, delta=delta, lambda=lambda, b=b, n=n, K=K, T_=T_, annot=annot,
+ annot_node=annot_node, active_mu=active_mu, active_sd=active_sd, inactive_mu=inactive_mu,
+ inactive_sd=inactive_sd, mu_type=mu_type, delta_type=delta_type, prior=NULL, sourceNode=NULL,
+ sinkNode=NULL, allint=FALSE, allpos=FALSE, flag_time_series=TRUE)
+
+ adja <- getSampleAdja(res$edges_all, n, annot_node, method=median, septype="->")
+
+ checkEquals(true_result, adja, tolerance=0.00001)
+ }
+ }
>
>
> proc.time()
user system elapsed
0.312 0.062 0.338
lpNet.Rcheck/lpNet-Ex.timings
| name | user | system | elapsed | |
| CV | 0.383 | 0.031 | 0.423 | |
| calcActivation | 0.005 | 0.000 | 0.005 | |
| calcPrediction | 0.007 | 0.001 | 0.008 | |
| calcRangeLambda | 0.004 | 0.001 | 0.004 | |
| doILP | 0.008 | 0.000 | 0.009 | |
| generateTimeSeriesNetStates | 0.006 | 0.000 | 0.007 | |
| getAdja | 0.007 | 0.000 | 0.007 | |
| getBaseline | 0.005 | 0.001 | 0.006 | |
| getEdgeAnnot | 0.001 | 0.000 | 0.002 | |
| getObsMat | 0.006 | 0.000 | 0.006 | |
| getSampleAdja | 0.004 | 0.000 | 0.004 | |
| summarizeRepl | 0.021 | 0.003 | 0.024 | |