dp : links

Author: petermeissner

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: diffrprojects
 Title: Using diffr for more than two files
 Date: 2016-08-01
-Version: 0.1.1.90000
+Version: 0.1.2.90000
 Authors@R: c(
   person(
     "Peter", "Meissner",

NAMESPACE

@@ -13,7 +13,6 @@ export(modus)
 export(rbind_fill)
 export(seq_dim1)
 export(shift)
-export(which_token)
 import(hellno)
 import(rtext)
 import(stringb)

R/diffrproject.R

@@ -36,8 +36,8 @@ diffrproject <-
       meta     = list(),
       options  = list(),
       tracks   = list(),
+      links    = list(),
       linkage  = list(),
-      texts_connected = list(),
       distance = list(),
       texts    = list(),
 
@@ -47,18 +47,7 @@ diffrproject <-
       text_add = function( rtext, name = NULL ){
 
         # input check
-        stopifnot("rtext"  %in% class(rtext))
-
-        # connecting text with other text
-        if( length(self$texts)>0 ){
-          next_item <- length(self$texts_connected)+1
-          last_item <- length(self$texts)
-          self$texts_connected[[next_item]] <-
-            list(
-              self$texts[[last_item]],
-              rtext
-            )
-        }
+        stopifnot("rtext"  %in% class(rtext) )
 
         # working variable creation
         names <- names(self$texts)
@@ -101,6 +90,21 @@ diffrproject <-
         dp_text_base_data(self)
       },
 
+      texts_link = function(from=NULL, to=NULL, delete=FALSE){
+        from <- names(self$texts[from])
+        to   <- names(self$texts[to])
+        linker <- function(from, to, delete){
+          name <- text_c(from, "_", to)
+          if(delete){
+            self$links[name] <- NULL
+          }else{
+            self$links[[name]] <- list(from=from, to=to)
+          }
+        }
+        mapply(linker, from, to, delete=delete)
+        invisible(self)
+      },
+
       # universal getter
       get = function(name){
         if(name=="private"){

R/tools.R

@@ -173,27 +173,6 @@ seq_dim1 <- function(x){
 }
 
 
-#' function returning index of spans that entail x
-#' @param x position of the character
-#' @param y1 start position of the token
-#' @param y2 end position of the token
-#' @export
-which_token <- function(x, y1, y2){
-  # how to order x and y?
-  order_x <- order(x)
-  order_y <- order(y1)
-  # order x and y! - which_token_worker expects inputs to be ordered
-  ordered_x  <- x[order_x]
-  ordered_y1 <- y1[order_y]
-  ordered_y2 <- y2[order_y]
-  # doing-duty-to-do
-  index <- which_token_worker(ordered_x, ordered_y1, ordered_y2)
-  # ordering back to input ordering
-  index <- order_y[index[order(order_x)]]
-  # return
-  index
-}
-
 
 
 

dev.R

@@ -21,13 +21,18 @@ dp$text_add(
     rtext$new(text_file=text_files[1], encoding="latin1")
 )
 
-dp$texts
-
 dp$text_add(
-  rtext = rtext$new(text_file=text_files[1], encoding="latin1"),
+  rtext = rtext$new(text_file=text_files[2], encoding="latin1"),
   name = basename(text_files[2])
 )
 
+length(dp$texts)
+names(dp$texts)
+
+dp$texts_link(1,2)
+dp$links
+
+dp$texts_link(1,2, TRUE)
 
 #### ---------------------------------------------------------------------------
 

man/which_token.Rd

@@ -13,19 +13,3 @@ test_that("easy examples work properly", {
 )
 
 
-
-context("tools which_token()")
-
-test_that("easy examples work properly", {
-  expect_true(  which_token( x =        1, y1 =        1, y2 =           1 )  ==        1 )
-  expect_true(  which_token( x =        2, y1 =   c(2,1), y2 =      c(2,1) )  ==        1 )
-  expect_true(  which_token( x =        1, y1 =   c(2,1), y2 =      c(2,1) )  ==        2 )
-  expect_equal( which_token( x =      1:2, y1 =   c(2,1), y2 =      c(2,1) ),      c(2,1) )
-  expect_equal( which_token( x = c(7,2,4), y1 = c(1,3,7), y2 = c(2,6,2000) ),    c(3,1,2) )
-  expect_equal( which_token( x =      1:4, y1 = c(1,3,7), y2 = c(2,6,2000) ), c(1,1,2,2))
-  expect_true(  is.na(which_token( x =     2001, y1 = c(1,3,7), y2 = c(2,6,2000) ))       )
-}
-)
-
-
-