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 702, Tue Jan 9 09:39:33 2007 UTC revision 712, Sun Mar 4 15:18:36 2007 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
3  # The "..." are additional arguments for the FunctionGenerator parser  # The "..." are additional arguments for the FunctionGenerator parser
4  setGeneric("TextDocCol", function(object, parser = readPlain, load = FALSE, ...) standardGeneric("TextDocCol"))  setGeneric("TextDocCol", function(object,
5                                      parser = readPlain,
6                                      load = FALSE,
7                                      dbControl = list(useDb = FALSE, dbName = "", dbType = "DB1"),
8                                      ...) standardGeneric("TextDocCol"))
9  setMethod("TextDocCol",  setMethod("TextDocCol",
10            signature(object = "Source"),            signature(object = "Source"),
11            function(object, parser = readPlain, load = FALSE, ...) {            function(object, parser = readPlain, load = FALSE, dbControl = list(useDb = FALSE, dbName = "", dbType = "DB1"), ...) {
12                if (inherits(parser, "FunctionGenerator"))                if (inherits(parser, "FunctionGenerator"))
13                    parser <- parser(...)                    parser <- parser(...)
14    
15                  if (dbControl$useDb) {
16                      if (!dbCreate(dbControl$dbName, dbControl$dbType))
17                          stop("error in creating database")
18                      db <- dbInit(dbControl$dbName, dbControl$dbType)
19                  }
20    
21                tdl <- list()                tdl <- list()
22                counter <- 1                counter <- 1
23                while (!eoi(object)) {                while (!eoi(object)) {
# Line 17  Line 27 
27                    # we need to load the corpus into memory at startup                    # we need to load the corpus into memory at startup
28                    if (!object@LoDSupport)                    if (!object@LoDSupport)
29                        load <- TRUE                        load <- TRUE
30                    tdl <- c(tdl, list(parser(elem, load, as.character(counter))))                    doc <- parser(elem, load, as.character(counter))
31                      if (dbControl$useDb) {
32                          dbInsert(db, ID(doc), doc)
33                          tdl <- c(tdl, ID(doc))
34                      }
35                      else
36                          tdl <- c(tdl, list(doc))
37                    counter <- counter + 1                    counter <- counter + 1
38                }                }
39    
40                dmeta.df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)                df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
41                  if (dbControl$useDb) {
42                      dbInsert(db, "DMetaData", df)
43                      dmeta.df <- data.frame(key = "DMetaData")
44                      dbDisconnect(db)
45                  }
46                  else
47                      dmeta.df <- df
48    
49                cmeta.node <- new("MetaDataNode",                cmeta.node <- new("MetaDataNode",
50                              NodeID = 0,                              NodeID = 0,
51                              MetaData = list(create_date = Sys.time(), creator = Sys.getenv("LOGNAME")),                              MetaData = list(create_date = Sys.time(), creator = Sys.getenv("LOGNAME")),
52                              children = list())                              children = list())
53    
54                return(new("TextDocCol", .Data = tdl, DMetaData = dmeta.df, CMetaData = cmeta.node))                return(new("TextDocCol", .Data = tdl, DMetaData = dmeta.df, CMetaData = cmeta.node, DBControl = dbControl))
55            })            })
56    
57  setGeneric("loadDoc", function(object, ...) standardGeneric("loadDoc"))  setGeneric("loadDoc", function(object, ...) standardGeneric("loadDoc"))
# Line 174  Line 198 
198                if (doclevel)                if (doclevel)
199                    return(object[sapply(object, FUN, ..., DMetaData = DMetaData(object))])                    return(object[sapply(object, FUN, ..., DMetaData = DMetaData(object))])
200                else                else
201                    return(object[FUN(object, ...)])                    return(object[FUN(object, ...)]) # TODO: Check that FUN knows about the database
202            })            })
203    
204  setGeneric("tmIndex", function(object, ..., FUN = sFilter, doclevel = FALSE) standardGeneric("tmIndex"))  setGeneric("tmIndex", function(object, ..., FUN = sFilter, doclevel = FALSE) standardGeneric("tmIndex"))
# Line 184  Line 208 
208                if (doclevel)                if (doclevel)
209                    return(sapply(object, FUN, ..., DMetaData = DMetaData(object)))                    return(sapply(object, FUN, ..., DMetaData = DMetaData(object)))
210                else                else
211                    return(FUN(object, ...))                    return(FUN(object, ...)) # TODO: Check that FUN knows about the database
212            })            })
213    
214    # TODO
215  sFilter <- function(object, s, ...) {  sFilter <- function(object, s, ...) {
216      query.df <- DMetaData(object)      query.df <- DMetaData(object)
217      con <- textConnection(s)      con <- textConnection(s)
# Line 256  Line 281 
281  setMethod("appendElem",  setMethod("appendElem",
282            signature(object = "TextDocCol", data = "TextDocument"),            signature(object = "TextDocCol", data = "TextDocument"),
283            function(object, data, meta = NULL) {            function(object, data, meta = NULL) {
284                  if (DBControl(object)[["useDb"]]) {
285                      db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
286                      if (dbExists(db, ID(data)))
287                          warning("document with identical ID already exists")
288                      dbInsert(db, ID(data), data)
289                      dbDisconnect(db)
290                      object@.Data[[length(object)+1]] <- ID(data)
291                  }
292                  else
293                object@.Data[[length(object)+1]] <- data                object@.Data[[length(object)+1]] <- data
294                object@DMetaData <- rbind(object@DMetaData, c(MetaID = CMetaData(object)@NodeID, meta))                DMetaData(object) <- rbind(DMetaData(object), c(MetaID = CMetaData(object)@NodeID, meta))
295                return(object)                return(object)
296            })            })
297    
# Line 265  Line 299 
299  setMethod("appendMeta",  setMethod("appendMeta",
300            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
301            function(object, cmeta = NULL, dmeta = NULL) {            function(object, cmeta = NULL, dmeta = NULL) {
302                object@CMetaData@MetaData <- c(object@CMetaData@MetaData, cmeta)                object@CMetaData@MetaData <- c(CMetaData(object)@MetaData, cmeta)
303                if (!is.null(cmeta))                if (!is.null(dmeta)) {
304                    object@DMetaData <- cbind(object@DMetaData, dmeta)                    DMetaData(object) <- cbind(DMetaData(object), dmeta)
305                  }
306                return(object)                return(object)
307            })            })
308    
# Line 279  Line 314 
314                    object@CMetaData@MetaData <- CMetaData(object)@MetaData[names(CMetaData(object)@MetaData) != cname]                    object@CMetaData@MetaData <- CMetaData(object)@MetaData[names(CMetaData(object)@MetaData) != cname]
315                }                }
316                if (!is.null(dname)) {                if (!is.null(dname)) {
317                    object@DMetaData <- DMetaData(object)[names(DMetaData(object)) != dname]                    DMetaData(object) <- DMetaData(object)[names(DMetaData(object)) != dname]
318                }                }
319                return(object)                return(object)
320            })            })
321    
322    # TODO
323  setGeneric("prescindMeta", function(object, meta) standardGeneric("prescindMeta"))  setGeneric("prescindMeta", function(object, meta) standardGeneric("prescindMeta"))
324  setMethod("prescindMeta",  setMethod("prescindMeta",
325            signature(object = "TextDocCol", meta = "character"),            signature(object = "TextDocCol", meta = "character"),
# Line 311  Line 347 
347                return(object)                return(object)
348            })            })
349    
350    # WARNING: DMetaData is changed (since both use the same database)
351  setMethod("[",  setMethod("[",
352            signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),            signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
353            function(x, i, j, ... , drop) {            function(x, i, j, ... , drop) {
# Line 321  Line 358 
358                object@.Data <- x@.Data[i, ..., drop = FALSE]                object@.Data <- x@.Data[i, ..., drop = FALSE]
359                df <- as.data.frame(DMetaData(object)[i, ])                df <- as.data.frame(DMetaData(object)[i, ])
360                names(df) <- names(DMetaData(object))                names(df) <- names(DMetaData(object))
361                object@DMetaData <- df                object@DMetaData(object) <- df
362                return(object)                return(object)
363            })            })
364    
365    # TODO
366  setMethod("[<-",  setMethod("[<-",
367            signature(x = "TextDocCol", i = "ANY", j = "ANY", value = "ANY"),            signature(x = "TextDocCol", i = "ANY", j = "ANY", value = "ANY"),
368            function(x, i, j, ... , value) {            function(x, i, j, ... , value) {
# Line 336  Line 374 
374  setMethod("[[",  setMethod("[[",
375            signature(x = "TextDocCol", i = "ANY", j = "ANY"),            signature(x = "TextDocCol", i = "ANY", j = "ANY"),
376            function(x, i, j, ...) {            function(x, i, j, ...) {
377                  if (DBControl(x)[["useDb"]]) {
378                      db <- dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])
379                      result <- dbFetch(db, x@.Data[[i]])
380                      dbDisconnect(db)
381                      return(loadDoc(result))
382                  }
383                  else
384                return(loadDoc(x@.Data[[i]]))                return(loadDoc(x@.Data[[i]]))
385            })            })
386    
# Line 343  Line 388 
388            signature(x = "TextDocCol", i = "ANY", j = "ANY", value = "ANY"),            signature(x = "TextDocCol", i = "ANY", j = "ANY", value = "ANY"),
389            function(x, i, j, ..., value) {            function(x, i, j, ..., value) {
390                object <- x                object <- x
391                  if (DBControl(object)[["useDb"]]) {
392                      db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
393                      index <- object@.Data[[i]]
394                      db[[index]] <- value
395                      dbDisconnect(db)
396                  }
397                  else
398                object@.Data[[i, ...]] <- value                object@.Data[[i, ...]] <- value
399                return(object)                return(object)
400            })            })
401    
402    # TODO
403  # Update \code{NodeID}s of a CMetaData tree  # Update \code{NodeID}s of a CMetaData tree
404  update_id <- function(object, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {  update_id <- function(object, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {
405      # Traversal of (binary) CMetaData tree with setup of \code{NodeID}s      # Traversal of (binary) CMetaData tree with setup of \code{NodeID}s
# Line 375  Line 428 
428      return(list(root = set_id(object), left.mapping = left.mapping, right.mapping = mapping))      return(list(root = set_id(object), left.mapping = left.mapping, right.mapping = mapping))
429  }  }
430    
431    # TODO
432  setMethod("c",  setMethod("c",
433            signature(x = "TextDocCol"),            signature(x = "TextDocCol"),
434            function(x, ..., meta = list(merge_date = Sys.time(), merger = Sys.getenv("LOGNAME")), recursive = TRUE) {            function(x, ..., meta = list(merge_date = Sys.time(), merger = Sys.getenv("LOGNAME")), recursive = TRUE) {
# Line 391  Line 445 
445                return(result)                return(result)
446            })            })
447    
448    # TODO
449  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"))
450  setMethod("c2",  setMethod("c2",
451            signature(x = "TextDocCol", y = "TextDocCol"),            signature(x = "TextDocCol", y = "TextDocCol"),
# Line 444  Line 499 
499                return(object)                return(object)
500            })            })
501    
502    # TODO
503  setMethod("c",  setMethod("c",
504            signature(x = "TextDocument"),            signature(x = "TextDocument"),
505            function(x, ..., recursive = TRUE){            function(x, ..., recursive = TRUE){
# Line 492  Line 547 
547                }                }
548      })      })
549    
550    # TODO
551  setGeneric("inspect", function(object) standardGeneric("inspect"))  setGeneric("inspect", function(object) standardGeneric("inspect"))
552  setMethod("inspect",  setMethod("inspect",
553            signature("TextDocCol"),            signature("TextDocCol"),
# Line 501  Line 557 
557                show(object@.Data)                show(object@.Data)
558            })            })
559    
560    # TODO
561  # No metadata is checked  # No metadata is checked
562  setGeneric("%IN%", function(x, y) standardGeneric("%IN%"))  setGeneric("%IN%", function(x, y) standardGeneric("%IN%"))
563  setMethod("%IN%",  setMethod("%IN%",

Legend:
Removed from v.702  
changed lines
  Added in v.712

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