R/Rm-methods.R

Defines functions undo rmLastJournalEntry rmAlias relatedViews

Documented in undo

## ==========================================================================
## Remove a view object from a workFlow. This will traverse down the tree
## and also remove all dependent objects to free their memory.
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## Return names of all views that are generated by a common actionItem
relatedViews <- function(view, wf)
{
    curView <- identifier(view)  
    curAction <- identifier(view@action)
    if(!isNull(view@action)){
        aiMatch <- sapply(edgeData(get(wf@tree), attr="actionItem"), identifier)
        gsub(".*\\|", "", names(aiMatch[aiMatch == curAction]))
    }else NULL
}

## remove alias for an identifier
rmAlias <- function(value, workflow)
{
    checkClass(value, "character", 1)
    checkClass(workflow, c("workFlow", "environment"))
    workflow <- alias(workflow)
    ind <- names(which(sapply(as.list(workflow), function(x)
                              value %in% x)==TRUE))
    for(i in ind){
        tmp <- workflow[[i]]
        tmp <- setdiff(tmp, value)
        if(!length(tmp))
            rm(list=i, envir=workflow)
        else
            workflow[[i]] <- tmp
    }
    return(invisible(NULL))
}

## For all views, we need to traverse all downstream actionItems and remove
## them. We also remove the associated data.
setMethod("Rm",
          signature=signature(symbol="view",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          curView <- identifier(symbol)
          depAction <- unique(sapply(edgeData(get(envir@tree), from=curView,
                                              attr="actionItem"),
                                     identifier))
          if(length(depAction))
              lapply(mget(depAction, envir), Rm, envir)
          Rm(symbol@data, envir)
          if(!length(relatedViews(symbol, envir)))
              Rm(symbol@action)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          assign(x=envir@tree, value=removeNode(curView, get(envir@tree)),
                 envir=envir)
          journal <- journal(envir)
          curAction <- identifier(action(symbol))
          aiMatch <- sapply(edgeData(get(envir@tree), attr="actionItem"), identifier)
          depNodes <- gsub(".*\\|", "", names(aiMatch[aiMatch == curAction]))
          delEntry <- match(identifier(action(symbol)), names(journal))
          if(!length(depNodes) && !is.na(delEntry))
              journal <- journal[-delEntry]
          assign(envir@journal, journal, envir)
          return(invisible(NULL))
      })

## For gateViews we also have to remove the filterResult
setMethod("Rm",
          signature=signature(symbol="gateView",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          selectMethod("Rm", signature("view", "workFlow", "character"))(symbol, envir)
          if(!length(relatedViews(symbol, envir)))
              Rm(symbol@filterResult, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })

## For transformViews we just need to remove the view itself
setMethod("Rm",
          signature=signature(symbol="transformView",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          selectMethod("Rm", signature("view", "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })


## For compensateViews we just need to remove the view itself
setMethod("Rm",
          signature=signature(symbol="compensateView",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          selectMethod("Rm", signature("view", "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })


## For normalizeViews we just need to remove the view itself
setMethod("Rm",
          signature=signature(symbol="normalizeView",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          selectMethod("Rm", signature("view", "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })

## For subsettingViews we just need to remove the view itself
setMethod("Rm",
          signature=signature(symbol="subsettingView",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          selectMethod("Rm", signature("view", "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })





## ==========================================================================
## Remove an actionItem object from a workFlow. This will traverse down the tree
## and also remove all dependent objects to free their memory.
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## For all actionItems we need to remove the associated views.
setMethod("Rm",
          signature=signature(symbol="actionItem",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol)
      {
          curAction <- identifier(symbol)
          aiMatch <- sapply(edgeData(get(envir@tree), attr="actionItem"), identifier)
          depNodes <- gsub(".*\\|", "", names(aiMatch[aiMatch == curAction]))
          journal <- journal(envir)
          delEntry <- match(curAction, names(journal))
          if(!is.na(delEntry))
              journal <- journal[-delEntry]
          assign(envir@journal, journal, envir)
          lapply(mget(depNodes, envir), Rm, envir)
          return(invisible(NULL))
      })

## For gateActionItems we need to remove the gate and the filterResult
setMethod("Rm",
          signature=signature(symbol="gateActionItem",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol)
      {
          Rm(symbol@gate, envir)
          selectMethod("Rm", signature("actionItem",
                                       "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))         
      })

## For transformActionItems we need to remove the transformation object
setMethod("Rm",
          signature=signature(symbol="transformActionItem",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol)
      {
          Rm(symbol@transform)
          selectMethod("Rm", signature("actionItem",
                                       "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })

## For compensateActionItems we need to remove the compensation object
setMethod("Rm",
          signature=signature(symbol="compensateActionItem",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol)
      {
          Rm(symbol@compensate)
          selectMethod("Rm", signature("actionItem",
                                       "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })

## For normalizeActionItems we need to remove the normalization object
setMethod("Rm",
          signature=signature(symbol="normalizeActionItem",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol)
      {
          Rm(symbol@normalization)
          selectMethod("Rm", signature("actionItem",
                                       "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })


## For subsettingActionItems we need to remove the subsetting object
setMethod("Rm",
          signature=signature(symbol="subsettingActionItem",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol)
      {
          Rm(symbol@subsetting)
          selectMethod("Rm", signature("actionItem",
                                       "workFlow", "character"))(symbol, envir)
          rmAlias(identifier(symbol), envir)
          suppressWarnings(rm(list=identifier(symbol), envir=envir@env))
          return(invisible(NULL))
      })



## ==========================================================================
## Remove an object referenced to by an fcReference object as well as the
## reference object itself (if possible)
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## Just the object and the reference
setMethod("Rm",
          signature=signature(symbol="fcReference",
                              envir="missing",
                              subSymbol="character"),
          definition=function(symbol, subSymbol, rmRef=TRUE)
      {
          suppressWarnings(rm(list=identifier(symbol), envir=symbol@env))
          rmAlias(identifier(symbol), symbol)
          ## This doesn't work because the name space is messing up the
          ## evaluation environment tree.
          ## rm(list=subSymbol, inherits=TRUE)
          ## Instead we are rather bold and remove the reference from the
          ## global env if it exists.
          if(rmRef && subSymbol %in% ls(globalenv(), all.names=TRUE) &&
             is(get(subSymbol, globalenv()), "fcReference"))
              suppressWarnings(rm(list=subSymbol, envir=globalenv()))
      })

## Object and reference and all dependent objects (further down in the
## workFlow tree). This is only recursive for actionItems and views. All
## other objects can be removed without further side effects, but we
## strongly discourage from doing so since the consequences might be
## catastrophic...
setMethod("Rm",
          signature=signature(symbol="fcReference",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, rmRef=TRUE)
      {
          suppressWarnings(rm(list=identifier(symbol), envir=symbol@env))
          rmAlias(identifier(symbol), envir)
          if(rmRef && subSymbol %in% ls(globalenv(), all.names=TRUE) &&
             is(get(subSymbol, globalenv()), "fcReference"))
              suppressWarnings(rm(list=subSymbol, envir=globalenv()))
      })

## For nullReferences we don't need to do anything
setMethod("Rm",
          signature=signature(symbol="fcNullReference",
                              envir="missing",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, ...){})



## ==========================================================================
## Remove an object from the workFlow environment
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## The general method to access the object by name. Note that there there
## are more sophisticated Rm methods for views and actionItems that traverse
## the tree and also remove all dependent objects. Those will get called
## automatically.
setMethod("Rm",
          signature=signature(symbol="character",
                              envir="workFlow",
                              subSymbol="character"),
          definition=function(symbol, envir, subSymbol, ...)
      {
          Rm(get(symbol, envir), envir)
      })



## ==========================================================================
## Undo one or several workFlow operations
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## Remove all objects in the last item of the journal list
rmLastJournalEntry <- function(wf)
{
    checkClass(wf, "workFlow")
    journal <- journal(wf)
    alias <- alias(wf)
    lastEntry <- tail(journal, n=1)
    if(names(lastEntry) != ".action_baseView"){
        tree <- tree(wf)
        nodes <- intersect(nodes(tree), unlist(lastEntry))
        if(length(nodes)){
            tree <- removeNode(nodes, tree)
            assign(wf@tree, tree, wf)
        }
        views <- grep("gateViewRef", unlist(lastEntry), value=TRUE)
        for(i in views){
            curView <- try(get(i, wf), silent=TRUE)
            if(!is(curView, "try-error")){
                thisView <- parent(curView)
                if(is(thisView, "gateView")){
                    thisView@data <- fcNullReference()
                    assign(identifier(thisView), thisView, wf@env)
                }
            }
        }
        try(sapply(unlist(lastEntry), rmAlias, wf), silent=TRUE)
        suppressWarnings(rm(list=unlist(lastEntry), envir=wf@env))
    }
}


undo <- function(wf, n=1)
{
    checkClass(wf, "workFlow")
    checkClass(n, "numeric", 1)
    journal <- get(wf@journal)
    lj <- length(journal)
    n <- min(lj-1, n)
    for(i in seq_len(n)){
        rmLastJournalEntry(wf)
        journal <- journal[-lj]
        lj <- length(journal)
        assign(wf@journal, journal, wf)
    }
    invisible(NULL)
}

Try the flowCore package in your browser

Any scripts or data that you put into this service are public.

flowCore documentation built on Nov. 17, 2017, 11:43 a.m.