porter helper function + tests

NAMESPACE

@@ -76,6 +76,7 @@ S3method(similarity_matrix,wrapped)
 S3method(split_alphanum,character)
 S3method(split_alphanum,data.frame)
 S3method(split_alphanum,list)
+S3method(stem_porter,porter_stemmer_model)
 S3method(stem_text,character)
 S3method(stem_text,data.frame)
 S3method(stem_text,list)
@@ -187,6 +188,7 @@ export(sklearn_text2bow)
 export(sklearn_tfidf)
 export(sklearn_word2vec)
 export(split_alphanum)
+export(stem_porter)
 export(stem_text)
 export(strip_multiple_spaces)
 export(strip_non_alphanum)

R/parsing.R

@@ -5,20 +5,43 @@
 #' from words in English. Its main use is as part of a term normalisation 
 #' process that is usually done when setting up Information Retrieval systems.
 #' 
+#' @param stemmer A porter stemmer as returned by \code{\link{porter_stemmer}}.
+#' @param text Text to parse.
+#' 
 #' @examples
 #' \dontrun{
+#' # create model
 #' stemmer <- porter_stemmer()
+#'
+#' # stem
 #' stemmer$stem("survey")
+#' # or convenience method
+#' stem_porter(stemmer, "survey")
 #' }
 #' 
 #' @name porter_stemmer
-#' 
 #' @export
 porter_stemmer <- function() {
   model <- gensim$parsing$porter$PorterStemmer()
+  model <- structure(model, class = c("porter_stemmer_model", class(model)))
   invisible(model)
 }
 
+#' @rdname porter_stemmer
+#' @export
+stem_porter <- function(stemmer, text) UseMethod("stem_porter")
+
+#' @rdname porter_stemmer
+#' @method stem_porter porter_stemmer_model
+#' @export
+stem_porter.porter_stemmer_model <- function(stemmer, text){
+  assert_that(!missing(text), msg = "Missing `text`.")
+
+  purrr::map(text, stemmer$stem) %>% 
+    purrr::map(reticulate::py_to_r) %>% 
+    unlist()
+}
+
 #' Remove stopwords
 #' 
 #' Remove stopwords from a character string.

tests/testthat/test-corpora.R

@@ -135,6 +135,10 @@ test_that("porter_stemmer and stem_words words", {
     reticulate::py_to_r()
   expect_equal(stemmed_porter, expected)
 
+  # convenienve function
+  stemmed_conv <- stem_porter(stemmer, word)
+  expect_equal(stemmed_porter, stemmed_conv)
+
   # stem
   stemmed <- stem_text(word)
   expect_equal(stemmed, expected)