/
word_pairs.R
127 lines (100 loc) · 4.77 KB
/
word_pairs.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#' @title Detect word pairs in text
#'
#' @description \code{word_pairs} searches for the occurrences of a pair of words in sentences. These words can be separated by intervening strings (viz. other in-between words).
#' @param corpus A character vector of sentences.
#' @param word_1 A regular expressions for the first word. The regex must enclose the word with word boundary character (i.e. \code{"\\\\b"}).
#' @param word_2 A regular expressions for the second word. The regex must enclose the word with word boundary character (i.e. \code{"\\\\b"}).
#' @param min_intervening Number of minimum occurrence of the intervening word.
#' The default is \code{0L}.
#' @param max_intervening Number of minimum occurrence of the intervening word.
#' The default is \code{3L}. Use \code{Inf} to get infinite intervening words after \code{word_1} and before the occurrence of \code{word_2}.
#'
#' @return A list object with the following elements:
#' \itemize{
#' \item{\code{pattern}: the extracted pattern spanning from the first word to the second word.}
#' \item{\code{pattern_tagged}: the version of \code{pattern} containing tags for the first and the second word.}
#' \item{\code{matches}: the sentence matches containing the word pairs that are tagged for the first and the second word.}
#' }
#' @export
#'
#' @examples
#' # co-occurrence of *me-X-kan* transitive verbs with *kepada*
#' word_1 <- "\\bmen[a-z]{3,}kan\\b"
#' word_2 <- "\\bkepada\\b"
#' corpus <- my_leipzig_sample
#' m <- word_pairs(corpus,
#' word_1 = word_1,
#' word_2 = word_2,
#' min_intervening = 0L,
#' max_intervening = 3L)
#'
#' # inspect the snippet of the results
#' head(m$pattern)
#' head(m$pattern_tagged)
#'
#' # generate frequency table for the patterns
#' freq_tb <- table(m$pattern_tagged)
#'
#' # sort in decreasing order of frequency
#' head(sort(freq_tb, decreasing = TRUE))
#'
#' @references Rajeg, Gede Primahadi Wijaya. (2018). wordpairs: An R package to retrieve word pair in sentences of the (Indonesian) Leipzig Corpora.
word_pairs <- function(corpus, word_1 = NULL, word_2 = NULL, min_intervening = 0L, max_intervening = 3L) {
if (is.null(word_1)) {
stop("Specify `word_1` argument!\n")
}
if (is.null(word_2)) {
stop("Specify `word_2` argument!\n")
}
if (is.null(corpus)) {
stop("Specify the input `corpus` argument!\n")
}
# design grouped regex for `word_1`
w_1 <- paste("(", word_1, ")", sep = "")
# design regex for the preceeding string of `word_2`
pre_word_2_rgx <- "([^.!?:;a-zA-Z0-9-]+?)"
w_2 <- paste(pre_word_2_rgx, "(", word_2, ")", sep = "")
# design regex for the intervening string between `word_1` and `word_2`
if (is.infinite(max_intervening)) {
max_intervening <- ""
}
intervening_quant <- paste("{", min_intervening, ",", max_intervening, "}?", sep = "")
## below are the non-alphanumeric characters that should preceed the intervening words
non_alphanum_rgx <- "[^.!?:;a-zA-Z0-9-]+?"
in_between_rgx <- paste("(", non_alphanum_rgx, "[a-zA-Z0-9-]+)", intervening_quant, sep = "")
# put together the regex for `word_1`, intervening string, and `word_2`
wp_rgx <- paste(w_1, in_between_rgx, w_2, sep = "")
# extract the corresponding sentences containing the word pair
sent <- grep(pattern = wp_rgx, x = corpus, perl = TRUE, value = TRUE)
if (length(sent) > 0) {
# get the attribute of the matched pattern
m_attr <- gregexpr(pattern = wp_rgx, text = sent, perl = TRUE)
m_length <- sapply(m_attr, length)
sent <- rep(sent, m_length)
# get the starting character-position of the pattern in `wp_rgx`
m_start <- unlist(m_attr)
# get the character-length of the pattern in `wp_rgx`
m_span <- unlist(sapply(m_attr, attr, "match.length"))
# get the ending character-position of the pattern in `wp_rgx`
m_end <- m_start + m_span
# extract the pattern
m_ptrn <- substr(sent, m_start, m_end-1)
# get the remaining strings to the left of the pattern
m_left_ctx <- substr(sent, 1, (m_start-1))
# get the remaining strings to the right of the pattern
m_right_ctx <- substr(sent, m_end, nchar(sent))
# tag `word_1` and `word_2` in the pattern
m_ptrn_tagged <- gsub("(\\b[a-zA-Z0-9-]+$)", "<w id='2'>\\1</w>", m_ptrn, perl = TRUE)
m_ptrn_tagged <- gsub("(^[a-zA-Z0-9-]+\\b)", "<w id='1'>\\1</w>", m_ptrn_tagged, perl = TRUE)
# combine the left string, matched pattern, and the right string
m_tagged <- paste(m_left_ctx, "<m>", m_ptrn_tagged, "</m>", m_right_ctx, sep = "")
# generate a list-output for the pattern
matches <- list(pattern = m_ptrn,
pattern_tagged = m_ptrn_tagged,
matches = m_tagged)
# return the output
return(matches)
} else {
message("No match found!\n")
}
}