4
$\begingroup$

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?

$\endgroup$
5
  • 2
    $\begingroup$ Believe this to be overly broad and not constructive. You are asking the software to think for you without specifying a specific pattern to identify. $\endgroup$
    – DWin
    Jul 18, 2012 at 5:06
  • 1
    $\begingroup$ Maybe a better fit for Cross Validated? $\endgroup$
    – Ryogi
    Jul 18, 2012 at 5:14
  • 1
    $\begingroup$ I'm not sure it's so silly a question. Difficult and/or computationally intensive, probably, but not that crazy. Would there be a way to take every possible combn of the unique values of x 2 at a time, 3 at a time, etc. and identify the most frequently occurring ones in the data. By my rough calculations, this could be a bit time-consuming to run given that there would be about half a million 4-number long sequence combinations in x. The basic logic behind it is not too mind-bending though. $\endgroup$ Jul 18, 2012 at 5:24
  • $\begingroup$ What if you limited the sequence length to 5? $\endgroup$
    – h.l.m
    Jul 18, 2012 at 5:25
  • $\begingroup$ There is no problem with the number of combinations, because any sequence of length $n$ has only $n(n-1)/2$ contiguous subsequences. $\endgroup$
    – whuber
    Jul 18, 2012 at 15:43

4 Answers 4

7
$\begingroup$

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:  
$\endgroup$
1
  • $\begingroup$ (+1) I especially like the test-function $\endgroup$
    – steffen
    Jul 18, 2012 at 15:37
2
$\begingroup$

Sounds a lot like n-gram to me.

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

$\endgroup$
3
  • 2
    $\begingroup$ I have seen that you are a regular user on stats.SE. I have a humble question: Can you please consider to flag questions like these (ML, DM) to move to stats.SE (and then answer them there) in order to grow the machine learning community on stats.SE ? $\endgroup$
    – steffen
    Jul 18, 2012 at 8:22
  • $\begingroup$ @steffen: I'm actually not convinced they belong to stats.SE. Many of the DM questions are much more about efficiency than about statistical correctness, and that may lead to quite some misunderstandings on stats.SE IMHO. $\endgroup$ Jul 18, 2012 at 10:35
  • $\begingroup$ Yes, this is true. However, some question are about correctness (like this one). Please think about it when facing future questions, I do not ask for more :). Thank you ! $\endgroup$
    – steffen
    Jul 18, 2012 at 11:06
1
$\begingroup$

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" 
$\endgroup$
1
  • $\begingroup$ I presume that this would need to be looped through to get combinations/sequences of longer lengths? $\endgroup$
    – h.l.m
    Jul 18, 2012 at 7:51
0
$\begingroup$

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
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.