Step-class {pipeFrame}R Documentation

Methods for Step objects

Description

Users can call Step object operation methods below to obtain information in objects.

Usage

## S4 method for signature 'Step'
init(.Object, prevSteps = list(), ...)

## S4 method for signature 'Step'
stepName(.Object, ...)

## S4 method for signature 'Step'
stepType(.Object, attachedTypes = TRUE, ...)

## S4 method for signature 'Step'
pipeName(.Object, ...)

## S4 method for signature 'Step'
input(.Object)

## S4 replacement method for signature 'Step'
input(.Object) <- value

## S4 method for signature 'Step'
output(.Object)

## S4 replacement method for signature 'Step'
output(.Object) <- value

## S4 method for signature 'Step'
param(.Object)

## S4 replacement method for signature 'Step'
param(.Object) <- value

## S4 method for signature 'Step'
property(.Object, ..., pipeName = NULL)

## S4 replacement method for signature 'Step'
property(.Object, pipeName = NULL) <- value

## S4 method for signature 'Step'
report(.Object)

## S4 replacement method for signature 'Step'
report(.Object) <- value

## S4 method for signature 'Step'
argv(.Object)

## S4 method for signature 'Step'
x$name

## S4 replacement method for signature 'Step'
x$name <- value

## S4 method for signature 'Step'
getParam(.Object, item, type = c("input", "output", "other"), ...)

## S4 method for signature 'Step'
getParamItems(.Object, type = c("input", "output", "other"), ...)

## S4 method for signature 'Step'
isReady(.Object, ...)

## S4 method for signature 'Step'
clearStepCache(.Object, ...)

## S4 method for signature 'Step'
getAutoPath(.Object, originPath, regexSuffixName, suffix, ...)

## S4 method for signature 'Step'
checkRequireParam(.Object, ...)

## S4 method for signature 'Step'
checkAllPath(.Object, ...)

## S4 method for signature 'Step'
getParamMD5Path(.Object, ...)

## S4 method for signature 'Step'
getStepWorkDir(.Object, filename = NULL, ...)

## S4 method for signature 'Step'
stepID(.Object, ...)

## S4 method for signature 'Step'
writeLog(
  .Object,
  msg,
  ...,
  isWarnning = FALSE,
  appendLog = TRUE,
  showMsg = TRUE
)

processing(.Object, ...)

genReport(.Object, ...)

Arguments

.Object

Step object scalar. Step object is returned by functions in each step.

prevSteps

List list of Step objects

...

Additional arguments, currently unused.

attachedTypes

Logical scalar. Show the new type name or show the original type name Default: TRUE

value

any type scalar. The value to be set for corresponding item in a list.

pipeName

Character scalar. The pipeline name that this step belongs to. Default: NULL. It will be replace by the only pipeline name.

x

Step object scalar. Step object is returned by functions in each step.

name

Character scalar. Name can be one of inputList, outputList, paramList, allList, propList or the item names of inputList, outputList or paramList

item

Character scalar. The items in parameter list (input, output and other) or report list.

type

Character scalar. Valid types of parameters including "input", "output" and "other"

originPath

Character scalar. The file name for output file is based on this original path name.

regexSuffixName

Character scalar. The suffix for replacement.

suffix

Character scalar. The new suffix for the file.

filename

Character scaler. The name of file under step working directiory

msg

Character scalar. The message to write into log file.

isWarnning

Logical scalar. Set this message as warning message. Default: FALSE

appendLog

Logical scalar. Append to the log file. Default: TRUE

showMsg

Logical scalar. Show the message on screen. Default: TRUE

Details

Step is a S4 class for generating Step S4 objects. All Step objects generated by child classes inherit from Step. To generate new Step objects, a function wrapper with fixed arguments needs to be implemented. Users use this function to generate new Step functions rather than Step S4 class to generate objects.

Value

the function and result of functions:

init

(For package developer only) A Step child class object with initialized input, output and other parameters

stepName

get Step object Character name

stepType

get Step object Character type name (class name)

pipeName

get Step object pipe name

input

get input list

input<-

set input list

output

get output list

output<-

set output list

param

get other parameters list

param<-

set other parameters list

property

get property list

property<-

set property list

report

get report list

report<-

set report list

argv

get arguments list

$

get inputList, outputList, paramList, allList, propList or any item value in inputList, outputList or paramList

$<-

set inputList, outputList, paramList, allList, propList or any item value in inputList, outputList or paramList

getParam

Get parameter value set by process function. See getParamItems to obtain valid items for query.

getParamItems

Get parameter name list

isReady

Is the process ready for downstream process

clearStepCache

Clear cache of Step object

getAutoPath

(For package developer) Developer can use this method to generate new file name based on exist input file name

checkRequireParam

(For package developer) Check required inputs or parameters are filled.

checkRequireParam

(For package developer) Check required inputs are filled.

getParamMD5Path

The Step object storage directory

getStepWorkDir

Get the step work directory of this object

stepID

Get the step ID

writeLog

(For package developer) write log.

processing

(For package developer) Run pipeline step

genReport

(For package developer) Generate report list

Author(s)

Zheng Wei

See Also

setGenome setThreads

Examples



library(BSgenome)
library(rtracklayer)
library(magrittr)

# generate new Step : RandomRegionOnGenome
setClass(Class = "RandomRegionOnGenome",
         contains = "Step"
)

setMethod(
    f = "init",
    signature = "RandomRegionOnGenome",
    definition = function(.Object,prevSteps = list(),...){
        # All arguments in function randomRegionOnGenome
        # will be passed from "..."
        # so get the arguments from "..." first.
        allparam <- list(...)
        sampleNumb <- allparam[["sampleNumb"]]
        regionLen <- allparam[["regionLen"]]
        genome <- allparam[["genome"]]
        outputBed <- allparam[["outputBed"]]
        # no previous steps for this step so ingnore the "prevSteps"
        # begin to set input parameters
        # no input for this step
        # begin to set output parameters
        if(is.null(outputBed)){
            output(.Object)$outputBed <-
                getStepWorkDir(.Object,"random.bed")
        }else{
            output(.Object)$outputBed <- outputBed
        }
        # begin to set other parameters
        param(.Object)$regionLen <-  regionLen
        param(.Object)$sampleNumb <- sampleNumb
        if(is.null(genome)){
            param(.Object)$bsgenome <-  getBSgenome(getGenome())
        }else{
            param(.Object)$bsgenome <-  getBSgenome(genome)
        }
        # don't forget to return .Object
        .Object
    }
)

setMethod(
    f = "processing",
    signature = "RandomRegionOnGenome",
    definition = function(.Object,...){
        # All arguments are set in .Object
        # so we can get them from .Object
        allparam <- list(...)
        sampleNumb <- getParam(.Object,"sampleNumb")
        regionLen <- getParam(.Object,"regionLen")
        bsgenome <- getParam(.Object,"bsgenome")
        outputBed <- getParam(.Object,"outputBed")
        # begin the calculation
        chrlens <-seqlengths(bsgenome)
        selchr <- grep("_|M",names(chrlens),invert=TRUE)
        chrlens <- chrlens[selchr]
        startchrlens <- chrlens - regionLen
        spchrs <- sample(x = names(startchrlens),
        size =  sampleNumb, replace = TRUE,
        prob = startchrlens / sum(startchrlens))
        gr <- GRanges()
        for(chr in names(startchrlens)){
            startpt <- sample(x = 1:startchrlens[chr],
            size = sum(spchrs == chr),replace = FALSE)
            gr <- c(gr,GRanges(seqnames = chr,
            ranges = IRanges(start = startpt, width = 1000)))
        }
        result <- sort(gr,ignore.strand=TRUE)
        rtracklayer::export.bed(object = result, con =  outputBed)
        # don't forget to return .Object
        .Object
    }
)



setMethod(
    f = "genReport",
    signature = "RandomRegionOnGenome",
    definition = function(.Object, ...){
        .Object
    }
)






# This function is exported in NAMESPACE for user to use
randomRegionOnGenome <- function(sampleNumb, regionLen = 1000,
                                 genome = NULL, outputBed = NULL, ...){
    allpara <- c(list(Class = "RandomRegionOnGenome", prevSteps = list()),
                 as.list(environment()),list(...))
    step <- do.call(new,allpara)
    invisible(step)
}


# generate another new Step : OverlappedRandomRegion
setClass(Class = "OverlappedRandomRegion",
         contains = "Step"
)

setMethod(
    f = "init",
    signature = "OverlappedRandomRegion",
    definition = function(.Object,prevSteps = list(),...){
        # All arguments in function overlappedRandomRegion and
        # runOerlappedRandomRegion will be passed from "..."
        # so get the arguments from "..." first.
        allparam <- list(...)
        inputBed <- allparam[["inputBed"]]
        randomBed <- allparam[["randomBed"]]
        outputBed <- allparam[["outputBed"]]
        # inputBed can obtain from previous step object when running
        # runOerlappedRandomRegion
        if(length(prevSteps)>0){
            prevStep <- prevSteps[[1]]
            input(.Object)$randomBed <-  getParam(prevStep,"outputBed")
        }
        # begin to set input parameters
        if(!is.null(inputBed)){
            input(.Object)$inputBed <- inputBed
        }
        if(!is.null(randomBed)){
            input(.Object)$randomBed <- randomBed
        }
        # begin to set output parameters
        # the output is recemended to set under the step work directory
        if(!is.null(outputBed)){
            output(.Object)$outputBed <-  outputBed
        }else{
            output(.Object)$outputBed <-
                getAutoPath(.Object, getParam(.Object, "inputBed"),
                            "bed", suffix = "bed")
            # the path can also be generate in this way
            # ib <- getParam(.Object,"inputBed")
            # output(.Object)$outputBed <-
            #    file.path(getStepWorkDir(.Object),
            #    paste0(substring(ib,1,nchar(ib)-3), "bed"))
        }
        # begin to set other parameters
        # no other parameters
        # don't forget to return .Object


        .Object
    }
)
setMethod(
    f = "processing",
    signature = "OverlappedRandomRegion",
    definition = function(.Object,...){
        # All arguments are set in .Object
        # so we can get them from .Object
        allparam <- list(...)
        inputBed <- getParam(.Object,"inputBed")
        randomBed <- getParam(.Object,"randomBed")
        outputBed <- getParam(.Object,"outputBed")

        # begin the calculation
        gr1 <- import.bed(con = inputBed)
        gr2 <- import.bed(con = randomBed)
        gr <- second(findOverlapPairs(gr1,gr2))
        export.bed(gr,con = outputBed)
        # don't forget to return .Object
        .Object
    }
)


setMethod(
    f = "genReport",
    signature = "OverlappedRandomRegion",
    definition = function(.Object, ...){
        .Object
    }
)




# This function is exported in NAMESPACE for user to use
overlappedRandomRegion <- function(inputBed, randomBed,
                                   outputBed = NULL, ...){
    allpara <- c(list(Class = "OverlappedRandomRegion",
        prevSteps = list()),as.list(environment()),list(...))
    step <- do.call(new,allpara)
    invisible(step)
}

setGeneric("runOverlappedRandomRegion",
           function(prevStep,
                    inputBed,
                    randomBed = NULL,
                    outputBed = NULL,
                    ...) standardGeneric("runOverlappedRandomRegion"))



setMethod(
    f = "runOverlappedRandomRegion",
    signature = "Step",
    definition = function(prevStep,
                          inputBed,
                          randomBed = NULL,
                          outputBed = NULL,
                          ...){
        allpara <- c(list(Class = "OverlappedRandomRegion",
            prevSteps = list(prevStep)),as.list(environment()),list(...))
        step <- do.call(new,allpara)
        invisible(step)
    }
)

# add to graph
addEdges(edges = c("RandomRegionOnGenome","OverlappedRandomRegion"),
         argOrder = 1)
# begin to test pipeline
setGenome("hg19")
# generate test BED file
test_bed <- file.path(tempdir(),"test.bed")
library(rtracklayer)
export.bed(GRanges("chr7:1-127473000"),test_bed)


rd <- randomRegionOnGenome(10000)
overlap <- runOverlappedRandomRegion(rd, inputBed = test_bed)

randombed <- getParam(rd,"outputBed")

randombed

overlap1 <-
    overlappedRandomRegion(inputBed = test_bed, randomBed = randombed)

clearStepCache(overlap1)
overlap1 <-
    overlappedRandomRegion(inputBed = test_bed, randomBed = randombed)
clearStepCache(rd)
clearStepCache(overlap1)
rd <- randomRegionOnGenome(10000) %>%
runOverlappedRandomRegion(inputBed = test_bed)

stepName(rd)
stepID(rd)


isReady(rd)

[Package pipeFrame version 1.10.0 Index]