[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