SCM

SCM Repository

[tm] Diff of /trunk/tm/R/textdoccol.R
ViewVC logotype

Diff of /trunk/tm/R/textdoccol.R

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

revision 72, Mon Nov 20 20:43:34 2006 UTC revision 73, Tue Nov 21 15:52:39 2006 UTC
# Line 23  Line 23 
23                    counter <- counter + 1                    counter <- counter + 1
24                }                }
25    
26                dmeta.df <- data.frame(MetaID = rep(0, length(tdl)))                dmeta.df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
27                dcmeta.node <- new("MetaDataNode",                dcmeta.node <- new("MetaDataNode",
28                              NodeID = 0,                              NodeID = 0,
29                              MetaData = list(create_date = date(), creator = Sys.getenv("LOGNAME")),                              MetaData = list(create_date = date(), creator = Sys.getenv("LOGNAME")),
# Line 398  Line 398 
398  setMethod("tm_transform",  setMethod("tm_transform",
399            signature(object = "TextDocCol", FUN = "function"),            signature(object = "TextDocCol", FUN = "function"),
400            function(object, FUN, ...) {            function(object, FUN, ...) {
401                result <- as(lapply(object, FUN, ..., DMetaData = DMetaData(object)), "TextDocCol")                result <- object
402                result@DMetaData <- DMetaData(object)                result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))
403                return(result)                return(result)
404            })            })
405    
# Line 474  Line 474 
474                return(object)                return(object)
475            })            })
476    
477  setGeneric("tm_filter", function(object, ..., FUN = s_filter) standardGeneric("tm_filter"))  setGeneric("tm_filter", function(object, ..., FUN = s_filter, doclevel = FALSE) standardGeneric("tm_filter"))
478  setMethod("tm_filter",  setMethod("tm_filter",
479            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
480            function(object, ..., FUN = s_filter) {            function(object, ..., FUN = s_filter, doclevel = FALSE) {
481                indices <- sapply(object, FUN, ..., DMetaData = DMetaData(object))                if (doclevel)
482                object[indices]                    return(object[sapply(object, FUN, ..., DMetaData = DMetaData(object))])
483                  else
484                      return(object[FUN(object, ...)])
485            })            })
486    
487  setGeneric("tm_index", function(object, ..., FUN = s_filter) standardGeneric("tm_index"))  setGeneric("tm_index", function(object, ..., FUN = s_filter, doclevel = FALSE) standardGeneric("tm_index"))
488  setMethod("tm_index",  setMethod("tm_index",
489            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
490            function(object, ..., FUN = s_filter) {            function(object, ..., FUN = s_filter, doclevel = FALSE) {
491                sapply(object, FUN, ..., DMetaData = DMetaData(object))                if (doclevel)
492                      return(sapply(object, FUN, ..., DMetaData = DMetaData(object)))
493                  else
494                      return(FUN(object, ...))
495            })            })
496    
497  s_filter <- function(object, s, ..., DMetaData) {  s_filter <- function(object, s, ...) {
498      b <- TRUE      query.df <- DMetaData(object)
499      for (tag in names(s)) {      con <- textConnection(s)
500          if (tag %in% names(LocalMetaData(object))) {      tokens <- scan(con, "character")
501              b <- b && any(grep(s[[tag]], LocalMetaData(object)[[tag]]))      close(con)
502          } else if (tag %in% names(DMetaData)){      local.meta <- lapply(object, LocalMetaData)
503              b <- b && any(grep(s[[tag]], DMetaData[[tag]]))      local.used.meta <- lapply(local.meta, function(x) names(x) %in% tokens)
504          } else {      l.meta <- NULL
505              b <- b && any(grep(s[[tag]], eval(call(tag, object))))      for (i in 1:length(object)) {
506            l.meta <- c(l.meta, list(local.meta[[i]][local.used.meta[[i]]]))
507        }
508        # TODO: Handle entries (\code{m} with length greater 1, i.e., lists)
509        for (i in 1:length(l.meta)) {
510            for (m in l.meta[[i]]) {
511                if (!(names(l.meta[[i]]) %in% names(query.df))) {
512                    before <- rep(NA, i - 1)
513                    after <- rep(NA, length(l.meta) - i)
514                    insert <- c(before, m, after)
515                    query.df <- cbind(query.df, insert, stringsAsFactors = FALSE)
516                    names(query.df)[length(query.df)] <- names(l.meta[[i]])
517                }
518                else {
519                    if (is.null(m))
520                        m <- NA
521                    #if (length(m) > 1)
522                    #    query.df[i,names(l.meta[[i]])] <- list(m)
523                    #else
524                        query.df[i,names(l.meta[[i]])] <- m
525                }
526          }          }
527      }      }
528      return(b)      attach(query.df)
529        result <- rownames(query.df) == row.names(query.df[eval(parse(text = s)), ])
530        detach(query.df)
531        return(result)
532  }  }
533    
534    #s_filter <- function(object, s, ..., DMetaData) {
535    #    b <- TRUE
536    #    for (tag in names(s)) {
537    #        if (tag %in% names(LocalMetaData(object))) {
538    #            b <- b && any(grep(s[[tag]], LocalMetaData(object)[[tag]]))
539    #        } else if (tag %in% names(DMetaData)){
540    #            b <- b && any(grep(s[[tag]], DMetaData[[tag]]))
541    #        } else {
542    #            b <- b && any(grep(s[[tag]], eval(call(tag, object))))
543    #        }
544    #    }
545    #    return(b)
546    #}
547    
548  setGeneric("fulltext_search_filter", function(object, pattern, ...) standardGeneric("fulltext_search_filter"))  setGeneric("fulltext_search_filter", function(object, pattern, ...) standardGeneric("fulltext_search_filter"))
549  setMethod("fulltext_search_filter",  setMethod("fulltext_search_filter",
550            signature(object = "PlainTextDocument", pattern = "character"),            signature(object = "PlainTextDocument", pattern = "character"),
# Line 552  Line 594 
594  #              return(object)  #              return(object)
595  #          })  #          })
596    
597    setGeneric("prescind_meta", function(object, meta) standardGeneric("prescind_meta"))
598    setMethod("prescind_meta",
599              signature(object = "TextDocCol", meta = "character"),
600              function(object, meta) {
601                  for (m in meta) {
602                      local.meta <- lapply(object, LocalMetaData)
603                      local.m <- lapply(local.meta, "[[", m)
604                      local.m <- lapply(local.m, function(x) if (is.null(x)) return(NA) else return(x))
605                      if (length(local.m) == length(unlist(local.m)))
606                          local.m <- unlist(local.m)
607                      else
608                          local.m <- I(local.m)
609                      object@DMetaData <- cbind(DMetaData(object), data.frame(m = local.m), stringsAsFactors = FALSE)
610                      names(object@DMetaData)[length(object@DMetaData)] <- m
611                  }
612                  return(object)
613              })
614    
615  setMethod("[",  setMethod("[",
616            signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),            signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
617            function(x, i, j, ... , drop) {            function(x, i, j, ... , drop) {
# Line 679  Line 739 
739                if(length(args) == 0)                if(length(args) == 0)
740                    return(x)                    return(x)
741    
742                dmeta.df <- data.frame(MetaID = rep(0, length(list(x, ...))))                dmeta.df <- data.frame(MetaID = rep(0, length(list(x, ...))), stringsAsFactors = FALSE)
743                dcmeta.node <- new("MetaDataNode",                dcmeta.node <- new("MetaDataNode",
744                              NodeID = 0,                              NodeID = 0,
745                              MetaData = list(create_date = date(), creator = Sys.getenv("LOGNAME")),                              MetaData = list(create_date = date(), creator = Sys.getenv("LOGNAME")),

Legend:
Removed from v.72  
changed lines
  Added in v.73

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge