在R中查找具有约束的值的组合

Question

I have a set of values in a vector, eg

all_points <- c(1, 4, 2, 12, 6, 5, 25)

I want to find all possible combinations where the numbers from left to right are in ascending order. The first and last numbers will always be included. For example, in this case they would be:

1, 4, 12, 25
1, 4, 6, 25
1, 4, 25
1, 2, 12, 25
1, 2, 6, 25
1, 2, 5, 25
1, 2, 25
1, 12, 25
1, 6, 25
1, 5, 25
1, 25

At the moment, I am trying to implement a recursive function that tests the size of all rightward values, and returns a list of vectors, but it isn't working. Included below is part R code and part pseudocode to explain my approach.

my_recursive_function <- function(input_points, running_vector = c(1)){
    start_point <- input_points[1]
    rightward_points <- input_points[2:length(input_points)
    for(i in 1:length(rightward_points)){
        if(rightward_points[i] != 25 & rightward_points[i] > start_point){
            set_of_points <- c(running_vector, rightward_points[i])
            my_recursive_function(rightward_points, set_of_points)
        }
        if(rightward_points[i] == 25){
            print(c(running_vector, 25)
            flush.console()
            #I will end up doing more than printing here, but this is enough for the example
        }

        #do something to return to the previous level of recursion, 
        #including returning running_vector and rightward_points
        #to the appropriate states
    }

So hopefully that kind of makes sense. I have 2 questions:

1. Am I overcomplicating this, and there is a better way? This is kind of a search algorithm, traversing a tree structure, so there might be something smart I can do here that I can't see.
2. If this is the best way, how do I do the pseudocode bit at the bottom? I'm getting very confused trying to work out what each vector looks like, in each level of recursion, and how to pop elements off my running_vector.

Answer 1

One possible approach is to use combn with different lengths to create all possible combinations as follows:

combis <- lapply(0L:(length(all_points)-2L), 
            function(n) combn(
                seq_along(all_points)[c(-1L, -length(all_points))], 
                n, 
                function(x) all_points[x],
                FALSE))

lapply(unlist(combis, recursive=FALSE),
    function(x) c(all_points[1L], x, all_points[length(all_points)]))

Explanation

1) The first line of code takes the number of elements ( n ) between first and last element and generate all possible combinations of indices and then extracts the corresponding elements using function(x) all_points[x]

2) unlist(..., recursive=FALSE) unnest the list by 1 level.

3) lapply(..., function(x) c(sorted[1L], x, sorted[length(sorted)])) appends the first and last element to each combination

Output

[[1]]
[1]  1 25

[[2]]
[1]  1  4 25

[[3]]
[1]  1  2 25

[[4]]
[1]  1 12 25

[[5]]
[1]  1  6 25

[[6]]
[1]  1  5 25

[[7]]
[1]  1  4  2 25

[[8]]
[1]  1  4 12 25

[[9]]
[1]  1  4  6 25

[[10]]
[1]  1  4  5 25

[[11]]
[1]  1  2 12 25

[[12]]
[1]  1  2  6 25

[[13]]
[1]  1  2  5 25

[[14]]
[1]  1 12  6 25

[[15]]
[1]  1 12  5 25

[[16]]
[1]  1  6  5 25

[[17]]
[1]  1  4  2 12 25

[[18]]
[1]  1  4  2  6 25

[[19]]
[1]  1  4  2  5 25

[[20]]
[1]  1  4 12  6 25

[[21]]
[1]  1  4 12  5 25

[[22]]
[1]  1  4  6  5 25

[[23]]
[1]  1  2 12  6 25

[[24]]
[1]  1  2 12  5 25

[[25]]
[1]  1  2  6  5 25

[[26]]
[1]  1 12  6  5 25

[[27]]
[1]  1  4  2 12  6 25

[[28]]
[1]  1  4  2 12  5 25

[[29]]
[1]  1  4  2  6  5 25

[[30]]
[1]  1  4 12  6  5 25

[[31]]
[1]  1  2 12  6  5 25

[[32]]
[1]  1  4  2 12  6  5 25

Answer 2

Here is a non recursive function. The output is a list of matrices, each of them with columns corresponding to the required vectors.

non_recursive_function <- function(X){
  N <- length(X)
  X2 <- X[-c(1, N)]
  res <- lapply(seq_along(X2), function(k) t(combn(X2, k)))
  inx <- lapply(res, function(x){
    apply(x, 1, function(y) all(diff(y) > 0))
  })
  res <- lapply(seq_along(res), function(i) res[[i]][inx[[i]], ])
  res <- res[sapply(res, length) > 0]
  res <- lapply(res, function(x) 
    apply(as.matrix(x), 1, function(y) c(X[1], y, X[N])))
  res
}

all_points <- c(1, 4, 2, 12, 6, 5, 25)
x <- non_recursive_function(all_points)