SCM

SCM Repository

[tm] Diff of /pkg/R/corpus.R
ViewVC logotype

Diff of /pkg/R/corpus.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 70, Tue Nov 7 18:18:51 2006 UTC revision 71, Sun Nov 19 17:30:26 2006 UTC
# Line 23  Line 23 
23                    counter <- counter + 1                    counter <- counter + 1
24                }                }
25    
26                return(new("TextDocCol", .Data = tdl))                dmeta.df <- data.frame(MetaID = rep(0, length(tdl)))
27                  dcmeta.node <- new("MetaDataNode",
28                                NodeID = 0,
29                                MetaData = list(create_date = date(), creator = Sys.getenv("LOGNAME")),
30                                children = list())
31    
32                  return(new("TextDocCol", .Data = tdl, DMetaData = dmeta.df, DCMetaData = dcmeta.node))
33            })            })
34    
35  setGeneric("DirSource", function(directory, load = FALSE) standardGeneric("DirSource"))  setGeneric("DirSource", function(directory, load = FALSE) standardGeneric("DirSource"))
# Line 371  Line 377 
377  setMethod("tm_transform",  setMethod("tm_transform",
378            signature(object = "TextDocCol", FUN = "function"),            signature(object = "TextDocCol", FUN = "function"),
379            function(object, FUN, ...) {            function(object, FUN, ...) {
380                result <- as(lapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object)), "TextDocCol")                result <- as(lapply(object, FUN, ..., DMetaData = DMetaData(object)), "TextDocCol")
381                result@GlobalMetaData <- GlobalMetaData(object)                result@DMetaData <- DMetaData(object)
382                return(result)                return(result)
383            })            })
384    
# Line 451  Line 457 
457  setMethod("tm_filter",  setMethod("tm_filter",
458            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
459            function(object, ..., FUN = s_filter) {            function(object, ..., FUN = s_filter) {
460                indices <- sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))                indices <- sapply(object, FUN, ..., DMetaData = DMetaData(object))
461                object[indices]                object[indices]
462            })            })
463    
# Line 459  Line 465 
465  setMethod("tm_index",  setMethod("tm_index",
466            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
467            function(object, ..., FUN = s_filter) {            function(object, ..., FUN = s_filter) {
468                sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))                sapply(object, FUN, ..., DMetaData = DMetaData(object))
469            })            })
470    
471  s_filter <- function(object, s, ..., GlobalMetaData) {  s_filter <- function(object, s, ..., DMetaData) {
472      b <- TRUE      b <- TRUE
473      for (tag in names(s)) {      for (tag in names(s)) {
474          if (tag %in% names(LocalMetaData(object))) {          if (tag %in% names(LocalMetaData(object))) {
475              b <- b && any(grep(s[[tag]], LocalMetaData(object)[[tag]]))              b <- b && any(grep(s[[tag]], LocalMetaData(object)[[tag]]))
476          } else if (tag %in% names(GlobalMetaData)){          } else if (tag %in% names(DMetaData)){
477              b <- b && any(grep(s[[tag]], GlobalMetaData[[tag]]))              b <- b && any(grep(s[[tag]], DMetaData[[tag]]))
478          } else {          } else {
479              b <- b && any(grep(s[[tag]], eval(call(tag, object))))              b <- b && any(grep(s[[tag]], eval(call(tag, object))))
480          }          }
# Line 487  Line 493 
493            })            })
494    
495  setGeneric("attach_data", function(object, data) standardGeneric("attach_data"))  setGeneric("attach_data", function(object, data) standardGeneric("attach_data"))
496  setMethod("attach_data",  setGeneric("attach_metadata", function(object, name, metadata) standardGeneric("attach_metadata"))
497            signature(object = "TextDocCol", data = "TextDocument"),  
498            function(object, data) {  setGeneric("append_doc", function(object, data, meta) standardGeneric("append_doc"))
499                data <- as(list(data), "TextDocCol")  setMethod("append_doc",
500                object@.Data <- as(c(object@.Data, data), "TextDocCol")            signature(object = "TextDocCol", data = "TextDocument", meta = "list"),
501              function(object, data, meta) {
502                  object@.Data <- c(object@.Data, list(data))
503                  object@DMetaData <- rbind(object@DMetaData, c(MetaID = DCMetaData(object)@NodeID, meta))
504                return(object)                return(object)
505            })            })
506    
507  setGeneric("attach_metadata", function(object, name, metadata) standardGeneric("attach_metadata"))  setGeneric("append_meta", function(object, dcmeta, dmeta) standardGeneric("append_meta"))
508  setMethod("attach_metadata",  setMethod("append_meta",
509            signature(object = "TextDocCol"),            signature(object = "TextDocCol", dcmeta = "list", dmeta = "list"),
510            function(object, name, metadata) {            function(object, dcmeta, dmeta) {
511                object@GlobalMetaData <- c(GlobalMetaData(object), new = list(metadata))                object@DCMetaData@MetaData <- c(object@DCMetaData@MetaData, dcmeta)
512                names(object@GlobalMetaData)[length(names(GlobalMetaData(object)))] <- name                object@DMetaData <- cbind(object@DMetaData, dmeta)
513                return(object)                return(object)
514            })            })
515    
516  setGeneric("remove_metadata", function(object, name) standardGeneric("remove_metadata"))  setGeneric("remove_metadata", function(object, name) standardGeneric("remove_metadata"))
517  setMethod("remove_metadata",  #setMethod("remove_metadata",
518            signature(object = "TextDocCol"),  #          signature(object = "TextDocCol"),
519            function(object, name) {  #          function(object, name) {
520                object@GlobalMetaData <- GlobalMetaData(object)[names(GlobalMetaData(object)) != name]  #              object@DMetaData <- DMetaData(object)[names(DMetaData(object)) != name]
521                return(object)  #              return(object)
522            })  #          })
523    
524  setGeneric("modify_metadata", function(object, name, metadata) standardGeneric("modify_metadata"))  setGeneric("modify_metadata", function(object, name, metadata) standardGeneric("modify_metadata"))
525  setMethod("modify_metadata",  #setMethod("modify_metadata",
526            signature(object = "TextDocCol"),  #          signature(object = "TextDocCol"),
527            function(object, name, metadata) {  #          function(object, name, metadata) {
528                object@GlobalMetaData[[name]] <- metadata  #              object@DMetaData[[name]] <- metadata
529                return(object)  #              return(object)
530            })  #          })
   
 setGeneric("set_subscriptable", function(object, name) standardGeneric("set_subscriptable"))  
 setMethod("set_subscriptable",  
           signature(object = "TextDocCol"),  
           function(object, name) {  
               if (!is.character(GlobalMetaData(object)$subscriptable))  
                   object <- attach_metadata(object, "subscriptable", name)  
               else  
                   object@GlobalMetaData$subscriptable <- c(GlobalMetaData(object)$subscriptable, name)  
               return(object)  
           })  
531    
532  setMethod("[",  setMethod("[",
533            signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),            signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
# Line 539  Line 537 
537    
538                object <- x                object <- x
539                object@.Data <- x@.Data[i, ..., drop = FALSE]                object@.Data <- x@.Data[i, ..., drop = FALSE]
540                for (m in names(GlobalMetaData(object))) {                object@DMetaData <- DMetaData(object)[i, ]
                   if (m %in% GlobalMetaData(object)$subscriptable) {  
                       object@GlobalMetaData[[m]] <- GlobalMetaData(object)[[m]][i, ..., drop = FALSE]  
                   }  
               }  
541                return(object)                return(object)
542            })            })
543    
# Line 569  Line 563 
563                return(object)                return(object)
564            })            })
565    
566    # Update \code{NodeID}s of a DCMetaData tree
567    # TODO: Avoid global variables outside of update_id function
568    update_id <- function(object) {
569        id <<- 0
570        mapping <<- left.mapping <<- NULL
571        level <<- 0
572        return(list(root = set_id(object), left.mapping = left.mapping, right.mapping = mapping))
573    }
574    
575    # Traversal of (binary) DCMetaData tree with setup of \code{NodeID}s
576    set_id <- function(object) {
577        object@NodeID <- id
578        id <<- id + 1
579        level <<- level + 1
580    
581        if (length(object@children) > 0) {
582            mapping <<- cbind(mapping, c(object@children[[1]]@NodeID, id))
583            left <- set_id(object@children[[1]])
584            if (level == 1) {
585                left.mapping <<- mapping
586                mapping <<- NULL
587            }
588            mapping <<- cbind(mapping, c(object@children[[2]]@NodeID, id))
589            right <- set_id(object@children[[2]])
590    
591            object@children <- list(left, right)
592        }
593        level <<- level - 1
594    
595        return(object)
596    }
597    
598  setMethod("c",  setMethod("c",
599            signature(x = "TextDocCol"),            signature(x = "TextDocCol"),
600            function(x, ..., recursive = TRUE){            function(x, y, ..., meta = list(merge_date = date(), merger = Sys.getenv("LOGNAME")), recursive = TRUE) {
601                args <- list(...)                if (!inherits(y, "TextDocCol"))
602                if(length(args) == 0)                    stop("invalid argument")
603                    return(x)  
604                return(as(c(as(x, "list"), ...), "TextDocCol"))                object <- x
605      })                # Concatenate data slots
606  setMethod("c",                object@.Data <- c(as(x, "list"), as(y, "list"))
607            signature(x = "TextDocument"),  
608            function(x, ..., recursive = TRUE){                # Update the DCMetaData tree
609                args <- list(...)                dcmeta <- new("MetaDataNode", NodeID = 0, MetaData = meta, children = list(DCMetaData(x), DCMetaData(y)))
610                if(length(args) == 0)                update.struct <- update_id(dcmeta)
611                    return(x)                object@DCMetaData <- update.struct$root
612                return(new("TextDocCol", .Data = list(x, ...)))  
613                  # Find indices to be updated for the left tree
614                  indices.mapping <- NULL
615                  for (m in levels(as.factor(DMetaData(x)$MetaID))) {
616                      indices <- (DMetaData(x)$MetaID == m)
617                      indices.mapping <- c(indices.mapping, list(m = indices))
618                      names(indices.mapping)[length(indices.mapping)] <- m
619                  }
620    
621                  # Update the DMetaData data frames for the left tree
622                  for (i in 1:ncol(update.struct$left.mapping)) {
623                      map <- update.struct$left.mapping[,i]
624                      x@DMetaData$MetaID <- replace(DMetaData(x)$MetaID, indices.mapping[[as.character(map[1])]], map[2])
625                  }
626    
627                  # Find indices to be updated for the right tree
628                  indices.mapping <- NULL
629                  for (m in levels(as.factor(DMetaData(y)$MetaID))) {
630                      indices <- (DMetaData(y)$MetaID == m)
631                      indices.mapping <- c(indices.mapping, list(m = indices))
632                      names(indices.mapping)[length(indices.mapping)] <- m
633                  }
634    
635                  # Update the DMetaData data frames for the right tree
636                  for (i in 1:ncol(update.struct$right.mapping)) {
637                      map <- update.struct$right.mapping[,i]
638                      y@DMetaData$MetaID <- replace(DMetaData(y)$MetaID, indices.mapping[[as.character(map[1])]], map[2])
639                  }
640    
641                  # Merge the DMetaData data frames
642                  labels <- setdiff(names(DMetaData(y)), names(DMetaData(x)))
643                  na.matrix <- matrix(NA, nrow = nrow(DMetaData(x)), ncol = length(labels), dimnames = list(row.names(DMetaData(x)), labels))
644                  x.dmeta.aug <- cbind(DMetaData(x), na.matrix)
645                  labels <- setdiff(names(DMetaData(x)), names(DMetaData(y)))
646                  na.matrix <- matrix(NA, nrow = nrow(DMetaData(y)), ncol = length(labels), dimnames = list(row.names(DMetaData(y)), labels))
647                  y.dmeta.aug <- cbind(DMetaData(y), na.matrix)
648                  object@DMetaData <- rbind(x.dmeta.aug, y.dmeta.aug)
649    
650                  return(object)
651      })      })
652    #setMethod("c",
653    #          signature(x = "TextDocument"),
654    #          function(x, ..., recursive = TRUE){
655    #              args <- list(...)
656    #              if(length(args) == 0)
657    #                  return(x)
658    #              return(new("TextDocCol", .Data = list(x, ...)))
659    #    })
660    
661  setMethod("length",  setMethod("length",
662            signature(x = "TextDocCol"),            signature(x = "TextDocCol"),
# Line 605  Line 677 
677            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
678            function(object){            function(object){
679                show(object)                show(object)
680                if (length(GlobalMetaData(object)) > 0) {                if (length(DMetaData(object)) > 0) {
681                    cat(sprintf(ngettext(length(GlobalMetaData(object)),                    cat(sprintf(ngettext(length(DMetaData(object)),
682                                                "\nThe global metadata consists of %d tag-value pair\n",                                                "\nThe global metadata consists of %d tag-value pair\n",
683                                                "\nThe global metadata consists of %d tag-value pairs\n"),                                                "\nThe global metadata consists of %d tag-value pairs\n"),
684                                         length(GlobalMetaData(object))))                                         length(DMetaData(object))))
685                    cat("Available tags are:\n")                    cat("Available tags are:\n")
686                    cat(names(GlobalMetaData(object)), "\n")                    cat(names(DMetaData(object)), "\n")
687                }                }
688      })      })
689    

Legend:
Removed from v.70  
changed lines
  Added in v.71

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge