[Swift-commit] r4064 - in SwiftApps/SwiftR/Swift: R exec

noreply at svn.ci.uchicago.edu noreply at svn.ci.uchicago.edu
Mon Feb 7 15:04:05 CST 2011


Author: tga
Date: 2011-02-07 15:04:05 -0600 (Mon, 07 Feb 2011)
New Revision: 4064

Added:
   SwiftApps/SwiftR/Swift/R/Init.R
Modified:
   SwiftApps/SwiftR/Swift/R/Apply.R
   SwiftApps/SwiftR/Swift/R/Export.R
   SwiftApps/SwiftR/Swift/R/Tests.R
   SwiftApps/SwiftR/Swift/R/Workers.R
   SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
Log:
Added automatic selection of directory for exports, cleanup of exported file, tests of export functionality.




Modified: SwiftApps/SwiftR/Swift/R/Apply.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Apply.R	2011-02-07 17:25:33 UTC (rev 4063)
+++ SwiftApps/SwiftR/Swift/R/Apply.R	2011-02-07 21:04:05 UTC (rev 4064)
@@ -127,21 +127,21 @@
   # to lifetime of this R process.  If we stored this in a global
   # variable, it is possible that, say, directory requests.55555/R0000005
   # is created, the user exits the session without saving, and therefore
-  # the swift.requestid counter is out of step with the file system
+  # the .swift.requestid counter is out of step with the file system
   requestdirbase = getOption("swift.requestdirbase") 
   if(!is.null(requestdirbase)) {
-    requestid = getOption("swift.requestid") + 1;
+    requestid = getOption(".swift.requestid") + 1;
   }
   else {
-    requestdirbase = sprintf("%s/%s/SwiftR/requests.P%.5d",tmpdir,
-                            Sys.info()[["user"]],Sys.getpid())
+    requestdirbase = file.path(tmpdir, Sys.info()[["user"]],"SwiftR",
+                sprintf("requests.P%.5d",Sys.getpid()))
     dir.create(requestdirbase,recursive=TRUE,showWarnings=FALSE, 
             mode=kDIR_MODE)
     options(swift.requestdirbase=requestdirbase)
     requestid = 0;
   }
-  options(swift.requestid=requestid)
-  reqdir = sprintf("%s/R%.7d",requestdirbase,requestid)
+  options(.swift.requestid=requestid)
+  reqdir = file.path(requestdirbase, sprintf("R%.7d",requestid))
   dir.create(reqdir,recursive=TRUE,showWarnings=FALSE,mode=kDIR_MODE)
   return (reqdir)
 }

Modified: SwiftApps/SwiftR/Swift/R/Export.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Export.R	2011-02-07 17:25:33 UTC (rev 4063)
+++ SwiftApps/SwiftR/Swift/R/Export.R	2011-02-07 21:04:05 UTC (rev 4064)
@@ -41,18 +41,42 @@
 #   partially undoes previous work
 
 
-swiftExportAll <- function () {
+swiftExportAll <- function (file=NULL) {
     # Exports all functions and data in global environment
-    return (swiftExport(list=ls(globalenv())))
+    swiftExport(list=ls(globalenv()), file=file)
 }
 
-#TODO: not implemented
 swiftExport <- function (..., list=NULL, file=NULL) {
     # List of object names (as R symbols or as strings)
     # These will be passed directly to save() to be serialized
-    # TODO: For now,while testing, must manually specify location
-    # TODO: choose file location
-    # expFile <- ???
+    if (is.null(file)) {
+        dir <- getExportDir()
+        if (is.null(dir)) {
+            error(paste("Could not determine an export directory, try", 
+                "setting the",
+                "swift.exportdir option to a directory accessible by this R",
+                "session and the Swift worker processes"))
+        }
+        # Separate directory for each new R session to keep files together
+        # and avoid conflicts.
+        cat("Export directory: ", dir, "\n")
+        dir.create(dir, recursive=T, showWarnings=FALSE, mode=kDIR_MODE)
+
+        # add the file, keeping a counter to use in the file name
+        expid = getOption(".swift.exportid")
+        if (is.null(expid)) expid = 0
+        options(.swift.exportid = expid + 1)
+        file <- file.path(dir, sprintf("E%.7d",expid))
+        cat("Export file: ", file, "\n")
+        
+        # Keep track of files for later cleanup
+        expfiles <- getOption(".swift.exportfiles")
+        if (is.null(expfiles)) expfiles = list()
+        expfiles[[length(expfiles) + 1]] <- file
+        options(.swift.exportfiles=expfiles)
+    }
+    
+    #TODO: file mode?
     if (is.null(list))
         save(..., file=file)
     else
@@ -81,3 +105,34 @@
     # it is hard to know when they can be safely removed
     options(.swift.session=newSession())
 }
+
+getExportDir <- function () {
+    d <- getOption("swift.exportdir")
+    if (! is.null(d))   d <- file.path(d, ".swiftr", "exports")
+    
+    # Home directory is a candidate
+    d <- Sys.getenv("HOME")[[1]]
+    if (d == "") {
+        return (NULL)
+    }
+    else {
+        d <- file.path(d, ".swiftr")
+        return (file.path(d, sprintf("exports.P%.5d",Sys.getpid())))
+    }
+}
+
+# Function called when Swift is unloaded or session ends
+# that is responsible for cleanup
+removeExports <- function () {
+    cat("removing exports\n")
+    expfiles <- getOption(".swift.exportfiles")
+    for (file in expfiles) {
+        #cat("removing", file, "\n")
+        file.remove(file)
+    }
+    options(.swift.exportfiles=NULL)
+    dir <- getExportDir()
+    if (!is.null(dir)) {
+        unlink(dir, recursive=T)
+    }
+}

Added: SwiftApps/SwiftR/Swift/R/Init.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Init.R	                        (rev 0)
+++ SwiftApps/SwiftR/Swift/R/Init.R	2011-02-07 21:04:05 UTC (rev 4064)
@@ -0,0 +1,80 @@
+# This file contains functions involved in starting up and shutting down
+# SwiftR
+
+.onLoad <- function (libname, packagename) {
+    detectSystemInfo()
+}
+
+.First.lib <- function(libname, packagename) {
+    # When the library is loaded, set up the
+    # list of workers
+    .swift.workers <<- list()
+}
+
+swiftCleanup <- function () {
+    # Shut down workers
+    swiftShutdown()
+    # Clean up exported files
+    removeExports()
+
+}
+
+.Last.lib <- function(p) 
+{
+    # If the library is unloaded we need to do cleanup
+    swiftCleanup()
+    removeHook()
+}
+
+# Hook to perform cleanup of workers upon shutting down an R
+# session
+addHook <- function() {
+    # Replace the user's last function with ours
+    # If .UserLast already exists don't worry about it
+    # as we've already added our hook
+    if (!exists(".UserLast")) {
+        if (!exists(".Last")) {
+            # Create a dummy function
+            .UserLast <<- function () {}
+    
+        }
+        else {
+            .UserLast <<- .Last
+        }
+        
+        .Last <<- function () {
+            swiftCleanup()
+            .UserLast()
+            removeHook()
+        }
+    }
+}
+
+removeHook <- function() {
+    if (exists(".UserLast", where=".GlobalEnv")) {
+        .Last <<- .UserLast
+        rm(".UserLast", pos=".GlobalEnv")
+    }
+}
+
+detectSystemInfo <- function () {
+    # Do initial detection and setting of options to
+    # reflect system info.  DOesn't guarantee options will be set
+    os <- tolower(R.version$os)
+    corecount <- 0
+    if (substr(os, 1, 5) == "linux") {
+        corecount <- try(as.numeric(system(
+                    "grep -c '^processor' /proc/cpuinfo", intern=T)))
+    }
+    #if (substr(os, 1, 5) == "darwin") {
+    #}
+    #TODO: detect cores on other systems:
+    #   * MAC OS X
+    #   * BSD?
+    #    
+
+    if (!inherits(corecount, "try-error") && corecount >= 1){
+        options(swift.system.cores=corecount)
+    }
+}
+

Modified: SwiftApps/SwiftR/Swift/R/Tests.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Tests.R	2011-02-07 17:25:33 UTC (rev 4063)
+++ SwiftApps/SwiftR/Swift/R/Tests.R	2011-02-07 21:04:05 UTC (rev 4064)
@@ -42,6 +42,98 @@
   }
 }
 
+#1.3.* tests export functionality
+swiftTest_1.3.1 <- function()
+{
+
+  initSwiftTestOptions()
+
+  cat("\n*** Starting  test 1.3.1 ***\n\n")
+  y <- 1
+  inc <- function(x) { x + y }
+
+  arglist = list(1,2,3,4,5,6,7,8,9)
+
+  cat("Test of local lapply\n")
+  localres = lapply(arglist, inc)
+  cat("local result=\n")
+  print(localres)
+
+  # Test swiftExport
+  swiftExport(y)
+  cat("\nTest of swiftLapply\n")
+  swiftres = swiftLapply(arglist, inc)
+  cat("Swift result:\n")
+  print(swiftres)
+
+  if(identical(localres,swiftres)) {
+    cat("\n==> test 1.3.1 passed\n")
+  } else {
+    cat("\n==> test 1.3.1 FAILED !!!!!\n")
+  }
+}
+
+swiftTest_1.3.2 <- function()
+{
+ # Test swiftExportAll()
+
+  cat("\n*** Starting  test 1.3.2 ***\n\n")
+  y <<- 1
+  inc <- function(x) { x + y }
+
+  arglist = list(1,2,3,4,5,6,7,8,9)
+
+  cat("Test of local lapply\n")
+  localres = lapply(arglist, inc)
+  cat("local result=\n")
+  print(localres)
+
+  # Test swiftExport
+  swiftExportAll()
+  cat("\nTest of swiftLapply\n")
+  swiftres = swiftLapply(arglist, inc)
+  cat("Swift result:\n")
+  print(swiftres)
+
+  if(identical(localres,swiftres)) {
+    cat("\n==> test 1.3.2 passed\n")
+  } else {
+    cat("\n==> test 1.3.2 FAILED !!!!!\n")
+  }
+}
+
+
+swiftTest_1.3.3 <- function()
+{
+
+  initSwiftTestOptions()
+
+  cat("\n*** Starting  test 1.3.3 ***\n\n")
+  y <- 1
+  inc <- function(x) { x + y }
+
+  arglist = list(1,2,3,4)
+
+  # Test swiftExportAll
+  swiftExportAll()
+  cat("\nTest of swiftLapply\n")
+  swiftres = swiftLapply(arglist, inc)
+  cat("Swift result before removal:\n")
+  print(swiftres)
+
+  swiftRemoveAll()
+  swiftres = swiftLapply(arglist, inc)
+  cat("Swift result after removal:\n")
+  for (e in swiftres) {
+    if (!inherits(e, "try-error")) {
+        cat("\n==> test 1.3.3 FAILED !!!!!\n")
+        return()
+    }
+  }
+  cat("\n==> test 1.3.3 passed\n")
+}
+
+
 basicSwiftTest <- function() { swiftTest_1.1() }
 
 # .... more tests from below to move here
@@ -242,8 +334,10 @@
     # swiftres = swiftapply(sumstuff,arglist,callsperbatch=2,site="pbs")
     # test variations on local vs ssh vs pbs; coasters vs non; etc.
 
+    swiftTest_1.3.1()
+    swiftTest_1.3.2()
+    swiftTest_1.3.3()
 
-
     ##### Test Group  2
 
     cat("\n*** Starting test group 2 - test matrix passing***\n")

Modified: SwiftApps/SwiftR/Swift/R/Workers.R
===================================================================
--- SwiftApps/SwiftR/Swift/R/Workers.R	2011-02-07 17:25:33 UTC (rev 4063)
+++ SwiftApps/SwiftR/Swift/R/Workers.R	2011-02-07 21:04:05 UTC (rev 4064)
@@ -225,72 +225,3 @@
         return (worker$cores * worker$nodes)
 }
 
-.onLoad <- function (libname, packagename) {
-    detectSystemInfo()
-}
-
-.First.lib <- function(libname, packagename) {
-    # When the library is loaded, set up the
-    # list of workers
-    .swift.workers <<- list()
-}
-
-.Last.lib <- function(p) 
-{
-    # If the library is unloaded we need to do cleanup
-    swiftShutdown()
-    removeHook()
-}
-
-# Hook to perform cleanup of workers upon shutting down an R
-# session
-addHook <- function() {
-    # Replace the user's last function with ours
-    # If .UserLast already exists don't worry about it
-    # as we've already added our hook
-    if (!exists(".UserLast")) {
-        if (!exists(".Last")) {
-            # Create a dummy function
-            .UserLast <<- function () {}
-    
-        }
-        else {
-            .UserLast <<- .Last
-        }
-        
-        .Last <<- function () {
-            swiftShutdown()
-            .UserLast()
-            removeHook()
-        }
-    }
-}
-
-removeHook <- function() {
-    if (exists(".UserLast", where=".GlobalEnv")) {
-        .Last <<- .UserLast
-        rm(".UserLast", pos=".GlobalEnv")
-    }
-}
-
-detectSystemInfo <- function () {
-    # Do initial detection and setting of options to
-    # reflect system info.  DOesn't guarantee options will be set
-    os <- tolower(R.version$os)
-    corecount <- 0
-    if (substr(os, 1, 5) == "linux") {
-        corecount <- try(as.numeric(system(
-                    "grep -c '^processor' /proc/cpuinfo", intern=T)))
-    }
-    #if (substr(os, 1, 5) == "darwin") {
-    #}
-    #TODO: detect cores on other systems:
-    #   * MAC OS X
-    #   * BSD?
-    #    
-
-    if (!inherits(corecount, "try-error") && corecount >= 1){
-        options(swift.system.cores=corecount)
-    }
-}
-

Modified: SwiftApps/SwiftR/Swift/exec/SwiftRServer.R
===================================================================
--- SwiftApps/SwiftR/Swift/exec/SwiftRServer.R	2011-02-07 17:25:33 UTC (rev 4063)
+++ SwiftApps/SwiftR/Swift/exec/SwiftRServer.R	2011-02-07 21:04:05 UTC (rev 4064)
@@ -70,7 +70,8 @@
 {
   success <- try(load(callBatchFileName));
   if (inherits(success, "try-error")) {
-    failBatch(rcall, success, resultBatchFileName)
+    failBatch(rcall, paste(callBatchFileName, "could not be opened"), 
+                resultBatchFileName)
     return()
   }
   success <- try(loadImports(rcall$imports))
@@ -133,10 +134,10 @@
 
 loadImports <- function (importlist) {
     # First check whether the session id has changed
-    cat(paste("Import list:", importlist$exports, "\n"), file=stderr())
-    cat(paste("New Session:", importlist$session, "\n"), file=stderr())
-    cat(paste("Old Session:", try(get(".current.session", envir=globalenv())), 
-                "\n"), file=stderr())
+    #cat(paste("Import list:", importlist$exports, "\n"), file=stderr())
+    #cat(paste("New Session:", importlist$session, "\n"), file=stderr())
+    #cat(paste("Old Session:", try(get(".current.session", envir=globalenv())), 
+    #            "\n"), file=stderr())
     doSetup <- FALSE
     if (!is.null(importlist)) {
         if (exists(".current.session", envir=globalenv())) {
@@ -155,7 +156,7 @@
         # Load the contents of the specified file
         # into the global environment
 
-        cat("File: ", file, "\n")
+        #cat("File: ", file, "\n")
         # check to see if already imported
         if (!exists(file, envir=.current.imported)) {
             #TODO: load can fail with warning
@@ -166,7 +167,7 @@
             cat("Loaded file ", file, "\n")
         }
         else {
-            cat("Ignored file ", file, "\n")
+            #cat("Ignored file ", file, "\n")
         }
     }
 }




More information about the Swift-commit mailing list