passing all checks

Author: petermeissner

DESCRIPTION

@@ -38,6 +38,7 @@ Imports:
     dtplyr (>= 0.0.1),
     Rcpp (>= 0.12.6),
     stringdist (>= 0.9.4.1),
+    magrittr,
     stats,
     graphics
 Suggests:

NAMESPACE

@@ -4,9 +4,6 @@ export("%>%")
 export(diff_align)
 export(diffrproject)
 export(dp_text_base_data)
-export(moc_helper_easy_matches)
-export(moc_helper_get_options_ordered_by_dist)
-export(moc_helper_trivial_matches)
 import(data.table)
 import(hellno)
 import(rtext)

NEWS.md

@@ -11,6 +11,7 @@ version 0.1.2 // 2016-08-26 ...
 
 * FEATURE
     - tests tests tests
+    - passing all checks
 
 
 * DEVELOPMENT

R/diffr.R

@@ -34,7 +34,7 @@ diff_align <- function(
   distance  = c("lv", "osa", "dl", "hamming", "lcs", "qgram", "cosine", "jaccard", "jw", "soundex"),
   useBytes = FALSE,
   weight = c(d = 1, i = 1, s = 1, t = 1),
-  maxDist = Inf,
+  maxDist = 0,
   q = 1,
   p = 0,
   nthread = getOption("sd_num_thread"),
@@ -56,6 +56,7 @@ diff_align <- function(
   if( length(text1) > 1){ text1 <- text_collapse(text1) }
   if( length(text2) > 1){ text2 <- text_collapse(text2) }
   distance <- distance[1]
+  if(maxDist == 0){ maxDist <- 1e-150}
 
   # tokenize
   message(" - tokenizing text")
@@ -67,6 +68,8 @@ diff_align <- function(
 
   # clean
   message(" - cleaning token")
+  text1_tokenized_prec <- text1_tokenized
+  text2_tokenized_prec <- text2_tokenized
   text1_tokenized$token <- clean(text1_tokenized$token)
   text2_tokenized$token <- clean(text2_tokenized$token)
 
@@ -78,6 +81,8 @@ diff_align <- function(
   text2_tokenized <- ignore(text2_tokenized)
 
   # column naming
+  text1_tokenized_prec <- stats::setNames(text1_tokenized_prec, c("from_1", "to_1", "token_1", "token_i_1"))
+  text2_tokenized_prec <- stats::setNames(text2_tokenized_prec, c("from_2", "to_2", "token_2", "token_i_2"))
   text1_tokenized_prei <- stats::setNames(text1_tokenized_prei, c("from_1", "to_1", "token_1", "token_i_1"))
   text2_tokenized_prei <- stats::setNames(text2_tokenized_prei, c("from_2", "to_2", "token_2", "token_i_2"))
   text1_tokenized <- stats::setNames(text1_tokenized, c("from_1", "to_1", "token_1", "token_i_1"))
@@ -97,7 +102,8 @@ diff_align <- function(
       maxDist = maxDist,
       q = q,
       p = p,
-      nthread = nthread
+      nthread = nthread,
+      matchNA = FALSE
     )
 
   # alignment
@@ -169,27 +175,14 @@ diff_align <- function(
       nthread = nthread
     )
 
-  alignment$token_1 <-
-    dplyr::left_join(
-      subset(alignment, TRUE, token_i_1),
-      subset(text1_tokenized_prei, TRUE, c(token_i_1, token_1) ),
-      by=c("token_i_1"="token_i_1")
-    )$token_1
-
-  alignment$token_2 <-
-    dplyr::left_join(
-      subset(alignment, TRUE, token_i_2),
-      subset(text2_tokenized_prei, TRUE, c(token_i_2, token_2) ),
-      by=c("token_i_2"="token_i_2")
-    )$token_2
   }
 
   # non matches
   if( dim1(text1_tokenized_prei)>0 ){
     tmp <-
       subset(
         cbind(text1_tokenized_prei, type="ignored"),
-        !(text1_tokenized_prei$token_i_2 %in% alignment$token_i_1)
+        !(text1_tokenized_prei$token_i_1 %in% alignment$token_i_1)
       )
     alignment <-
       rtext:::rbind_fill(alignment, tmp)
@@ -205,19 +198,39 @@ diff_align <- function(
     rtext:::rbind_fill(alignment, tmp)
   }
 
-  # return
+  # original token
+  if( dim1(alignment) > 0 ){
+  alignment$token_1 <-
+    dplyr::left_join(
+      subset(alignment, select="token_i_1"),
+      subset(text1_tokenized_prec, select=c("token_i_1", "token_1") ),
+      by=c("token_i_1"="token_i_1")
+    )$token_1
+
+  alignment$token_2 <-
+    dplyr::left_join(
+      subset(alignment, TRUE, token_i_2),
+      subset(text2_tokenized_prec, select=c("token_i_2", "token_2") ),
+      by=c("token_i_2"="token_i_2")
+    )$token_2
+  }
+
+  # column order and missing columns
   if( !("type" %in% names(alignment)) ){
     alignment <- cbind(alignment, type=character(0))
   }
+
   alignment <-
     subset(
       alignment,
       select=c(
-        token_i_1, token_i_2, distance, type,
-        from_1, to_1, from_2, to_2,
-        token_1,  token_2
+        "token_i_1", "token_i_2", "distance", "type",
+        "from_1", "to_1", "from_2", "to_2",
+        "token_1",  "token_2"
       )
     )
+
+  # return
   return(alignment)
 }
 

R/moc.R

@@ -40,11 +40,11 @@ moc <- function(
   # prepare tt1 and tt2 as lists of data.frames
   tt1 <-
     text1_tokenized %>%
-    filter( !(token_i %in% res$token_i_1) )
+    dplyr::filter( !(token_i %in% res$token_i_1) )
 
   tt2 <-
     text2_tokenized %>%
-    filter( !(token_i %in% res$token_i_2) )
+    dplyr::filter( !(token_i %in% res$token_i_2) )
 
   tt1_split <- split_tt_by_length(tt1)
   tt2_split <- split_tt_by_length(tt2)

R/moc_helper.R

@@ -3,23 +3,11 @@
 #' @keywords internal
 split_tt_by_length <- function(tt){
   tt %>%
-    dplyr::mutate(
-      token_length = nchar(token)
-    ) %>%
-    split(
-      .$token_length
-    ) %>%
-    lapply(
-      dplyr::mutate,
-      token_length = NULL
-    ) %>%
-    lapply(
-      as.data.table
-    ) %>%
-    lapply(
-      setkey,
-      token, token_i
-    )
+    dplyr::mutate( token_length = nchar(token) ) %>%
+    split( .$token_length ) %>%
+    lapply( dplyr::mutate, token_length = NULL ) %>%
+    lapply( as.data.table  ) %>%
+    lapply( setkey, "token", "token_i"  )
 }
 
 
@@ -28,20 +16,20 @@ split_tt_by_length <- function(tt){
 #' method of comparison helper function
 #' @param tt1 tokenized text number 1
 #' @param tt2 tokenized text number 2
-#' @export
+#' @keywords internal
 moc_helper_trivial_matches <- function(tt1, tt2){
   # preparation
-  tt1 <- subset( tt1, is_unique(token), c(token, token_i))
+  tt1 <- subset( tt1, is_unique(token), select=c("token", "token_i"))
   tt1 <- data.table::as.data.table(tt1)
-  data.table::setkey(tt1, token)
+  data.table::setkey("tt1", "token")
 
-  tt2 <- subset( tt2, is_unique(token), c(token, token_i))
+  tt2 <- subset( tt2, is_unique(token), select=c("token", "token_i"))
   tt2 <- data.table::as.data.table(tt2)
-  data.table::setkey(tt2, token)
+  data.table::setkey("tt2", "token")
 
   # merge / join
   matches <- suppressWarnings(dplyr::inner_join(tt1, tt2, by="token"))
-             data.table::setkey(matches, token_i.x, token_i.y)
+             data.table::setkey(matches, "token_i.x", "token_i.y")
 
   # clean up names
   names(matches) <-
@@ -59,7 +47,7 @@ moc_helper_trivial_matches <- function(tt1, tt2){
 #' method of comparison helper function
 #' @param tt1 tokenized text number 1
 #' @param tt2 tokenized text number 2
-#' @export
+#' @keywords internal
 moc_helper_easy_matches <- function(tt1, tt2, res, type=c(1,2), fullreturn=TRUE){
   # check input
   if( is.null(tt1) | is.null(tt2) ){
@@ -73,12 +61,12 @@ moc_helper_easy_matches <- function(tt1, tt2, res, type=c(1,2), fullreturn=TRUE)
   # preparation
   tt1_tmp <-
     tt1 %>%
-    dplyr::select(token, token_i) %>%
+    subset(select = c("token", "token_i") ) %>%
     dplyr::filter(
       !(token_i %in% res$token_i_1)
     ) %>%
     as.data.table()
-  setkey(tt1_tmp, token_i)
+  setkey(tt1_tmp, "token_i")
 
   tt2_tmp <-
     tt2 %>%
@@ -87,7 +75,7 @@ moc_helper_easy_matches <- function(tt1, tt2, res, type=c(1,2), fullreturn=TRUE)
       !(token_i %in% res$token_i_2)
     ) %>%
     as.data.table()
-  setkey(tt2_tmp, token_i)
+  setkey(tt2_tmp, "token_i")
 
   # decide which tokens (from text1 or from text2) should be unique
   if( type == 1){
@@ -106,10 +94,10 @@ moc_helper_easy_matches <- function(tt1, tt2, res, type=c(1,2), fullreturn=TRUE)
   chosen <-
     choose_options(matches$token_i_1, matches$token_i_2, res$token_i_1, res$token_i_2) %>%
     as.data.table() %>%
-    setkey(token_i_1)
+    setkey("token_i_1")
 
   # add token to get it rbind-ed to res
-  tt1_tmp <- setNames(tt1_tmp, c("token", "token_i_1"))
+  tt1_tmp <- stats::setNames(tt1_tmp, c("token", "token_i_1"))
   chosen <- dplyr::left_join(chosen, tt1_tmp, by="token_i_1")
 
   # return
@@ -128,7 +116,7 @@ moc_helper_easy_matches <- function(tt1, tt2, res, type=c(1,2), fullreturn=TRUE)
 #' @param tt2 tokenized text number 2
 #' @param res data.frame of already matched
 #' @import data.table
-#' @export
+#' @keywords internal
 moc_helper_get_options_ordered_by_dist <- function(tt1, tt2, res){
   # distance between availible token positions and positions of tokens already matched
   dist           <- which_dist_min_absolute(tt1$token_i, res$token_i_1)
@@ -137,7 +125,7 @@ moc_helper_get_options_ordered_by_dist <- function(tt1, tt2, res){
   res_tmp <-
     res[dist$location, ] %>%
     dplyr::select(token_i_1, token_i_2) %>%
-    setNames( paste0("res_",names(.)) )
+    stats::setNames( paste0("res_",names(.)) )
   # combine res with info from tt1
   tt1_tmp <-
     tt1 %>%
@@ -160,10 +148,10 @@ moc_helper_get_options_ordered_by_dist <- function(tt1, tt2, res){
   # delete columns
   tt1_tmp[, res_token_i_2 := NULL]
   # sort
-  data.table::setorder(tt1_tmp, min_dist_1, min_dist_2, token_i_1, token_i_2)
+  data.table::setorder(tt1_tmp, "min_dist_1", "min_dist_2", "token_i_1", "token_i_2")
   # delete columns
-  tt1_tmp[, min_dist_1 := NULL]
-  tt1_tmp[, min_dist_2 := NULL]
+  tt1_tmp[, "min_dist_1" := NULL]
+  tt1_tmp[, "min_dist_2" := NULL]
   # return
   return(tt1_tmp)
 }