[Swift-commit] r4177 - in SwiftApps/SwiftR: . Swift Swift/R
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Mon Mar 14 17:00:33 CDT 2011
Author: tga
Date: 2011-03-14 17:00:33 -0500 (Mon, 14 Mar 2011)
New Revision: 4177
Modified:
SwiftApps/SwiftR/IMMEDIATE-TODO
SwiftApps/SwiftR/Swift/NAMESPACE
SwiftApps/SwiftR/Swift/R/Apply.R
SwiftApps/SwiftR/Swift/R/Tests.R
Log:
Added in implementation of swiftSapply function.
Modified: SwiftApps/SwiftR/IMMEDIATE-TODO
===================================================================
--- SwiftApps/SwiftR/IMMEDIATE-TODO 2011-03-14 18:08:37 UTC (rev 4176)
+++ SwiftApps/SwiftR/IMMEDIATE-TODO 2011-03-14 22:00:33 UTC (rev 4177)
@@ -5,6 +5,8 @@
+VERY HIGH:
+-- get working on beagle.
VERY HIGH:
-- Benchmarks
@@ -18,8 +20,6 @@
HIGH:
-- Feedback from queue
-HIGH:
--- get working on beagle.
HIGH:
-- Test on Mac
@@ -44,22 +44,12 @@
-- Add OpenMx tests to test suite
HIGH:
-- tests
--- simple calibration tests (n args, arg sizes, durations, etc)
--- openmx tests
- --- OmxParallelCI
- --- OmxParallelBootstrap
-
-HIGH:
- perf approach
-- socket?
- -- swift fast branch?
-- swift times?
-- micro studies on provider staging etc.
-
MID:
-
- test on Ranger
MID:
Modified: SwiftApps/SwiftR/Swift/NAMESPACE
===================================================================
--- SwiftApps/SwiftR/Swift/NAMESPACE 2011-03-14 18:08:37 UTC (rev 4176)
+++ SwiftApps/SwiftR/Swift/NAMESPACE 2011-03-14 22:00:33 UTC (rev 4177)
@@ -1,5 +1,6 @@
export(swiftapply)
export(swiftLapply)
+export(swiftSapply)
export(swiftInit)
export(getNodeList)
export(swiftShutdown)
Modified: SwiftApps/SwiftR/Swift/R/Apply.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Apply.R 2011-03-14 18:08:37 UTC (rev 4176)
+++ SwiftApps/SwiftR/Swift/R/Apply.R 2011-03-14 22:00:33 UTC (rev 4177)
@@ -122,7 +122,49 @@
swiftapply(func, arglists)
}
+swiftSapply <- function( tlist, func, ..., simplify=TRUE, USE.NAMES=TRUE) {
+ # replicate sapply behaviour:
+ # simplify to 1d vector or 2d matrix if possible
+ res <- swiftLapply(tlist, func, ...)
+ if (USE.NAMES) {
+ # same rules as sapply
+ if (is.null(names(res)) && is.character(tlist)) {
+ names(res) <- tlist
+ }
+ }
+ if (simplify && length(res) > 0) {
+ # Check to see if list is multidimensional
+ lens <- unique(lapply(res, length))
+ if (length(lens) != 1) {
+ # ragged list, can't simplify
+ return (res)
+ }
+ else {
+ if (lens == 1) {
+ # just a plain list
+ return (unlist(res, recursive=F))
+ }
+ else {
+ # multidimensional list: convert to 2d matrix
+ res <- unlist(res, recursive=F)
+ if (!(is.null(n1 <- names(res[[1]]))) &&
+ !(is.null(n2 <- names(res)))) {
+ # names of first and second dimnesion
+ dimnames <- list(n1, n2)
+ }
+ else {
+ dimnames <- NULL
+ }
+ res <- array(res, dim=c(lens, length(tlist)),
+ dimnames=dimnames)
+ return(res)
+ }
+ }
+ }
+ return (res)
+}
+
setupRequestDir <- function (tmpdir) {
# Initialize globals if first call in this invocation of R
# Use the options mechanism so that setting is tied
Modified: SwiftApps/SwiftR/Swift/R/Tests.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Tests.R 2011-03-14 18:08:37 UTC (rev 4176)
+++ SwiftApps/SwiftR/Swift/R/Tests.R 2011-03-14 22:00:33 UTC (rev 4177)
@@ -586,8 +586,69 @@
return (FALSE)
}
}
+swiftTest_6.1 <- function () {
+ # test sapply
+ args <- list(1,2,3,4,5,6,7)
+ parRes <- swiftSapply(args, log)
+ serRes <- sapply(args, log)
+ if (!all(parRes == serRes)) {
+ cat("\n!!!==> test 6.1 failed.\n")
+ cat(paste("actual: ", parRes, "\nexpected:", serRes, "\n"))
+ return (FALSE)
+ }
+ if (is.list(parRes)) {
+ cat("\n!!!==> test 6.1 failed.\n")
+ cat("parRes is a list\n")
+ return (FALSE)
+ }
+
+ cat("\n!!!==> test 6.1 passed.\n")
+ return (TRUE)
+}
+
+swiftTest_6.2 <- function () {
+ # test sapply
+ args <- list(list(1,2),list(3),list(4,5),list(6,7))
+ f <- function (x) {lapply(x, function(y) { y * 2 })}
+ serRes <- sapply(args, f)
+ parRes <- swiftSapply(args, f)
+
+
+ if (!identical(parRes, serRes)) {
+ cat("\n!!!==> test 6.2 failed.\n")
+ cat(paste("actual: ", parRes, "\nexpected:", serRes, "\n"))
+ return (FALSE)
+ }
+ if (!is.list(parRes)) {
+ cat("\n!!!==> test 6.2 failed.\n")
+ cat("parRes is not a list\n")
+ return (FALSE)
+ }
+
+ cat("\n!!!==> test 6.2 passed.\n")
+ return (TRUE)
+
+}
+
+swiftTest_6.3 <- function () {
+ # test sapply forms matrix ok
+ args <- list(list(1,2),list(3, 5),list(4,5),list(6,7))
+ f <- function (x) {lapply(x, function(y) { y * 2 })}
+ serRes <- sapply(args, f)
+ parRes <- swiftSapply(args, f)
+
+
+ if (!identical(parRes, serRes) || (!is.matrix(parRes))) {
+ cat("\n!!!==> test 6.3 failed.\n")
+ cat(paste("actual: ", parRes, "\nexpected:", serRes, "\n"))
+ return (FALSE)
+ }
+ cat("\n!!!==> test 6.3 passed.\n")
+ return (TRUE)
+}
+
runAllSwiftTests <- function(...) {
startTime = proc.time()[["elapsed"]]
@@ -648,6 +709,11 @@
name="5 - remote R service error ",
tests = list(mkTest(swiftTest_5.1)))
+testGroup6 <- makeTestGroup(
+ name="6 - test apply variants",
+ tests = list(mkTest(swiftTest_6.1),
+ mkTest(swiftTest_6.2),
+ mkTest(swiftTest_6.3)))
makeFullTestSuite <- function (...) {
initArgs <- list(...)
@@ -657,6 +723,6 @@
options(swift.initialexpr="initVar1 <- 19; initVar2 <- sqrt(400)+3")
do.call(swiftInit, initArgs) }, # swiftInit controlled via options
groups=list(testGroup1.1, testGroup2, testGroup1.2, testGroup1.3, testGroup3, testGroup4,
- testGroup5),
+ testGroup5, testGroup6),
teardown=function () { swiftShutdown() })
}
More information about the Swift-commit
mailing list