CODEWITHSUNDEEP
r
Tyler Rinker
Tyler Rinker

Reputation: 110062

Count occurrences of multi-row and column pattern

I have a specific speech pattern I want to count. There are actors in column 1 and types of sentences in column 2. I'm wanting to programatically identify a conversational pattern called IRF/IRE. The pattern is this:

So I'm looking for Teacher-Student-Teacher in Column 1 corresponding to a ?-[.!]-[?.!].

So in the fake data below the following rows meet this pattern and count:

33  Teacher    ?
34  Student    .
35  Teacher    .

I did this visually inspecting the data. How could I find what is essentially the following matrix pattern:

| Teacher    |    ?  |    
| Student    | [.!]  |    
| Teacher    | [?!.] |

I am open to any outside packages if it makes things faster/easier.

n <- 100
set.seed(10)
dat <- data.frame(
    actor = sample(c("Teacher", "Student"), n, TRUE, c(.6, .4)),
    type = c(sample(c('?', '.', '!'), n, TRUE, c(.3, .5, .1)))
)

head(dat)

##     actor type
## 1 Teacher    .
## 2 Teacher    .
## 3 Teacher    .
## 4 Student    .
## 5 Teacher    !
## 6 Teacher    ?
## . 
## . 
## .

Upvotes: 0

Views: 58

Answers (2)

bgoldst
bgoldst

Reputation: 35324

Here's an approach using only base R indexing, comparisons, and logical operations:

hits <- which(
      dat$actor[-seq(nrow(dat),by=-1L,len=2L)]=='Teacher'
    & dat$type [-seq(nrow(dat),by=-1L,len=2L)]=='?'
    & dat$actor[-c(1L,nrow(dat))]=='Student'
    & dat$type [-c(1L,nrow(dat))]%in%c('.','!')
    & dat$actor[-1:-2]=='Teacher'
    & dat$type [-1:-2]%in%c('?','!','.')
);
hits;
## [1] 33 51 95
dat[rep(hits,each=3L)+0:2,];
##      actor type
## 33 Teacher    ?
## 34 Student    .
## 35 Teacher    .
## 51 Teacher    ?
## 52 Student    .
## 53 Teacher    .
## 95 Teacher    ?
## 96 Student    .
## 97 Teacher    ?

I generalized the solution to parameterize the comparison operators as a list of functions and the operands as a data.frame of list columns with column names identifying the target columns:

dfmatch <- function(df,operands,preds=rep(list(`%in%`),length(operands))) {
    preds <- as.list(preds);
    operands <- as.data.frame(operands);
    if (length(preds)!=ncol(operands)) stop('length(preds)!=ncol(operands).');
    predLen <- length(preds);
    rowLen <- nrow(operands);
    if (rowLen>nrow(df)) return(integer());
    which(Reduce(`&`,lapply(seq_len(predLen),function(opi) {
        pred <- preds[[opi]];
        Reduce(`&`,lapply(seq_len(rowLen),function(ri) {
            operand <- operands[[opi]][[ri]];
            pred(df[[names(operands[opi])]][-c(seq(1L,len=ri-1L),seq(nrow(df),by=-1L,len=rowLen-ri))],operand);
        }));
    })));
}; ## end dfmatch()

operands <- data.frame(actor=I(list('Teacher','Student','Teacher')),type=I(list('?',c('.','!'),c('?','!','.'))));
operands;
##     actor    type
## 1 Teacher       ?
## 2 Student    ., !
## 3 Teacher ?, !, .
dfmatch(dat,operands);
## [1] 33 51 95

Upvotes: 1

Tyler Rinker
Tyler Rinker

Reputation: 110062

Here's one approach:

if (!require("pacman")) install.packages("pacman")
pacman::p_load(dplyr, zoo)

dat2 <- dat %>%
    mutate(
        combo = paste0(actor, type)

    )


patterns <- expand.grid(
    paste0('Teacher', '?'),    
    paste0('Student', c('.', '!')),  
    paste0('Teacher', c('.', '!', '?'))   
)

locs <- apply(patterns, 1, function(x){
    with(dat2, which(rollapply(combo, 3, identical, unname(unlist(x, use.names=FALSE)))))
})

lapply(unlist(locs[sapply(locs, length) > 0]), function(i) {
    dat2[i:(i+2),]
})

## [[1]]
##      actor type    combo
## 33 Teacher    ? Teacher?
## 34 Student    . Student.
## 35 Teacher    . Teacher.
## 
## [[2]]
##      actor type    combo
## 51 Teacher    ? Teacher?
## 52 Student    . Student.
## 53 Teacher    . Teacher.
## 
## [[3]]
##      actor type    combo
## 95 Teacher    ? Teacher?
## 96 Student    . Student.
## 97 Teacher    ? Teacher?

length(unlist(locs[sapply(locs, length) > 0]))

## 3

Upvotes: 0

Related Questions