permu.new

Description

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.

Usage

1
2
permu.new(perm, fun, funsave, values = 0, savemax = 1e+05, cores = NULL,
  cluster = NULL)

Arguments

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: x for current permutations and resultobject for saving purposes. See examples for more information.

values

numeric; Cache for resultobject

savemax

numeric; Cache of results calculated by fun

cores

numeric; Number of preocessors should be used

cluster

cluster-variable created by makeCluster if more computers should be used.

Value

list of all return values of funsave.

Examples

 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)

Want to suggest features or report bugs for rdrr.io? Use the GitHub issue tracker.