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

pkg/tm/R/textdoccol.R revision 884, Wed Jan 28 10:24:27 2009 UTC pkg/R/textdoccol.R revision 902, Fri Mar 20 20:08:39 2009 UTC
# Line 20  Line 20 
20                if (is.null(readerControl$load))                if (is.null(readerControl$load))
21                    readerControl$load = TRUE                    readerControl$load = TRUE
22    
23                if (dbControl$useDb) {                if (dbControl$useDb && require("filehash")) {
24                    if (!dbCreate(dbControl$dbName, dbControl$dbType))                    if (!dbCreate(dbControl$dbName, dbControl$dbType))
25                        stop("error in creating database")                        stop("error in creating database")
26                    db <- dbInit(dbControl$dbName, dbControl$dbType)                    db <- dbInit(dbControl$dbName, dbControl$dbType)
# Line 41  Line 41 
41                    if (!object@LoDSupport)                    if (!object@LoDSupport)
42                        readerControl$load <- TRUE                        readerControl$load <- TRUE
43                    doc <- readerControl$reader(elem, readerControl$load, readerControl$language, as.character(counter))                    doc <- readerControl$reader(elem, readerControl$load, readerControl$language, as.character(counter))
44                    if (dbControl$useDb) {                    if (dbControl$useDb && require("filehash")) {
45                        dbInsert(db, ID(doc), doc)                        dbInsert(db, ID(doc), doc)
46                        if (object@Length > 0)                        if (object@Length > 0)
47                            tdl[[counter]] <- ID(doc)                            tdl[[counter]] <- ID(doc)
# Line 58  Line 58 
58                }                }
59    
60                df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)                df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
61                if (dbControl$useDb) {                if (dbControl$useDb && require("filehash")) {
62                    dbInsert(db, "DMetaData", df)                    dbInsert(db, "DMetaData", df)
63                    dmeta.df <- data.frame(key = "DMetaData", subset = I(list(NA)))                    dmeta.df <- data.frame(key = "DMetaData", subset = I(list(NA)))
64                }                }
# Line 91  Line 91 
91  setMethod("loadDoc",  setMethod("loadDoc",
92            signature(object =  "XMLTextDocument"),            signature(object =  "XMLTextDocument"),
93            function(object, ...) {            function(object, ...) {
94                if (!Cached(object)) {                if (!Cached(object) && require("XML")) {
95                    con <- eval(URI(object))                    con <- eval(URI(object))
96                    corpus <- paste(readLines(con), "\n", collapse = "")                    corpus <- paste(readLines(con), "\n", collapse = "")
97                    close(con)                    close(con)
# Line 171  Line 171 
171            function(object, FUN, ..., lazy = FALSE) {            function(object, FUN, ..., lazy = FALSE) {
172                result <- object                result <- object
173                # Note that text corpora are automatically loaded into memory via \code{[[}                # Note that text corpora are automatically loaded into memory via \code{[[}
174                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
175                    if (lazy)                    if (lazy)
176                        warning("lazy mapping is deactived when using database backend")                        warning("lazy mapping is deactived when using database backend")
177                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
# Line 238  Line 238 
238  setMethod("asPlain",  setMethod("asPlain",
239            signature(object = "XMLTextDocument"),            signature(object = "XMLTextDocument"),
240            function(object, FUN, ...) {            function(object, FUN, ...) {
241                  require("XML")
242    
243                corpus <- Content(object)                corpus <- Content(object)
244    
245                # As XMLDocument is no native S4 class, restore valid information                # As XMLDocument is no native S4 class, restore valid information
# Line 249  Line 251 
251  setMethod("asPlain",  setMethod("asPlain",
252            signature(object = "Reuters21578Document"),            signature(object = "Reuters21578Document"),
253            function(object, FUN, ...) {            function(object, FUN, ...) {
254                  require("XML")
255    
256                FUN <- convertReut21578XMLPlain                FUN <- convertReut21578XMLPlain
257                corpus <- Content(object)                corpus <- Content(object)
258    
# Line 317  Line 321 
321  setMethod("appendElem",  setMethod("appendElem",
322            signature(object = "Corpus", data = "TextDocument"),            signature(object = "Corpus", data = "TextDocument"),
323            function(object, data, meta = NULL) {            function(object, data, meta = NULL) {
324                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
325                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
326                    if (dbExists(db, ID(data)))                    if (dbExists(db, ID(data)))
327                        warning("document with identical ID already exists")                        warning("document with identical ID already exists")
# Line 388  Line 392 
392    
393                object <- x                object <- x
394                object@.Data <- x@.Data[i, ..., drop = FALSE]                object@.Data <- x@.Data[i, ..., drop = FALSE]
395                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
396                    index <- object@DMetaData[[1 , "subset"]]                    index <- object@DMetaData[[1 , "subset"]]
397                    if (any(is.na(index)))                    if (any(is.na(index)))
398                        object@DMetaData[[1 , "subset"]] <- i                        object@DMetaData[[1 , "subset"]] <- i
# Line 404  Line 408 
408            signature(x = "Corpus", i = "ANY", j = "ANY", value = "ANY"),            signature(x = "Corpus", i = "ANY", j = "ANY", value = "ANY"),
409            function(x, i, j, ... , value) {            function(x, i, j, ... , value) {
410                object <- x                object <- x
411                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
412                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
413                    counter <- 1                    counter <- 1
414                    for (id in object@.Data[i, ...]) {                    for (id in object@.Data[i, ...]) {
# Line 424  Line 428 
428  setMethod("[[",  setMethod("[[",
429            signature(x = "Corpus", i = "ANY", j = "ANY"),            signature(x = "Corpus", i = "ANY", j = "ANY"),
430            function(x, i, j, ...) {            function(x, i, j, ...) {
431                if (DBControl(x)[["useDb"]]) {                if (DBControl(x)[["useDb"]] && require("filehash")) {
432                    db <- dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])                    db <- dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])
433                    result <- dbFetch(db, x@.Data[[i]])                    result <- dbFetch(db, x@.Data[[i]])
434                    return(loadDoc(result))                    return(loadDoc(result))
# Line 441  Line 445 
445            signature(x = "Corpus", i = "ANY", j = "ANY", value = "ANY"),            signature(x = "Corpus", i = "ANY", j = "ANY", value = "ANY"),
446            function(x, i, j, ..., value) {            function(x, i, j, ..., value) {
447                object <- x                object <- x
448                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
449                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
450                    index <- object@.Data[[i]]                    index <- object@.Data[[i]]
451                    db[[index]] <- value                    db[[index]] <- value
# Line 495  Line 499 
499                    return(x)                    return(x)
500    
501                if (!all(sapply(args, inherits, "Corpus")))                if (!all(sapply(args, inherits, "Corpus")))
502                    stop("not all arguments are text document collections")                    stop("not all arguments are corpora")
503                if (DBControl(x)[["useDb"]] == TRUE || any(unlist(sapply(args, DBControl)["useDb", ])))                if (DBControl(x)[["useDb"]] || any(unlist(sapply(args, DBControl)["useDb", ])))
504                    stop("concatenating text document collections with activated database is not supported")                    stop("concatenating corpora with activated database is not supported")
505    
506                result <- x                Reduce(c2, base::c(list(x), args))
               for (c in args) {  
                   result <- c2(result, c)  
               }  
               return(result)  
507            })            })
508    
509  setGeneric("c2", function(x, y, ..., meta = list(merge_date = Sys.time(), merger = Sys.getenv("LOGNAME")), recursive = TRUE) standardGeneric("c2"))  setGeneric("c2", function(x, y, ..., meta = list(merge_date = Sys.time(), merger = Sys.getenv("LOGNAME")), recursive = TRUE) standardGeneric("c2"))
# Line 592  Line 592 
592            signature(object = "Corpus"),            signature(object = "Corpus"),
593            function(object){            function(object){
594                cat(sprintf(ngettext(length(object),                cat(sprintf(ngettext(length(object),
595                                     "A text document collection with %d text document\n",                                     "A corpus with %d text document\n",
596                                     "A text document collection with %d text documents\n"),                                     "A corpus with %d text documents\n"),
597                            length(object)))                            length(object)))
598      })      })
599    
# Line 619  Line 619 
619            function(object) {            function(object) {
620                summary(object)                summary(object)
621                cat("\n")                cat("\n")
622                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
623                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
624                    show(dbMultiFetch(db, unlist(object)))                    show(dbMultiFetch(db, unlist(object)))
625                }                }
# Line 632  Line 632 
632  setMethod("%IN%",  setMethod("%IN%",
633            signature(x = "TextDocument", y = "Corpus"),            signature(x = "TextDocument", y = "Corpus"),
634            function(x, y) {            function(x, y) {
635                if (DBControl(y)[["useDb"]]) {                if (DBControl(y)[["useDb"]] && require("filehash")) {
636                    db <- dbInit(DBControl(y)[["dbName"]], DBControl(y)[["dbType"]])                    db <- dbInit(DBControl(y)[["dbName"]], DBControl(y)[["dbType"]])
637                    result <- any(sapply(y, function(x, z) {x %in% Content(z)}, x))                    result <- any(sapply(y, function(x, z) {x %in% Content(z)}, x))
638                }                }
# Line 644  Line 644 
644  setMethod("lapply",  setMethod("lapply",
645            signature(X = "Corpus"),            signature(X = "Corpus"),
646            function(X, FUN, ...) {            function(X, FUN, ...) {
647                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]] && require("filehash")) {
648                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
649                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)
650                }                }
# Line 660  Line 660 
660  setMethod("sapply",  setMethod("sapply",
661            signature(X = "Corpus"),            signature(X = "Corpus"),
662            function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) {            function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) {
663                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]] && require("filehash")) {
664                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
665                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)
666                }                }

Legend:
Removed from v.884  
changed lines
  Added in v.902

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