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 744, Mon Apr 23 00:35:10 2007 UTC revision 760, Thu Jun 21 22:40:15 2007 UTC
# Line 43  Line 43 
43                if (dbControl$useDb) {                if (dbControl$useDb) {
44                    dbInsert(db, "DMetaData", df)                    dbInsert(db, "DMetaData", df)
45                    dmeta.df <- data.frame(key = "DMetaData", subset = I(list(NA)))                    dmeta.df <- data.frame(key = "DMetaData", subset = I(list(NA)))
                   dbDisconnect(db)  
46                }                }
47                else                else
48                    dmeta.df <- df                    dmeta.df <- df
# Line 145  Line 144 
144                        db[[id]] <- FUN(object[[i]], ..., DMetaData = DMetaData(object))                        db[[id]] <- FUN(object[[i]], ..., DMetaData = DMetaData(object))
145                        i <- i + 1                        i <- i + 1
146                    }                    }
                   dbDisconnect(db)  
147                }                }
148                else                else
149                    result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))                    result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))
# Line 170  Line 168 
168                return(FUN(xmlRoot(corpus), ...))                return(FUN(xmlRoot(corpus), ...))
169            })            })
170  setMethod("asPlain",  setMethod("asPlain",
171              signature(object = "Reuters21578Document"),
172              function(object, FUN, ...) {
173                  FUN <- convertReut21578XMLPlain
174                  corpus <- Corpus(object)
175    
176                  # As XMLDocument is no native S4 class, restore valid information
177                  class(corpus) <- "XMLDocument"
178                  names(corpus) <- c("doc","dtd")
179    
180                  return(FUN(xmlRoot(corpus), ...))
181              })
182    setMethod("asPlain",
183              signature(object = "RCV1Document"),
184              function(object, FUN, ...) {
185                  FUN <- convertRCV1Plain
186                  corpus <- Corpus(object)
187    
188                  # As XMLDocument is no native S4 class, restore valid information
189                  class(corpus) <- "XMLDocument"
190                  names(corpus) <- c("doc","dtd")
191    
192                  return(FUN(xmlRoot(corpus), ...))
193              })
194    setMethod("asPlain",
195            signature(object = "NewsgroupDocument"),            signature(object = "NewsgroupDocument"),
196            function(object, FUN, ...) {            function(object, FUN, ...) {
197                new("PlainTextDocument", .Data = Corpus(object), Cached = TRUE, URI = "", Author = Author(object),                new("PlainTextDocument", .Data = Corpus(object), Cached = TRUE, URI = "", Author = Author(object),
# Line 198  Line 220 
220            signature(object = "PlainTextDocument"),            signature(object = "PlainTextDocument"),
221            function(object, language = "english", ...) {            function(object, language = "english", ...) {
222                splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))                splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
223                stemmedCorpus <- if (require("Rstem"))                stemmedCorpus <- if (require("Rstem", quietly = TRUE))
224                    Rstem::wordStem(splittedCorpus, language)                    Rstem::wordStem(splittedCorpus, language)
225                else                else
226                    SnowballStemmer(splittedCorpus, Weka_control(S = language))                    SnowballStemmer(splittedCorpus, Weka_control(S = language))
# Line 224  Line 246 
246                return(object)                return(object)
247            })            })
248    
249    setGeneric("replaceWords", function(object, words, by, ...) standardGeneric("replaceWords"))
250    setMethod("replaceWords",
251              signature(object = "PlainTextDocument", words = "character", by = "character"),
252              function(object, words, by, ...) {
253                  pattern <- paste(words, collapse = "|")
254                  Corpus(object) <- gsub(pattern, by, Corpus(object))
255                  return(object)
256              })
257    
258  setGeneric("tmFilter", function(object, ..., FUN = sFilter, doclevel = FALSE) standardGeneric("tmFilter"))  setGeneric("tmFilter", function(object, ..., FUN = sFilter, doclevel = FALSE) standardGeneric("tmFilter"))
259  setMethod("tmFilter",  setMethod("tmFilter",
260            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
# Line 285  Line 316 
316                    if (dbExists(db, ID(data)))                    if (dbExists(db, ID(data)))
317                        warning("document with identical ID already exists")                        warning("document with identical ID already exists")
318                    dbInsert(db, ID(data), data)                    dbInsert(db, ID(data), data)
                   dbDisconnect(db)  
319                    object@.Data[[length(object)+1]] <- ID(data)                    object@.Data[[length(object)+1]] <- ID(data)
320                }                }
321                else                else
# Line 378  Line 408 
408                        }                        }
409                        counter <- counter + 1                        counter <- counter + 1
410                    }                    }
                   dbDisconnect(db)  
411                }                }
412                else                else
413                    object@.Data[i, ...] <- value                    object@.Data[i, ...] <- value
# Line 391  Line 420 
420                if (DBControl(x)[["useDb"]]) {                if (DBControl(x)[["useDb"]]) {
421                    db <- dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])                    db <- dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])
422                    result <- dbFetch(db, x@.Data[[i]])                    result <- dbFetch(db, x@.Data[[i]])
                   dbDisconnect(db)  
423                    return(loadDoc(result))                    return(loadDoc(result))
424                }                }
425                else                else
# Line 406  Line 434 
434                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
435                    index <- object@.Data[[i]]                    index <- object@.Data[[i]]
436                    db[[index]] <- value                    db[[index]] <- value
                   dbDisconnect(db)  
437                }                }
438                else                else
439                    object@.Data[[i, ...]] <- value                    object@.Data[[i, ...]] <- value
# Line 576  Line 603 
603                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]]) {
604                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
605                    show(dbMultiFetch(db, unlist(object)))                    show(dbMultiFetch(db, unlist(object)))
                   dbDisconnect(db)  
606                }                }
607                else                else
608                    show(object@.Data)                    show(object@.Data)
# Line 590  Line 616 
616                if (DBControl(y)[["useDb"]]) {                if (DBControl(y)[["useDb"]]) {
617                    db <- dbInit(DBControl(y)[["dbName"]], DBControl(y)[["dbType"]])                    db <- dbInit(DBControl(y)[["dbName"]], DBControl(y)[["dbType"]])
618                    result <- any(sapply(y, function(x, z) {x %in% Corpus(z)}, x))                    result <- any(sapply(y, function(x, z) {x %in% Corpus(z)}, x))
                   dbDisconnect(db)  
619                }                }
620                else                else
621                    result <- x %in% y                    result <- x %in% y
# Line 603  Line 628 
628                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]]) {
629                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
630                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)
                   dbDisconnect(db)  
631                }                }
632                else                else
633                    result <- base::lapply(X, FUN, ...)                    result <- base::lapply(X, FUN, ...)
# Line 616  Line 640 
640                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]]) {
641                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
642                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)
                   dbDisconnect(db)  
643                }                }
644                else                else
645                    result <- base::sapply(X, FUN, ...)                    result <- base::sapply(X, FUN, ...)

Legend:
Removed from v.744  
changed lines
  Added in v.760

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