r sequence recognition for univariate data sequence mining

Question

I am looking for a method to detect sequences within univariate discrete data without specifying the length of the sequence or the exact nature of the sequence beforehand (see e.g. Wikipedia - Sequence Mining)

Here is example data

x <- c(round(rnorm(100)*10),
       c(1:5),
       c(6,4,6),
       round(rnorm(300)*10), 
       c(1:5), 
       round(rnorm(70)*10),
       c(1:5), 
       round(rnorm(100)*10),
       c(6,4,6),
       round(rnorm(200)*10),
       c(1:5), 
       round(rnorm(70)*10),
       c(1:5),
       c(6,4,6),
       round(rnorm(70)*10),
       c(1:5), 
       round(rnorm(100)*10),
       c(6,4,6),
       round(rnorm(200)*10),
       c(1:5), 
       round(rnorm(70)*10),
       c(1:5),
       c(6,4,6))

The method should be able to identify the fact that x contains the sequence 1,2,3,4,5 at least eight times and the sequence 6,4,6 at least five times ("at least" because the random normal part can potentially generate the same sequence).

I have found the arules and arulesSequences package but I could'nt make them work with univariate data. Are there any other packages that might be more appropriate here ?

I'm aware that only eight or five occurrences for each sequence is not going to be enough to generate statistically significant information, but my question was to ask if there was a good method of doing this, assuming the data repeated several times.

Also note the important part is that the method is done without knowing beforehand that the structure in the data had the sequences 1,2,3,4,5 and 6,4,6 built into it. The aim was to find those sequences from x and identify where it occurs in the data.

Any help would be greatly appreciated!

P.S This was put up here upon suggestion from a stackoverflow comment...

Update: perhaps due to the computational difficulty due to the number of combinations, the length of sequence can have a maximum of say 5?

Answer 1

Finding the high-frequency sequences is the hard part: once they have been obtained, basic matching functions will identify where they occur and how often.

Within a sequence of length k there are k+1-n n-grams, whence for n-grams up to length n.max, there are fewer than k * n.max n-grams. Any reasonable algorithm shouldn't have to do much more computing than that. Since the longest possible n-gram is k, every possible sequence could be explored in $O(k^2)$ time. (There may be an implicit factor of $O(k)$ for any hashing or associative tables used to keep track of the counts.)

To tabulate all n-grams, assemble appropriately shifted copies of the sequence and count the patterns that emerge. To be fully general we do not assume the sequence consists of positive integers: we treat its elements as factors. This slows things down a bit, but not terribly so:

ngram <- function(x, n) {
  # Returns a tabulation of all n-grams of x
  k <- length(x)
  z <- as.factor(x)
  y <- apply(matrix(1:n, ncol=1), 1, function(i) z[i:(k-n+i)])
  ngrams <- apply(y, 1, function(s) paste("(", paste(s, collapse=","), ")", sep=""))
  table(as.factor(ngrams))
}

(For pretty output later, the penultimate line encloses each n-gram in parentheses.)

Let's generate the data suggested in the question:

set.seed(17)
f <- function(n) c(round(rnorm(n, sd=10)), 1:5, c(6,4,6))
x <- unlist(sapply(c(100,300,70,100,200,70,70,100,200,70), f))

We will want to look only at the highest frequencies:

test <- function(y, e=0, k=2) {
  # Returns all extraordinarily high counts in `y`, which is a table
  # of n-grams of `x`.  "Extraordinarily high" is at least `k` and 
  # is unusual for a Poisson distribution of mean `e`.
  u <- max(k, ceiling(e + 5 * sqrt(e)))
  y[y >= u]
}

Let's do it!

n.alphabet <- length(unique(x))   # Pre-compute to save time
n.string <- length(x)             # Used for computing `e` below
n.max <- 9                        # Longest subsequence to look for
threshold <- 4                    # Minimum number of occurrences of interesting subsequences
y <- lapply(as.list(1:n.max), 
     function(i) test(ngram(x,i), e=(n.string+1-i) / n.alphabet^i, k=threshold))

This calculation took 0.22 seconds to find all high-frequency n-grams, with n=1, 2, ..., 9 within a string of length 1360. Here is a compact list (the corresponding frequencies can also be found in y: just print it out, for instance):

> temp <- lapply(as.list(1:n.max), 
          function(i) {cat(sprintf("%d-grams:", i), names(y[[i]]), "\n")})

1-grams: (-1) (-3) (-4) (-7) (0) (1) (2) (3) (4) (5) (6) 
2-grams: (-1,-1) (-1,0) (-1,1) (-11,0) (-3,-7) (-3,-8) (-3,3) (-4,-4) (-6,-1) (-6,0) (-7,-3) (-7,-5) (-7,-7) (-7,-9) (-8,3) (-9,0) (-9,9) (0,5) (0,9) (1,2) (1,4) (10,6) (12,-7) (2,-5) (2,-7) (2,3) (3,-1) (3,-2) (3,2) (3,4) (4,-5) (4,-9) (4,4) (4,5) (4,6) (5,-2) (5,-4) (5,6) (6,-4) (6,1) (6,3) (6,4) (6,5) (6,7) (7,6) (8,-7) (8,14) 
3-grams: (1,2,3) (2,3,4) (3,4,5) (4,5,6) (5,6,4) (6,4,6) 
4-grams: (1,2,3,4) (2,3,4,5) (3,4,5,6) (4,5,6,4) (5,6,4,6) 
5-grams: (1,2,3,4,5) (2,3,4,5,6) (3,4,5,6,4) (4,5,6,4,6) 
6-grams: (1,2,3,4,5,6) (2,3,4,5,6,4) (3,4,5,6,4,6) 
7-grams: (1,2,3,4,5,6,4) (2,3,4,5,6,4,6) 
8-grams: (1,2,3,4,5,6,4,6) 
9-grams:  

Answer 2

Sounds a lot like n-gram to me.

Extract all n-grams, then find the most frequent n-grams?

Answer 3

Okay, this is a bit of a quick test to see if I could get a proof of concept.

Set up some sample data

x <- sample(letters[1:6],100,replace=TRUE)

> head(x)
[1] "c" "d" "d" "f" "f" "b"

Get all the unique combinations

combox <- expand.grid(unique(x),unique(x))
combox <- combox[combox$Var1!=combox$Var2,]
combox <- as.matrix(combox)

> head(combox)
  Var1 Var2
2 "d"  "c" 
3 "f"  "c" 
4 "b"  "c" 
5 "e"  "c" 
6 "a"  "c" 
7 "c"  "d" 

Get the sequences 2 at a time (sequence length=2)

lagx <- embed(x,2)[,2:1]

> head(lagx)
     [,1] [,2]
[1,] "c"  "d" 
[2,] "d"  "d" 
[3,] "d"  "f" 
[4,] "f"  "f" 
[5,] "f"  "b" 

Define a number of matches function

countseq <- function(num) {
        sum(apply(lagx,1,function(y) all(combox[num,]==y)))
        }

Apply the countseq function to see how many times each sequence appears in the original vector

result <- sapply(1:nrow(combox),function(x) countseq(x))

> head(result)
[1] 1 2 2 3 5 0

Get the list of most frequently occurring responses

combox[result==max(result),]

Real result:

> combox[result==max(result),]
Var1 Var2 
 "c"  "e" 

Answer 4

I have just tried the n-grams suggestion that Anony-Mousse suggested...I had to edit the sample data a bit to get it to work as n-grams I think has a maximum of 27 different possible entries for a sequence..

# getting a modified version of the data
x <- c(round(rnorm(100)*7),
    c(1:5),
    c(6,4,6),
    round(rnorm(300)*7),
    c(1:5),
    round(rnorm(70)*7),
    c(1:5),
    round(rnorm(100)*7),
    c(6,4,6),
    round(rnorm(200)*7),
    c(1:5),
    round(rnorm(70)*7),
    c(1:5),
    c(6,4,6),
    round(rnorm(70)*7),
    c(1:5),
    round(rnorm(100)*7),
    c(6,4,6),
    round(rnorm(200)*7),
    c(1:5),
    round(rnorm(70)*7),
    c(1:5),
    c(6,4,6))
# taking absolute values
x1 <- abs(x)
# converting it to letters
x2 <- c()
for( i in 1:length(x1)){
x2[i] <- letters[x1[i]+1]
}
x3 <- gsub(", ","",toString(x2))

# Carrying out the ngrams analysis
m <- textcnt(x3, method="ngram", n=5L, decreasing=TRUE)

# subsetting for sequences greater than 1 and a frequency greater than 2
m1 <- m[nchar(attr(m,"names"))>1 & m>2]

# Now getting the sequences which are statistically significant using the binomial distribution
u <- length(unique(x1))
p <- 1/u
k <- as.data.frame(cbind(as.vector(m1), nchar(attr(m1,"names"))))     
colnames(k) <- c("freq","len.of.seq")
rownames(k) <- attr(m1,"names")
k$p.val <- dbinom(k$freq, u, p)
s <- rownames(k[k$p.val<0.05,])

# Re-converting the data back to numbers and producing a list of the most commonly occurring sequences
s1 <- list()
for (i in 1:length(s)){
   g <- c()
  for(j in 1:nchar(s[i])){
    g[j] <- as.character(match(substr(s[i],j,j), letters)-1)
    }
    s1[[i]] <- as.numeric(g)
}
s1