[Swift-commit] r4174 - in SwiftApps/SwiftR: . Swift Swift/R Swift/tests Swift/tests/OpenMx
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Wed Mar 9 14:57:16 CST 2011
Author: tga
Date: 2011-03-09 14:57:14 -0600 (Wed, 09 Mar 2011)
New Revision: 4174
Added:
SwiftApps/SwiftR/Swift/tests/OpenMx/
SwiftApps/SwiftR/Swift/tests/OpenMx/BootstrapParallelBigger.R
SwiftApps/SwiftR/Swift/tests/OpenMx/RAM-3Factor-96Indicators-covdata-a.R
SwiftApps/SwiftR/Swift/tests/perf_tests.R
Removed:
SwiftApps/SwiftR/mxtests/
Modified:
SwiftApps/SwiftR/IMMEDIATE-TODO
SwiftApps/SwiftR/Swift/NAMESPACE
SwiftApps/SwiftR/Swift/R/TestFramework.R
Log:
Fixed up the performance test suite so that it is packaged with the library.
Fixed up analysis functions to work more nicely. This is still a work in progress.
Modified: SwiftApps/SwiftR/IMMEDIATE-TODO
===================================================================
--- SwiftApps/SwiftR/IMMEDIATE-TODO 2011-03-08 00:24:50 UTC (rev 4173)
+++ SwiftApps/SwiftR/IMMEDIATE-TODO 2011-03-09 20:57:14 UTC (rev 4174)
@@ -16,9 +16,34 @@
- parallel OpenMx Tests
HIGH:
+-- Feedback from queue
+
+HIGH:
-- get working on beagle.
HIGH:
+-- Test on Mac
+
+HIGH:
+-- Usability testing package
+-- Instructions + survey
+
+MED:
+-- OpenMx specific instructions.
+
+HIGH:
+-- Check java version ahead of time
+
+HIGH:
+-- email swift-devel about automated tests
+
+MED:
+-- IBI performance tests
+
+MED:
+-- Add OpenMx tests to test suite
+
+HIGH:
- tests
-- simple calibration tests (n args, arg sizes, durations, etc)
-- openmx tests
Modified: SwiftApps/SwiftR/Swift/NAMESPACE
===================================================================
--- SwiftApps/SwiftR/Swift/NAMESPACE 2011-03-08 00:24:50 UTC (rev 4173)
+++ SwiftApps/SwiftR/Swift/NAMESPACE 2011-03-09 20:57:14 UTC (rev 4174)
@@ -27,4 +27,6 @@
export(mkPerfTest)
export(doPerfTest)
export(analysePerf)
+export(analyseSuitePerf)
+export(mergeGroupResults)
Modified: SwiftApps/SwiftR/Swift/R/TestFramework.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/TestFramework.R 2011-03-08 00:24:50 UTC (rev 4173)
+++ SwiftApps/SwiftR/Swift/R/TestFramework.R 2011-03-09 20:57:14 UTC (rev 4174)
@@ -46,8 +46,26 @@
return (makeTestGroup(name, tests, setup, teardown))
}
-analysePerf <- function (testGroupResults, nargs=0, perfparams=NULL) {
+analyseSuitePerf <- function (testSuite, ...) {
+ # See analyse perf below: does the same for a test suite and returns a list of the results
+ # for each group
+ lapply(testSuite$groups,
+ function (g) {
+ res <- analysePerf(g, ...)
+ n <- length(res[[1]])
+ res$group <- rep(g$name, n)
+ return (res)
+ })
+}
+
+analysePerf <- function (testGroupResults, argnames=NULL, perfparams=NULL, includePassed=FALSE) {
# Build a list of vectors of performance results for easier analysis
+ # argnames: names to give to the arguments to the test function, ordered by position
+ # The number here is the number of arguments that are extracted from
+ # the test result data.
+ # perfparams: names of the parameters passed to swfit/snowfall init functions
+ # that you want to include in the final data
+
# [[1]] -> first arg
# [[2]] -> second arg
# ... ... .......
@@ -56,18 +74,21 @@
# $passed
# $time
collated <- list()
- if (nargs >= 1) {
- for (i in 1:nargs) {
+ if (length(argnames) >= 1) {
+ for (i in 1:length(argnames)) {
collated[[i]] <- unlist(lapply(testGroupResults$tests,
function(test) {test$args[[i]]}))
+ names(collated)[[i]] <- argnames[[i]]
}
}
n <- length(testGroupResults$tests)
collated$name <- unlist(lapply(testGroupResults$tests,
function(test) {test$name }))
- collated$passed <-unlist(lapply(testGroupResults$tests,
- function(test) {test$passed }))
+ if (includePassed) {
+ collated$passed <-unlist(lapply(testGroupResults$tests,
+ function(test) {test$passed }))
+ }
collated$time <- unlist(lapply(testGroupResults$tests,
function(test) {test$time }))
@@ -82,6 +103,18 @@
}
+# Takes a list of analysed group results from analysePerf and combines them into
+# a single data frame. This has to assume that all data in these lists is valid
+# for inclusion in a data frame. Merge rules are those of the built-in merge function
+mergeGroupResults <- function (groupResults) {
+ frames <- lapply(groupResults, data.frame)
+ res <- frames[[1]]
+ for (frame in frames[2:length(frames)]) {
+ res <- merge(res, frame, all=T)
+ }
+ return (res)
+}
+
runTestGroup <- function (group) {
cat("\n*** Starting test group ", group$name, "***\n")
if (!is.null(group$setup))
Added: SwiftApps/SwiftR/Swift/tests/OpenMx/BootstrapParallelBigger.R
===================================================================
--- SwiftApps/SwiftR/Swift/tests/OpenMx/BootstrapParallelBigger.R (rev 0)
+++ SwiftApps/SwiftR/Swift/tests/OpenMx/BootstrapParallelBigger.R 2011-03-09 20:57:14 UTC (rev 4174)
@@ -0,0 +1,206 @@
+#!/bin/env Rscript
+# Copyright 2007-2010 The OpenMx Project
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# This file is meant to be opened using the source command from an R instance
+# with working directory of either
+# a) the root of the R library directory in which is
+# b) the root of the SwiftR source trunk
+# ie.
+# > source("Swift/tests/OpenMx/BootstrapParallelBigger.R")
+#
+# You can then make a custom bootstrap performance testing suite
+# using makeBootstrapTestGroup and makeTestSuite, and run it
+# using swiftR's test suite mechanism.
+
+require(OpenMx)
+require(Swift)
+source("Swift/tests/perf_tests.R")
+
+
+
+# This is the main test function, which can be
+# run with varying combinations of the three
+# parameters.
+bootstrapTest <- function (nVar, nObs, nReps) {
+ set.seed(10)
+ topModel <- buildModels(nVar, nObs, nReps)
+
+ modelResults <- mxRun(topModel, silent=TRUE, suppressWarnings=TRUE)
+
+ print(modelResults at output$wallTime)
+ # Only return some statistics about the model: the returned model data
+ # can be huge in size otherwise
+ return (modelResults at output)
+}
+
+
+# This function sets up the OpenMx models to
+# use for the test
+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.")
+ }
+
+ 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
+
+ # dimension names for OpenMx
+ dn <- list()
+ dn[[1]] <- paste("Var", 1:nVar, sep="")
+ dn[[2]] <- dn[[1]]
+
+ # 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)
+ }
+
+ 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)
+ }
+
+
+ # 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)
+ names(submodels) <- imxExtractNames(submodels)
+ topModel at submodels <- submodels
+
+ return (topModel)
+}
+
+
+
+# Construct a performance test group which contains bootstrap instances with
+# a range of different parameter values. Additional arguments are
+# passed to swiftInit or sfInit as appropriate
+makeBootstrapTestGroup <- function (argsList, ...) {
+ makePerfTestGroup(
+ name="BootstrapParallelBigger",
+ f=bootstrapTest,
+ allargs=argsList,
+ ... )
+}
+
+
+
+testArgs <- list(
+ list(75, 100, 4),
+ list(75, 100, 8),
+ list(75, 100, 16),
+ list(75, 100, 32),
+ list(75, 100, 64),
+ list(75, 100, 128),
+ list(75, 100, 256),
+ list(75, 100, 512),
+ list(75, 100, 786),
+ list(75, 100, 1024),
+ list(75, 100, 1024 + 512),
+ list(75, 100, 2048 )
+ )
+
+testArgsShort <- list(
+ list(25, 100, 4),
+ list(25, 100, 8),
+ list(25, 100, 16),
+ list(25, 100, 32),
+ list(25, 100, 64),
+ list(25, 100, 128),
+ list(25, 100, 256),
+ list(25, 100, 512),
+ list(25, 100, 786),
+ list(25, 100, 1024),
+ list(25, 100, 1024 + 512),
+ list(25, 100, 2048 )
+ )
+
+
+
+# An example test suite which runs on a ssh cluster
+# on multiple cores of a machine and in vanilla R
+sampleTestSuite <- makeTestSuite(
+ groups=list(
+ # 16 cores
+ makeBootstrapTestGroup(mode="swift", server="ssh", cores=2,
+ hosts=c("nettle", "wapato", "dandelion", "cattail",
+ "chicory", "echinacea", "amaranth", "black-cohosh"),
+ argsList=testArgs[3:5]),
+ # 8 cores
+ makeBootstrapTestGroup(mode="swift", server="ssh", cores=2,
+ hosts="nettle wapato dandelion cattail",
+ argsList=testArgs[2:5]),
+ makeBootstrapTestGroup(mode="swift", server="local", cores=4,
+ argsList=testArgs[1:4]),
+ makeBootstrapTestGroup(mode="swift", server="local", cores=2,
+ argsList=testArgs[1:4]),
+ makeBootstrapTestGroup(mode="swift", server="local", cores=1,
+ argsList=testArgs[1:2]),
+ makeBootstrapTestGroup(mode="swift", server="local", cores=1,
+ argsList=testArgs[1:2]),
+ makeBootstrapTestGroup(mode="serial", argsList=testArgs[1:2])
+ ))
+
Copied: SwiftApps/SwiftR/Swift/tests/OpenMx/RAM-3Factor-96Indicators-covdata-a.R (from rev 4173, SwiftApps/SwiftR/mxtests/swift/RAM-3Factor-96Indicators-covdata-a.R)
===================================================================
--- SwiftApps/SwiftR/Swift/tests/OpenMx/RAM-3Factor-96Indicators-covdata-a.R (rev 0)
+++ SwiftApps/SwiftR/Swift/tests/OpenMx/RAM-3Factor-96Indicators-covdata-a.R 2011-03-09 20:57:14 UTC (rev 4174)
@@ -0,0 +1,143 @@
+# ---------------------------------------------------------------------
+# Program: RAM-3Factor-12Indicators.R
+# Author: Steven M. Boker
+# Date: Fri Jul 30 13:45:12 EDT 2010
+#
+# This program is a factor model using standard RAM.
+#
+# ---------------------------------------------------------------------
+# Revision History
+# -- Fri Jul 30 13:45:12 EDT 2010
+# Created RAM-3Factor-12Indicators.R.
+#
+# ---------------------------------------------------------------------
+
+# ----------------------------------
+# Read libraries and set options.
+
+library(OpenMx)
+library(Swift)
+
+# ---------------------------------------------------------------------
+# Data for factor model.
+
+
+defaultArgs <- list(1000, 3, 32)
+
+
+
+# Construct a performance test group which contains CI instances with
+# a range of different parameter values. Additional arguments are
+# passed to swiftInit or sfInit as appropriate
+makeCITestGroup <- function (argsList, ...) {
+ makePerfTestGroup(
+ name="cov.confidence.interval",
+ f=cov.confidence.interval,
+ allargs=argsList,
+ ... )
+}
+
+cov.confidence.interval <- function (numberSubjects, numberFactors, numberIndPerFactor) {
+
+ #numberSubjects <- 1000
+ #numberFactors <- 3
+ #numberIndPerFactor <- 32
+ numberIndicators <- numberIndPerFactor*numberFactors # must be a multiple of numberFactors
+
+ XMatrix <- matrix(rnorm(numberSubjects*numberFactors, mean=0, sd=1), numberSubjects, numberFactors)
+
+ tLoadings <- c(1, seq(.5, .9, length.out=(numberIndPerFactor-1)), rep(0, numberIndPerFactor*2),
+ rep(0, numberIndPerFactor*1), 1, seq(.5, .9, length.out=(numberIndPerFactor-1)), rep(0, numberIndPerFactor*1),
+ rep(0, numberIndPerFactor*2), 1, seq(.5, .9, length.out=(numberIndPerFactor-1)))
+ BMatrix <- matrix(tLoadings, numberFactors, numberIndicators, byrow=TRUE)
+ UMatrix <- matrix(rnorm(numberSubjects*numberIndicators, mean=0, sd=1), numberSubjects, numberIndicators)
+ YMatrix <- XMatrix %*% BMatrix + UMatrix
+
+ cor(XMatrix)
+
+ dimnames(YMatrix) <- list(NULL, paste("X", 1:numberIndicators, sep=""))
+
+ YFrame <- data.frame(YMatrix)
+
+ round(cor(YFrame), 3)
+ round(cov(YFrame), 3)
+
+ indicators <- paste("X", 1:numberIndicators, sep="")
+ totalVars <- numberIndicators + numberFactors
+
+ # ----------------------------------
+ # Build an orthogonal simple structure factor model
+
+ latents <- paste("F", 1:numberFactors, sep="")
+
+ uniqueLabels <- paste("U_", indicators, sep="")
+ meanLabels <- paste("M_", latents, sep="")
+ factorVarLabels <- paste("Var_", latents, sep="")
+
+ latents1 <- latents[1]
+ indicators1 <- indicators[1:numberIndPerFactor]
+ loadingLabels1 <- paste("b_F1", indicators[1:numberIndPerFactor], sep="")
+ latents2 <- latents[2]
+ indicators2 <- indicators[numberIndPerFactor+(1:numberIndPerFactor)]
+ loadingLabels2 <- paste("b_F2", indicators[numberIndPerFactor+(1:numberIndPerFactor)], sep="")
+ latents3 <- latents[3]
+ indicators3 <- indicators[(2*numberIndPerFactor)+(1:numberIndPerFactor)]
+ loadingLabels3 <- paste("b_F3", indicators[(2*numberIndPerFactor)+(1:numberIndPerFactor)], sep="")
+
+ threeFactorOrthogonal <- mxModel("threeFactorOrthogonal",
+ type="RAM",
+ manifestVars=c(indicators),
+ latentVars=c(latents,"dummy1"),
+ mxPath(from=latents1, to=indicators1,
+ arrows=1, all=TRUE,
+ free=TRUE, values=.2,
+ labels=loadingLabels1),
+ mxPath(from=latents2, to=indicators2,
+ arrows=1, all=TRUE,
+ free=TRUE, values=.2,
+ labels=loadingLabels2),
+ mxPath(from=latents3, to=indicators3,
+ arrows=1, all=TRUE,
+ free=TRUE, values=.2,
+ labels=loadingLabels3),
+ mxPath(from=latents1, to=indicators1[1],
+ arrows=1,
+ free=FALSE, values=1),
+ mxPath(from=latents2, to=indicators2[1],
+ arrows=1,
+ free=FALSE, values=1),
+ mxPath(from=latents3, to=indicators3[1],
+ arrows=1,
+ free=FALSE, values=1),
+ mxPath(from=indicators,
+ arrows=2,
+ free=TRUE, values=.2,
+ labels=uniqueLabels),
+ mxPath(from=latents,
+ arrows=2,
+ free=TRUE, values=.8,
+ labels=factorVarLabels),
+ mxPath(from="one", to=indicators,
+ arrows=1, free=FALSE, values=0),
+ mxPath(from="one", to=c(latents),
+ arrows=1, free=TRUE, values=.1,
+ labels=meanLabels),
+ mxCI(c('A', 'S')),
+ mxData(observed=cov(YFrame), means=mean(YFrame),
+ numObs=nrow(YFrame), type="cov")
+ )
+
+ threeFactorOrthogonalOut <- mxRun(threeFactorOrthogonal)
+ threeFactorCI <- omxParallelCI(threeFactorOrthogonalOut)
+
+ totalTime <- threeFactorCI at output$wallTime
+ seqTime <- threeFactorOrthogonalOut at output$wallTime
+
+
+ return (threeFactorCI at output)
+}
+
+sampleTestSuite <- makeTestSuite(
+ groups=list(makeCITestGroup(mode="swift",
+ argsList=list(defaultArgs), server="local", cores=4
+ )))
Copied: SwiftApps/SwiftR/Swift/tests/perf_tests.R (from rev 4173, SwiftApps/SwiftR/mxtests/swift/MakeTests.R)
===================================================================
--- SwiftApps/SwiftR/Swift/tests/perf_tests.R (rev 0)
+++ SwiftApps/SwiftR/Swift/tests/perf_tests.R 2011-03-09 20:57:14 UTC (rev 4174)
@@ -0,0 +1,74 @@
+# Helper functions for building performance tests suites that don't quite fit in the
+# main SwiftR code because they can detach the Swift package..
+
+
+swiftSetup <- function (...) {
+ library(Swift)
+ swiftSess <- swiftInit(...)
+ # Wait to start
+ Sys.sleep(10)
+ # Run some small jobs to ensure workers are started and warmed up
+ swiftapply(function (x) { x },
+ rep(1, swiftSess$cores * swiftSess$nodes * 2),
+ callsperbatch=1)
+ 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,
+ perfparams = params,
+ setup=function() {swiftSetup(...)},
+ teardown = swiftTearDown)
+ }
+ else if (mode == "snowfall") {
+ tg <- makeParamTestGroup(name=paste("sf_",name, paramstr, sep=""),
+ f=f,
+ allargs=allargs,
+ perfparams = params,
+ setup=function() {sfSetup(...)},
+ teardown = sfTearDown)
+
+ }
+ else {
+ print("Making serial test")
+ tg <- makeParamTestGroup(name=paste("serial_",name, paramstr, sep=""),
+ f=f,
+ allargs=allargs,
+ perfparams = list(),
+ setup=function()
+ {try(detach(package:Swift)); try(detach(package:Snowfall))} )
+ }
+ return (tg)
+}
+
+
+
Property changes on: SwiftApps/SwiftR/Swift/tests/perf_tests.R
___________________________________________________________________
Name: svn:mergeinfo
+
More information about the Swift-commit
mailing list