[Swift-commit] r4084 - in SwiftApps/SwiftR: Swift Swift/R mxtests/swift
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Thu Feb 10 17:25:54 CST 2011
Author: tga
Date: 2011-02-10 17:25:49 -0600 (Thu, 10 Feb 2011)
New Revision: 4084
Added:
SwiftApps/SwiftR/mxtests/swift/MakeTests.R
Modified:
SwiftApps/SwiftR/Swift/NAMESPACE
SwiftApps/SwiftR/Swift/R/TestFramework.R
SwiftApps/SwiftR/Swift/R/Tests.R
SwiftApps/SwiftR/mxtests/swift/BootstrapParallelBigger.R
Log:
Added infrastructure for comparative tests of swift and snowfall.
Working towards unifying the performance testing so that the same
test can be run on swift, snowfall, and serially.
now running basic performance tests for the bootstrap example.
Modified: SwiftApps/SwiftR/Swift/NAMESPACE
===================================================================
--- SwiftApps/SwiftR/Swift/NAMESPACE 2011-02-10 21:10:50 UTC (rev 4083)
+++ SwiftApps/SwiftR/Swift/NAMESPACE 2011-02-10 23:25:49 UTC (rev 4084)
@@ -15,6 +15,7 @@
export(makeParamTestGroup)
export(runTestGroup)
export(runTestSuite)
+export(makeTestSuite)
export(printTestGroup)
export(mkTest)
@@ -26,3 +27,4 @@
export(mkPerfTest)
export(doPerfTest)
export(analysePerf)
+
Modified: SwiftApps/SwiftR/Swift/R/TestFramework.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/TestFramework.R 2011-02-10 21:10:50 UTC (rev 4083)
+++ SwiftApps/SwiftR/Swift/R/TestFramework.R 2011-02-10 23:25:49 UTC (rev 4084)
@@ -112,10 +112,16 @@
}
}
+makeTestSuite <- function(tests, setup=NULL, teardown=NULL) {
+ return (list(tests=tests, setup=setup, teardown=teardown))
+}
+
runTestSuite <- function (suite) {
- suite$setup()
+ if (!is.null(suite$setup))
+ suite$setup()
resSuite <- lapply(suite$tests, runTestGroup)
- suite$teardown()
+ if (!is.null(suite$teardown))
+ suite$teardown()
lapply(resSuite, printTestGroup)
return (resSuite)
Modified: SwiftApps/SwiftR/Swift/R/Tests.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Tests.R 2011-02-10 21:10:50 UTC (rev 4083)
+++ SwiftApps/SwiftR/Swift/R/Tests.R 2011-02-10 23:25:49 UTC (rev 4084)
@@ -653,7 +653,7 @@
-swiftTestSuite <- list(
+swiftTestSuite <- makeTestSuite(
setup=function () { initSwiftTestOptions();
swiftInit() }, # swiftInit controlled via options
tests=list(testGroup1.1, testGroup2, testGroup1.2, testGroup1.3, testGroup3, testGroup4,
Modified: SwiftApps/SwiftR/mxtests/swift/BootstrapParallelBigger.R
===================================================================
--- SwiftApps/SwiftR/mxtests/swift/BootstrapParallelBigger.R 2011-02-10 21:10:50 UTC (rev 4083)
+++ SwiftApps/SwiftR/mxtests/swift/BootstrapParallelBigger.R 2011-02-10 23:25:49 UTC (rev 4084)
@@ -1,4 +1,4 @@
-#
+#!/bin/env Rscript
# Copyright 2007-2010 The OpenMx Project
#
# Licensed under the Apache License, Version 2.0 (the "License");
@@ -15,102 +15,153 @@
require(OpenMx)
require(Swift)
+source("mxtests/swift/MakeTests.R")
-hostfile <- Sys.getenv(c("PBS_NODEFILE"))
+#hostfile <- Sys.getenv(c("PBS_NODEFILE"))[[1]]
-hostnames <- read.table(hostfile, stringsAsFactors=FALSE)[[1]]
+#hostnames <- read.table(hostfile, stringsAsFactors=FALSE)[[1]]
+#cat("Running on hosts:", hostnames, "\n")
-swiftSess <- swiftInit(server="ssh", cores=8, hosts=hostnames)
-swiftLibrary("OpenMx")
+main <- function () {
+ swiftLibrary(OpenMx)
-set.seed(10)
+ swiftSess <- swiftSetup(server="local", cores=4)
-# parameters for the simulation: lambda = factor loadings,
-# specifics = specific variances
-nVar <- 75
-nObs <- 10000
-nReps <- 1024
-goodStartValues <- TRUE
-if (!is.logical(goodStartValues)) {
- stop("'goodStartValues' should be logical. Try again.")
+ nVar <- 75
+ nObs <- 10000
+ nReps <- 1024
+
+ perfExperiment(nVar, nObs, nReps)
+ swiftShutdown(swiftSess)
}
-lambda <- matrix(1:nVar*2/nVar, nVar, 1)
-specifics <- diag(nVar)
-chl <- chol(lambda %*% t(lambda) + specifics)
-# indices for parameters and hessian estimate in results
-pStrt <- 3
-pEnd <- pStrt + 2*nVar - 1
-hStrt <- pEnd + 1
-hEnd <- hStrt + 2*nVar - 1
+bootstrapTest <- function (nVar, nObs, nReps) {
+ set.seed(10)
+ topModel <- buildModels(nVar, nObs, nReps)
-# dimension names for OpenMx
-dn <- list()
-dn[[1]] <- paste("Var", 1:nVar, sep="")
-dn[[2]] <- dn[[1]]
+ modelResults <- mxRun(topModel, silent=TRUE, suppressWarnings=TRUE)
-# function to get a covariance matrix
-randomCov <- function(nObs, nVar, chl, dn) {
- x <- matrix(rnorm(nObs*nVar), nObs, nVar)
- x <- x %*% chl
- thisCov <- cov(x)
- dimnames(thisCov) <- dn
- return(thisCov)
+ print(modelResults at output$wallTime)
+ return (modelResults)
}
-createNewModel <- function(index, prefix, model) {
- modelname <- paste(prefix, index, sep='')
- model at data@observed <- randomCov(nObs, nVar, chl, dn)
- model at name <- modelname
- return(model)
-}
-getStats <- function(model) {
- retval <- c(model at output$status[[1]],
- max(abs(model at output$gradient)),
- model at output$estimate,
- sqrt(diag(solve(model at output$hessian))))
- return(retval)
+
+
+ #nVar, nObs, nReps
+#testArgs <- list(
+# list(75, 10000, 4),
+# list(75, 10000, 8),
+# list(75, 10000, 16),
+# list(75, 10000, 32))
+
+testArgs <- list(
+ list(75, 1000, 4),
+ list(75, 1000, 8),
+ list(75, 1000, 16),
+ list(75, 1000, 32))
+
+makeBootstrapTestGroup <- function (...) {
+ makePerfTestGroup(
+ name="BootstrapParallelBigger",
+ f=bootstrapTest,
+ allargs=testArgs,
+ ... )
}
-# initialize obsCov for MxModel
-obsCov <- randomCov(nObs, nVar, chl, dn)
-# results matrix: get results for each simulation
-results <- matrix(0, nReps, hEnd)
-dnr <- c("inform", "maxAbsG", paste("lambda", 1:nVar, sep=""),
- paste("specifics", 1:nVar, sep=""),
- paste("hessLambda", 1:nVar, sep=""),
- paste("hessSpecifics", 1:nVar, sep=""))
-dimnames(results)[[2]] <- dnr
-# instantiate MxModel
-template <- mxModel(name="stErrSim",
- mxMatrix(name="lambda", type="Full", nrow=nVar, ncol=1,
- free=TRUE, values=(1:nVar*2/nVar)*goodStartValues),
- mxMatrix(name="specifics", type="Diag", nrow=nVar,
- free=TRUE, values=rep(1, nVar)),
- mxAlgebra(lambda %*% t(lambda) + specifics,
- name="preCov", dimnames=dn),
- mxData(observed=obsCov, type="cov", numObs=nObs),
- mxMLObjective(covariance='preCov'),
- independent = TRUE)
+buildModels <- function (nVar, nObs, nReps) {
+ # parameters for the simulation: lambda = factor loadings,
+ # specifics = specific variances
+ goodStartValues <- TRUE
+ if (!is.logical(goodStartValues)) {
+ stop("'goodStartValues' should be logical. Try again.")
+ }
-topModel <- mxModel(name = 'container')
+ lambda <- matrix(1:nVar*2/nVar, nVar, 1)
+ specifics <- diag(nVar)
+ chl <- chol(lambda %*% t(lambda) + specifics)
-swiftExportAll()
+ # indices for parameters and hessian estimate in results
+ pStrt <- 3
+ pEnd <- pStrt + 2*nVar - 1
+ hStrt <- pEnd + 1
+ hEnd <- hStrt + 2*nVar - 1
-submodels <- swiftLapply(1:nReps, createNewModel, 'stErrSim', template)
+ # dimension names for OpenMx
+ dn <- list()
+ dn[[1]] <- paste("Var", 1:nVar, sep="")
+ dn[[2]] <- dn[[1]]
-names(submodels) <- imxExtractNames(submodels)
-topModel at submodels <- submodels
+ # function to get a covariance matrix
+ randomCov <- function(nObs, nVar, chl, dn) {
+ x <- matrix(rnorm(nObs*nVar), nObs, nVar)
+ x <- x %*% chl
+ thisCov <- cov(x)
+ dimnames(thisCov) <- dn
+ return(thisCov)
+ }
-modelResults <- mxRun(topModel, silent=TRUE, suppressWarnings=TRUE)
+ createNewModel <- function(index, prefix, model) {
+ modelname <- paste(prefix, index, sep='')
+ model at data@observed <- randomCov(nObs, nVar, chl, dn)
+ model at name <- modelname
+ return(model)
+ }
-print(ncpus)
-print(modelResults at output$wallTime)
+ getStats <- function(model) {
+ retval <- c(model at output$status[[1]],
+ max(abs(model at output$gradient)),
+ model at output$estimate,
+ sqrt(diag(solve(model at output$hessian))))
+ return(retval)
+ }
-swiftShutdown(swiftSess)
+
+ # initialize obsCov for MxModel
+ obsCov <- randomCov(nObs, nVar, chl, dn)
+
+ # results matrix: get results for each simulation
+# results <- matrix(0, nReps, hEnd)
+# dnr <- c("inform", "maxAbsG", paste("lambda", 1:nVar, sep=""),
+# paste("specifics", 1:nVar, sep=""),
+# paste("hessLambda", 1:nVar, sep=""),
+# paste("hessSpecifics", 1:nVar, sep=""))
+# dimnames(results)[[2]] <- dnr
+
+ # instantiate MxModel
+ template <- mxModel(name="stErrSim",
+ mxMatrix(name="lambda", type="Full", nrow=nVar, ncol=1,
+ free=TRUE, values=(1:nVar*2/nVar)*goodStartValues),
+ mxMatrix(name="specifics", type="Diag", nrow=nVar,
+ free=TRUE, values=rep(1, nVar)),
+ mxAlgebra(lambda %*% t(lambda) + specifics,
+ name="preCov", dimnames=dn),
+ mxData(observed=obsCov, type="cov", numObs=nObs),
+ mxMLObjective(covariance='preCov'),
+ independent = TRUE)
+
+ topModel <- mxModel(name = 'container')
+
+ # Don't need to export as local environment will automatically
+ # be sent
+ #swiftExportAll()
+ submodels <- omxLapply(1:nReps, createNewModel, 'stErrSim', template)
+ cat(length(submodels), "submodels created\n")
+ names(submodels) <- imxExtractNames(submodels)
+ topModel at submodels <- submodels
+
+ return (topModel)
+}
+
+swiftTestSuite <- makeTestSuite(
+ tests=list(
+ makeBootstrapTestGroup(mode="swift", server="local", cores=2),
+ makeBootstrapTestGroup(mode="swift", server="local", cores=4),
+ makeBootstrapTestGroup(mode="swift", server="ssh", cores=8, hosts="nettle antares deneb"),
+ makeBootstrapTestGroup(mode="serial")
+ ))
Added: SwiftApps/SwiftR/mxtests/swift/MakeTests.R
===================================================================
--- SwiftApps/SwiftR/mxtests/swift/MakeTests.R (rev 0)
+++ SwiftApps/SwiftR/mxtests/swift/MakeTests.R 2011-02-10 23:25:49 UTC (rev 4084)
@@ -0,0 +1,64 @@
+
+
+
+swiftSetup <- function (...) {
+ library(Swift)
+ swiftSess <- swiftInit(...)
+ # Run some small jobs to esnure workers are started and warmed up
+ swiftLapply(rep(1, swiftSess$cores * swiftSess$nodes * 2),
+ function (x) { x })
+ return (swiftSess)
+}
+
+swiftTearDown <- function (...) {
+ swiftShutdown()
+ detach(package:Swift)
+}
+
+sfSetup <- function(..., cpus=ncpus) {
+ library(snowfall)
+ sfInit(..., cpus=ncpus)
+ # warmup
+ sfLapply(rep(1, ncpus * 2),
+ function (x) { x })
+
+}
+
+sfTearDown <- function (...) {
+ sfStop()
+ detach(package:snowfall)
+}
+
+
+
+makePerfTestGroup <- function (mode, name, f, allargs, ...) {
+ params <- list(...)
+ paramstr <- paste(names(params),
+ rep("=", length(params)),
+ lapply(params, deparse),
+ sep="", collapse=", ")
+ if (mode == "swift") {
+ tg <- makeParamTestGroup(name=paste("swift_",name, " ", paramstr,sep=""),
+ f=f,
+ allargs=allargs,
+ setup=function() {swiftSetup(...)},
+ tearDown <- swiftTearDown)
+ }
+ else if (mode == "snowfall") {
+ tg <- makeParamTestGroup(name=paste("sf_",name, paramstr, sep=""),
+ f=f,
+ allargs=allargs,
+ setup=function() {sfSetup(...)},
+ tearDown <- sfTearDown)
+
+ }
+ else {
+ print("Making serial test")
+ tg <- makeParamTestGroup(name=paste("serial_",name, paramstr, sep=""),
+ f=f,
+ allargs=allargs,
+ setup=function()
+ {try(detach(package:Swift)); try(detach(package:Snowfall))} )
+ }
+ return (tg)
+}
More information about the Swift-commit
mailing list