[Rodbcext-commits] r52 - in pkg/genutils: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Mar 27 07:23:25 CET 2014


Author: jaunario
Date: 2014-03-27 07:23:25 +0100 (Thu, 27 Mar 2014)
New Revision: 52

Added:
   pkg/genutils/R/worker.r
Modified:
   pkg/genutils/
   pkg/genutils/DESCRIPTION
   pkg/genutils/R/logutils.R
Log:
Added worker.r (function: get.jobs)


Property changes on: pkg/genutils
___________________________________________________________________
Modified: svn:ignore
   - *.Rbuildignore
*.Rhistory
*.Rproj
*.user

   + *.Rbuildignore
*.Rhistory
*.Rproj
*.user
.project

Added: svn:global-ignores
   + .settings


Modified: pkg/genutils/DESCRIPTION
===================================================================
--- pkg/genutils/DESCRIPTION	2014-03-14 03:58:23 UTC (rev 51)
+++ pkg/genutils/DESCRIPTION	2014-03-27 06:23:25 UTC (rev 52)
@@ -1,7 +1,7 @@
 Package: genutils
 Type: Package
 Title: IRRI Geography Lab - General Utilities
-Version: 0.0.3
+Version: 0.0.4
 Date: 2011-10-19
 Depends: methods
 Author: Jorrel Khalil S. Aunario

Modified: pkg/genutils/R/logutils.R
===================================================================
--- pkg/genutils/R/logutils.R	2014-03-14 03:58:23 UTC (rev 51)
+++ pkg/genutils/R/logutils.R	2014-03-27 06:23:25 UTC (rev 52)
@@ -6,7 +6,7 @@
 show.message <- function(..., EL=FALSE, delay=0){
   # Real-time console messages
   if (EL){
-    message(rep(" ", options("width")),"\r", appendLF=FALSE)
+    message(rep(" ", options("width")$width-1),"\r", appendLF=FALSE)
   } 
   message(...)
   Sys.sleep(delay)

Added: pkg/genutils/R/worker.r
===================================================================
--- pkg/genutils/R/worker.r	                        (rev 0)
+++ pkg/genutils/R/worker.r	2014-03-27 06:23:25 UTC (rev 52)
@@ -0,0 +1,44 @@
+# Author: Jorrel Khalil S. Aunario, jaunario at gmail.com
+# Date :  27 March 2014
+# Version 0.0.1
+# Licence GPL v3
+
+get.jobs <- function(initjobs, jobfile="jobs.Rdata",workload=500,delay=10, maxtries=100){
+	myjob <- vector()
+	worker.id <- Sys.getpid()
+	
+	if(!file.exists(jobfile)){
+		jobs <- initjobs
+		save(jobs, file=jobfile)
+		
+		filelock <- data.frame(filename=character(0),worker=numeric(0))
+		filelock[1,] <- NA
+		filelock$filename[1] <- jobfile   
+		write.csv(filelock,"files.csv",row.names=FALSE)		
+ 
+	}
+	
+	tries <- 0
+	repeat{
+		filelock <- read.csv("files.csv",stringsAsFactors=FALSE)
+		if(is.na(filelock$worker[filelock$filename==jobfile])){
+			filelock$worker[filelock$filename==jobfile] <- worker.id
+			write.csv(filelock,"files.csv",row.names=FALSE)
+			load(jobfile)
+			myjob <- jobs[1:min(workload,length(jobs))] 
+			jobs <- jobs[!jobs %in% myjob]
+			save(jobs, file=jobfile)
+			filelock$worker[filelock$filename==jobfile] <- NA
+			write.csv(filelock,"files.csv",row.names=FALSE)
+			break
+		} else if (tries<maxtries){
+			message("Job directory currently in use. Waiting.", appendLF=TRUE)
+			Sys.sleep(delay)	
+			tries <- tries+1
+		} else {
+			message("Too many workers queued. Try again next time.", appendLF=TRUE)
+			break
+		}	
+	}
+	return(myjob)
+}



More information about the Rodbcext-commits mailing list