Description Usage Arguments Value Examples
INTERNAL. Generates permutations of perm
and calls a callback fun
for every permutation, without preallocating
memory. It uses SNOW-package for parallel computing. This helps, when permutating very large vectors.
1 2 |
perm |
numeric vector; numbers which should be permuted |
fun |
function; callback function with 1 parameter. See examples for more information. |
funsave |
function; callback function with 2 parameters: |
values |
numeric; Cache for |
savemax |
numeric; Cache of results calculated by |
cores |
numeric; Number of preocessors should be used |
cluster |
cluster-variable created by |
list of all return values of funsave
.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | #callback "fun"
perm.callback.FUN.STUMP <- function(x,resultobject){
resultobject[CONST_SAVE] <-TRUE
resultobject[CONST_SKIP] <-FALSE
return(resultobject)
}
#callback "funsave"
perm.callback.FUNSAVE.STUMP <- function(resultlist){
res <- resultlist[['resultobject']]
lis <- resultlist[['results']]
return(list(results=lis, resultobject= res))
}
# Example:
#----------------------------------------------------------------
# EXAMPLE CALLBACK
#----------------------------------------------------------------
# Prunes, if 3 is last number in permutation
# Saves only, if sum() of permutation is the highest found yet.
# IMPORTANT: return has to be a "resultobject", which is provided
# through the parameters.
# Use
# resultobject[CONST_SKIP] <- TRUE/FALSE (prune after this permutation T/F)
# resultobject[CONST_SAVE] <- TRUE/FALSE (return this permutation, save it T/F)
# resultobject[CONST_VAL] <- NUMERIC (use this to save something for the process)
#-----------------------------------------------------------------
perm.callback <- function(x,resultobject){
#CALCULATE STUFF HERE;
#SKIP EXAMPLE
#Skip this one? skip next permutations if the last number is 3
resultobject[CONST_SKIP] <- (x[length(x)] == 3)
#SAVE EXAMPLE
#Should we save this permutation?
#Save only, if sum of permutation is bigger than the ones we already saved.
s <- sum(x)
if(s > resultobject[CONST_VAL]){
resultobject[CONST_VAL] <- s
resultobject[CONST_SAVE] <-TRUE
}else{
resultobject[CONST_SAVE] <-FALSE
}
return(resultobject)
}
#----------------------------------------------------------------
# EXAMPLE CALLBACK FOR SAVING
#-----------------------------------------------------------------
# Orders resultlist, saves only "TOP 50"
#
# INPUT: List with 2 items: 'resultobject' and 'results'
# res <- resultlist[['resultobject']]
# lis <- resultlist[['results']]
#
# OUTPUT: (list with item 'results'(resultlist)) and resultobject,
# to pass on to further calculations
# return(list(results=lis, resultobject= res))
#-----------------------------------------------------------------
perm.callback.save <- function(resultlist){
res <- resultlist[['resultobject']]
lis <- resultlist[['results']]
# ORDER RESULTLIST
if(length(lis) > 0){
#For Example "TOP 50": Only save the top 50!
allvals <- sapply(lis, function(x) x[['values']], simplify = TRUE ) # get all values
lis <- lis[ order( allvals ) ] # order list by values
if(length(lis) > 50)
lis <- lis[1:50] # only save Top 50
res[CONST_VAL] <- max(allvals)
}
return(list(results=lis, resultobject= res))
}
#Execution
result <- permu.new(perm=1:10, fun=perm.callback,funsave=perm.callback.save,values=1, cores = 4)
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.