Make values not adjacent to each other NA

Viewed 72

The values >=10 in the data frame below (values 31,89,12,69) does sometimes come in order like 89 and 12. By that I mean de order 123456789, they are adjacent to eachother. I would like to make the values which are not adjacent to each other(31,69, in 31 nr 2 is missing in between to be in order, for 69, nr 7 and8 are missing to be in order) NA. How to code this? Imagine a big dataset! :)

 id <- factor(rep(letters[1:2], each=5))
    A <- c(1,2,NA,67,8,9,0,6,7,9)
    B <- c(5,6,31,9,8,1,NA,9,7,4)
    C <- c(2,3,5,NA,NA,2,7,6,4,6)
    D <- c(6,5,89,3,2,9,NA,12,69,8)
    df <- data.frame(id, A, B,C,D) 
    df
  id  A  B  C  D
1   a  1  5  2  6
2   a  2  6  3  5
3   a NA 31  5 89
4   a 67  9 NA  3
5   a  8  8 NA  2
6   b  9  1  2  9
7   b  0 NA  7 NA
8   b  6  9  6 12
9   b  7  7  4 69
10  b  9  4  6  8 

It should look like:

 id  A  B  C  D
1   a  1  5  2  6
2   a  2  6  3  5
3   a NA NA  5 89
4   a 67  9 NA  3
5   a  8  8 NA  2
6   b  9  1  2  9
7   b  0 NA  7 NA
8   b  6  9  6 12
9   b  7  7  4 NA
10  b  9  4  6  8
3 Answers

Another solution defining a vector of the values to keep beforehand (only up to two-digit numbers, but could be extended):

numerals <- 1:9
vector <- 0:9
for (i in numerals) {
  j <- numerals[i+1]
  if (!is.na(j)) {
    number <- as.numeric(paste(c(i, j), collapse = ""))
    number_reverse <- as.numeric(paste(c(j, i), collapse = ""))
    vector <- c(vector, number, number_reverse)
  }
}

vector
[1]  0  1  2  3  4  5  6  7  8  9 12 21 23 32 34 43 45 54 56 65 67 76 78 87 89 98

Function to replace number if not in vector:

replace <- function(x) {
  x <- ifelse(!x %in% vector, NA, x)
  return(x)
}

Result:

df %>% mutate_at(c("A", "B", "C", "D"), replace)

   id  A  B  C  D
1   a  1  5  2  6
2   a  2  6  3  5
3   a NA NA  5 89
4   a 67  9 NA  3
5   a  8  8 NA  2
6   b  9  1  2  9
7   b  0 NA  7 NA
8   b  6  9  6 12
9   b  7  7  4 NA
10  b  9  4  6  8

Here is a function that tests individual numbers

MyFunction <- function(A){
  NumbersToCheck <- lapply(strsplit(as.character(A),""),as.integer)
  check <- lapply(2:length(unlist(NumbersToCheck)), function(X) ifelse(NumbersToCheck[[1]][X]-NumbersToCheck[[1]][X-1]==1,TRUE,FALSE))
  return(ifelse(FALSE %in% check,NA,A))
}

Which can then be applied to your entire df as follows

df[,2:ncol(df)] <- lapply(2:ncol(df),  function(X) unlist(lapply(df[,X],MyFunction)))

to get the following result

> df
   id  A  B  C  D
1   a  1  5  2  6
2   a  2  6  3  5
3   a NA NA  5 89
4   a 67  9 NA  3
5   a  8  8 NA  2
6   b  9  1  2  9
7   b  0 NA  7 NA
8   b  6  9  6 12
9   b  7  7  4 NA
10  b  9  4  6  8
df[] <- lapply(df, function(col) {
  # Split each value character by character
  NAs <- sapply(strsplit(as.character(col), split = ""), function(chars) {
    # Convert them back to integer to compare with `diff`
    # and verify the increment is always 1 or -1
    diff <- diff(as.integer(chars))
    !all(diff == 1) && !all(diff == -1)
  })
  # If not, replace those values with NA
  col[NAs] <- NA
  col
})
#> Warning in diff(as.integer(chars)): NAs introduced by coercion

#> Warning in diff(as.integer(chars)): NAs introduced by coercion

#> ...

#> Warning in diff(as.integer(chars)): NAs introduced by coercion
df
#>    id  A  B  C  D
#> 1   a  1  5  2  6
#> 2   a  2  6  3  5
#> 3   a NA NA  5 89
#> 4   a 67  9 NA  3
#> 5   a  8  8 NA  2
#> 6   b  9  1  2  9
#> 7   b  0 NA  7 NA
#> 8   b  6  9  6 12
#> 9   b  7  7  4 NA
#> 10  b  9  4  6  8

Created on 2020-03-31 by the reprex package (v0.3.0)

Related