auto-commit

Author: yvanrichard

parallelisation/check-screens.r

@@ -0,0 +1,19 @@
+rm(list=ls())
+source('parallel-pars.r')
+
+load('cores_alloc.rdata')
+comps <- unique(cores_alloc$comp)
+
+cp <- comps[1]
+
+for (cp in comps)
+  {
+    cat('*****', cp,'\n')
+    cmd <- sprintf('ssh -A %s@%s "cd dragonfly/%s/%s; tail screenlog.0"', user, cp, projectname, runfold)
+    cat(cmd,'\n')
+    system(cmd, wait=T)
+    cat('\n\n')
+  }
+
+cat('Done.\n\n')
+

parallelisation/compile-functions.r

@@ -0,0 +1,40 @@
+rm(list=ls())
+
+library(compiler)
+enableJIT(3)
+
+library(popbio)
+library(stats)
+
+setwd('~/dragonfly/sra-foundations/modelling/bh-dd-k50')
+
+is.compile <- function(func)
+{
+  ## this function lets us know if a function has been byte-coded or not
+  ##If you have a better idea for how to do this - please let me know...
+  if(class(func) != "function") stop("You need to enter a function")
+  last_2_lines <- tail(capture.output(func),2)
+  any(grepl("bytecode:", last_2_lines)) # returns TRUE if it finds the text "bytecode:" in any of the last two lines of the function's print
+}
+
+## source('functions.r')
+cmpfile('functions.r', 'functions_cmp.r')
+cmpfile('functions-model.r', 'functions-model_cmp.r')
+
+
+## rm(list=ls())
+## source('functions.r')
+## funs1 <- ls()
+## save(funs1, file='funs1.rdata')
+
+## rm(list=ls())
+## source('functions-model.r')
+## funs2 <- ls()
+## save(funs2, file='funs2.rdata')
+
+## rm(list=ls())
+## load('funs1.rdata')
+## load('funs2.rdata')
+
+## funs1[funs1 %in% funs2]
+## funs2[funs2 %in% funs1]

parallelisation/gather-results.r

@@ -0,0 +1,112 @@
+###  Fetch results from all computers  ###
+##########################################
+
+rm(list=ls())
+library(compiler)
+
+basefold <- '~/dragonfly/sra-foundations/modelling/bh-dd-k50/'
+setwd(basefold)
+
+source('parallel-pars.r')
+## source('functions.r')
+loadcmp('functions_cmp.r')
+
+load(datafile)
+
+load('cores_alloc.rdata')
+othercomps <- unique(cores_alloc$comp[!(cores_alloc$comp %in% thiscomp)])
+
+c=othercomps[1]
+for (c in othercomps)
+  {
+    fold <- sprintf('%s-%s', outputfold, c)
+    dir.create(fold, showWarnings=F)
+    ## Mount results from other computers
+    if (!length(dir(fold)))
+      system(sprintf('sshfs %s:/home/%s/dragonfly/%s/%s/%s %s',
+                     c, user, projectname, runfold, outputfold, fold))
+  }
+
+
+resi <- NULL
+resf <- NULL
+
+folds <- c(outputfold, sprintf('%s-%s', outputfold, othercomps))
+for (d in folds)  # d='results-taiko'    # d='results'
+  {
+    cat('\nMerging files in', d, '...\n')
+    setwd(sprintf('%s%s', basefold, d))
+    
+    inter <- dir(pattern='.*pars1-steps.*..rdata')
+    fin <- dir(patter='.*pars-steps.*..rdata')
+
+    for (f in inter)                    # f=inter[1]
+      {
+        load(f)
+        resi <- rbind2(resi, pars1)
+      }
+
+    for (f in fin)                      # f=fin[2]
+      {
+        load(f)
+        resf <- rbind2(resf, pars)
+      }
+  }
+
+
+setwd(basefold)
+
+## Unmount other computers
+for (c in othercomps)  # c='frank'
+  {
+    fold <- sprintf('%s-%s', outputfold, c)
+    system(sprintf('fusermount -u %s', fold))
+    unlink(fold, recursive=T)
+  }
+
+allresdir <- sprintf('%sall-results', basefold)
+dir.create(allresdir, showWarnings=F)
+setwd(allresdir)
+
+
+## Merge intermediate and final results
+resi2 <- resi[!(resi$row %in% resf$row),]  # remove finished rows from intermediate results
+res <- rbind(resi2, resf)                  
+
+res <- res[order(res$row),]
+
+
+
+## Check missing rows and summarise
+missingrows <- dem$row[!(dem$row %in% res$row)]
+if (length(missingrows))
+  {
+    mr <- as.numeric(missingrows)
+    mseq <- collapseseq(mr)
+    cat(sprintf('\n%i missing sequences (%i rows):\n', length(mseq$n), length(mr)))
+    df <- data.frame(seq=mseq$seq, n=mseq$n, row.names=1:length(mseq$n))
+    print(df)
+    save(df, file='missing-rows_df.rdata')
+  }
+
+cat(sprintf('\n%i rows done (%i duplicates) after merging intermediates and final results.
+   Details:', nrow(res), sum(duplicated(res$row))),'\n')
+print(table(res$species))
+
+if ('pbr0' %in% names(res))
+  cat(sprintf('\n%i PBR values (%0.1f%%) already calculated.\n', sum(!is.na(res$pbr0)),
+      100*sum(!is.na(res$pbr0))/nrow(res))) else
+         cat('\nNo PBR values already calculated.\n')
+
+
+### Save appended results
+res <- res[order(res$row),]
+
+setwd(allresdir)
+save(res, file='results_res.rdata')
+
+
+
+
+
+

parallelisation/gitsync.r

@@ -0,0 +1,19 @@
+rm(list=ls())
+source('../pars_parallel.r')
+
+load('cores_alloc.rdata')
+comps <- unique(cores_alloc$comp)
+comps <- comps[!(comps %in% thiscomp)]
+
+cp <- comps[1]
+
+for (cp in comps)
+  {
+    cat('*****', cp,'\n')
+    cmd <- sprintf('ssh -A %s@%s "cd %s/%s; git pull"', user, cp, basefold, projectname)
+    cat(cmd,'\n')
+    system(cmd, wait=T)
+    cat('\n\n')
+  }
+
+cat('Done.\n\n')

parallelisation/kill-all-r.r

@@ -0,0 +1,19 @@
+rm(list=ls())
+source('parallel-pars.r')
+
+load('cores_alloc.rdata')
+comps <- unique(cores_alloc$comp)
+
+cp <- comps[1]
+
+for (cp in comps)
+  {
+    cat('*****', cp,'\n')
+    cmd <- sprintf('ssh -A %s@%s "killall R -u %s"', user, cp, user)
+    cat(cmd,'\n')
+    system(cmd, wait=T)
+    cat('\n\n')
+  }
+
+cat('Done.\n\n')
+

parallelisation/kill-all-screens.r

@@ -0,0 +1,19 @@
+rm(list=ls())
+source('parallel-pars.r')
+
+load('cores_alloc.rdata')
+comps <- unique(cores_alloc$comp)
+
+cp <- comps[1]
+
+for (cp in comps)
+  {
+    cat('*****', cp,'\n')
+    cmd <- sprintf('ssh -A %s@%s "killall -u %s screen"', user, cp, user)
+    cat(cmd,'\n')
+    system(cmd, wait=T)
+    cat('\n\n')
+  }
+
+cat('Done.\n\n')
+    

parallelisation/parallel-pars.r

@@ -0,0 +1,29 @@
+
+user <- 'yvan'
+thiscomp <- 'robin'
+
+ca <- data.frame(comp  = c('robin', 'tieke', 'leon', 'frank', 'taiko'),
+                 cores = c(   5   ,    5   ,    5  ,    4   ,    5   ),
+                 weight= c(   1   ,   1.1  ,    1  ,    1   ,   1.2  ),
+                 stringsAsFactors=F
+                 )
+
+
+datafile <- '../init-samples/all-results/all-good-samples-bh_dem.rdata'
+dataname <- 'dat'  # name of data frame
+rowidcol <- 'row'
+
+##  For makefiles
+projectname <- 'projectx'
+runfold <- 'modelling/calc'  # where the run file is, relatively to project base folder
+runfile <- 'run1.r'   # file to run job on each slice, needs to take sequence of ids as txt in arguments
+outputfold <- 'results'  # relatively to runfold
+outputbasename <- 'slice'  # slice seq and .rdata will be appended to it
+allresfold <- 'all-results'
+
+sources <- NULL
+libs <- NULL
+deps <- NULL
+## sources <- 'functions.r'
+## libs <- 
+## deps <- c('functions-model.r', 'functions.r')  # dependencies in runfold

parallelisation/park-prev.r

@@ -0,0 +1,41 @@
+rm(list=ls())
+source('../pars_parallel.r')
+
+fls <- dir(sprintf('%s/%s', basefold, projectname))
+
+comps <- ca$comp
+
+timeflag <- format(Sys.time(), '%y%m%d-%H%M')
+
+cp <- comps[1]
+for (cp in comps)
+  {
+    cat('\n***  Parking ', cp, '... \n', sep='')
+
+    ## results
+    f <- sprintf('%s/%s/%s/%s', basefold, projectname, runfold, outputfold)
+    a <- suppressWarnings(system(sprintf('ssh -A %s@%s "ls -d %s" 2>&1', user, cp, f), intern=T))
+    if (!grepl('^ls:',a))
+      {
+        cmd <- sprintf('ssh -A %s@%s "cd %s/%s/%s; mv %s %s_%s"', user, cp,
+                       basefold, projectname, runfold, outputfold, outputfold, timeflag); cat(cmd,'\n')
+        system(cmd, wait=T)
+      } else cat(sprintf('!!!  Folder %s does not exist on %s. Skip...\n', f, cp))
+
+    
+    ## all-results
+    f <- sprintf('%s/%s/%s/%s', basefold, projectname, runfold, allresfold)
+    a <- suppressWarnings(system(sprintf('ssh -A %s@%s "ls -d %s" 2>&1', user, cp, f), intern=T))
+    if (!grepl('^ls:',a))
+      {
+        cmd <- sprintf('ssh -A %s@%s "cd %s/%s/%s; mv %s %s_%s"', user, cp,
+                       basefold, projectname, runfold, allresfold, allresfold, timeflag); cat(cmd,'\n')
+        system(cmd, wait=T)
+      } else cat(sprintf('!!!  Folder %s does not exist on %s. Skip...\n', f, cp))
+
+    cat('Done.\n\n')
+  }
+
+if (length(warnings()))
+  print(warnings())
+