[Swift-commit] r4393 - in SwiftApps/SwiftR/Swift: . R exec
tga at ci.uchicago.edu
tga at ci.uchicago.edu
Wed Apr 20 17:13:51 CDT 2011
Author: tga
Date: 2011-04-20 17:13:51 -0500 (Wed, 20 Apr 2011)
New Revision: 4393
Modified:
SwiftApps/SwiftR/Swift/DESCRIPTION
SwiftApps/SwiftR/Swift/R/Apply.R
SwiftApps/SwiftR/Swift/R/Tests.R
SwiftApps/SwiftR/Swift/exec/EvalRBatchPersistent.sh
SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
Log:
Fixed bug which occurred when applied function returns NULL.
R has rather inconsistent behaviour when inserting NULL values in lists.
The new version of the code manages to skirt around the problems.
Incremented version.
Modified: SwiftApps/SwiftR/Swift/DESCRIPTION
===================================================================
--- SwiftApps/SwiftR/Swift/DESCRIPTION 2011-04-20 18:55:38 UTC (rev 4392)
+++ SwiftApps/SwiftR/Swift/DESCRIPTION 2011-04-20 22:13:51 UTC (rev 4393)
@@ -1,12 +1,12 @@
Package: Swift
Type: Package
Title: R interface to Swift parallel scripting languaage
-Version: 0.2.2
-Date: 2011-04-18
+Version: 0.2.3
+Date: 2011-04-20
Author: Michael Wilde
Maintainer: Michael Wilde <wilde at mcs.anl.gov>
Description: Routines to invoke R functions on remote resources through Swift.
License: Apache License
LazyLoad: yes
-Packaged: 2011-04-18; Tim Armstrong
+Packaged: 2011-04-20; Tim Armstrong
Modified: SwiftApps/SwiftR/Swift/R/Apply.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Apply.R 2011-04-20 18:55:38 UTC (rev 4392)
+++ SwiftApps/SwiftR/Swift/R/Apply.R 2011-04-20 22:13:51 UTC (rev 4393)
@@ -66,9 +66,9 @@
reqdir <- setupRequestDir(tmpdir=tmpdir)
if (printTiming)
startTime = proc.time()[["elapsed"]]
- nbatches <- writeRequestBatches(func, arglists, initialexpr,
+ batchsizes <- writeRequestBatches(func, arglists, initialexpr,
reqdir, callsperbatch)
-
+ nbatches <- length(batchsizes)
if (printTiming) {
endTime = proc.time()[["elapsed"]]
cat(nbatches, "Swift request files written to: ", reqdir,
@@ -122,7 +122,7 @@
if (printTiming) startTime = proc.time()[["elapsed"]]
# Fetch the batch results
- res <- fetchBatchResults(reqdir, nbatches, arglists, keepwork, quiet)
+ res <- fetchBatchResults(reqdir, batchsizes, arglists, keepwork, quiet)
if (printTiming) {
endTime = proc.time()[["elapsed"]]
cat(paste("Swift results retrieved from disk in",
@@ -227,6 +227,8 @@
narglists <- length(arglists) # number of arglists to process
batch <- 1 # Next arglist batch number to fill
arglist <- 1 # Next arglist number to insert
+
+ batchsizes <- list()
while(arglist <= narglists) {
arglistsleft <- narglists - arglist + 1
if(arglistsleft >= callsperbatch) {
@@ -246,29 +248,37 @@
save(rcall,
file=file.path(reqdir,
paste("cbatch.",as.character(batch),".Rdata",sep="")))
+ batchsizes[[batch]] <- batchsize
batch <- batch + 1;
}
- return (batch - 1)
+ return (batchsizes)
}
-fetchBatchResults <- function (reqdir, nbatches, arglists, keepwork, quiet) {
+fetchBatchResults <- function (reqdir, batchsizes, arglists, keepwork, quiet) {
rno <- 1
- rlist <- list()
+ rlist <- list() # Big result list
+ nbatches <- length(batchsizes)
for(batch in 1:nbatches) {
# The result in the file will be named "result"
+ # Initialize result variable to reflect
result <- NULL
load(file.path(reqdir,
paste("rbatch.",as.character(batch),".Rdata",sep="")))
- nresults <- length(result)
- for(r in 1:nresults) {
- rlist[[rno]] <- result[[r]]
- if(inherits(result[[r]], "try-error")) {
- cat("ERROR in eval: ", result[[r]], "\n");
+
+# cat("Batch #", batch, " of ", nbatches, ":\n")
+# print(result)
+
+ # Check returned results for errors
+ for (res in result) {
+ if(inherits(res, "try-error")) {
+ cat("ERROR in eval: ", res, "\n");
}
- #DB cat("swiftapply: result rno=",rno,":\n") # FIXME: for logging
- #DB cat(rlist[[rno]]@output$gradient,"\n")
- rno <- rno + 1
}
+ # Assign to correct result list slice
+ # error will be thrown here if size of result list is wrong
+ batchsize <- batchsizes[[batch]]
+ rlist[rno:(rno + batchsize - 1)] <- result
+ rno <- rno + batchsize
}
names(rlist) = names(arglists)
if( ! keepwork ) {
Modified: SwiftApps/SwiftR/Swift/R/Tests.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Tests.R 2011-04-20 18:55:38 UTC (rev 4392)
+++ SwiftApps/SwiftR/Swift/R/Tests.R 2011-04-20 22:13:51 UTC (rev 4393)
@@ -69,7 +69,6 @@
} else {
cat("\n!!!==> test 1.2.1 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -104,7 +103,6 @@
} else {
cat("\n!!!==> test 1.2.2 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -139,13 +137,43 @@
} else {
cat("\n!!!==> test 1.2.3 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
+swiftTest_1.2.5 <- function () {
+ # Test null corner case
+ f <- function (x) {NULL}
+ inl <- list(1,2)
+ localres = lapply(inl, f)
+ cat("Local result:\n")
+ print(localres)
+
+ swiftres = swiftLapply(inl,f)
+ cat("Swift result:\n")
+ print(swiftres)
+
+ diffs <- 0
+ for(i in 1:length(swiftres) ) {
+ if( !identical(swiftres[[i]],localres[[i]]) ) {
+ diffs <- diffs + 1
+ if( diffs < 10 ) cat(sprintf("res[%d]=%s\n",i, format( swiftres[[i]] )))
+ }
+ }
+ if(diffs == 0) {
+ cat("\n==> test 1.2.5 passed\n")
+ return (TRUE)
+ } else {
+ cat("\n!!!==> test 1.2.5 failed.\n")
+ cat(sprintf(" %d result elements failed to match.\n",diffs));
+ return (FALSE)
+ }
+
+}
+
+
swiftTest_1.2.4 <- function () {
sumstuff <- function(treedata,cardata)
{ sum( treedata$Height, cardata$dist ) }
@@ -177,7 +205,6 @@
} else {
cat("\n!!!==> test 1.2.4 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -379,7 +406,6 @@
} else {
cat("\n!!!==> test 2.1 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -418,7 +444,6 @@
} else {
cat("\n!!!==> test 2.2 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -472,7 +497,6 @@
} else {
cat("\n!!!==> test 3.1 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -502,7 +526,6 @@
} else {
cat("\n!!!==> test 3.2 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
@@ -582,7 +605,6 @@
} else {
cat("\n!!!==> test 5.1 failed.\n")
cat(sprintf(" %d result elements failed to match.\n",diffs));
- failures=failures+1
return (FALSE)
}
}
@@ -789,7 +811,7 @@
name="1.2 Basic Test - Adding data sets",
tests = list(mkTest(swiftTest_1.2.1),
mkTest(swiftTest_1.2.2), mkTest(swiftTest_1.2.3),
- mkTest(swiftTest_1.2.4)))
+ mkTest(swiftTest_1.2.4), mkTest(swiftTest_1.2.5)))
testGroup1.3 <- makeTestGroup(
name="1.3 - Export functionality",
Modified: SwiftApps/SwiftR/Swift/exec/EvalRBatchPersistent.sh
===================================================================
--- SwiftApps/SwiftR/Swift/exec/EvalRBatchPersistent.sh 2011-04-20 18:55:38 UTC (rev 4392)
+++ SwiftApps/SwiftR/Swift/exec/EvalRBatchPersistent.sh 2011-04-20 22:13:51 UTC (rev 4393)
@@ -130,6 +130,7 @@
echo LD_LIBRARYPATH= $LD_LIBRARY_PATH
PATH=.:$PATH
echo PATH= $PATH
+ echo R_LIBS_USER= $R_LIBS_USER
# Use R instead of Rscript due to Rscript issues on some
# platforms (e.g. cray xt)
R --slave --no-restore --file=$RServerScript \
Modified: SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
===================================================================
--- SwiftApps/SwiftR/Swift/exec/SwiftRServer.R 2011-04-20 18:55:38 UTC (rev 4392)
+++ SwiftApps/SwiftR/Swift/exec/SwiftRServer.R 2011-04-20 22:13:51 UTC (rev 4393)
@@ -11,6 +11,8 @@
print("SwiftRServer arguments:")
print(argv)
+ print(".libPaths:")
+ print(.libPaths())
fifoDir = argv[1]; # FIXME: test for valid arguments
@@ -110,13 +112,12 @@
}
cat("DB: Doing apply\n", file=stderr())
- result <- list()
- for(c in 1:length(rcall$arglistbatch)) {
- # FIXME: run this under try/catch and save error status
- # in results object (need to make it a list: rval + error status)
- result[[c]] = try(do.call( rcall$func,
- as.list(rcall$arglistbatch[[c]] )))
- }
+ #Using lapply here will ensure that NULLs are handled
+ # correctly
+ result <- lapply(rcall$arglistbatch,
+ function (arglist) {
+ try(do.call(rcall$func, as.list(arglist)))
+ })
cat("DB: Saving Results\n", file=stderr())
save(result,file=resultBatchFileName)
cat("DB: Results saved\n", file=stderr())
More information about the Swift-commit
mailing list