SCM

SCM Repository

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

Diff of /pkg/R/textdoccol.R

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

revision 885, Thu Jan 29 09:34:44 2009 UTC revision 886, Thu Jan 29 22:47:34 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 496  Line 500 
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 text document collections")
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 text document collections with activated database is not supported")
505    
506                result <- x                result <- x
# Line 619  Line 623 
623            function(object) {            function(object) {
624                summary(object)                summary(object)
625                cat("\n")                cat("\n")
626                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]] && require("filehash")) {
627                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
628                    show(dbMultiFetch(db, unlist(object)))                    show(dbMultiFetch(db, unlist(object)))
629                }                }
# Line 632  Line 636 
636  setMethod("%IN%",  setMethod("%IN%",
637            signature(x = "TextDocument", y = "Corpus"),            signature(x = "TextDocument", y = "Corpus"),
638            function(x, y) {            function(x, y) {
639                if (DBControl(y)[["useDb"]]) {                if (DBControl(y)[["useDb"]] && require("filehash")) {
640                    db <- dbInit(DBControl(y)[["dbName"]], DBControl(y)[["dbType"]])                    db <- dbInit(DBControl(y)[["dbName"]], DBControl(y)[["dbType"]])
641                    result <- any(sapply(y, function(x, z) {x %in% Content(z)}, x))                    result <- any(sapply(y, function(x, z) {x %in% Content(z)}, x))
642                }                }
# Line 644  Line 648 
648  setMethod("lapply",  setMethod("lapply",
649            signature(X = "Corpus"),            signature(X = "Corpus"),
650            function(X, FUN, ...) {            function(X, FUN, ...) {
651                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]] && require("filehash")) {
652                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
653                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)
654                }                }
# Line 660  Line 664 
664  setMethod("sapply",  setMethod("sapply",
665            signature(X = "Corpus"),            signature(X = "Corpus"),
666            function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) {            function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) {
667                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]] && require("filehash")) {
668                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
669                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)
670                }                }

Legend:
Removed from v.885  
changed lines
  Added in v.886

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