How can you check whether a sequence is an 'almost increasing sequence' in R?-CodePudding

A sequence (e.g. c(1,2,3,4)) is almost increasing when we can remove exactly one element from the sequence and get a strictly increasing sequence (i.e. a0 < a1 < ... < an). I'm trying to find a way to check whether a sequence is almost increasing. If it is, I want to return TRUE; if it isn't I want to output FALSE. I've got this far:

solution <- function(sequence) {
  sequence1 <- unlist(sequence)
  if (length(sequence1) == 1) {
    next
  }
  count <- 0
  for (i in (length(sequence1) - 1)) {
    if (sequence1[i   1] > sequence1[i]) {
      next
    } else if (((sequence1[i   2] > sequence1[i]) & count == 0) & i != 
length(sequence1)-1) {
      sequence1 <- sequence1[- (i   1)]
      count <- count   1
    } else if ((sequence1[i   1] > sequence1[i - 1]) & count == 0 & i != 1) {
      sequence1 <- sequence1[-i]
      count <- count   1
    } else {
      return(FALSE)
    }
  }
  return(TRUE)
}

I've used unlist() because codesignal, for some reason, doesn't accept you to refer to the function argument within the function. This works for some sequences: solution(c(4,1,5)) correctly returns TRUE. It doesn't work for others: solution(c(1, 1, 1, 2, 3)) incorrectly returns TRUE. solution(c(2,1,2,1)) correctly returns FALSE and yet solution(c(1,2,1,2)) incorrectly returns TRUE. I've lost my grip on what's going on. I wonder if anyone can spot anything?

Clarification: the basic idea of my code is to iterate through the sequence and for each element check whether its right neighbour is a bigger number. If it isn't, then we have two options: get rid of i or get rid of i 1, so I check those in turn. Since we can only make one change, i've added the condition that if count is 1, then we skip to finish. Also, if the index is 1 then we can't check i-1, and if the index is length(sequence)-1, then we can't check i 2, so i've added those conditions in to make sure my code skips to the other option if appropriate.

CodePudding user response：

Here is a function with diff and rle.

solution <- function(x) {
  d <- c(TRUE, diff(x))
  y <- x[-which.min(d > 0)]
  all(rle(y)$lengths == 1L)
}

x0 <- 1:4
x1 <- c(4,1,5)
x2 <- c(1, 1, 1, 2, 3)
x3 <- c(2,1,2,1)
x4 <- c(1,2,1,2)
x_list <- mget(ls(pattern = "^x"))

sapply(x_list, solution)
#>    x0    x1    x2    x3    x4 
#>  TRUE  TRUE FALSE FALSE FALSE

^{Created on 2022-03-21 by the reprex package (v2.0.1)}

CodePudding user response：

You are making this way harder than it needs to be. You could just do:

check_almost <- function(vec) {
  sum(!(vec[-1] > head(cummax(vec), -1))) < 2
}

And testing it on some examples:

almost1 <- c(1, 2, 3, 2, 5)
almost2 <- c(1, 2, 3, 2, 5)
not_almost1 <- c(1, 0, 2, 0, 5)
not_almost2 <- c(1, 2, 1, 0, 4)

check_almost(almost1)
#> [1] TRUE
check_almost(almost2)
#> [1] TRUE
check_almost(not_almost1)
#> [1] FALSE
check_almost(not_almost2)
#> [1] FALSE

And on Rui's examples:

x0 <- 1:4
x1 <- c(4,1,5)
x2 <- c(1, 1, 1, 2, 3)
x3 <- c(2,1,2,1)
x4 <- c(1,2,1,2)
x_list <- mget(ls(pattern = "^x"))

sapply(x_list, check_almost)
#>   x0    x1    x2    x3    x4 
#> TRUE  TRUE FALSE FALSE FALSE

And on jochen's example:

check_almost(c(4, 3, 2, 1))
#> [1] FALSE

CodePudding user response：

Here is a solution which works for me. The idea is that diff(x) has negative elements for every downwards step in x. For example, min(diff(x)) is positive, if x is strictly increasing. If diff(x)[i] <= 0 for exactly one index i, we have to check whether either removing x[i] or removing x[i 1] makes the sequence strictly increasing. The following function passed all tests I tried:

check_almost <- function(x) {
  if (length(x) < 2) {
    return(TRUE)
  }
  
  d <- diff(x)
  i <- which(d <= 0)
  if (length(i) == 0) {
    return(TRUE) # strictly increasing
  } else if (length(i) > 1) {
    return(FALSE)
  }

  return(i == 1 || # we can remove x[1]
           i == length(d) ||  # we can remove x[length(x)]
           d[i-1] d[i] > 0 || # we can remove x[i]
           d[i]   d[i 1] > 0) # we can remove x[i 1]
}