R/model-class.R
In BussemakerLab/SelexGLM: Functions for performing feature-based analyis of SELEX-seq data using generalized linear models
#' @include model-validity.R
#' @include N-class.R
#' @include Shape-class.R
#' @include Intercept-class.R
#' @include featureSet-class.R
#' @include generic-functions-definitions.R
#' @include dnaSequenceTools.R
#' @include buildRawRegressionFormula.R
NULL
#' Class \linkS4class{model} for SelexGLM
#'
#' An S4 class to represent model object to store library design, model design, and model parameters for a SelexGLM project.
#'
#' @slot name Name to be associated with the model object. If unspecified, empty string is assigned by default.
#' @slot varRegLen Length of the library design for the selex data.
#' @slot leftFixedSeq Fixed sequence to the left of random library in library design.
#' @slot rightFixedSeq Fixed sequence to the right of random library in library design.
#' @slot seedLen Length of k-mer used to seed the regression. If unspecified, empty numeric value is assigned by default.
#' @slot consensusSeq Optional regular expression input specifying consensus sequence to be used to determine the seed sequence for building a PSAM from the k-mer table used to seed the analysis. If "consensusSeq" is input in iupac notation, it is converted to a standard regular expression during initialization of model object.
#' @slot leftFixedSeqOverlap Number of bp into the left fixed flank to be considered in analysis. If unspecified, 0 is assigned by default.
#' @slot rightFixedSeqOverlap Number of bp into the right fixed flank to be considered in analysis. If unspecified, \code{rightFixedSeqOverlap} is set to \code{leftFixedSeqOverlap} by default.
#' @slot affinityType name of affinity variable in k-mer table to be used in building the seeding PSAM. If no value is specified, affinityType = 'Affinity'.
#' @slot numViews number of distinct views of length k contained in each strand. Must be equal to leftFixedSeqOverlap+varRegLen+rightFixedSeqOverlap.
#' @slot rounds list of length 1 with rounds[[1]] equal to a vector containing the rounds of data to be fit.
#' @slot confidenceLevel view confidence level cutoff required for probes used in glm fit.
#' @slot minAffinity minimum view affinity required for probes used in glm fit.
#' @slot missingValueSuppression difference in ddG between the lowest fit beta values and estimates of betas for features that do not occur in the design matrix passed to glm fit.
#' @slot minSeedValue minimum value for mono-nucleotide affinities specified in initial seeding PSAM. If no value is specified explicitly, minSeedValue = 0.
#' @slot regressionFormula regression formula ('character' class) specifying the feature design of the 'model' object.
#' @slot iteration number of glm iterations performed.
#' @slot upFootprintExtend number of upstream base pairs to consider beyond the seed.
#' @slot downFootprintExtend number of downstream base pairs to consider beyond the seed.
#' @slot rcSymmetric boolean indicating whether of not a reverse complement symmetric model should be fit.
#' @slot includeDNAstrand boolean indicating whether or not a strand orientation specific offset should be included in the 'model' fit. If includeView == TRUE, includeDNAstrand is ignored.
#' @slot includeView boolean indicating whether or not a view+strand orientation specific offset should be included in the 'model' fit. If includeView == TRUE and rcSymmetric == TRUE, view offsets will be fit for only one of the two DNA strand orientations.
#' @slot includeShape boolean indicating whether or not shape coefficients should be included in the 'model' fit.
#' @slot useFixedValuesOffset.N logical: use initial, fixed values for mononucleotide positions within the model footprint, but not in N.set, as an offset to glm fit.
#' @slot useFixedValuesOffset.Shape logical: use initial, fixed values for shape positions within the model footprint, but not in Shape.set, as an offset to glm fit.
#' @slot exUpBases number of bases upstream of the mono-nucleotide position required to describe shape at the same position. If no value is specified explicitly, exUpBases = 2.
#' @slot exDownBases number of bases downstream of the mono-nucleotide position required to describe shape at the same position. If no value is specified explicitly, exDownBases = 2.
#' @slot fpLen footprint length of model. Must be fpLen = upFootprintExtend+seedLen+downFootprintExtend.
#' @slot shapeParamsUsed list of length one contaning a vector of shape features to be included in 'model'. Only used if includeShape == TRUE.
#' @slot shapeTable table of shape parameters to be used as predictors. Only used if includeShape == TRUE.
#' @slot features object of class 'featureSet' containing specifics of model design and values for model parameters.
#' @slot verbose logical: indicates whether to use verbose options in \pkg{SelexGLM} functions.
#' @slot dateInitialized Character string generated by date() at the time when the object of class 'model' is created.
#' @slot dateBetasLastAdded Character string generated by date() at the time when the object of class 'model' was last changed to incorporate new beta values.
#' @slot dateLastModified Character string generated by date() at the time when the object of class 'model' was changed using any of the methods associated with it.
#' @export model
model <- setClass("model",
representation(name = "character",
varRegLen = "numeric",
leftFixedSeq = "character",
rightFixedSeq = "character",
seedLen = "numeric",
consensusSeq = "character",
leftFixedSeqOverlap = "numeric",
rightFixedSeqOverlap = "numeric",
affinityType = "character",
numViews = "numeric",
rounds = "list",
confidenceLevel = "numeric",
minAffinity = "numeric",
missingValueSuppression = "numeric",
minSeedValue = "numeric",
regressionFormula = "character",
iteration = "numeric",
upFootprintExtend = "numeric",
downFootprintExtend = "numeric",
rcSymmetric = "logical",
includeDNAstrand = "logical",
includeView = "logical",
includeShape = "logical",
useFixedValuesOffset.N = "logical",
useFixedValuesOffset.Shape = "logical",
exUpBases = "numeric",
exDownBases = "numeric",
fpLen = "numeric",
shapeParamsUsed = "list",
shapeTable = "list",
features = "featureSet",
verbose = "logical",
dateInitialized= "character",
dateBetasLastAdded = "character",
dateLastModified = "character"),
validity=validModel)
#' Initialize object of class 'model'
#'
#' Initializes an S4 class to represent full model features
#'
#' @param model Object of class 'model'
#' @export
setMethod("initialize",
"model",
function(.Object,
name,
varRegLen,
leftFixedSeq,
rightFixedSeq,
seedLen,
consensusSeq,
leftFixedSeqOverlap,
rightFixedSeqOverlap,
affinityType,
numViews,
rounds,
confidenceLevel,
minAffinity,
missingValueSuppression,
minSeedValue,
regressionFormula,
iteration,
upFootprintExtend,
downFootprintExtend,
rcSymmetric,
includeDNAstrand,
includeView,
includeShape,
useFixedValuesOffset.N,
useFixedValuesOffset.Shape,
exUpBases,
exDownBases,
fpLen,
shapeParamsUsed,
shapeTable,
features,
verbose,
dateInitialized,
dateBetasLastAdded,
dateLastModified,
N,
Intercept,
Shape,
N.upFootprintExtend,
N.downFootprintExtend,
N.set,
N.values,
N.errors,
N.z,
N.sig,
N.oldValues,
N.oldErrors,
N.oldZ,
N.oldSig,
N.equivMat,
I.values,
I.errors,
I.z,
I.sig,
I.oldValues,
I.oldErrors,
I.oldZ,
I.oldSig,
Shape.upFootprintExtend,
Shape.downFootprintExtend,
Shape.set,
Shape.values,
Shape.errors,
Shape.z,
Shape.sig,
Shape.oldValues,
Shape.oldErrors,
Shape.oldZ,
Shape.oldSig,
Shape.equivMat,
...) {
# rcSymmetric attribute initialized
if (!missing(name)) {
.Object@name <- name
} else {
.Object@name = character(0)
}
if (!missing(varRegLen)) {
.Object@varRegLen <- varRegLen
} else {
stop('varRegLen must be specified')
}
if (!missing(leftFixedSeq)) {
.Object@leftFixedSeq <- leftFixedSeq
} else {
stop('leftFixedSeq must be specified')
}
if (!missing(rightFixedSeq)) {
.Object@rightFixedSeq <- rightFixedSeq
} else {
stop('rightFixedSeq must be specified')
}
# seedLen attribute initialized
if (!missing(seedLen)) {
.Object@seedLen = seedLen
} else if (!missing(consensusSeq)) {
if (length(consensusSeq) > 0) {
.Object@seedLen = countDNAseqLength(consensusSeq)
}
} else {
stop('no value specified for "seedLen" or consensusSeq.')
}
# consensusSeq attribute initialized
if (!missing(consensusSeq)) {
if (length(consensusSeq) > 0) {
.Object@consensusSeq = convertSeq2RegEx(consensusSeq)
} else {
.Object@consensusSeq = paste("[ACGT]{", .Object@seedLen, "}", sep = "")
}
} else {
.Object@consensusSeq = paste("[ACGT]{", .Object@seedLen, "}", sep = "")
}
# leftFixedSeqOverlap attribute initialized
if (!missing(leftFixedSeqOverlap)) {
.Object@leftFixedSeqOverlap = leftFixedSeqOverlap
} else {
.Object@leftFixedSeqOverlap = 0
message('no value specified for "leftFixedSeqOverlap"; set to default value: leftFixedSeqOverlap = 0')
}
# rightFixedSeqOverlap attribute initialized
if (!missing(rightFixedSeqOverlap)) {
.Object@rightFixedSeqOverlap = rightFixedSeqOverlap
} else {
.Object@rightFixedSeqOverlap = .Object@leftFixedSeqOverlap
}
# affinityType attribute initialized
if (!missing(affinityType)) {
.Object@affinityType = affinityType
} else {
.Object@affinityType= "Affinity"
}
# rounds attribute initialized
if (!missing(rounds)) {
if (length(rounds) != 1) {
stop('"rounds" must be a list of length 1. rounds[[1]] should be a vector of any length containing shape parameters to be used.')
}
.Object@rounds = rounds
} else {
stop('"rounds" must be specified.')
}
.Object@rounds[[1]] = .Object@rounds[[1]][order(.Object@rounds[[1]])]
# confidenceLevel attribute initialized
if (!missing(confidenceLevel)) {
.Object@confidenceLevel = confidenceLevel
} else {
.Object@confidenceLevel= .95
message('no value specified for "confidenceLevel"; set to default value: confidenceLevel = .95')
}
# minAffinity attribute initialized
if (!missing(minAffinity)) {
.Object@minAffinity = minAffinity
} else {
.Object@minAffinity = 0
message('no value specified for "minAffinity"; set to default value: minAffinity = 0')
}
# missingValueSuppression attribute initialized
if (!missing(missingValueSuppression)) {
.Object@missingValueSuppression = missingValueSuppression
} else {
.Object@missingValueSuppression = 1
message('no value specified for "missingValueSuppression"; set to default value: missingValueSuppression = 1')
}
# minSeedValue attribute initialized
if (!missing(minSeedValue)) {
.Object@minSeedValue = minSeedValue
} else {
.Object@minSeedValue= 0
message('no value specified for "minSeedValue"; set to default value: minSeedValue = 0')
}
#regression formula attribute initialized
if (!missing(regressionFormula)) {
stop('"regressionFormula" cannot be specified directly. The "regression" formula slot will be automatically generated to reflect the feature design-related slots.')
}
# iteration attribute initialized
if (!missing(iteration)) {
.Object@iteration = iteration
} else {
.Object@iteration = 0
}
# upFootprintExtend attribute initialized
if (!missing(upFootprintExtend)) {
.Object@upFootprintExtend = upFootprintExtend
} else {
.Object@upFootprintExtend = 0
}
# downFootprintExtend attribute initialized
if (!missing(downFootprintExtend)) {
.Object@downFootprintExtend = downFootprintExtend
} else {
.Object@downFootprintExtend = upFootprintExtend
}
# fpLen attribute initialized
if (!missing(fpLen)) {
message('value specified for "fpLen" will be overridden if inconsistent with fpLen = seedLen+upFootprintExtend+downFootprintExtend')
}
.Object@fpLen = .Object@seedLen+.Object@upFootprintExtend+.Object@downFootprintExtend
if (.Object@fpLen > .Object@leftFixedSeqOverlap+.Object@varRegLen+.Object@rightFixedSeqOverlap) {
stop("Can't choose upFootprintExtend, downFootprintExtend, and seedLen such that fpLen > varRegLen+leftFixedSeqOverlap+rightFixedSeqOverlap")
}
# numViews attribute initialized
if (!missing(numViews)) {
message('value specified for "numViews" will be overridden if inconsistent with numViews = varRegLen+leftFixedSeqOverlap+rightFixedSeqOverlap-fpLen+1')
}
.Object@numViews = .Object@varRegLen+.Object@leftFixedSeqOverlap+.Object@rightFixedSeqOverlap-.Object@fpLen+1
if (.Object@numViews < 1) {
stop("'numViews' must be a positive number. Choose shorter fpLen or use more of fixed flanking region such that the footprint of the model fits within the DNA sequence under consideration.")
}
# rcSymmetric attribute initialized
if (!missing(rcSymmetric)) {
.Object@rcSymmetric = rcSymmetric
} else {
.Object@rcSymmetric = FALSE
message('no value specified for "rcSymmetric"; set to default value: rcSymmetric = FALSE')
}
#includeDNAstrand attribute initialized
if (!missing(includeDNAstrand)) {
if ((.Object@rcSymmetric == TRUE) & (includeDNAstrand == TRUE)) {
stop('"rcSymmetric" and "includeDNAstrand" cannot both be TRUE for the same "model" object.')
}
.Object@includeDNAstrand = includeDNAstrand
} else {
.Object@includeDNAstrand = FALSE
}
#includeView attribute initialized
if (!missing(includeView)) {
.Object@includeView = includeView
if ((.Object@includeView == TRUE) & (.Object@includeDNAstrand == TRUE)) {
message("includeDNAstrand & includeView can't both be true. Setting includeDNAstrand = FALSE.")
.Object@includeDNAstrand = FALSE
}
} else {
.Object@includeView = FALSE
}
# includeShape attribute initialized
if (!missing(includeShape)) {
.Object@includeShape= includeShape
} else {
.Object@includeShape = FALSE
}
# useFixedValuesOffset.N attribute initialized
if (!missing(useFixedValuesOffset.N)) {
.Object@useFixedValuesOffset.N= useFixedValuesOffset.N
} else {
.Object@useFixedValuesOffset.N= FALSE
}
# useFixedValuesOffset.Shape attribute initialized
if (!missing(useFixedValuesOffset.Shape)) {
.Object@useFixedValuesOffset.Shape= useFixedValuesOffset.Shape
} else {
.Object@useFixedValuesOffset.Shape= FALSE
}
# exUpBases attribute initialized
if (!missing(exUpBases)) {
.Object@exUpBases = exUpBases
} else {
.Object@exUpBases = 2
}
# exDownBases attribute initialized
if (!missing(exDownBases)) {
.Object@exDownBases = exDownBases
} else {
.Object@exDownBases = 2
}
# shapeParamsUsed attribute initialized
if (!missing(shapeParamsUsed)) {
if (!is.list(shapeParamsUsed)) {
stop('"shapeParamsUsed" must be a list of length 1. shapeParamsUsed[[1]] should be a vector of any length containing shape parameters to be used.')
}
if (length(shapeParamsUsed) != 1) {
stop('"shapeParamsUsed" must be a list of length 1. shapeParamsUsed[[1]] should be a vector of any length containing shape parameters to be used.')
}
if (!missing(includeShape)) {
if (includeShape == FALSE) {
if (length(shapeParamsUsed[[1]]) != 0) {
stop("If 'includeShape' is FALSE, 'shapeParamsUsed' should equal list(c(character(0)).")
}
} else {
if (length(shapeParamsUsed) != 1) {
stop("If 'includeShape' is TRUE, 'shapeParamsUsed' must be a list of length 1, with shapeParamsUsed[[1]] of length >= 1.")
}
}
} else {
if (length(shapeParamsUsed[[1]]) != 0) {
stop("If 'includeShape' is FALSE, 'shapeParamsUsed' should equal list(c(character(0)).")
}
}
.Object@shapeParamsUsed = shapeParamsUsed
.Object@shapeParamsUsed[[1]] = .Object@shapeParamsUsed[[1]][order(.Object@shapeParamsUsed[[1]])]
} else {
if (!missing(includeShape)) {
if (includeShape == TRUE) {
stop("For includeShape == TRUE, must initialize shapeParamsUsed as a list of length 1 containing a vector with at least one of the following c('HelT', 'MGW', 'ProT', 'Roll').")
} else {
.Object@shapeParamsUsed = list(c(character(0)))
}
} else {
.Object@shapeParamsUsed = list(c(character(0)))
}
}
# shapeTable attribute initialized
if (!missing(shapeTable)) {
.Object@shapeTable= shapeTable
} else {
if (.Object@includeShape == TRUE) {
stop('If "includeShape" is TRUE, must specify a shapeTable.')
}
}
# verbose attribute initialized
if (!missing(verbose)) {
.Object@verbose = verbose
} else {
.Object@verbose = FALSE
}
# initialize features slot
if (!missing(features)) {
if (features@seedLen != .Object@seedLen) {
stop('features@seedLen is not consistent with "seedLen" slot.')
}
if (features@upFootprintExtend != .Object@upFootprintExtend) {
stop('features@upFootprintExtend is not consistent with "upFootprintExtend" slot.')
}
if (features@downFootprintExtend != .Object@downFootprintExtend) {
stop('features@downFootprintExtend is not consistent with "downFootprintExtend" slot.')
}
if (features@numViews != .Object@numViews) {
stop('features@numViews is not consistent with "numViews" slot.')
}
if (!all(features@rounds[[1]][order(features@rounds[[1]])] == .Object@rounds[[1]][order(.Object@rounds[[1]])])) {
stop('features@rounds is not consistent with "rounds" slot.')
}
if (features@rcSymmetric != .Object@rcSymmetric) {
stop('features@rcSymmetric is not consistent with "rcSymmetric" slot.')
}
if (length(features@shapeParamsUsed[[1]]) != 0) {
if (length(features@shapeParamsUsed[[1]]) == length(.Object@shapeParamsUsed[[1]])) {
if (!all(features@shapeParamsUsed[[1]][order(features@shapeParamsUsed[[1]])] == .Object@shapeParamsUsed[[1]][order(.Object@shapeParamsUsed[[1]])])) {
stop('features@shapeParamsUsed is not consistent with "shapeParamsUsed" slot.')
}
} else {
stop('features@shapeParamsUsed is not consistent with "shapeParamsUsed" slot.')
}
} else if (length(.Object@shapeParamsUsed[[1]]) != 0) {
stop('features@shapeParamsUsed is not consistent with "shapeParamsUsed" slot.')
}
.Object@features = featureSet(seedLen = features@seedLen,
upFootprintExtend = features@upFootprintExtend,
downFootprintExtend = features@downFootprintExtend,
numViews = features@numViews,
rounds = features@rounds,
shapeParamsUsed = features@shapeParamsUsed,
rcSymmetric = features@rcSymmetric,
N = features@N,
Intercept = features@Intercept,
Shape = features@Shape)
if ((!missing(N)) | (!missing(Shape))| (!missing(Intercept))| (!missing(Shape.upFootprintExtend))|
(!missing(Shape.downFootprintExtend))| (!missing(Shape.set))| (!missing(Shape.values))| (!missing(Shape.errors))|
(!missing(Shape.z))| (!missing(Shape.sig))| (!missing(Shape.oldValues))| (!missing(Shape.oldErrors))| (!missing(Shape.oldZ))|
(!missing(Shape.oldSig))| (!missing(Shape.equivMat))| (!missing(I.values)) | (!missing(I.errors)) | (!missing(I.z))|
(!missing(I.sig))|(!missing(I.oldValues))|(!missing(I.oldErrors))|(!missing(I.oldZ))|(!missing(I.oldSig))|
(!missing(N.upFootprintExtend))|(!missing(N.downFootprintExtend))|(!missing(N.values))|(!missing(N.errors))|(!missing(N.z))|
(!missing(N.sig))|(!missing(N.oldValues))|(!missing(N.oldErrors))|(!missing(N.oldZ))|(!missing(N.oldSig))|(!missing(N.equivMat))) {
stop('If "features" slot is specified, "N", "Shape", "Intercept", and all of the slots for these objects cannot be specified.')
}
} else {
fArgs = c(list("featureSet",
seedLen = .Object@seedLen,
upFootprintExtend = .Object@upFootprintExtend,
downFootprintExtend = .Object@downFootprintExtend,
numViews = .Object@numViews,
rounds = .Object@rounds,
rcSymmetric = .Object@rcSymmetric,
shapeParamsUsed = .Object@shapeParamsUsed))
if (!missing(N)) {fArgs = append(fArgs, list(N = N))}
if (!(missing(N.upFootprintExtend))) {fArgs = append(fArgs, list(N.upFootprintExtend = N.upFootprintExtend))}
if (!(missing(N.downFootprintExtend))) {fArgs = append(fArgs, list(N.downFootprintExtend = N.downFootprintExtend))}
if (!(missing(N.set))) {fArgs = append(fArgs, list(N.set = N.set))}
if (!(missing(N.equivMat))) {fArgs = append(fArgs, list(N.equivMat = N.equivMat))}
if (!(missing(N.values))) {fArgs = append(fArgs, list(N.values = N.values))}
if (!(missing(N.errors))) {fArgs = append(fArgs, list(N.errors = N.errors))}
if (!(missing(N.z))) {fArgs = append(fArgs, list(N.z = N.z))}
if (!(missing(N.sig))) {fArgs = append(fArgs, list(N.sig = N.sig))}
if (!(missing(N.oldValues))) {fArgs = append(fArgs, list(N.oldValues = N.oldValues))}
if (!(missing(N.oldErrors))) {fArgs = append(fArgs, list(N.oldErrors = N.oldErrors))}
if (!(missing(N.oldZ))) {fArgs = append(fArgs, list(N.oldZ = N.oldZ))}
if (!(missing(N.oldSig))) {fArgs = append(fArgs, list(N.oldSig = N.oldSig))}
if (.Object@includeShape == FALSE) {
if (!missing(Shape)) {stop("'Shape' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.upFootprintExtend))) {stop("'Shape.upFootprintExtend' should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.upFootprintExtend' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.downFootprintExtend))) {stop("'Shape.downFootprintExtend' should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.downFootprintExtend' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.set))) {stop("'Shape.set' should not be included as an input to model() when 'includeShape' == FALSE. Remove 'Shape.set' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.equivMat))) {stop("'Shape.equivMat' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.equivMat' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.values))) {stop("'Shape.values' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.values' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.errors))) {stop("'Shape.errors' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.errors' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.z))) {stop("'Shape.z' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.z' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.sig))) {stop("'Shape.sig' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.sig' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldValues))) {stop("'Shape.oldValues' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldValues' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldErrors))) {stop("'Shape.oldErrors' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldErrors' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldZ))) {stop("'Shape.oldZ' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldZ' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldSig))) {stop("'Shape.oldSig' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldSig' from function input or add 'includeShape' == TRUE.")}
} else {
if (!missing(Shape)) {fArgs = append(fArgs, list(Shape = Shape))}
if (!(missing(Shape.upFootprintExtend))) {fArgs = append(fArgs, list(Shape.upFootprintExtend = Shape.upFootprintExtend))}
if (!(missing(Shape.downFootprintExtend))) {fArgs = append(fArgs, list(Shape.downFootprintExtend = Shape.downFootprintExtend))}
if (!(missing(Shape.set))) {fArgs = append(fArgs, list(Shape.set = Shape.set))}
if (!(missing(Shape.equivMat))) {fArgs = append(fArgs, list(Shape.equivMat = Shape.equivMat))}
if (!(missing(Shape.values))) {fArgs = append(fArgs, list(Shape.values = Shape.values))}
if (!(missing(Shape.errors))) {fArgs = append(fArgs, list(Shape.errors = Shape.errors))}
if (!(missing(Shape.z))) {fArgs = append(fArgs, list(Shape.z = Shape.z))}
if (!(missing(Shape.sig))) {fArgs = append(fArgs, list(Shape.sig = Shape.sig))}
if (!(missing(Shape.oldValues))) {fArgs = append(fArgs, list(Shape.oldValues = Shape.oldValues))}
if (!(missing(Shape.oldErrors))) {fArgs = append(fArgs, list(Shape.oldErrors = Shape.oldErrors))}
if (!(missing(Shape.oldZ))) {fArgs = append(fArgs, list(Shape.oldZ = Shape.oldZ))}
if (!(missing(Shape.oldSig))) {fArgs = append(fArgs, list(Shape.oldSig = Shape.oldSig))}
}
if (!missing(Intercept)) {fArgs = append(fArgs, list(Intercept = Intercept))}
if (!(missing(I.values))) {fArgs = append(fArgs, list(I.values = I.values))}
if (!(missing(I.errors))) {fArgs = append(fArgs, list(I.errors = I.errors))}
if (!(missing(I.z))) {fArgs = append(fArgs, list(I.z = I.z))}
if (!(missing(I.sig))) {fArgs = append(fArgs, list(I.sig = I.sig))}
if (!(missing(I.oldValues))) {fArgs = append(fArgs, list(I.oldValues = I.oldValues))}
if (!(missing(I.oldErrors))) {fArgs = append(fArgs, list(I.oldErrors = I.oldErrors))}
if (!(missing(I.oldZ))) {fArgs = append(fArgs, list(I.oldZ = I.oldZ))}
if (!(missing(I.oldSig))) {fArgs = append(fArgs, list(I.oldSig = I.oldSig))}
.Object@features = do.call("new", fArgs)
}
if ((.Object@useFixedValuesOffset.N == TRUE) & (all(c(1:.Object@fpLen) %in% .Object@features@N@N.set))) {
message('Input for useFixedValuesOffset.N = TRUE, but N.set includes all positions of the model. Setting useFixedValuesOffset.N = FALSE.')
.Object@useFixedValuesOffset.N = FALSE
}
if ((.Object@useFixedValuesOffset.Shape == TRUE) & (all(c(1:.Object@fpLen) %in% .Object@features@Shape@Shape.set))) {
message('Input for useFixedValuesOffset.Shape = TRUE, but Shape.set includes all positions of the model. Setting useFixedValuesOffset.Shape = FALSE.')
.Object@useFixedValuesOffset.Shape = FALSE
}
.Object@regressionFormula = buildRawRegressionFormula(.Object)
validObject(.Object)
.Object@dateInitialized = date()
.Object
}
)
#' Get Name Slot.
#'
#' Gets 'name' slot from object of class \linkS4class{model}.
#'
#' @param object object of class 'model'
#' @export
setMethod(
f = "getName",
signature = "model",
definition = function(object) {
return(object@name)
}
)
#' Sets name slot.
#'
#' Sets 'name' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'name' slot from \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setName",
signature = "model",
definition = function(object, value) {
object@name <- value
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Variable Region Length
#'
#' Gets 'varRegLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getVarRegLen",
signature = "model",
definition = function(object) {
return(object@varRegLen)
}
)
#
#' Set Variable Region Length.
#'
#' Sets 'varRegLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}
#' @param value 'varRegLen' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setVarRegLen",
signature = "model",
definition = function(object, value) {
object@varRegLen <- value
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@varRegLen <- value
object@numViews = object@varRegLen+object@leftFixedSeqOverlap+object@rightFixedSeqOverlap-object@fpLen+1
object@features@numViews = object@numViews
object@features@Intercept = new("Intercept", numViews = object@numViews, rounds = object@rounds)
} else {
stop('Cannot reset varRegLen after fitting Intercept parameters.')
}
} else {
stop('Cannot reset varRegLen after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Left Fixed Sequence
#'
#' Gets 'leftFixedSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getLeftFixedSeq",
signature = "model",
definition = function(object) {
return(object@leftFixedSeq)
}
)
#' Set Left Fixed Sequence
#'
#' Sets 'leftFixedSeq' slot for object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'leftFixedSeq' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setLeftFixedSeq",
signature = "model",
definition = function(object, value) {
object@leftFixedSeq <- value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Right Fixed Sequence
#'
#' Gets 'rightFixedSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRightFixedSeq",
signature = "model",
definition = function(object) {
return(object@rightFixedSeq)
}
)
#' Set Right Fixed Sequence
#'
#' Sets 'rightFixedSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'rightFixedSeq' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRightFixedSeq",
signature = "model",
definition = function(object, value) {
object@rightFixedSeq <- value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Seed Length
#'
#' Gets 'seedLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getSeedLen",
signature = "model",
definition = function(object) {
return(object@seedLen)
}
)
#
#' Set Seed Length
#'
#' Sets 'seedLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'seedLen' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setSeedLen",
signature = "model",
definition = function(object, value) {
object@seedLen <- value
if (object@iteration == 0) {
if (dim(getOldValues(object@features@N))[3] == 0) {
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = object@features@N@fS.upFootprintExtend,
fS.downFootprintExtend = object@features@N@fS.downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
} else {
stop('Cannot reset seedLen after adding non-zero N parameters.')
}
}else {
stop('Cannot reset seedLen after adding non-zero N parameters.')
}
if (all(getValues(object@features@Shape) == 0)) {
if (dim(getOldValues(object@features@Shape))[3] == 0) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = object@features@Shape@fS.upFootprintExtend,
fS.downFootprintExtend = object@features@Shape@fS.downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
} else {
stop('Cannot reset seedLen after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset seedLen after adding non-zero Shape parameters.')
}
oldSeqLen = countDNAseqLength(convertSeq2RegEx(object@consensusSeq))
if (object@seedLen != oldSeqLen) {
if (object@consensusSeq != paste("[ACGT]{", oldSeqLen, "}", sep = "")) {
stop("New 'seedLen' does not match 'consensusSeq'.")
} else {
object@consensusSeq = paste("[ACGT]{", object@seedLen, "}", sep = "")
}
}
object@fpLen = object@upFootprintExtend+object@downFootprintExtend+object@seedLen
object@numViews = object@leftFixedSeqOverlap+object@rightFixedSeqOverlap+object@varRegLen-object@fpLen+1
object@features@seedLen = object@seedLen
object@features@numViews = object@numViews
} else {
stop('Cannot reset varRegLen after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Left Fixed Sequence Overlap
#'
#' Gets 'leftFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getLeftFixedSeqOverlap",
signature = "model",
definition = function(object) {
return(object@leftFixedSeqOverlap)
}
)
#' Set Left Fixed Sequence Overlap
#'
#' Sets 'leftFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'leftFixedSeqOverlap' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setLeftFixedSeqOverlap",
signature = "model",
definition = function(object, value) {
object@leftFixedSeqOverlap <- value
object@numViews = object@varRegLen+object@leftFixedSeqOverlap+object@rightFixedSeqOverlap-object@fpLen+1
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@numViews = object@numViews
object@features@Intercept = new("Intercept", numViews = object@numViews, rounds = object@rounds)
} else {
stop('Cannot reset leftFixedSeqOverlap after fitting Intercept parameters.')
}
} else {
stop('Cannot reset leftFixedSeqOverlap after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Right Fixed Sequence Overlap
#'
#' Gets 'rightFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRightFixedSeqOverlap",
signature = "model",
definition = function(object) {
return(object@rightFixedSeqOverlap)
}
)
#' Set Right Fixed Sequence Overlap
#'
#' Sets 'rightFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'rightFixedSeqOverlap' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRightFixedSeqOverlap",
signature = "model",
definition = function(object, value) {
object@rightFixedSeqOverlap <- value
object@numViews = object@varRegLen+object@leftFixedSeqOverlap+object@rightFixedSeqOverlap-object@fpLen+1
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@numViews = object@numViews
object@features@Intercept = new("Intercept", numViews = object@numViews, rounds = object@rounds)
} else {
stop('Cannot reset rightFixedSeqOverlap after fitting Intercept parameters.')
}
} else {
stop('Cannot reset rightFixedSeqOverlap after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Consensus Sequence
#'
#' Gets 'consensusSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getConsensusSeq",
signature = "model",
definition = function(object) {
return(object@consensusSeq)
}
)
#
#' Set Consensus Sequence
#'
#' Sets 'consensusSeq' slot for object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'consensusSeq' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setConsensusSeq",
signature = "model",
definition = function(object, value) {
value = convertSeq2RegEx(value)
if (object@seedLen != countDNAseqLength(value)) {
stop("New 'consensusSeq' is not the same length as seedLen.")
}
if (object@iteration == 0) {
if (all(getValues(object@features@N) == 0)) {
object@consensusSeq <- value
} else {
stop('Cannot reset consensusSeq after adding non-zero N parameters.')
}
} else {
stop('Cannot reset consensusSeq after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Affinity Type
#'
#' Gets 'affinityType' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getAffinityType",
signature = "model",
definition = function(object) {
return(object@affinityType)
}
)
#
#' Set Affinity Type
#'
#' Sets 'affinityType' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'affinityType' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setAffinityType",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@N) == 0)) {
object@affinityType <- value
} else {
stop('Cannot reset "affinityType" after adding non-zero N parameters.')
}
} else {
stop('Cannot reset "affinityType" after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Number of Views per Strand
#'
#' Gets 'numViews' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getNumViews",
signature = "model",
definition = function(object) {
return(object@numViews)
}
)
#' Set Number of Views per Strand
#'
#' Sets 'numViews' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'numViews' slot for \linkS4class{model} object
#' @export
setReplaceMethod(
f = "setNumViews",
signature = "model",
definition = function(object, value) {
stop('Cannot set "numViews" directly--change seedLen, upFootprintExtend, downFootprintExtend, leftFixedSeqOverlap, rightFixedSeqOverlap, or varRegLen.')
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Rounds
#'
#' Gets 'rounds' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRounds",
signature = "model",
definition = function(object) {
return(object@rounds)
}
)
#
#' Set Rounds
#'
#' Sets 'rounds' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}
#' @param value 'rounds' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRounds",
signature = "model",
definition = function(object, value) {
if (length(value) != 1) {
stop("New 'rounds' slot must be a list of length one.")
} else {
if (length(value[[1]]) <= 0) {
stop("New 'rounds' slot must be a list of length one, where the list has at least one entry.")
}
}
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@rounds <- value
object@features@rounds <- object@rounds
object@features@Intercept <- new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset rounds after fitting Intercept parameters.')
}
} else {
stop('Cannot reset rounds after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Confidence Level
#'
#' Gets 'confidenceLevel' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getConfidenceLevel",
signature = "model",
definition = function(object) {
return(object@confidenceLevel)
}
)
#
#' Set Confidence Level
#'
#' Sets 'confidenceLevel' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'confidenceLevel' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setConfidenceLevel",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@confidenceLevel <- value
} else {
stop('Cannot reset confidenceLevel after fitting beta parameters.')
}
} else {
stop('Cannot reset confidenceLevel after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Minimum Affinity
#'
#' Gets 'minAffinity' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getMinAffinity",
signature = "model",
definition = function(object) {
return(object@minAffinity)
}
)
#
#' Set Minimum Affinity
#'
#' Sets 'minAffinity' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'minAffinity' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setMinAffinity",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@minAffinity <- value
} else {
stop('Cannot reset minAffinity after fitting beta parameters.')
}
} else {
stop('Cannot reset minAffinity after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Missing Value Suppression Factor
#'
#' Gets 'missingValueSuppression' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getMissingValueSuppression",
signature = "model",
definition = function(object) {
return(object@missingValueSuppression)
}
)
#' Set Missing Value Suppression Factor
#'
#' Sets 'missingValueSuppression' slot from object of class \linkS4class{model}.
#'
#' @param object object of class \linkS4class{model}.
#' @param value 'missingValueSuppression' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setMissingValueSuppression",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@missingValueSuppression <- value
} else {
stop('Cannot reset missingValueSuppression after fitting beta parameters.')
}
} else {
stop('Cannot reset missingValueSuppression after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Minimum Seed Value
#'
#' Gets 'minSeedValue' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getMinSeedValue",
signature = "model",
definition = function(object) {
return(object@minSeedValue)
}
)
#
#' Set Minimum Seed Value
#'
#' Sets 'minSeedValue' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'minSeedValue' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setMinSeedValue",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@N) == 0)) {
object@minSeedValue <- value
} else {
stop('Cannot reset minSeedValue after "N" seed is already set.')
}
} else {
stop('Cannot reset minSeedValue after "N" seed is already set.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Regression Formula
#'
#' Gets 'regressionFormula' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRegressionFormula",
signature = "model",
definition = function(object) {
return(object@regressionFormula)
}
)
#' Set Regression Formula
#'
#' Sets 'regressionFormula' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'regressionFormula' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRegressionFormula",
signature = "model",
definition = function(object, value) {
stop('Cannot set "regressionFormula" directly--"regressionFormula" is built automatically from model.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Iteration
#'
#' Gets 'iteration' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIteration",
signature = "model",
definition = function(object) {
return(object@iteration)
}
)
#' Set Iteration
#'
#' Sets 'iteration' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'iteration' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIteration",
signature = "model",
definition = function(object, value) {
stop('Cannot set "iteration" directly--"iteration" is updated automatically when new beta values are added.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length Upstream Footprint Extension
#'
#' Gets 'upFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getUpFootprintExtend",
signature = "model",
definition = function(object) {
return(object@upFootprintExtend)
}
)
#' Set Length Upstream Footprint Extension
#'
#' Sets 'upFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'upFootprintExtend' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setUpFootprintExtend",
signature = "model",
definition = function(object, value) {
object@upFootprintExtend = value
object@features@upFootprintExtend = object@upFootprintExtend
object@fpLen = object@upFootprintExtend+object@downFootprintExtend+object@seedLen
object@numViews = object@leftFixedSeqOverlap+object@rightFixedSeqOverlap+object@varRegLen-object@fpLen+1
object@features@numViews = object@numViews
if (object@iteration == 0) {
if (dim(getOldValues(object@features@N))[3] == 0) {
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = value,
fS.downFootprintExtend = object@features@N@fS.downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = value,
fS.downFootprintExtend = object@features@Shape@fS.downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
if (dim(getOldValues(object@features@Intercept))[4] == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@Intercept = new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length Downstream Footprint Extension
#'
#' Gets 'downFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getDownFootprintExtend",
signature = "model",
definition = function(object) {
return(object@downFootprintExtend)
}
)
#' Set Length Downstream Footprint Extension
#'
#' Sets 'downFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'downFootprintExtend' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setDownFootprintExtend",
signature = "model",
definition = function(object, value) {
object@downFootprintExtend = value
object@features@downFootprintExtend = object@downFootprintExtend
object@fpLen = object@upFootprintExtend+object@downFootprintExtend+object@seedLen
object@numViews = object@leftFixedSeqOverlap+object@rightFixedSeqOverlap+object@varRegLen-object@fpLen+1
object@features@numViews = object@numViews
if (object@iteration == 0) {
if (dim(getOldValues(object@features@N))[3] == 0) {
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
if (dim(getOldValues(object@features@Intercept))[4] == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@Intercept = new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Reverse Complement Symmetric (logical)
#'
#' Gets 'rcSymmetric' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRcSymmetric",
signature = "model",
definition = function(object) {
return(object@rcSymmetric)
}
)
#' Set Reverse Complement Symmetric (logical)
#'
#' Sets 'rcSymmetric' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'rcSymmetric' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRcSymmetric",
signature = "model",
definition = function(object, value) {
if (object@rcSymmetric != value) {
object@rcSymmetric = value
object@features@rcSymmetric = object@rcSymmetric
if (object@iteration != 0) {
stop('Cannot reset rcSymmetric after fitting beta parameters.')
}
if (dim(getOldValues(object@features@N))[3] != 0) {
stop('Cannot reset rcSymmetric after adding non-zero N parameters.')
}
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
} else {
stop('Cannot reset rcSymmetric after adding non-zero N parameters.')
}
if (dim(getOldValues(object@features@Shape))[3] != 0) {
stop('Cannot reset rcSymmetric after adding non-zero Shape parameters.')
}
if (all(getValues(object@features@Shape) == 0)) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
} else {
stop('Cannot reset rcSymmetric after adding non-zero Shape parameters.')
}
if (dim(getOldValues(object@features@Intercept))[4] != 0) {
stop('Cannot reset rcSymmetric after adding non-zero Intercept parameters.')
}
if (all(getValues(object@features@Intercept) == 0)) {
object@features@Intercept = new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset rcSymmetric after adding non-zero Intercept parameters.')
}
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get includeDNAstrand (logical)
#'
#' Gets 'includeDNAstrand' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIncludeDNAstrand",
signature = "model",
definition = function(object) {
return(object@includeDNAstrand)
}
)
#
#' Set includeDNAstrand (logical)
#'
#' Sets 'includeDNAstrand' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'includeDNAstrand' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIncludeDNAstrand",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
if ((object@includeView == FALSE) | (value == FALSE)) {
object@includeDNAstrand <- value
} else {
stop("If 'includeView' is TRUE, 'includeDNAstrand' is necessarily false. To chance 'includeDNAstrand' to TRUE, first change 'includeView' to FALSE.")
}
} else {
stop('Cannot reset includeDNAstrand after "Intercept" seed is already set.')
}
} else {
stop('Cannot reset includeDNAstrand after "Intercept" seed is already set.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get includeView (logical)
#'
#' Gets 'includeView' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIncludeView",
signature = "model",
definition = function(object) {
return(object@includeView)
}
)
#' Set includeView (logical)
#'
#' Sets 'includeView' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'includeView' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIncludeView",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@includeView <- value
} else {
stop('Cannot reset includeView after "Intercept" seed is already set.')
}
} else {
stop('Cannot reset includeView after "Intercept" seed is already set.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get includeShape (logical)
#'
#' Gets 'includeShape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIncludeShape",
signature = "model",
definition = function(object) {
return(object@includeShape)
}
)
#' Get useFixedValuesOffset.N (logical)
#'
#' Gets 'useFixedValuesOffset.N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getUseFixedValuesOffset.N",
signature = "model",
definition = function(object) {
return(object@getUseFixedValuesOffset.N)
}
)
#' Get useFixedValuesOffset.Shape (logical)
#'
#' Gets 'useFixedValuesOffset.Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getUseFixedValuesOffset.Shape",
signature = "model",
definition = function(object) {
return(object@getUseFixedValuesOffset.Shape)
}
)
#' Set includeShape (logical)
#'
#' Sets 'includeShape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'includeShape' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIncludeShape",
signature = "model",
definition = function(object, value) {
if ((value == TRUE) & (object@includeShape == FALSE)) {
stop("Cannot set includeShape to TRUE after the model design is set up. Instead, create a new model object with includeShape = TRUE.")
} else if (object@includeShape == FALSE) {
object@regressionFormula = buildRawRegressionFormula(object)
} else {
if (object@iteration == 0) {
if (all(getValues(object@features@Shape) == 0)) {
object@shapeParamsUsed = list(c(character(0)))
object@features@shapeParamsUsed = list(c(character(0)))
shapeArrays = array(0, dim = c(0, object@fpLen, dim(object@features@Shape@Shape.oldValues)[3]),
dimnames = list(NULL, c(1:object@fpLen), dimnames(object@features@Shape@Shape.oldValues)[[3]]))
nShape <- Shape(seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
shapeParamsUsed = object@shapeParamsUsed,
rcSymmetric = object@rcSymmetric,
Shape.oldValues = shapeArrays,
Shape.oldErrors = shapeArrays,
Shape.oldZ = shapeArrays,
Shape.oldSig = shapeArrays)
if (object@seedLen != nShape@seedLen) {
stop('Current and replacement versions of Shape slot must have the same seed length.')
}
if (object@upFootprintExtend != nShape@fS.upFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.upFootprintExtend.')
}
if (object@downFootprintExtend != nShape@fS.downFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.downFootprintExtend.')
}
if (!all(c(ncol(getValues(nShape)),ncol(getErrors(nShape)), ncol(getZ(nShape)), ncol(getSig(nShape)), ncol(getOldValues(nShape)),
ncol(getOldErrors(nShape)), ncol(getOldZ(nShape)), ncol(getOldSig(nShape))) == object@fpLen)) {
stop("All beta related slots in new 'Shape' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
if (!all(c(nrow(getValues(nShape)),nrow(getErrors(nShape)), nrow(getZ(nShape)), nrow(getSig(nShape)), nrow(getOldValues(nShape)),
nrow(getOldErrors(nShape)), nrow(getOldZ(nShape)), nrow(getOldSig(nShape))) == nrow(getOldSig(nShape)))) {
stop("All beta related slots in new 'Shape' must have a number of rows equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
validObject(nShape)
object@features@Shape <- nShape
validObject(object)
object@includeShape = FALSE
} else {
stop('Cannot reset includeShape after "Shape" beta values have been added to the "model" object.')
}
} else {
stop('Cannot reset includeShape after "Shape" beta values have been added to the "model" object.')
}
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set 'useFixedValuesOffset.N' (logical)
#'
#' Sets 'useFixedValuesOffset.N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'useFixedValuesOffset.N'' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setUseFixedValuesOffset.N",
signature = "model",
definition = function(object, value) {
if ((value == TRUE) & (length(object@features@N@N.set) == object@fpLen)) {
stop("Cannot set 'setUseFixedValuesOffset.N'=TRUE if all nucleotide positions within the model footprint are in N.set and aren't fixed.")
}
object@useFixedValuesOffset.N = value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set useFixedValuesOffset.Shape (logical)
#'
#' Sets 'useFixedValuesOffset.Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'useFixedValuesOffset.Shape'' slot for \linkS4class{model} object
#' @export
setReplaceMethod(
f = "setUseFixedValuesOffset.Shape",
signature = "model",
definition = function(object, value) {
if ((value == TRUE) & (length(object@features@Shape@Shape.set) == object@fpLen)) {
stop("Cannot set 'setUseFixedValuesOffset.Shape'=TRUE if all shape positions within the model footprint are in Shape.set and aren't fixed.")
}
if ((value == TRUE) & (length(object@shapeParamsUsed[[1]]) == 0)) {
stop("Cannot set 'setUseFixedValuesOffset.Shape'=TRUE if there are no shape parameters in the model (i.e. shapeParamsUsed = list(c(character(0)))).")
}
object@useFixedValuesOffset.Shape = value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length of Extension Upstream Bases for Shape Parameters
#'
#' Gets 'exUpBases' slot from object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getExUpBases",
signature = "model",
definition = function(object) {
return(object@exUpBases)
}
)
#' Set Length of Extension Upstream Bases for Shape Parameters
#'
#' Sets 'exUpBases' slot for object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'exUpBases' slot for 'model' object
#' @export
setReplaceMethod(
f = "setExUpBases",
signature = "model",
definition = function(object, value) {
stop('Cannot set "exUpBases" directly after model is initialized.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length of Extension Downstream Bases for Shape Parameters
#'
#' Gets 'exDownBases' slot from object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getExDownBases",
signature = "model",
definition = function(object) {
return(object@exDownBases)
}
)
#' Set Length of Extension Downstream Bases for Shape Parameters
#'
#' Sets 'exDownBases' slot for object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'exDownBases' slot for 'model' object
#' @export
setReplaceMethod(
f = "setExDownBases",
signature = "model",
definition = function(object, value) {
stop('Cannot set "exDownBases" directly after model is initialized.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Footprint Length
#'
#' Gets 'fpLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getFpLen",
signature = "model",
definition = function(object) {
return(object@fpLen)
}
)
#' Set Footprint Length
#'
#' Sets 'fpLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'fpLen' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setFpLen",
signature = "model",
definition = function(object, value) {
stop('Cannot set "fpLen" directly--"fpLen" is built automatically from "seedLen", "upFootprintExtend", and "downFootprintExtend".')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Shape Parameters Used
#'
#' Gets 'shapeParamsUsed' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getShapeParamsUsed",
signature = "model",
definition = function(object) {
return(object@shapeParamsUsed)
}
)
#
#' Set Shape Parameters Used
#'
#' Sets 'shapeParamsUsed' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'shapeParamsUsed' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setShapeParamsUsed",
signature = "model",
definition = function(object, value) {
if (!is.list(value)) {
stop("New 'shapeParamsUsed' slot must be a list of length one.")
}
if (length(value) != 1) {
stop("New 'shapeParamsUsed' slot must be a list of length one.")
}
if (object@iteration == 0) {
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
if (!all(value[[1]] %in% c("HelT", "MGW", "ProT", "Roll"))) {
stop(paste("New 'shapeParamsUsed' (",
paste(values[[1]], collapse = ", "),
") contains parameters not in c('HelT', 'MGW', 'ProT', 'Roll').",
sep = ""))
} else if (!all(value[[1]] %in% colnames(object@shapeTable))) {
stop(paste("New 'shapeParamsUsed' (",
paste(values[[1]], collapse = ", "),
") contains parameters not contained in 'shapeTable' (",
paste(colnames(object@shapeTable), collapse = ", "),
") .",
sep = ""))
} else {
object@shapeParamsUsed <- value
object@features@shapeParamsUsed <- object@shapeParamsUsed
object@features@Shape <- new("Shape",
seedLen = object@seedLen,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
Shape.set = object@features@Shape@Shape.set,
Shape.equivMat = object@features@Shape@Shape.equivMat,
shapeParamsUsed = object@shapeParamsUsed,
rcSymmetric = object@rcSymmetric)
}
} else {
stop('Cannot reset rounds after fitting Shape parameters.')
}
} else {
stop('Cannot reset rounds after fitting Shape parameters.')
}
} else {
stop('Cannot reset rounds after fitting Shape parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Shape Table
#'
#' Gets 'shapeTable' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getShapeTable",
signature = "model",
definition = function(object) {
return(object@shapeTable)
}
)
#' Set Shape Table
#'
#' Sets 'shapeTable' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'shapeTable' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setShapeTable",
signature = "model",
definition = function(object, value) {
if (object@includeShape == TRUE) {
if (object@iteration == 0) {
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
if (length(value) > 0) {
sCols = gsub("Shape.", "", nrow(object@features@Shape@Shape.values))
if (!all(sCols %in% colnames(value))){
stop(paste("New 'shapeTable' columns (",
paste(colnames(value), collapse = ", "),
") do not contain all of the parameters implied by shapeParamsUsed[[1]] (",
paste(sCol, collapse = ", "),
").",
sep = ""))
} else {
object@shapeTable <- value
}
} else {
stop(paste("New 'shapeTable' is not a valid choice for the parameters in shapeParamsUsed[[1]] (",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
").",
sep = ""))
}
} else {
stop('Cannot reset shapeTable after fitting Shape parameters.')
}
} else {
stop('Cannot reset shapeTable after fitting Shape parameters.')
}
} else {
stop('Cannot reset shapeTable after fitting Shape parameters.')
}
} else {
object@shapeTable = value
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Verbose (logical)
#'
#' Gets 'verbose' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getVerbose",
signature = "model",
definition = function(object) {
return(object@verbose)
}
)
#' Get Date Initialized
#'
#' Gets 'dateInitialized' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getDateInitialized",
signature = "model",
definition = function(object) {
return(object@dateInitialized)
}
)
#' Get Date Last Modified
#'
#' Gets 'dateLastModified' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getDateLastModified",
signature = "model",
definition = function(object) {
return(object@dateLastModified)
}
)
#' Get Date Betas Last Added.
#'
#' Gets 'dateBetasLastAdded' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}
#' @export
setMethod(
f = "getDateBetasLastAdded",
signature = "model",
definition = function(object) {
return(object@dateBetasLastAdded)
}
)
#' Set verbose (logical)
#'
#' Sets 'verbose' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'verbose' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setVerbose",
signature = "model",
definition = function(object, value) {
object@verbose = value
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set Date Initialized
#'
#' Sets 'dateInitialized' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setDateInitialized",
signature = "model",
definition = function(object, value) {
stop('dateInitialized is automatically updated by the model-class and its related methods. This parameter should not be changed manually.')
}
)
#' Set Date Last Modified
#'
#' Sets 'dateLastModified' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setDateLastModified",
signature = "model",
definition = function(object, value) {
stop('dateLastModified is automatically updated by the model-class and its related methods. This parameter should not be changed manually.')
}
)
#' Set Date Betas Last Added
#'
#' Sets 'dateBetasLastAdded' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setDateBetasLastAdded",
signature = "model",
definition = function(object, value) {
stop('dateBetasLastAdded is automatically updated by the model-class and its related methods. This parameter should not be changed manually.')
}
)
#' Get N
#'
#' Gets 'N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getN",
signature = "model",
definition = function(object) {
return(object@features@N)
}
)
#' Get Intercept
#'
#' Gets 'Intercept' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIntercept",
signature = "model",
definition = function(object) {
return(object@features@Intercept)
}
)
#' Get Shape
#'
#' Gets 'Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getShape",
signature = "model",
definition = function(object) {
return(object@features@Shape)
}
)
#' Get Features
#'
#' Gets 'features' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getFeatures",
signature = "model",
definition = function(object) {
return(object@features)
}
)
#' Set Features
#'
#' Sets 'features' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'features' slot for \linkS4class{model} object
#' @export
setReplaceMethod(
f = "setFeatures",
signature = "model",
definition = function(object, value) {
object@iteration = 0
if (object@seedLen != value@seedLen) {
stop("New 'seedLen' for 'features' slot must equal 'seedLen' for model.")
}
if (object@upFootprintExtend != value@upFootprintExtend) {
stop("New 'upFootprintExtend' for 'features' slot must equal 'upFootprintExtend' for model.")
}
if (object@downFootprintExtend != value@downFootprintExtend) {
stop("New 'downFootprintExtend' for 'features' slot must equal 'downFootprintExtend' for model.")
}
if (!all(unique(object@rounds[[1]])[order(unique(object@rounds[[1]]))] == unique(value@rounds[[1]])[order(unique(value@rounds[[1]]))])) {
stop("New 'rounds' for 'features' slot must equal 'rounds' for model.")
}
if (!all(object@shapeParamsUsed[order(object@shapeParamsUsed[[1]])] == value@shapeParamsUsed[[1]][order(value@shapeParamsUsed[[1]])])) {
stop("New 'shapeParamsUsed' for 'features' slot must equal 'shapeParamsUsed' for model.")
}
if (object@numViews != value@numViews) {
stop("New 'numViews' for 'features' slot must equal 'numViews' for model.")
}
if (object@rcSymmetric != value@rcSymmetric) {
stop("New 'rcSymmetric' for 'features' slot must equal 'rcSymmetric' for model.")
}
object@features = value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set N
#'
#' Sets 'N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Object of class \linkS4class{N}.
#' @export
setReplaceMethod(
f = "setN",
signature = "model",
definition = function(object, value) {
oldN = getN(object)
if (oldN@seedLen != value@seedLen) {
stop('Current and replacement versions of N must have the same seed length.')
}
if (oldN@fS.upFootprintExtend != value@fS.upFootprintExtend) {
stop('Current and replacement versions of N must have the same value of fS.upFootprintExtend.')
}
if (oldN@fS.downFootprintExtend != value@fS.downFootprintExtend) {
stop('Current and replacement versions of N must have the same value of fS.downFootprintExtend.')
}
if (!all(c(ncol(getValues(value)),ncol(getErrors(value)), ncol(getZ(value)), ncol(getSig(value)), ncol(getOldValues(value)),
ncol(getOldErrors(value)), ncol(getOldZ(value)), ncol(getOldSig(value))) == ncol(getValues(oldN)))) {
stop("All beta related slots in new 'N' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
setValues(value) = getValues(value)
setErrors(value) = getErrors(value)
setZ(value) = getZ(value)
setSig(value) = getSig(value)
setOldValues(value) = getOldValues(value)
setOldErrors(value) = getOldErrors(value)
setOldZ(value) = getOldZ(value)
setOldSig(value) = getOldSig(value)
setEquivMat(value) = getEquivMat(value)
validObject(value)
object@features@N <- value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Set Intercept
#'
#' Sets 'Intercept' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Object of class \linkS4class{Intercept}.
#' @export
setReplaceMethod(
f = "setIntercept",
signature = "model",
definition = function(object, value) {
oldI = getIntercept(object)
if (!all(c(ncol(getValues(value)),ncol(getErrors(value)), ncol(getZ(value)), ncol(getSig(value)), ncol(getOldValues(value)),
ncol(getOldErrors(value)), ncol(getOldZ(value)), ncol(getOldSig(value))) == ncol(getValues(oldI)))) {
stop("All beta related slots in new 'Intercept' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
if (!all(c(dim(getValues(value))[3],dim(getErrors(value))[3], dim(getZ(value))[3], dim(getSig(value))[3], dim(getOldValues(value))[3],
dim(getOldErrors(value))[3], dim(getOldZ(value))[3], dim(getOldSig(value))[3]) == dim(getValues(oldI))[3])) {
stop("All beta related slots in new 'Intercept' must have the same number of rounds (dim[3]).")
}
setValues(value) = getValues(value)
setErrors(value) = getErrors(value)
setZ(value) = getZ(value)
setSig(value) = getSig(value)
setOldValues(value) = getOldValues(value)
setOldErrors(value) = getOldErrors(value)
setOldZ(value) = getOldZ(value)
setOldSig(value) = getOldSig(value)
validObject(value)
object@features@Intercept <- value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Set Shape
#'
#' Sets 'Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Object of class \linkS4class{Shape}.
#' @export
setReplaceMethod(
f = "setShape",
signature = "model",
definition = function(object, value) {
oldS = getShape(object)
if (oldS@seedLen != value@seedLen) {
stop('Current and replacement versions of Shape slot must have the same seed length.')
}
if (oldS@fS.upFootprintExtend != value@fS.upFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.upFootprintExtend.')
}
if (oldS@fS.downFootprintExtend != value@fS.downFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.downFootprintExtend.')
}
if (!all(c(ncol(getValues(value)),ncol(getErrors(value)), ncol(getZ(value)), ncol(getSig(value)), ncol(getOldValues(value)),
ncol(getOldErrors(value)), ncol(getOldZ(value)), ncol(getOldSig(value))) == ncol(getValues(oldS)))) {
stop("All beta related slots in new 'Shape' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
if (!all(c(nrow(getValues(value)),nrow(getErrors(value)), nrow(getZ(value)), nrow(getSig(value)), nrow(getOldValues(value)),
nrow(getOldErrors(value)), nrow(getOldZ(value)), nrow(getOldSig(value))) == nrow(getValues(oldS)))) {
stop("All beta related slots in new 'Shape' must have a number of rows equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
setValues(value) = getValues(value)
setErrors(value) = getErrors(value)
setZ(value) = getZ(value)
setSig(value) = getSig(value)
setOldValues(value) = getOldValues(value)
setOldErrors(value) = getOldErrors(value)
setOldZ(value) = getOldZ(value)
setOldSig(value) = getOldSig(value)
setEquivMat(value) = getEquivMat(value)
validObject(value)
object@features@Shape <- value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Show \linkS4class{model}
#'
#' Defines a show method for class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "show",
signature = "model",
definition = function(object) {
cat('An object of class "', class(object), '"\n', sep = "")
cat("\n")
if (length(object@name) > 0) {
cat('Slot "name": ', object@name, '\n')
} else {
cat('Slot "name": ', "char(0)", '\n')
}
cat('Slot "varRegLen": ', object@varRegLen, '\n')
cat('Slot "leftFixedSeq": ', object@leftFixedSeq, '\n')
cat('Slot "rightFixedSeq": ', object@rightFixedSeq, '\n')
cat('Slot "seedLen": ', object@seedLen, '\n')
cat('Slot "consensusSeq": ', object@consensusSeq, '\n')
cat('Slot "leftFixedSeqOverlap": ', object@leftFixedSeqOverlap, '\n')
cat('Slot "rightFixedSeqOverlap": ', object@rightFixedSeqOverlap, '\n')
cat('Slot "affinityType": ', object@affinityType, '\n')
cat('Slot "numViews": ', object@numViews, '\n')
cat('Slot "rounds[[1]]": ', object@rounds[[1]], '\n')
cat('Slot "confidenceLevel": ', object@confidenceLevel, '\n')
cat('Slot "minAffinity": ', object@minAffinity, '\n')
cat('Slot "missingValueSuppression": ', object@missingValueSuppression, '\n')
cat('Slot "minSeedValue": ', object@minSeedValue, '\n')
cat('Slot "regressionFormula": ', object@regressionFormula, '\n')
cat('Slot "iteration": ', object@iteration, '\n')
cat('Slot "upFootprintExtend": ', object@upFootprintExtend, '\n')
cat('Slot "downFootprintExtend": ', object@downFootprintExtend, '\n')
cat('Slot "rcSymmetric": ', object@rcSymmetric, '\n')
cat('Slot "includeDNAstrand": ', object@includeDNAstrand, '\n')
cat('Slot "includeView": ', object@includeView, '\n')
cat('Slot "includeShape": ', object@includeShape, '\n')
cat('Slot "useFixedValuesOffset.N": ', object@useFixedValuesOffset.N, '\n')
cat('Slot "useFixedValuesOffset.Shape": ', object@useFixedValuesOffset.Shape, '\n')
cat('Slot "exUpBases": ', object@exUpBases, '\n')
cat('Slot "exDownBases": ', object@exDownBases, '\n')
cat('Slot "fpLen": ', object@fpLen, '\n')
if (length(object@shapeParamsUsed[[1]]) > 0) {
cat('Slot "shapeParamsUsed[[1]]": ', object@shapeParamsUsed[[1]], '\n')
} else {
cat('Slot "shapeParamsUsed[[1]]": ', "list()", '\n')
}
if (length(object@shapeTable) > 0) {
cat('Slot "shapeTable" (first 6 rows): ','\n')
print(head(object@shapeTable))
} else {
cat('Slot "shapeTable": ','list()','\n')
}
cat("\n")
cat('Slot "features": ', '\n')
cat("\n")
cat('Slot "N": \n')
show(object@features@N)
cat("\n")
cat('Slot "Intercept": \n')
show(object@features@Intercept)
cat("\n")
cat('Slot "Shape": \n')
show(object@features@Shape)
cat("\n")
cat("\n")
cat('Slot "verbose": ', object@verbose, '\n')
cat("\n")
invisible(NULL)
}
)
#' Print \linkS4class{model}
#'
#' Defines a print method for class \linkS4class{model}.
#'
#' @param x Object of class \linkS4class{model}.
#' @export
setMethod(
f = "print",
signature = "model",
definition = function(x) {
show(x)
}
)
#' Get Feature Design
#'
#' Defines a print design method for class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getFeatureDesign",
signature = "model",
definition = function(object) {
cat("Feature design for object of class '", class(object), "'\n", sep = "")
cat("\n")
cat('seedLen: ', object@seedLen, '\n')
cat('upFootprintExtend: ', object@upFootprintExtend, '\n')
cat('downFootprintExtend: ', object@downFootprintExtend, '\n')
cat('rcSymmetric: ', object@rcSymmetric, '\n')
cat("\n")
cat('Slot "N":', '\n')
cat('N.upFootprintExtend: ', object@features@N@N.upFootprintExtend, '\n')
cat('N.downFootprintExtend: ', object@features@N@N.downFootprintExtend, '\n')
cat('N.set: ', object@features@N@N.set, '\n')
cat('Number of previous iterations: ', dim(object@features@N@N.oldValues)[3], '\n')
cat("\n")
if (object@includeView == TRUE) {
if (object@rcSymmetric == TRUE) {
cat('Slot "Intercept": (View-Specific Factors Included in Fit)', '\n')
} else {
cat('Slot "Intercept": (View+Strand Orientation-Specific Factors Included in Fit)', '\n')
}
} else if (object@includeDNAstrand == TRUE) {
cat('Slot "Intercept": (Strand Orientation-Specific Factors Included in Fit)', '\n')
} else {
cat('Slot "Intercept": (No View or Strand Orientation-Specific Factors Included in Fit)', '\n')
}
cat("Number of Views per Strand of DNA: ", ncol(object@features@Intercept@I.values), '\n', sep = "")
cat("Number of Rounds: ", dim(object@features@Intercept@I.values)[3]," (", paste(gsub("Round.", "", dimnames(object@features@Intercept@I.values)[[3]]), collapse = ", "),")\n", sep = "")
cat('Number of previous iterations: ', dim(object@features@Intercept@I.oldValues)[4], '\n', sep = "")
cat("\n")
cat('Slot "Shape":', '\n')
if (nrow(object@features@Shape@Shape.values) > 0) {
cat('ShapeParamsUsed: ', object@features@Shape@shapeParamsUsed[[1]], '\n')
cat('Shape.upFootprintExtend: ', object@features@Shape@Shape.upFootprintExtend, '\n')
cat('Shape.downFootprintExtend: ', object@features@Shape@Shape.downFootprintExtend, '\n')
cat('Shape.set: ', object@features@Shape@Shape.set, '\n')
cat('Number of previous iterations: ', dim(object@features@Shape@Shape.oldValues)[3], '\n')
} else {
cat('"ShapeParamsUsed": NONE')
}
cat("\n")
invisible(NULL)
}
)
#' Summary method for \linkS4class{model}
#'
#' Defines a summary method for class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "summary",
signature = "model",
definition = function(object) {
cat("An object of class '", class(object), "'\n", sep = "")
cat("\n")
if (length(object@name) > 0) {
cat('Slot "name": ', object@name, '\n')
}
cat('Slot "varRegLen": ', object@varRegLen, '\n')
cat('Slot "leftFixedSeq": ', object@leftFixedSeq, '\n')
cat('Slot "rightFixedSeq": ', object@rightFixedSeq, '\n')
cat('Slot "leftFixedSeqOverlap": ', object@leftFixedSeqOverlap, '\n')
cat('Slot "rightFixedSeqOverlap": ', object@rightFixedSeqOverlap, '\n')
cat('Slot "confidenceLevel": ', object@confidenceLevel, '\n')
cat('Slot "minAffinity": ', object@minAffinity, '\n')
cat('Slot "missingValueSuppression": ', object@missingValueSuppression, '\n')
cat('Slot "minSeedValue": ', object@minSeedValue, '\n')
cat('Slot "seedLen": ', object@seedLen, '\n')
cat('Slot "consensusSeq": ', object@consensusSeq, '\n')
cat('Slot "upFootprintExtend": ', object@upFootprintExtend, '\n')
cat('Slot "downFootprintExtend": ', object@downFootprintExtend, '\n')
cat('Slot "fpLen": ', object@fpLen, '\n')
cat("\n")
if ((object@includeShape == TRUE) & (object@includeView == TRUE)) {
fString = paste(" for mono-nucleotide, view, and shape features (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") ",
sep = "")
} else if ((object@includeShape == TRUE) & (object@includeDNAstrand == TRUE)) {
fString = paste(" for mono-nucleotide, strand orientation, and shape features (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") ",
sep = "")
} else if (object@includeShape == TRUE) {
fString = paste(" for mono-nucleotide and shape features (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") ",
sep = "")
} else {
fString = " for mono-nucleotide features "
}
if (object@useFixedValuesOffset.N==TRUE ) {
if (object@useFixedValuesOffset.Shape == TRUE) {
f2string = "with fixed values for mono-nucleotide positions not included in N.set and for shape parameter positions not included in Shape.set used as offsets for the glm fit, and "
} else {
f2string = "with fixed values for mono-nucleotide positions not included in N.set used as offsets for the glm fit, and "
}
} else if (object@useFixedValuesOffset.Shape == TRUE) {
f2string = "with fixed values for shape parameter positions not included in Shape.set used as offsets for the glm fit, and "
} else {
f2string = "with "
}
if (object@rcSymmetric == TRUE) {
cat("Fits a model of footprint length ",
object@fpLen,
fString,
f2string,
object@numViews,
" view(s) per strand of DNA and ",
length(object@rounds[[1]]),
" round(s) of data (round = ",
paste(object@rounds[[1]], collapse = ", "),
") with reverse complement symmetry.\n",
sep = "")
} else {
cat("Fits a model of footprint length ",
object@fpLen,
fString,
" with ",
object@numViews,
" view(s) per strand of DNA and ",
length(object@rounds[[1]]),
" round(s) of data (round = ",
paste(object@rounds[[1]], collapse = ", "),
") without reverse complement symmetry.\n",
sep = "")
}
cat("\n")
cat('Slot "regressionFormula": ', object@regressionFormula, '\n')
cat("\n")
if (getIncludeShape(object) == TRUE) {
if (length(object@shapeParamsUsed[[1]]) > 0) {
cat('Slot "shapeParamsUsed[[1]]": ', object@shapeParamsUsed[[1]], '\n')
}
}
cat("\n")
cat("Includes the following feature sub-classes: \n")
cat("An object of class '", class(getN(object)),"'", "\n", sep = "")
cat("Fits ",
length(getPositions(getN(object))),
" nucleotides for a feature model of length ",
(object@upFootprintExtend+object@downFootprintExtend+object@seedLen),
".\n",
sep = "")
if (!all(getEquivMat(getN(object)) == 0)) {
if (all(getEquivMat(getN(object))[,1:(getFpLen(object) %/%2)] == 0)) {
halfMatCheck = getEquivMat(getN(object))[1:(getFpLen(object) %/%2+getFpLen(object) %%2),
(getFpLen(object) %/%2+1):getFpLen(object)]
halfMatCheck = halfMatCheck[,ncol(halfMatCheck):1]
if (all(diag(halfMatCheck) == -1)) {
cat("Nucleotide features are reverse complement symmetric.\n")
}
}
}
cat("Nucleotide beta values:\n")
print(getValues(getN(object)))
cat("\n")
cat("Nucleotide beta errors:\n")
print(getErrors(getN(object)))
cat("\n")
cat("\n")
cat("An object of class '", class(getIntercept(object)),"'", "\n", sep = "")
if ((getIncludeView(object) == TRUE) & (getRcSymmetric(object) == TRUE)) {
cat("Fits ",
(1+1*(object@rcSymmetric == FALSE))*ncol(getValues(getIntercept(object))),
" views and ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,,i]
rownames(vals)[1] = "StrandView"
print(vals[1,, drop = FALSE])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,,i]
rownames(errs)[1] = "StrandView"
print(errs[1,,drop = FALSE])
cat("\n")
}
} else if ((getIncludeView(object) == TRUE) & (getRcSymmetric(object) == FALSE)) {
cat("Fits ",
(1+1*(object@rcSymmetric == FALSE))*ncol(getValues(getIntercept(object))),
" views and ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,,i]
print(vals[,])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,,i]
print(errs[,])
cat("\n")
}
} else if ((getIncludeDNAstrand(object) == TRUE) & (getRcSymmetric(object) == FALSE)) {
cat("Fits 2 strand orientations and ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,,i]
colnames(vals)[1] = "Strand"
print(vals[,1, drop = FALSE])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,,i]
colnames(errs)[1] = "Strand"
print(errs[,1, drop = FALSE])
cat("\n")
}
} else {
cat("Fits intercept(s) for ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,1,i, drop = FALSE]
rownames(vals)[1] = "Intercept"
colnames(vals) = NULL
print(vals[1,drop = FALSE])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,1,i, drop = FALSE]
rownames(errs)[1] = "Intercept"
colnames(errs) = NULL
print(errs[1,drop = FALSE])
cat("\n")
}
}
cat("\n")
cat("\n")
cat("An object of class '", class(getShape(object)),"'", "\n", sep = "")
cat("Fits ",
nrow(getValues(getShape(object)))*length(getPositions(getShape(object))),
" shape coefficients for ",
nrow(getValues(getShape(object))),
" kinds of shape parameter(s) (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") for a feature model of length ",
(getFpLen(object)),
".\n",
sep = "")
if (nrow(getValues(getShape(object))) > 0) {
if (!all(getEquivMat(getShape(object)) == 0)) {
if (all(getEquivMat(getShape(object))[,1:(getFpLen(object) %/%2)] == 0)) {
halfMatCheck = getEquivMat(getShape(object))[1:(getFpLen(getShape(object)) %/%2+getFpLen(getShape(object)) %%2),
(getFpLen(getShape(object)) %/%2+1):getFpLen(getShape(object))]
halfMatCheck = halfMatCheck[,ncol(halfMatCheck):1]
if (all(diag(halfMatCheck) == -1)) {
cat("Shape features are reverse complement symmetric.\n")
}
}
}
cat("Shape beta values:\n")
print(getValues(getShape(object)))
cat("\n")
cat("Shape beta errors:\n")
print(getErrors(getShape(object)))
cat("\n")
}
invisible(NULL)
}
)
#' Length of \linkS4class{model}
#'
#' Defines 'length' method for object of class \linkS4class{model}.
#'
#' The length of \linkS4class{model} object is defined as the footprint length of the model.
#' The footprint length is given by \code{fpLen} = \code{seedLen}+\code{upFootprintExtend}+\code{downFootprintExtend}.
#'
#' @param x Object of class \linkS4class{model}.
#' @export
setMethod(
f = "length",
signature = "model",
definition = function(x) {
length = x@fpLen
return (length)
}
)
#' Add Seed PSAM
#'
#' Adds seeding nucleotide PSAM to \linkS4class{model} class.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Seeding PSAM for nucleotides.
#' @export
setReplaceMethod(
f = "addSeedPsam",
signature = "model",
definition = function(object, value){
setValues(object@features@N) = value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Build Seed PSAM
#'
#' Uses k-mer table to build PSAM matrix for seeding SelexGLM.
#'
#' @param object Object of class \linkS4class{model}.
#' @param seedTable Kmer table used to build nucleotide seed.
#' @return Kmer table-derived nucleotide Beta Values.
#' @export
setMethod(
f = "seedTable2psam",
signature = "model",
definition = function(object, seedTable){
if (nchar(seedTable$Kmer[1]) != getSeedLen(object)) {
stop("Seed Table Kmers do not match seedLen specified for model")
}
psam = getPSAM(object)
seedPos = c((object@upFootprintExtend+1):(object@upFootprintExtend+object@seedLen))
psam[,seedPos] = NA
psam = psam[,(object@upFootprintExtend+1):(object@upFootprintExtend+object@seedLen)]
b = c("A", "C", "G", "T")
psam_seq = array(dim=c(4, getSeedLen(object)))
rownames(psam) = b
rownames(psam_seq) = b
seedTable = seedTable[order(-seedTable[,getAffinityType(object)]),]
rownames(seedTable) = NULL
testSeq = seedTable$Kmer[grep(getConsensusSeq(object), seedTable$Kmer)[1]]
testSeq = gsub(getConsensusSeq(object), "",testSeq)
extraChars = nchar(testSeq)
if (extraChars == 0) {
seedSeq = seedTable$Kmer[grep(getConsensusSeq(object), seedTable$Kmer)[1]]
} else {
cS = paste("[ACGT]{", (extraChars/2), "}", getConsensusSeq(object), "[ACGT]{", (extraChars/2), "}", sep = "")
seedSeq = seedTable$Kmer[grep(cS, seedTable$Kmer)[1]]
}
for (i in (seedPos-object@upFootprintExtend)) {
for (j in (1:4)) {
if (i == 1) {
tempseq = paste(b[j], stringi::stri_sub(seedSeq, (i+1), getSeedLen(object)), sep="")
} else if (i == getSeedLen(object)) {
tempseq = paste(stringi::stri_sub(seedSeq, 1, (i-1)), b[j], sep="")
} else {
tempseq = paste(stringi::stri_sub(seedSeq, 1, i-1), b[j], stringi::stri_sub(seedSeq, i+1, getSeedLen(object)), sep = "")
}
psam_seq[j, i] = tempseq
ind = grep(tempseq, seedTable$Kmer)
if (length(ind) == 1) {
psam[j, i] = seedTable[ind, getAffinityType(object)]
}
}
}
S.equivMat = object@features@Shape@Shape.equivMat[seedPos,seedPos]
if (!all(S.equivMat == 0)) {
cNames = colnames(S.equivMat)
for (i in 1:ncol(S.equivMat)) {
c = cNames[i]
if (all(S.equivMat[,c] == 0)) {
next
}
if (length(cNames[S.equivMat[,c] == -1]) == 1) {
r = cNames[S.equivMat[,c] == -1]
psamCol1 = psam[,c]
psamCol2 = psam[,r]
for (j in 1:4) {
if (is.na(psamCol1[j]) == TRUE) {
if (is.na(psamCol2[5-j]) == FALSE) {
psamCol1[j] = psamCol2[5-j]
}
}
if (is.na(psamCol2[5-j]) == TRUE) {
if (is.na(psamCol1[j]) == FALSE) {
psamCol2[5-j] = psamCol1[j]
}
}
}
psam[,c] = psamCol1
psam[,r] = psamCol2
}
if (length(cNames[S.equivMat[,c] == 1]) == 1) {
r = cNames[S.equivMat[,c] == 1]
psamCol1 = psam[,c]
psamCol2 = psam[,r]
for (j in 1:4) {
if (is.na(psamCol1[j]) == TRUE) {
if (is.na(psamCol2[j]) == FALSE) {
psamCol1[j] = psamCol2[j]
}
}
if (is.na(psamCol2[j]) == TRUE) {
if (is.na(psamCol1[j]) == FALSE) {
psamCol2[j] = psamCol1[j]
}
}
}
psam[,c] = psamCol1
psam[,r] = psamCol2
}
}
}
MinPSAM = min(psam, na.rm = TRUE)
psam[is.na(psam)] = MinPSAM/exp(getMissingValueSuppression(object))
psam[psam < getMinSeedValue(object)] = getMinSeedValue(object)
psam = log(psam)
if (object@rcSymmetric == TRUE) {
psamH1 = psam[,1:ceiling(ncol(psam)/2)]
psamH2 = psam[4:1, ncol(psam):1][,1:ceiling(ncol(psam)/2)]
psamH = (psamH1+psamH2)/2
psam = cbind(psamH,psamH[4:1,(floor(ncol(psam)/2)):1])
}
colnames(psam) = seedPos
psam = t(psam)
MaxCol = apply(psam, 1, max)
psam[,1] = psam[,1]-MaxCol
psam[,2] = psam[,2]-MaxCol
psam[,3] = psam[,3]-MaxCol
psam[,4] = psam[,4]-MaxCol
psam = t(psam)
r.psam = matrix(0, nrow = 4, ncol = getUpFootprintExtend(object))
l.psam = matrix(0, nrow = 4, ncol = getDownFootprintExtend(object))
psam = cbind(r.psam, psam, l.psam)
rownames(psam) = c("N.A", "N.C", "N.G", "N.T")
colnames(psam) = 1:getFpLen(object)
return (psam)
}
)
#' Add New Betas to \linkS4class{model}
#'
#' Adds new betas to object of class \linkS4class{model} using the output of a glm fit.
#'
#' @param object Object of class \linkS4class{model}.
#' @param design Design table used to fit glm model.
#' @param value Glm fit object.
#' @return \linkS4class{model} object updated to include glm fit data.
#' @export
setMethod(
f = "addNewBetas",
signature = "model",
definition = function(object, design, value){
object@iteration = object@iteration+1
glmFits = object@features@glmFits
iter = object@iteration
newFit = summary(value)
newFit$deviance.resid = c(NA)
if (length(glmFits) == 0) {
glmFits = list(newFit)
names(glmFits) = c("iter1")
} else {
glmFits[[length(glmFits)+1]] <- newFit
names(glmFits)[length(glmFits)] = c(paste("iter", length(glmFits), sep = ""))
}
object@features@glmFits = glmFits
dM = getDesignMatrix(object, design)
dMsummary = object@features@designMatrixSummary
if (length(dMsummary) == 0) {
dMsummary = list(dM)
names(dMsummary) = c("iter1")
} else {
dMsummary[[length(dMsummary)+1]] <- dM
names(dMsummary)[length(dMsummary)] = c(paste("iter", length(dMsummary), sep = ""))
}
object@features@designMatrixSummary = dMsummary
# Add Nucleotide Data from fit
object@features@N = addNewBetas(object@features@N, design = design, value = value, missingValueSuppression = object@missingValueSuppression, useFixedValuesOffset.N = object@useFixedValuesOffset.N)
# Add Intercept Data from fit
object@features@Intercept = addNewBetas(object@features@Intercept, design = design, value = value, missingValueSuppression = object@missingValueSuppression, includeDNAstrand = object@includeDNAstrand, includeView = object@includeView, rcSymmetric = object@rcSymmetric)
# Add Shape Data from fit
object@features@Shape = addNewBetas(object@features@Shape, design = design, value = value, useFixedValuesOffset.Shape = object@useFixedValuesOffset.Shape)
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object@dateBetasLastAdded = date()
return(object)
}
)
#' Finalize Beta Values
#'
#' Finalizes beta values in \linkS4class{model} object by restoring NA's that were removed to allow for the iteration.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "finalizeFeatureBetas",
signature = "model",
definition = function(object){
iter = object@iteration
betaSummary = object@features@glmFits[[paste("iter", iter, sep = "")]]$coefficients
dM = object@features@designMatrixSummary[[paste("iter", iter, sep = "")]]
# Finalize N betas
N.set = object@features@N@N.set
N.notSet = c(1:object@fpLen)[!(c(1:object@fpLen) %in% N.set)]
N.ncol = object@fpLen
N.values = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
N.errors = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
N.z = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
N.sig = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
if (length(N.notSet) > 0) {
if (object@useFixedValuesOffset.N == TRUE) {
N.values[,N.notSet] = getValues(object@features@N)[,N.notSet]
N.errors[,N.notSet] = getErrors(object@features@N)[,N.notSet]
N.z[,N.notSet] = getZ(object@features@N)[,N.notSet]
N.sig[,N.notSet] = getSig(object@features@N)[,N.notSet]
} else {
N.values[,N.notSet] = 0
N.errors[,N.notSet] = 0
N.z[,N.notSet] = 0
N.sig[,N.notSet] = 0
}
}
if (!all(N.set == 0)) {
sumN = dM$N
refN = apply(sumN, 1, which.max)
zeroNs = matrix(c(refN, as.numeric(names(refN))), nrow = length(refN),
ncol = 2, byrow = FALSE)
N.values[zeroNs] = 0
N.errors[zeroNs] = 0
N.z[zeroNs] = 0
N.sig[zeroNs] = 0
grStr = "N.[ACGT][0-9]{1,}"
Ns = rownames(betaSummary)[grep(grStr, rownames(betaSummary))]
cols = as.numeric(gsub("N.[ACGT]", "", Ns))
rows = gsub("[0-9]{1,}", "", Ns)
names(cols) = Ns
names(rows) = Ns
for (n in Ns) {
N.values[rows[n], cols[n]] = betaSummary[n,1]
N.errors[rows[n], cols[n]] = betaSummary[n,2]
N.z[rows[n], cols[n]] = betaSummary[n,3]
N.sig[rows[n], cols[n]] = betaSummary[n,4]
}
if (!(all(object@features@N@N.equivMat == 0))) {
equivMat = object@features@N@N.equivMat
for (i in rev(N.set)) {
matchCol = equivMat[,i]
matchIndices = which(matchCol != 0)
if (length(matchIndices[matchIndices %in% N.set]) > 0) {
matchIndex = min(matchIndices[matchIndices %in% N.set])
if (matchCol[matchIndex] == 1) {
N.values[,i] = N.values[,matchIndex]
N.errors[,i] = N.errors[,matchIndex]
N.z[,i] = N.z[,matchIndex]
N.sig[,i] = N.sig[,matchIndex]
equivMat[i,] = 0
} else if (matchCol[matchIndex] == -1) {
if (matchIndex != i) {
N.values[,i] = rev(N.values[,matchIndex])
N.errors[,i] = rev(N.errors[,matchIndex])
N.z[,i] = rev(N.z[,matchIndex])
N.sig[,i] = rev(N.sig[,matchIndex])
equivMat[i,] = 0
} else {
N.values[3:4,i] = rev(N.values[1:2,i])
N.errors[3:4,i] = rev(N.errors[1:2,i])
N.z[3:4,i] = rev(N.z[1:2,i])
N.sig[3:4,i] = rev(N.sig[1:2,i])
}
}
}
}
}
}
object@features@N@N.values = N.values
object@features@N@N.errors = N.errors
object@features@N@N.z = N.z
object@features@N@N.sig = N.sig
validObject(object)
interceptData = betaSummary[grep("Intercept", rownames(betaSummary)),]
newValues = array(interceptData[1],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
newErrors = array(interceptData[2],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
newZ = array(interceptData[3],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
newSig = array(interceptData[4],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
if (object@rcSymmetric == TRUE) {
newValues["Strand.R",,] = 0
newErrors["Strand.R",,] = 0
newZ["Strand.R",,] = 0
newSig["Strand.R",,] = 0
}
grStr = paste("Round.", "[0-9]{1,}", sep = "")
round.inds = grep(grStr, rownames(betaSummary))
betaSub = betaSummary[round.inds,,drop = FALSE]
if (nrow(betaSub) > 0) {
newValues["Strand.F",,rownames(betaSub)] = newValues["Strand.F",,rownames(betaSub)]+array(betaSub[rownames(betaSub), 1],
dim = c(1, dim(newValues)[2]))
newErrors["Strand.F",,rownames(betaSub)] = sqrt(newErrors["Strand.F",,rownames(betaSub)]^2+array(betaSub[rownames(betaSub), 2],
dim = c(1, dim(newValues)[2]))^2)
newZ["Strand.F",,rownames(betaSub)] = newValues["Strand.F",,rownames(betaSub)]/newErrors["Strand.F",,rownames(betaSub)]
newSig["Strand.F",,rownames(betaSub)] = 2*pnorm(-abs(newZ["Strand.F",,rownames(betaSub)]))
}
if (object@includeView == TRUE) {
if (object@rcSymmetric == FALSE) {
grView = paste("Strand.[FR][0-9]{1,}", sep = "")
} else {
grView = paste("Strand.F[0-9]{1,}", sep = "")
}
view.inds = grep(grView, rownames(betaSummary))
V.values = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
V.errors = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
V.z = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
V.sig = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
if (object@rcSymmetric == TRUE) {
V.values["Strand.R",,] = 0
V.errors["Strand.R",,] = 0
V.z["Strand.R",,] = 0
V.sig["Strand.R",,] = 0
}
sumI = dM$Intercept
maxViewIndex = which(sumI[,paste("View.",1:object@numViews,sep = "")] == max(sumI[,paste("View.",1:object@numViews,sep = "")]), arr.ind = TRUE)[1,]
V.values[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
V.errors[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
V.z[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
V.sig[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
Vs = rownames(betaSummary)[grep(grView, rownames(betaSummary))]
if (length(Vs) > 0) {
for (vVar in Vs) {
vStr = gsub("[0-9]{1,}", "", vVar)
vV = paste("View.", gsub("Strand.[FR]", "", vVar), sep = "")
V.values[vStr,vV,] = betaSummary[vVar,1]
V.errors[vStr,vV,] = betaSummary[vVar,2]
V.z[vStr,vV,] = betaSummary[vVar,3]
V.sig[vStr,vV,] = betaSummary[vVar,4]
}
}
newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]+V.values[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = sqrt(newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2+V.errors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2)
newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]/newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newSig[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = 2*pnorm(-abs(newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]))
} else if (object@includeDNAstrand == TRUE) {
St.set = c("Strand.F", "Strand.R")
St.values = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
St.errors = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
St.z = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
St.sig = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
sumS = dM$Intercept[,ncol(dM$Intercept), drop = FALSE]
maxSt = which.max(sumS[,1])
St.values[maxSt,,] = 0
St.errors[maxSt,,] = 0
St.z[maxSt,,] = 0
St.sig[maxSt,,] = 0
if (length(St.set) > 0) {
grStr = "Strand.[FR]$"
Sts = rownames(betaSummary)[grep(grStr, rownames(betaSummary))]
if (length(Sts) > 0) {
for (strVar in Sts) {
St.values[strVar,,] = betaSummary[strVar,1]
St.errors[strVar,,] = betaSummary[strVar,2]
St.z[strVar,,]= betaSummary[strVar,3]
St.sig[strVar,,] = betaSummary[strVar,4]
}
}
}
newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]+St.values[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = sqrt(newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2+St.errors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2)
newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]/newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newSig[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = 2*pnorm(-abs(newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]))
}
object@features@Intercept@I.values = newValues
object@features@Intercept@I.errors = newErrors
object@features@Intercept@I.z = newZ
object@features@Intercept@I.sig = newSig
validObject(object)
if (((length(object@shapeParamsUsed[[1]]) > 0)) & (object@includeShape == TRUE)) {
Shape.set = object@features@Shape@Shape.set
Shape.notSet = c(1:object@fpLen)[!(c(1:object@fpLen) %in% Shape.set)]
Shape.ncol = object@fpLen
rowNames = row.names(getValues(object@features@Shape))
numRows = nrow(getValues(object@features@Shape))
Shape.values = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
Shape.errors = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
Shape.z = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
Shape.sig = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
if (length(Shape.notSet) > 0) {
if (object@useFixedValuesOffset.Shape == TRUE) {
Shape.values[,Shape.notSet] = getValues(object@features@Shape)[,Shape.notSet]
Shape.errors[,Shape.notSet] = getErrors(object@features@Shape)[,Shape.notSet]
Shape.z[,Shape.notSet] = getZ(object@features@Shape)[,Shape.notSet]
Shape.sig[,Shape.notSet] = getSig(object@features@Shape)[,Shape.notSet]
} else {
Shape.values[,Shape.notSet] = 0
Shape.errors[,Shape.notSet] = 0
Shape.z[,Shape.notSet] = 0
Shape.sig[,Shape.notSet] = 0
}
}
if (!all(Shape.set == 0)) {
grStr = "^Shape.[A-Za-z]{1,}[0-9]{1,}"
shapeParamBetas = rownames(betaSummary)[grep(grStr, rownames(betaSummary))]
cols = as.numeric(gsub("^Shape.[A-Za-z]{1,}", "", shapeParamBetas))
rows = gsub("[0-9]{1,}", "", shapeParamBetas)
names(cols) = shapeParamBetas
names(rows) = shapeParamBetas
for (s in shapeParamBetas) {
Shape.values[rows[s], cols[s]] = betaSummary[s,1]
Shape.errors[rows[s], cols[s]] = betaSummary[s,2]
Shape.z[rows[s], cols[s]] = betaSummary[s,3]
Shape.sig[rows[s], cols[s]] = betaSummary[s,4]
}
if (!(all(object@features@Shape@Shape.equivMat == 0))) {
equivMat = object@features@Shape@Shape.equivMat
for (i in rev(Shape.set)) {
matchCol = equivMat[,i]
matchIndices = which(matchCol != 0)
if (length(matchIndices[matchIndices %in% Shape.set]) > 0) {
matchIndex = min(matchIndices[matchIndices %in% Shape.set])
if (matchCol[matchIndex] == 1) {
S = matchIndex
S.equiv = i
if (S != S.equiv) {
Shape.values[,S.equiv] = Shape.values[,S]
Shape.errors[,S.equiv] = Shape.errors[,S]
Shape.z[,S.equiv] = Shape.z[,S]
Shape.sig[,S.equiv] = Shape.sig[,S]
}
equivMat[i,] = 0
equivMat[i,] = 0
} else if (matchCol[matchIndex] == -1) {
if (matchIndex != i) {
S = matchIndex
S.RC= i
shapeParams = object@shapeParamsUsed[[1]]
if ("MGW" %in% shapeParams) {
Shape.values["Shape.MGW", S.RC] = Shape.values["Shape.MGW", S]
Shape.errors["Shape.MGW", S.RC] = Shape.errors["Shape.MGW", S]
Shape.z["Shape.MGW", S.RC] = Shape.z["Shape.MGW", S]
Shape.sig["Shape.MGW", S.RC] = Shape.sig["Shape.MGW", S]
}
if ("ProT" %in% shapeParams) {
Shape.values["Shape.ProT", S.RC] = Shape.values["Shape.ProT", S]
Shape.errors["Shape.ProT", S.RC] = Shape.errors["Shape.ProT", S]
Shape.z["Shape.ProT", S.RC] = Shape.z["Shape.ProT", S]
Shape.sig["Shape.ProT", S.RC] = Shape.sig["Shape.ProT", S]
}
if ("HelT" %in% shapeParams) {
Shape.values["Shape.HelTB", S.RC] = Shape.values["Shape.HelTA", S]
Shape.errors["Shape.HelTB", S.RC] = Shape.errors["Shape.HelTA", S]
Shape.z["Shape.HelTB", S.RC] = Shape.z["Shape.HelTA", S]
Shape.sig["Shape.HelTB", S.RC] = Shape.sig["Shape.HelTA", S]
Shape.values["Shape.HelTA", S.RC] = Shape.values["Shape.HelTB", S]
Shape.errors["Shape.HelTA", S.RC] = Shape.errors["Shape.HelTB", S]
Shape.z["Shape.HelTA", S.RC] = Shape.z["Shape.HelTB", S]
Shape.sig["Shape.HelTA", S.RC] = Shape.sig["Shape.HelTB", S]
}
if ("Roll" %in% shapeParams) {
Shape.values["Shape.RollB", S.RC] = Shape.values["Shape.RollA", S]
Shape.errors["Shape.RollB", S.RC] = Shape.errors["Shape.RollA", S]
Shape.z["Shape.RollB", S.RC] = Shape.z["Shape.RollA", S]
Shape.sig["Shape.RollB", S.RC] = Shape.sig["Shape.RollA", S]
Shape.values["Shape.RollA", S.RC] = Shape.values["Shape.RollB", S]
Shape.errors["Shape.RollA", S.RC] = Shape.errors["Shape.RollB", S]
Shape.z["Shape.RollA", S.RC] = Shape.z["Shape.RollB", S]
Shape.sig["Shape.RollA", S.RC] = Shape.sig["Shape.RollB", S]
}
equivMat[i,] = 0
} else {
S = i
shapeParams = object@shapeParamsUsed[[1]]
if ("HelT" %in% shapeParams) {
Shape.values["Shape.HelTB", S] = Shape.values["Shape.HelTA", S]
Shape.errors["Shape.HelTB", S] = Shape.errors["Shape.HelTA", S]
Shape.z["Shape.HelTB", S] = Shape.z["Shape.HelTA", S]
Shape.sig["Shape.HelTB", S] = Shape.sig["Shape.HelTA", S]
}
if ("Roll" %in% shapeParams) {
Shape.values["Shape.RollB", S] = Shape.values["Shape.RollA", S]
Shape.errors["Shape.RollB", S] = Shape.errors["Shape.RollA", S]
Shape.z["Shape.RollB", S] = Shape.z["Shape.RollA", S]
Shape.sig["Shape.RollB", S] = Shape.sig["Shape.RollA", S]
}
}
}
}
}
}
}
object@features@Shape@Shape.values = Shape.values
object@features@Shape@Shape.errors = Shape.errors
object@features@Shape@Shape.z = Shape.z
object@features@Shape@Shape.sig = Shape.sig
validObject(object)
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object@dateBetasLastAdded = date()
return (object)
}
)
#' Get Mononucleotide PSAM
#'
#' Gets mononucleotide PSAM (i.e. mono-nucleotide normalized relative affinity contributions) from object of class \linkS4class{model} for specific iteration.
#'
#' If iteration==NULL, the most recent round of the glm fit values will be used.
#'
#' @param object Object of class \linkS4class{model}.
#' @param iteration Iteration of model fit to be used for PSAM
#' @export
setMethod(
f = "getPSAM",
signature = "model",
definition = function(object, iteration=NULL){
if (is.null(iteration)) {
PSAM = t(object@features@N@N.values)
} else {
oldIters = as.numeric(dimnames(object@features@N@N.oldValues)[[3]])
if (iteration == max(oldIters)+1) {
PSAM = t(object@features@N@N.values)
} else if (iteration %in% oldIters) {
PSAM = t(object@features@N@N.oldValues[,,as.character(iteration)])
} else {
stop('Invalid value for iteration')
}
}
maxNs = apply(PSAM, 1, max, na.rm = TRUE)
for (i in 1:4) {
PSAM[,i] = PSAM[,i]-maxNs
}
PSAM = t(exp(PSAM))
rownames(PSAM) = c("A", "C", "G", "T")
return (PSAM)
}
)
#' Get design matrix for all features
#'
#' Gets feature design from design matrix.
#'
#' @param object Object of class \linkS4class{model}.
#' @param design Data frame with design matrix, as generated by addDesignMatrix function.
#' @export
setMethod(
f = "getDesignMatrix",
signature = "model",
definition = function(object, design) {
sumN = getDesignMatrix(object@features@N, design)
sumI = getDesignMatrix(object@features@Intercept, design)
sumI = cbind(sumI, StrandTotal = c(sum(sumI[1,]), sum(sumI[2,])))
sumR = getRoundDesign(object@features@Intercept, design)
sumR = cbind(sumR, Total = c(sum(sumR[1,])))
if ((object@includeShape == TRUE) & (!all(object@features@Shape@Shape.set == 0))) {
sumS = getDesignMatrix(object@features@Shape, design)
} else {
sumS = matrix(0, nrow = 0, ncol = 0)
}
if (object@useFixedValuesOffset.N == TRUE) {
sumFVN = summary(design$fixedNddG)
} else {sumFVN = numeric(0)}
if (object@useFixedValuesOffset.Shape == TRUE) {
sumFVS = summary(design$fixedSddG)
} else {
sumFVS = numeric(0)
}
dM = c(list(Intercept = sumI, Round = sumR,N = sumN, FixedValues.N = sumFVN, Shape = sumS, FixedValues.Shape = sumFVS))
return(dM)
}
)
#' Plot \linkS4class{model}
#'
#' Plots object of class \linkS4class{model} for any combination of inputs.
#'
#' @param x Object of class \linkS4class{model}.
#' @param plotTitle Optional title parameter to be used for plot.
#' @param maxErr Optional parameter giving maximum error to be displayed in nucleotide affinity plot.
#' @param iter Iteration of beta values to be used in plot. If iteration == NULL, the most recent round of beta values are used.
#' @param regs Optional list containing names of different shaded regions for nucleotide and shape plots.
#' @param lengths Optional list containing lengths of regions in \code{regs}, corresponding to different shaded regions for nucleotide and shape plots.
#' @param Nplot.ddG logical: If TRUE, ddG scaling is used for nucleotide plot. If FALSE, affinity scaling is using for nucleotide plot.
#' @param verticalPlots logical: If TRUE, all plots are stacked vertically. If false, plots are fit into a roughly square block.
#' @return ggplot plots of intercept values
#' @export
setMethod(
f = "plot",
signature = "model",
definition = function(x, plotTitle=NULL, maxErr = 1, iter=NULL, regs, lengths, Nplot.ddG = FALSE, verticalPlots = FALSE) {
if (missing(regs)) {
regs = list(c("Unseeded", "Seeded", "Unseeded"))
}
if (missing(lengths)) {
lengths = list(c(x@upFootprintExtend, x@seedLen, x@downFootprintExtend))
}
if (Nplot.ddG == FALSE) {
Ntitle = expression('Mono-nucleotide Affinities')
} else {
Ntitle = expression(paste('Mononucleotide -', Delta, Delta, 'G values'))
}
if ((x@useFixedValuesOffset.N == TRUE) | (!all(x@features@N@N.set == 0))) {
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
includeN = TRUE
} else {
if (!missing(iter)) {
if (!is.null(iter)) {
if (iter == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else if (dim(x@features@N@N.oldValues)[3] == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else {
includeN = FALSE
}
} else if (dim(x@features@N@N.oldValues)[3] == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else {
includeN = FALSE
}
} else if (dim(x@features@N@N.oldValues)[3] == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else {
includeN = FALSE
}
}
includeView = x@includeView
includeDNAstrand = x@includeDNAstrand
numR = length(x@rounds[[1]])
if (numR > 1) { includeRound = TRUE
} else {includeRound = FALSE}
rcSymmetric = x@rcSymmetric
includeShape = x@includeShape
viewTitle = expression(paste('View-Specific Intercept -', Delta, Delta, 'G values'))
roundTitle = expression(paste('Round-Specific Intercept -', Delta, Delta, 'G values'))
if (includeView == TRUE) {
Vplot = plotViews(x@features@Intercept, rcSymmetric, title = viewTitle, iter = iter)
}
if (includeRound == TRUE) {
Rplot = plotRounds(x@features@Intercept, x@features@designMatrixSummary[[paste("iter", x@iteration, sep = "")]]$Intercept, title = roundTitle, iter = iter)
}
dTitle = expression(paste('Strand-Specific Intercept -', Delta, Delta, 'G values'))
if (includeDNAstrand == TRUE) {
Dplot = plotStrands(x@features@Intercept, title = dTitle, iter = iter)
}
iTitle = expression(paste('Intercept -', Delta, Delta, 'G value'))
if ((includeView == FALSE) & (includeDNAstrand == FALSE) & (includeRound == FALSE)) {
Iplot = plotBasicIntercept(x@features@Intercept, title = iTitle, iter = iter)
}
if (includeShape == TRUE) {
Stitle = expression(paste('Shape parameters -', Delta, Delta, 'G', ' per ', ring(A)))
Splot = plot(x@features@Shape, title = Stitle, iter=iter, regs = regs, lengths = lengths, verticalPlots = verticalPlots)
}
if (includeView == TRUE) {
if (includeRound == TRUE) {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Vplot, Rplot, Splot, nrow = 2, ncol =2, heights=c(4.0,4.0),
widths = c(2.5, 3.5),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Vplot, Rplot, ncol =1, heights=c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Vplot, Rplot, Splot, nrow = 2, ncol =2, layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Vplot, Rplot, ncol =1, heights=c((3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, Vplot, nrow = 2,layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Vplot, Rplot, nrow = 3, ncol = 1, heights = c(4.0, 3.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, Vplot, nrow = 2,heights = c(3.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Vplot, Rplot, nrow = 2, ncol = 1, heights = c(3.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
#
} else {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Vplot, Splot, nrow = 2,layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Vplot, nrow = 3,heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Vplot, Splot, nrow = 2, heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Vplot, nrow = 2, heights = c((3.0*nrow(x@features@Shape@Shape.values)), 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Vplot, nrow = 2, heights = c(4.0, 3.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Vplot, nrow = 2, heights = c(4.0, 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Vplot, widths = c(6.0), heights = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Vplot, nrow = 1, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
}
} else {
if (includeDNAstrand == TRUE) {
if (includeRound == TRUE) {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Dplot, Splot, Rplot, nrow = 2, ncol =2, heights=c(4.0,4.0),
widths = c(3.5, 2.5),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Dplot, Rplot, nrow = 4, heights=c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Dplot, Rplot, Splot, nrow = 2, ncol =2, layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Dplot, Rplot, nrow = 3, heights=c((3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, Dplot, nrow = 2,layout_matrix = rbind(c(1, 1), c(2, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Dplot, Rplot, nrow = 3, heights = c(4.0, 2.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, Dplot, nrow = 2, heights = c(3.0, 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Dplot, Rplot, nrow = 2, heights = c(2.0, 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
} else {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Dplot, Splot, nrow = 2,layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot,Splot, Dplot, nrow = 3,heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Dplot, Splot, nrow = 2,heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Dplot, nrow = 2,heights = c((3.0*nrow(x@features@Shape@Shape.values)), 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g =gridExtra::arrangeGrob(Nplot, Dplot, nrow = 2,heights = c(2.75, 2.25),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g =gridExtra::arrangeGrob(Nplot, Dplot, nrow = 2,heights = c(4.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g =gridExtra::arrangeGrob(Dplot, nrow = 1,heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g =gridExtra::arrangeGrob(Dplot, nrow = 1,heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
}
} else {
if (includeRound == TRUE) {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, Splot, layout_matrix = rbind(c(1,1, 2), c(3, 3,3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot,Splot, Rplot, nrow = 3, heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, Splot, nrow = 2, heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Rplot, nrow = 2, heights = c((3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, nrow = 2, heights = c(3.0, 2.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Rplot, nrow = 2, heights = c(4.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, nrow = 2, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Rplot, nrow = 2, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
} else {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Iplot, Splot, layout_matrix = rbind(c(1,1, 2), c(3, 3,3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Iplot, nrow = 3, heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Iplot, Splot, nrow = 2, heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Iplot, nrow = 2, heights = c((3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Iplot, nrow = 2, heights = c(3.0, 2.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Iplot, nrow = 2, heights = c(4.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Iplot, nrow = 1, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Iplot, nrow = 1, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
}
}
}
return(g)
}
)
BussemakerLab/SelexGLM documentation built on May 17, 2019, 5:41 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @include model-validity.R
#' @include N-class.R
#' @include Shape-class.R
#' @include Intercept-class.R
#' @include featureSet-class.R
#' @include generic-functions-definitions.R
#' @include dnaSequenceTools.R
#' @include buildRawRegressionFormula.R
NULL
#' Class \linkS4class{model} for SelexGLM
#'
#' An S4 class to represent model object to store library design, model design, and model parameters for a SelexGLM project.
#'
#' @slot name Name to be associated with the model object. If unspecified, empty string is assigned by default.
#' @slot varRegLen Length of the library design for the selex data.
#' @slot leftFixedSeq Fixed sequence to the left of random library in library design.
#' @slot rightFixedSeq Fixed sequence to the right of random library in library design.
#' @slot seedLen Length of k-mer used to seed the regression. If unspecified, empty numeric value is assigned by default.
#' @slot consensusSeq Optional regular expression input specifying consensus sequence to be used to determine the seed sequence for building a PSAM from the k-mer table used to seed the analysis. If "consensusSeq" is input in iupac notation, it is converted to a standard regular expression during initialization of model object.
#' @slot leftFixedSeqOverlap Number of bp into the left fixed flank to be considered in analysis. If unspecified, 0 is assigned by default.
#' @slot rightFixedSeqOverlap Number of bp into the right fixed flank to be considered in analysis. If unspecified, \code{rightFixedSeqOverlap} is set to \code{leftFixedSeqOverlap} by default.
#' @slot affinityType name of affinity variable in k-mer table to be used in building the seeding PSAM. If no value is specified, affinityType = 'Affinity'.
#' @slot numViews number of distinct views of length k contained in each strand. Must be equal to leftFixedSeqOverlap+varRegLen+rightFixedSeqOverlap.
#' @slot rounds list of length 1 with rounds[[1]] equal to a vector containing the rounds of data to be fit.
#' @slot confidenceLevel view confidence level cutoff required for probes used in glm fit.
#' @slot minAffinity minimum view affinity required for probes used in glm fit.
#' @slot missingValueSuppression difference in ddG between the lowest fit beta values and estimates of betas for features that do not occur in the design matrix passed to glm fit.
#' @slot minSeedValue minimum value for mono-nucleotide affinities specified in initial seeding PSAM. If no value is specified explicitly, minSeedValue = 0.
#' @slot regressionFormula regression formula ('character' class) specifying the feature design of the 'model' object.
#' @slot iteration number of glm iterations performed.
#' @slot upFootprintExtend number of upstream base pairs to consider beyond the seed.
#' @slot downFootprintExtend number of downstream base pairs to consider beyond the seed.
#' @slot rcSymmetric boolean indicating whether of not a reverse complement symmetric model should be fit.
#' @slot includeDNAstrand boolean indicating whether or not a strand orientation specific offset should be included in the 'model' fit. If includeView == TRUE, includeDNAstrand is ignored.
#' @slot includeView boolean indicating whether or not a view+strand orientation specific offset should be included in the 'model' fit. If includeView == TRUE and rcSymmetric == TRUE, view offsets will be fit for only one of the two DNA strand orientations.
#' @slot includeShape boolean indicating whether or not shape coefficients should be included in the 'model' fit.
#' @slot useFixedValuesOffset.N logical: use initial, fixed values for mononucleotide positions within the model footprint, but not in N.set, as an offset to glm fit.
#' @slot useFixedValuesOffset.Shape logical: use initial, fixed values for shape positions within the model footprint, but not in Shape.set, as an offset to glm fit.
#' @slot exUpBases number of bases upstream of the mono-nucleotide position required to describe shape at the same position. If no value is specified explicitly, exUpBases = 2.
#' @slot exDownBases number of bases downstream of the mono-nucleotide position required to describe shape at the same position. If no value is specified explicitly, exDownBases = 2.
#' @slot fpLen footprint length of model. Must be fpLen = upFootprintExtend+seedLen+downFootprintExtend.
#' @slot shapeParamsUsed list of length one contaning a vector of shape features to be included in 'model'. Only used if includeShape == TRUE.
#' @slot shapeTable table of shape parameters to be used as predictors. Only used if includeShape == TRUE.
#' @slot features object of class 'featureSet' containing specifics of model design and values for model parameters.
#' @slot verbose logical: indicates whether to use verbose options in \pkg{SelexGLM} functions.
#' @slot dateInitialized Character string generated by date() at the time when the object of class 'model' is created.
#' @slot dateBetasLastAdded Character string generated by date() at the time when the object of class 'model' was last changed to incorporate new beta values.
#' @slot dateLastModified Character string generated by date() at the time when the object of class 'model' was changed using any of the methods associated with it.
#' @export model
model <- setClass("model",
representation(name = "character",
varRegLen = "numeric",
leftFixedSeq = "character",
rightFixedSeq = "character",
seedLen = "numeric",
consensusSeq = "character",
leftFixedSeqOverlap = "numeric",
rightFixedSeqOverlap = "numeric",
affinityType = "character",
numViews = "numeric",
rounds = "list",
confidenceLevel = "numeric",
minAffinity = "numeric",
missingValueSuppression = "numeric",
minSeedValue = "numeric",
regressionFormula = "character",
iteration = "numeric",
upFootprintExtend = "numeric",
downFootprintExtend = "numeric",
rcSymmetric = "logical",
includeDNAstrand = "logical",
includeView = "logical",
includeShape = "logical",
useFixedValuesOffset.N = "logical",
useFixedValuesOffset.Shape = "logical",
exUpBases = "numeric",
exDownBases = "numeric",
fpLen = "numeric",
shapeParamsUsed = "list",
shapeTable = "list",
features = "featureSet",
verbose = "logical",
dateInitialized= "character",
dateBetasLastAdded = "character",
dateLastModified = "character"),
validity=validModel)
#' Initialize object of class 'model'
#'
#' Initializes an S4 class to represent full model features
#'
#' @param model Object of class 'model'
#' @export
setMethod("initialize",
"model",
function(.Object,
name,
varRegLen,
leftFixedSeq,
rightFixedSeq,
seedLen,
consensusSeq,
leftFixedSeqOverlap,
rightFixedSeqOverlap,
affinityType,
numViews,
rounds,
confidenceLevel,
minAffinity,
missingValueSuppression,
minSeedValue,
regressionFormula,
iteration,
upFootprintExtend,
downFootprintExtend,
rcSymmetric,
includeDNAstrand,
includeView,
includeShape,
useFixedValuesOffset.N,
useFixedValuesOffset.Shape,
exUpBases,
exDownBases,
fpLen,
shapeParamsUsed,
shapeTable,
features,
verbose,
dateInitialized,
dateBetasLastAdded,
dateLastModified,
N,
Intercept,
Shape,
N.upFootprintExtend,
N.downFootprintExtend,
N.set,
N.values,
N.errors,
N.z,
N.sig,
N.oldValues,
N.oldErrors,
N.oldZ,
N.oldSig,
N.equivMat,
I.values,
I.errors,
I.z,
I.sig,
I.oldValues,
I.oldErrors,
I.oldZ,
I.oldSig,
Shape.upFootprintExtend,
Shape.downFootprintExtend,
Shape.set,
Shape.values,
Shape.errors,
Shape.z,
Shape.sig,
Shape.oldValues,
Shape.oldErrors,
Shape.oldZ,
Shape.oldSig,
Shape.equivMat,
...) {
# rcSymmetric attribute initialized
if (!missing(name)) {
.Object@name <- name
} else {
.Object@name = character(0)
}
if (!missing(varRegLen)) {
.Object@varRegLen <- varRegLen
} else {
stop('varRegLen must be specified')
}
if (!missing(leftFixedSeq)) {
.Object@leftFixedSeq <- leftFixedSeq
} else {
stop('leftFixedSeq must be specified')
}
if (!missing(rightFixedSeq)) {
.Object@rightFixedSeq <- rightFixedSeq
} else {
stop('rightFixedSeq must be specified')
}
# seedLen attribute initialized
if (!missing(seedLen)) {
.Object@seedLen = seedLen
} else if (!missing(consensusSeq)) {
if (length(consensusSeq) > 0) {
.Object@seedLen = countDNAseqLength(consensusSeq)
}
} else {
stop('no value specified for "seedLen" or consensusSeq.')
}
# consensusSeq attribute initialized
if (!missing(consensusSeq)) {
if (length(consensusSeq) > 0) {
.Object@consensusSeq = convertSeq2RegEx(consensusSeq)
} else {
.Object@consensusSeq = paste("[ACGT]{", .Object@seedLen, "}", sep = "")
}
} else {
.Object@consensusSeq = paste("[ACGT]{", .Object@seedLen, "}", sep = "")
}
# leftFixedSeqOverlap attribute initialized
if (!missing(leftFixedSeqOverlap)) {
.Object@leftFixedSeqOverlap = leftFixedSeqOverlap
} else {
.Object@leftFixedSeqOverlap = 0
message('no value specified for "leftFixedSeqOverlap"; set to default value: leftFixedSeqOverlap = 0')
}
# rightFixedSeqOverlap attribute initialized
if (!missing(rightFixedSeqOverlap)) {
.Object@rightFixedSeqOverlap = rightFixedSeqOverlap
} else {
.Object@rightFixedSeqOverlap = .Object@leftFixedSeqOverlap
}
# affinityType attribute initialized
if (!missing(affinityType)) {
.Object@affinityType = affinityType
} else {
.Object@affinityType= "Affinity"
}
# rounds attribute initialized
if (!missing(rounds)) {
if (length(rounds) != 1) {
stop('"rounds" must be a list of length 1. rounds[[1]] should be a vector of any length containing shape parameters to be used.')
}
.Object@rounds = rounds
} else {
stop('"rounds" must be specified.')
}
.Object@rounds[[1]] = .Object@rounds[[1]][order(.Object@rounds[[1]])]
# confidenceLevel attribute initialized
if (!missing(confidenceLevel)) {
.Object@confidenceLevel = confidenceLevel
} else {
.Object@confidenceLevel= .95
message('no value specified for "confidenceLevel"; set to default value: confidenceLevel = .95')
}
# minAffinity attribute initialized
if (!missing(minAffinity)) {
.Object@minAffinity = minAffinity
} else {
.Object@minAffinity = 0
message('no value specified for "minAffinity"; set to default value: minAffinity = 0')
}
# missingValueSuppression attribute initialized
if (!missing(missingValueSuppression)) {
.Object@missingValueSuppression = missingValueSuppression
} else {
.Object@missingValueSuppression = 1
message('no value specified for "missingValueSuppression"; set to default value: missingValueSuppression = 1')
}
# minSeedValue attribute initialized
if (!missing(minSeedValue)) {
.Object@minSeedValue = minSeedValue
} else {
.Object@minSeedValue= 0
message('no value specified for "minSeedValue"; set to default value: minSeedValue = 0')
}
#regression formula attribute initialized
if (!missing(regressionFormula)) {
stop('"regressionFormula" cannot be specified directly. The "regression" formula slot will be automatically generated to reflect the feature design-related slots.')
}
# iteration attribute initialized
if (!missing(iteration)) {
.Object@iteration = iteration
} else {
.Object@iteration = 0
}
# upFootprintExtend attribute initialized
if (!missing(upFootprintExtend)) {
.Object@upFootprintExtend = upFootprintExtend
} else {
.Object@upFootprintExtend = 0
}
# downFootprintExtend attribute initialized
if (!missing(downFootprintExtend)) {
.Object@downFootprintExtend = downFootprintExtend
} else {
.Object@downFootprintExtend = upFootprintExtend
}
# fpLen attribute initialized
if (!missing(fpLen)) {
message('value specified for "fpLen" will be overridden if inconsistent with fpLen = seedLen+upFootprintExtend+downFootprintExtend')
}
.Object@fpLen = .Object@seedLen+.Object@upFootprintExtend+.Object@downFootprintExtend
if (.Object@fpLen > .Object@leftFixedSeqOverlap+.Object@varRegLen+.Object@rightFixedSeqOverlap) {
stop("Can't choose upFootprintExtend, downFootprintExtend, and seedLen such that fpLen > varRegLen+leftFixedSeqOverlap+rightFixedSeqOverlap")
}
# numViews attribute initialized
if (!missing(numViews)) {
message('value specified for "numViews" will be overridden if inconsistent with numViews = varRegLen+leftFixedSeqOverlap+rightFixedSeqOverlap-fpLen+1')
}
.Object@numViews = .Object@varRegLen+.Object@leftFixedSeqOverlap+.Object@rightFixedSeqOverlap-.Object@fpLen+1
if (.Object@numViews < 1) {
stop("'numViews' must be a positive number. Choose shorter fpLen or use more of fixed flanking region such that the footprint of the model fits within the DNA sequence under consideration.")
}
# rcSymmetric attribute initialized
if (!missing(rcSymmetric)) {
.Object@rcSymmetric = rcSymmetric
} else {
.Object@rcSymmetric = FALSE
message('no value specified for "rcSymmetric"; set to default value: rcSymmetric = FALSE')
}
#includeDNAstrand attribute initialized
if (!missing(includeDNAstrand)) {
if ((.Object@rcSymmetric == TRUE) & (includeDNAstrand == TRUE)) {
stop('"rcSymmetric" and "includeDNAstrand" cannot both be TRUE for the same "model" object.')
}
.Object@includeDNAstrand = includeDNAstrand
} else {
.Object@includeDNAstrand = FALSE
}
#includeView attribute initialized
if (!missing(includeView)) {
.Object@includeView = includeView
if ((.Object@includeView == TRUE) & (.Object@includeDNAstrand == TRUE)) {
message("includeDNAstrand & includeView can't both be true. Setting includeDNAstrand = FALSE.")
.Object@includeDNAstrand = FALSE
}
} else {
.Object@includeView = FALSE
}
# includeShape attribute initialized
if (!missing(includeShape)) {
.Object@includeShape= includeShape
} else {
.Object@includeShape = FALSE
}
# useFixedValuesOffset.N attribute initialized
if (!missing(useFixedValuesOffset.N)) {
.Object@useFixedValuesOffset.N= useFixedValuesOffset.N
} else {
.Object@useFixedValuesOffset.N= FALSE
}
# useFixedValuesOffset.Shape attribute initialized
if (!missing(useFixedValuesOffset.Shape)) {
.Object@useFixedValuesOffset.Shape= useFixedValuesOffset.Shape
} else {
.Object@useFixedValuesOffset.Shape= FALSE
}
# exUpBases attribute initialized
if (!missing(exUpBases)) {
.Object@exUpBases = exUpBases
} else {
.Object@exUpBases = 2
}
# exDownBases attribute initialized
if (!missing(exDownBases)) {
.Object@exDownBases = exDownBases
} else {
.Object@exDownBases = 2
}
# shapeParamsUsed attribute initialized
if (!missing(shapeParamsUsed)) {
if (!is.list(shapeParamsUsed)) {
stop('"shapeParamsUsed" must be a list of length 1. shapeParamsUsed[[1]] should be a vector of any length containing shape parameters to be used.')
}
if (length(shapeParamsUsed) != 1) {
stop('"shapeParamsUsed" must be a list of length 1. shapeParamsUsed[[1]] should be a vector of any length containing shape parameters to be used.')
}
if (!missing(includeShape)) {
if (includeShape == FALSE) {
if (length(shapeParamsUsed[[1]]) != 0) {
stop("If 'includeShape' is FALSE, 'shapeParamsUsed' should equal list(c(character(0)).")
}
} else {
if (length(shapeParamsUsed) != 1) {
stop("If 'includeShape' is TRUE, 'shapeParamsUsed' must be a list of length 1, with shapeParamsUsed[[1]] of length >= 1.")
}
}
} else {
if (length(shapeParamsUsed[[1]]) != 0) {
stop("If 'includeShape' is FALSE, 'shapeParamsUsed' should equal list(c(character(0)).")
}
}
.Object@shapeParamsUsed = shapeParamsUsed
.Object@shapeParamsUsed[[1]] = .Object@shapeParamsUsed[[1]][order(.Object@shapeParamsUsed[[1]])]
} else {
if (!missing(includeShape)) {
if (includeShape == TRUE) {
stop("For includeShape == TRUE, must initialize shapeParamsUsed as a list of length 1 containing a vector with at least one of the following c('HelT', 'MGW', 'ProT', 'Roll').")
} else {
.Object@shapeParamsUsed = list(c(character(0)))
}
} else {
.Object@shapeParamsUsed = list(c(character(0)))
}
}
# shapeTable attribute initialized
if (!missing(shapeTable)) {
.Object@shapeTable= shapeTable
} else {
if (.Object@includeShape == TRUE) {
stop('If "includeShape" is TRUE, must specify a shapeTable.')
}
}
# verbose attribute initialized
if (!missing(verbose)) {
.Object@verbose = verbose
} else {
.Object@verbose = FALSE
}
# initialize features slot
if (!missing(features)) {
if (features@seedLen != .Object@seedLen) {
stop('features@seedLen is not consistent with "seedLen" slot.')
}
if (features@upFootprintExtend != .Object@upFootprintExtend) {
stop('features@upFootprintExtend is not consistent with "upFootprintExtend" slot.')
}
if (features@downFootprintExtend != .Object@downFootprintExtend) {
stop('features@downFootprintExtend is not consistent with "downFootprintExtend" slot.')
}
if (features@numViews != .Object@numViews) {
stop('features@numViews is not consistent with "numViews" slot.')
}
if (!all(features@rounds[[1]][order(features@rounds[[1]])] == .Object@rounds[[1]][order(.Object@rounds[[1]])])) {
stop('features@rounds is not consistent with "rounds" slot.')
}
if (features@rcSymmetric != .Object@rcSymmetric) {
stop('features@rcSymmetric is not consistent with "rcSymmetric" slot.')
}
if (length(features@shapeParamsUsed[[1]]) != 0) {
if (length(features@shapeParamsUsed[[1]]) == length(.Object@shapeParamsUsed[[1]])) {
if (!all(features@shapeParamsUsed[[1]][order(features@shapeParamsUsed[[1]])] == .Object@shapeParamsUsed[[1]][order(.Object@shapeParamsUsed[[1]])])) {
stop('features@shapeParamsUsed is not consistent with "shapeParamsUsed" slot.')
}
} else {
stop('features@shapeParamsUsed is not consistent with "shapeParamsUsed" slot.')
}
} else if (length(.Object@shapeParamsUsed[[1]]) != 0) {
stop('features@shapeParamsUsed is not consistent with "shapeParamsUsed" slot.')
}
.Object@features = featureSet(seedLen = features@seedLen,
upFootprintExtend = features@upFootprintExtend,
downFootprintExtend = features@downFootprintExtend,
numViews = features@numViews,
rounds = features@rounds,
shapeParamsUsed = features@shapeParamsUsed,
rcSymmetric = features@rcSymmetric,
N = features@N,
Intercept = features@Intercept,
Shape = features@Shape)
if ((!missing(N)) | (!missing(Shape))| (!missing(Intercept))| (!missing(Shape.upFootprintExtend))|
(!missing(Shape.downFootprintExtend))| (!missing(Shape.set))| (!missing(Shape.values))| (!missing(Shape.errors))|
(!missing(Shape.z))| (!missing(Shape.sig))| (!missing(Shape.oldValues))| (!missing(Shape.oldErrors))| (!missing(Shape.oldZ))|
(!missing(Shape.oldSig))| (!missing(Shape.equivMat))| (!missing(I.values)) | (!missing(I.errors)) | (!missing(I.z))|
(!missing(I.sig))|(!missing(I.oldValues))|(!missing(I.oldErrors))|(!missing(I.oldZ))|(!missing(I.oldSig))|
(!missing(N.upFootprintExtend))|(!missing(N.downFootprintExtend))|(!missing(N.values))|(!missing(N.errors))|(!missing(N.z))|
(!missing(N.sig))|(!missing(N.oldValues))|(!missing(N.oldErrors))|(!missing(N.oldZ))|(!missing(N.oldSig))|(!missing(N.equivMat))) {
stop('If "features" slot is specified, "N", "Shape", "Intercept", and all of the slots for these objects cannot be specified.')
}
} else {
fArgs = c(list("featureSet",
seedLen = .Object@seedLen,
upFootprintExtend = .Object@upFootprintExtend,
downFootprintExtend = .Object@downFootprintExtend,
numViews = .Object@numViews,
rounds = .Object@rounds,
rcSymmetric = .Object@rcSymmetric,
shapeParamsUsed = .Object@shapeParamsUsed))
if (!missing(N)) {fArgs = append(fArgs, list(N = N))}
if (!(missing(N.upFootprintExtend))) {fArgs = append(fArgs, list(N.upFootprintExtend = N.upFootprintExtend))}
if (!(missing(N.downFootprintExtend))) {fArgs = append(fArgs, list(N.downFootprintExtend = N.downFootprintExtend))}
if (!(missing(N.set))) {fArgs = append(fArgs, list(N.set = N.set))}
if (!(missing(N.equivMat))) {fArgs = append(fArgs, list(N.equivMat = N.equivMat))}
if (!(missing(N.values))) {fArgs = append(fArgs, list(N.values = N.values))}
if (!(missing(N.errors))) {fArgs = append(fArgs, list(N.errors = N.errors))}
if (!(missing(N.z))) {fArgs = append(fArgs, list(N.z = N.z))}
if (!(missing(N.sig))) {fArgs = append(fArgs, list(N.sig = N.sig))}
if (!(missing(N.oldValues))) {fArgs = append(fArgs, list(N.oldValues = N.oldValues))}
if (!(missing(N.oldErrors))) {fArgs = append(fArgs, list(N.oldErrors = N.oldErrors))}
if (!(missing(N.oldZ))) {fArgs = append(fArgs, list(N.oldZ = N.oldZ))}
if (!(missing(N.oldSig))) {fArgs = append(fArgs, list(N.oldSig = N.oldSig))}
if (.Object@includeShape == FALSE) {
if (!missing(Shape)) {stop("'Shape' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.upFootprintExtend))) {stop("'Shape.upFootprintExtend' should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.upFootprintExtend' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.downFootprintExtend))) {stop("'Shape.downFootprintExtend' should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.downFootprintExtend' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.set))) {stop("'Shape.set' should not be included as an input to model() when 'includeShape' == FALSE. Remove 'Shape.set' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.equivMat))) {stop("'Shape.equivMat' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.equivMat' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.values))) {stop("'Shape.values' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.values' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.errors))) {stop("'Shape.errors' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.errors' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.z))) {stop("'Shape.z' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.z' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.sig))) {stop("'Shape.sig' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.sig' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldValues))) {stop("'Shape.oldValues' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldValues' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldErrors))) {stop("'Shape.oldErrors' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldErrors' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldZ))) {stop("'Shape.oldZ' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldZ' from function input or add 'includeShape' == TRUE.")}
if (!(missing(Shape.oldSig))) {stop("'Shape.oldSig' object should not be included as an input to model() with 'includeShape' == FALSE. Remove 'Shape.oldSig' from function input or add 'includeShape' == TRUE.")}
} else {
if (!missing(Shape)) {fArgs = append(fArgs, list(Shape = Shape))}
if (!(missing(Shape.upFootprintExtend))) {fArgs = append(fArgs, list(Shape.upFootprintExtend = Shape.upFootprintExtend))}
if (!(missing(Shape.downFootprintExtend))) {fArgs = append(fArgs, list(Shape.downFootprintExtend = Shape.downFootprintExtend))}
if (!(missing(Shape.set))) {fArgs = append(fArgs, list(Shape.set = Shape.set))}
if (!(missing(Shape.equivMat))) {fArgs = append(fArgs, list(Shape.equivMat = Shape.equivMat))}
if (!(missing(Shape.values))) {fArgs = append(fArgs, list(Shape.values = Shape.values))}
if (!(missing(Shape.errors))) {fArgs = append(fArgs, list(Shape.errors = Shape.errors))}
if (!(missing(Shape.z))) {fArgs = append(fArgs, list(Shape.z = Shape.z))}
if (!(missing(Shape.sig))) {fArgs = append(fArgs, list(Shape.sig = Shape.sig))}
if (!(missing(Shape.oldValues))) {fArgs = append(fArgs, list(Shape.oldValues = Shape.oldValues))}
if (!(missing(Shape.oldErrors))) {fArgs = append(fArgs, list(Shape.oldErrors = Shape.oldErrors))}
if (!(missing(Shape.oldZ))) {fArgs = append(fArgs, list(Shape.oldZ = Shape.oldZ))}
if (!(missing(Shape.oldSig))) {fArgs = append(fArgs, list(Shape.oldSig = Shape.oldSig))}
}
if (!missing(Intercept)) {fArgs = append(fArgs, list(Intercept = Intercept))}
if (!(missing(I.values))) {fArgs = append(fArgs, list(I.values = I.values))}
if (!(missing(I.errors))) {fArgs = append(fArgs, list(I.errors = I.errors))}
if (!(missing(I.z))) {fArgs = append(fArgs, list(I.z = I.z))}
if (!(missing(I.sig))) {fArgs = append(fArgs, list(I.sig = I.sig))}
if (!(missing(I.oldValues))) {fArgs = append(fArgs, list(I.oldValues = I.oldValues))}
if (!(missing(I.oldErrors))) {fArgs = append(fArgs, list(I.oldErrors = I.oldErrors))}
if (!(missing(I.oldZ))) {fArgs = append(fArgs, list(I.oldZ = I.oldZ))}
if (!(missing(I.oldSig))) {fArgs = append(fArgs, list(I.oldSig = I.oldSig))}
.Object@features = do.call("new", fArgs)
}
if ((.Object@useFixedValuesOffset.N == TRUE) & (all(c(1:.Object@fpLen) %in% .Object@features@N@N.set))) {
message('Input for useFixedValuesOffset.N = TRUE, but N.set includes all positions of the model. Setting useFixedValuesOffset.N = FALSE.')
.Object@useFixedValuesOffset.N = FALSE
}
if ((.Object@useFixedValuesOffset.Shape == TRUE) & (all(c(1:.Object@fpLen) %in% .Object@features@Shape@Shape.set))) {
message('Input for useFixedValuesOffset.Shape = TRUE, but Shape.set includes all positions of the model. Setting useFixedValuesOffset.Shape = FALSE.')
.Object@useFixedValuesOffset.Shape = FALSE
}
.Object@regressionFormula = buildRawRegressionFormula(.Object)
validObject(.Object)
.Object@dateInitialized = date()
.Object
}
)
#' Get Name Slot.
#'
#' Gets 'name' slot from object of class \linkS4class{model}.
#'
#' @param object object of class 'model'
#' @export
setMethod(
f = "getName",
signature = "model",
definition = function(object) {
return(object@name)
}
)
#' Sets name slot.
#'
#' Sets 'name' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'name' slot from \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setName",
signature = "model",
definition = function(object, value) {
object@name <- value
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Variable Region Length
#'
#' Gets 'varRegLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getVarRegLen",
signature = "model",
definition = function(object) {
return(object@varRegLen)
}
)
#
#' Set Variable Region Length.
#'
#' Sets 'varRegLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}
#' @param value 'varRegLen' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setVarRegLen",
signature = "model",
definition = function(object, value) {
object@varRegLen <- value
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@varRegLen <- value
object@numViews = object@varRegLen+object@leftFixedSeqOverlap+object@rightFixedSeqOverlap-object@fpLen+1
object@features@numViews = object@numViews
object@features@Intercept = new("Intercept", numViews = object@numViews, rounds = object@rounds)
} else {
stop('Cannot reset varRegLen after fitting Intercept parameters.')
}
} else {
stop('Cannot reset varRegLen after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Left Fixed Sequence
#'
#' Gets 'leftFixedSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getLeftFixedSeq",
signature = "model",
definition = function(object) {
return(object@leftFixedSeq)
}
)
#' Set Left Fixed Sequence
#'
#' Sets 'leftFixedSeq' slot for object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'leftFixedSeq' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setLeftFixedSeq",
signature = "model",
definition = function(object, value) {
object@leftFixedSeq <- value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Right Fixed Sequence
#'
#' Gets 'rightFixedSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRightFixedSeq",
signature = "model",
definition = function(object) {
return(object@rightFixedSeq)
}
)
#' Set Right Fixed Sequence
#'
#' Sets 'rightFixedSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'rightFixedSeq' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRightFixedSeq",
signature = "model",
definition = function(object, value) {
object@rightFixedSeq <- value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Seed Length
#'
#' Gets 'seedLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getSeedLen",
signature = "model",
definition = function(object) {
return(object@seedLen)
}
)
#
#' Set Seed Length
#'
#' Sets 'seedLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'seedLen' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setSeedLen",
signature = "model",
definition = function(object, value) {
object@seedLen <- value
if (object@iteration == 0) {
if (dim(getOldValues(object@features@N))[3] == 0) {
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = object@features@N@fS.upFootprintExtend,
fS.downFootprintExtend = object@features@N@fS.downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
} else {
stop('Cannot reset seedLen after adding non-zero N parameters.')
}
}else {
stop('Cannot reset seedLen after adding non-zero N parameters.')
}
if (all(getValues(object@features@Shape) == 0)) {
if (dim(getOldValues(object@features@Shape))[3] == 0) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = object@features@Shape@fS.upFootprintExtend,
fS.downFootprintExtend = object@features@Shape@fS.downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
} else {
stop('Cannot reset seedLen after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset seedLen after adding non-zero Shape parameters.')
}
oldSeqLen = countDNAseqLength(convertSeq2RegEx(object@consensusSeq))
if (object@seedLen != oldSeqLen) {
if (object@consensusSeq != paste("[ACGT]{", oldSeqLen, "}", sep = "")) {
stop("New 'seedLen' does not match 'consensusSeq'.")
} else {
object@consensusSeq = paste("[ACGT]{", object@seedLen, "}", sep = "")
}
}
object@fpLen = object@upFootprintExtend+object@downFootprintExtend+object@seedLen
object@numViews = object@leftFixedSeqOverlap+object@rightFixedSeqOverlap+object@varRegLen-object@fpLen+1
object@features@seedLen = object@seedLen
object@features@numViews = object@numViews
} else {
stop('Cannot reset varRegLen after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Left Fixed Sequence Overlap
#'
#' Gets 'leftFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getLeftFixedSeqOverlap",
signature = "model",
definition = function(object) {
return(object@leftFixedSeqOverlap)
}
)
#' Set Left Fixed Sequence Overlap
#'
#' Sets 'leftFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'leftFixedSeqOverlap' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setLeftFixedSeqOverlap",
signature = "model",
definition = function(object, value) {
object@leftFixedSeqOverlap <- value
object@numViews = object@varRegLen+object@leftFixedSeqOverlap+object@rightFixedSeqOverlap-object@fpLen+1
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@numViews = object@numViews
object@features@Intercept = new("Intercept", numViews = object@numViews, rounds = object@rounds)
} else {
stop('Cannot reset leftFixedSeqOverlap after fitting Intercept parameters.')
}
} else {
stop('Cannot reset leftFixedSeqOverlap after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Right Fixed Sequence Overlap
#'
#' Gets 'rightFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRightFixedSeqOverlap",
signature = "model",
definition = function(object) {
return(object@rightFixedSeqOverlap)
}
)
#' Set Right Fixed Sequence Overlap
#'
#' Sets 'rightFixedSeqOverlap' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'rightFixedSeqOverlap' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRightFixedSeqOverlap",
signature = "model",
definition = function(object, value) {
object@rightFixedSeqOverlap <- value
object@numViews = object@varRegLen+object@leftFixedSeqOverlap+object@rightFixedSeqOverlap-object@fpLen+1
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@numViews = object@numViews
object@features@Intercept = new("Intercept", numViews = object@numViews, rounds = object@rounds)
} else {
stop('Cannot reset rightFixedSeqOverlap after fitting Intercept parameters.')
}
} else {
stop('Cannot reset rightFixedSeqOverlap after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Consensus Sequence
#'
#' Gets 'consensusSeq' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getConsensusSeq",
signature = "model",
definition = function(object) {
return(object@consensusSeq)
}
)
#
#' Set Consensus Sequence
#'
#' Sets 'consensusSeq' slot for object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'consensusSeq' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setConsensusSeq",
signature = "model",
definition = function(object, value) {
value = convertSeq2RegEx(value)
if (object@seedLen != countDNAseqLength(value)) {
stop("New 'consensusSeq' is not the same length as seedLen.")
}
if (object@iteration == 0) {
if (all(getValues(object@features@N) == 0)) {
object@consensusSeq <- value
} else {
stop('Cannot reset consensusSeq after adding non-zero N parameters.')
}
} else {
stop('Cannot reset consensusSeq after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Affinity Type
#'
#' Gets 'affinityType' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getAffinityType",
signature = "model",
definition = function(object) {
return(object@affinityType)
}
)
#
#' Set Affinity Type
#'
#' Sets 'affinityType' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'affinityType' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setAffinityType",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@N) == 0)) {
object@affinityType <- value
} else {
stop('Cannot reset "affinityType" after adding non-zero N parameters.')
}
} else {
stop('Cannot reset "affinityType" after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Number of Views per Strand
#'
#' Gets 'numViews' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getNumViews",
signature = "model",
definition = function(object) {
return(object@numViews)
}
)
#' Set Number of Views per Strand
#'
#' Sets 'numViews' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'numViews' slot for \linkS4class{model} object
#' @export
setReplaceMethod(
f = "setNumViews",
signature = "model",
definition = function(object, value) {
stop('Cannot set "numViews" directly--change seedLen, upFootprintExtend, downFootprintExtend, leftFixedSeqOverlap, rightFixedSeqOverlap, or varRegLen.')
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Rounds
#'
#' Gets 'rounds' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRounds",
signature = "model",
definition = function(object) {
return(object@rounds)
}
)
#
#' Set Rounds
#'
#' Sets 'rounds' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}
#' @param value 'rounds' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRounds",
signature = "model",
definition = function(object, value) {
if (length(value) != 1) {
stop("New 'rounds' slot must be a list of length one.")
} else {
if (length(value[[1]]) <= 0) {
stop("New 'rounds' slot must be a list of length one, where the list has at least one entry.")
}
}
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@rounds <- value
object@features@rounds <- object@rounds
object@features@Intercept <- new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset rounds after fitting Intercept parameters.')
}
} else {
stop('Cannot reset rounds after fitting Intercept parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Confidence Level
#'
#' Gets 'confidenceLevel' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getConfidenceLevel",
signature = "model",
definition = function(object) {
return(object@confidenceLevel)
}
)
#
#' Set Confidence Level
#'
#' Sets 'confidenceLevel' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'confidenceLevel' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setConfidenceLevel",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@confidenceLevel <- value
} else {
stop('Cannot reset confidenceLevel after fitting beta parameters.')
}
} else {
stop('Cannot reset confidenceLevel after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Minimum Affinity
#'
#' Gets 'minAffinity' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getMinAffinity",
signature = "model",
definition = function(object) {
return(object@minAffinity)
}
)
#
#' Set Minimum Affinity
#'
#' Sets 'minAffinity' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'minAffinity' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setMinAffinity",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@minAffinity <- value
} else {
stop('Cannot reset minAffinity after fitting beta parameters.')
}
} else {
stop('Cannot reset minAffinity after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Missing Value Suppression Factor
#'
#' Gets 'missingValueSuppression' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getMissingValueSuppression",
signature = "model",
definition = function(object) {
return(object@missingValueSuppression)
}
)
#' Set Missing Value Suppression Factor
#'
#' Sets 'missingValueSuppression' slot from object of class \linkS4class{model}.
#'
#' @param object object of class \linkS4class{model}.
#' @param value 'missingValueSuppression' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setMissingValueSuppression",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@missingValueSuppression <- value
} else {
stop('Cannot reset missingValueSuppression after fitting beta parameters.')
}
} else {
stop('Cannot reset missingValueSuppression after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Minimum Seed Value
#'
#' Gets 'minSeedValue' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getMinSeedValue",
signature = "model",
definition = function(object) {
return(object@minSeedValue)
}
)
#
#' Set Minimum Seed Value
#'
#' Sets 'minSeedValue' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'minSeedValue' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setMinSeedValue",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@N) == 0)) {
object@minSeedValue <- value
} else {
stop('Cannot reset minSeedValue after "N" seed is already set.')
}
} else {
stop('Cannot reset minSeedValue after "N" seed is already set.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Regression Formula
#'
#' Gets 'regressionFormula' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRegressionFormula",
signature = "model",
definition = function(object) {
return(object@regressionFormula)
}
)
#' Set Regression Formula
#'
#' Sets 'regressionFormula' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'regressionFormula' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRegressionFormula",
signature = "model",
definition = function(object, value) {
stop('Cannot set "regressionFormula" directly--"regressionFormula" is built automatically from model.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Iteration
#'
#' Gets 'iteration' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIteration",
signature = "model",
definition = function(object) {
return(object@iteration)
}
)
#' Set Iteration
#'
#' Sets 'iteration' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'iteration' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIteration",
signature = "model",
definition = function(object, value) {
stop('Cannot set "iteration" directly--"iteration" is updated automatically when new beta values are added.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length Upstream Footprint Extension
#'
#' Gets 'upFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getUpFootprintExtend",
signature = "model",
definition = function(object) {
return(object@upFootprintExtend)
}
)
#' Set Length Upstream Footprint Extension
#'
#' Sets 'upFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'upFootprintExtend' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setUpFootprintExtend",
signature = "model",
definition = function(object, value) {
object@upFootprintExtend = value
object@features@upFootprintExtend = object@upFootprintExtend
object@fpLen = object@upFootprintExtend+object@downFootprintExtend+object@seedLen
object@numViews = object@leftFixedSeqOverlap+object@rightFixedSeqOverlap+object@varRegLen-object@fpLen+1
object@features@numViews = object@numViews
if (object@iteration == 0) {
if (dim(getOldValues(object@features@N))[3] == 0) {
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = value,
fS.downFootprintExtend = object@features@N@fS.downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = value,
fS.downFootprintExtend = object@features@Shape@fS.downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
if (dim(getOldValues(object@features@Intercept))[4] == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@Intercept = new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset upFootprintExtend after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length Downstream Footprint Extension
#'
#' Gets 'downFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getDownFootprintExtend",
signature = "model",
definition = function(object) {
return(object@downFootprintExtend)
}
)
#' Set Length Downstream Footprint Extension
#'
#' Sets 'downFootprintExtend' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'downFootprintExtend' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setDownFootprintExtend",
signature = "model",
definition = function(object, value) {
object@downFootprintExtend = value
object@features@downFootprintExtend = object@downFootprintExtend
object@fpLen = object@upFootprintExtend+object@downFootprintExtend+object@seedLen
object@numViews = object@leftFixedSeqOverlap+object@rightFixedSeqOverlap+object@varRegLen-object@fpLen+1
object@features@numViews = object@numViews
if (object@iteration == 0) {
if (dim(getOldValues(object@features@N))[3] == 0) {
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
if (dim(getOldValues(object@features@Intercept))[4] == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@features@Intercept = new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Intercept parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero Shape parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after adding non-zero N parameters.')
}
} else {
stop('Cannot reset downFootprintExtend after fitting beta parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Reverse Complement Symmetric (logical)
#'
#' Gets 'rcSymmetric' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getRcSymmetric",
signature = "model",
definition = function(object) {
return(object@rcSymmetric)
}
)
#' Set Reverse Complement Symmetric (logical)
#'
#' Sets 'rcSymmetric' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'rcSymmetric' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setRcSymmetric",
signature = "model",
definition = function(object, value) {
if (object@rcSymmetric != value) {
object@rcSymmetric = value
object@features@rcSymmetric = object@rcSymmetric
if (object@iteration != 0) {
stop('Cannot reset rcSymmetric after fitting beta parameters.')
}
if (dim(getOldValues(object@features@N))[3] != 0) {
stop('Cannot reset rcSymmetric after adding non-zero N parameters.')
}
if (all(getValues(object@features@N) == 0)) {
object@features@N = new("N",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
N.upFootprintExtend = object@features@N@N.upFootprintExtend,
N.downFootprintExtend = object@features@N@N.downFootprintExtend,
rcSymmetric = object@rcSymmetric)
} else {
stop('Cannot reset rcSymmetric after adding non-zero N parameters.')
}
if (dim(getOldValues(object@features@Shape))[3] != 0) {
stop('Cannot reset rcSymmetric after adding non-zero Shape parameters.')
}
if (all(getValues(object@features@Shape) == 0)) {
object@features@Shape = new("Shape",
seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
rcSymmetric = object@rcSymmetric,
shapeParamsUsed = object@shapeParamsUsed)
} else {
stop('Cannot reset rcSymmetric after adding non-zero Shape parameters.')
}
if (dim(getOldValues(object@features@Intercept))[4] != 0) {
stop('Cannot reset rcSymmetric after adding non-zero Intercept parameters.')
}
if (all(getValues(object@features@Intercept) == 0)) {
object@features@Intercept = new("Intercept",
numViews = object@numViews,
rounds = object@rounds)
} else {
stop('Cannot reset rcSymmetric after adding non-zero Intercept parameters.')
}
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get includeDNAstrand (logical)
#'
#' Gets 'includeDNAstrand' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIncludeDNAstrand",
signature = "model",
definition = function(object) {
return(object@includeDNAstrand)
}
)
#
#' Set includeDNAstrand (logical)
#'
#' Sets 'includeDNAstrand' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'includeDNAstrand' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIncludeDNAstrand",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
if ((object@includeView == FALSE) | (value == FALSE)) {
object@includeDNAstrand <- value
} else {
stop("If 'includeView' is TRUE, 'includeDNAstrand' is necessarily false. To chance 'includeDNAstrand' to TRUE, first change 'includeView' to FALSE.")
}
} else {
stop('Cannot reset includeDNAstrand after "Intercept" seed is already set.')
}
} else {
stop('Cannot reset includeDNAstrand after "Intercept" seed is already set.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get includeView (logical)
#'
#' Gets 'includeView' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIncludeView",
signature = "model",
definition = function(object) {
return(object@includeView)
}
)
#' Set includeView (logical)
#'
#' Sets 'includeView' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'includeView' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIncludeView",
signature = "model",
definition = function(object, value) {
if (object@iteration == 0) {
if (all(getValues(object@features@Intercept) == 0)) {
object@includeView <- value
} else {
stop('Cannot reset includeView after "Intercept" seed is already set.')
}
} else {
stop('Cannot reset includeView after "Intercept" seed is already set.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get includeShape (logical)
#'
#' Gets 'includeShape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIncludeShape",
signature = "model",
definition = function(object) {
return(object@includeShape)
}
)
#' Get useFixedValuesOffset.N (logical)
#'
#' Gets 'useFixedValuesOffset.N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getUseFixedValuesOffset.N",
signature = "model",
definition = function(object) {
return(object@getUseFixedValuesOffset.N)
}
)
#' Get useFixedValuesOffset.Shape (logical)
#'
#' Gets 'useFixedValuesOffset.Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getUseFixedValuesOffset.Shape",
signature = "model",
definition = function(object) {
return(object@getUseFixedValuesOffset.Shape)
}
)
#' Set includeShape (logical)
#'
#' Sets 'includeShape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'includeShape' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setIncludeShape",
signature = "model",
definition = function(object, value) {
if ((value == TRUE) & (object@includeShape == FALSE)) {
stop("Cannot set includeShape to TRUE after the model design is set up. Instead, create a new model object with includeShape = TRUE.")
} else if (object@includeShape == FALSE) {
object@regressionFormula = buildRawRegressionFormula(object)
} else {
if (object@iteration == 0) {
if (all(getValues(object@features@Shape) == 0)) {
object@shapeParamsUsed = list(c(character(0)))
object@features@shapeParamsUsed = list(c(character(0)))
shapeArrays = array(0, dim = c(0, object@fpLen, dim(object@features@Shape@Shape.oldValues)[3]),
dimnames = list(NULL, c(1:object@fpLen), dimnames(object@features@Shape@Shape.oldValues)[[3]]))
nShape <- Shape(seedLen = object@seedLen,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
shapeParamsUsed = object@shapeParamsUsed,
rcSymmetric = object@rcSymmetric,
Shape.oldValues = shapeArrays,
Shape.oldErrors = shapeArrays,
Shape.oldZ = shapeArrays,
Shape.oldSig = shapeArrays)
if (object@seedLen != nShape@seedLen) {
stop('Current and replacement versions of Shape slot must have the same seed length.')
}
if (object@upFootprintExtend != nShape@fS.upFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.upFootprintExtend.')
}
if (object@downFootprintExtend != nShape@fS.downFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.downFootprintExtend.')
}
if (!all(c(ncol(getValues(nShape)),ncol(getErrors(nShape)), ncol(getZ(nShape)), ncol(getSig(nShape)), ncol(getOldValues(nShape)),
ncol(getOldErrors(nShape)), ncol(getOldZ(nShape)), ncol(getOldSig(nShape))) == object@fpLen)) {
stop("All beta related slots in new 'Shape' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
if (!all(c(nrow(getValues(nShape)),nrow(getErrors(nShape)), nrow(getZ(nShape)), nrow(getSig(nShape)), nrow(getOldValues(nShape)),
nrow(getOldErrors(nShape)), nrow(getOldZ(nShape)), nrow(getOldSig(nShape))) == nrow(getOldSig(nShape)))) {
stop("All beta related slots in new 'Shape' must have a number of rows equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
validObject(nShape)
object@features@Shape <- nShape
validObject(object)
object@includeShape = FALSE
} else {
stop('Cannot reset includeShape after "Shape" beta values have been added to the "model" object.')
}
} else {
stop('Cannot reset includeShape after "Shape" beta values have been added to the "model" object.')
}
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set 'useFixedValuesOffset.N' (logical)
#'
#' Sets 'useFixedValuesOffset.N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'useFixedValuesOffset.N'' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setUseFixedValuesOffset.N",
signature = "model",
definition = function(object, value) {
if ((value == TRUE) & (length(object@features@N@N.set) == object@fpLen)) {
stop("Cannot set 'setUseFixedValuesOffset.N'=TRUE if all nucleotide positions within the model footprint are in N.set and aren't fixed.")
}
object@useFixedValuesOffset.N = value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set useFixedValuesOffset.Shape (logical)
#'
#' Sets 'useFixedValuesOffset.Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'useFixedValuesOffset.Shape'' slot for \linkS4class{model} object
#' @export
setReplaceMethod(
f = "setUseFixedValuesOffset.Shape",
signature = "model",
definition = function(object, value) {
if ((value == TRUE) & (length(object@features@Shape@Shape.set) == object@fpLen)) {
stop("Cannot set 'setUseFixedValuesOffset.Shape'=TRUE if all shape positions within the model footprint are in Shape.set and aren't fixed.")
}
if ((value == TRUE) & (length(object@shapeParamsUsed[[1]]) == 0)) {
stop("Cannot set 'setUseFixedValuesOffset.Shape'=TRUE if there are no shape parameters in the model (i.e. shapeParamsUsed = list(c(character(0)))).")
}
object@useFixedValuesOffset.Shape = value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length of Extension Upstream Bases for Shape Parameters
#'
#' Gets 'exUpBases' slot from object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getExUpBases",
signature = "model",
definition = function(object) {
return(object@exUpBases)
}
)
#' Set Length of Extension Upstream Bases for Shape Parameters
#'
#' Sets 'exUpBases' slot for object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'exUpBases' slot for 'model' object
#' @export
setReplaceMethod(
f = "setExUpBases",
signature = "model",
definition = function(object, value) {
stop('Cannot set "exUpBases" directly after model is initialized.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Length of Extension Downstream Bases for Shape Parameters
#'
#' Gets 'exDownBases' slot from object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getExDownBases",
signature = "model",
definition = function(object) {
return(object@exDownBases)
}
)
#' Set Length of Extension Downstream Bases for Shape Parameters
#'
#' Sets 'exDownBases' slot for object of class \linkS4class{model}
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'exDownBases' slot for 'model' object
#' @export
setReplaceMethod(
f = "setExDownBases",
signature = "model",
definition = function(object, value) {
stop('Cannot set "exDownBases" directly after model is initialized.')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Footprint Length
#'
#' Gets 'fpLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getFpLen",
signature = "model",
definition = function(object) {
return(object@fpLen)
}
)
#' Set Footprint Length
#'
#' Sets 'fpLen' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'fpLen' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setFpLen",
signature = "model",
definition = function(object, value) {
stop('Cannot set "fpLen" directly--"fpLen" is built automatically from "seedLen", "upFootprintExtend", and "downFootprintExtend".')
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Shape Parameters Used
#'
#' Gets 'shapeParamsUsed' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getShapeParamsUsed",
signature = "model",
definition = function(object) {
return(object@shapeParamsUsed)
}
)
#
#' Set Shape Parameters Used
#'
#' Sets 'shapeParamsUsed' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'shapeParamsUsed' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setShapeParamsUsed",
signature = "model",
definition = function(object, value) {
if (!is.list(value)) {
stop("New 'shapeParamsUsed' slot must be a list of length one.")
}
if (length(value) != 1) {
stop("New 'shapeParamsUsed' slot must be a list of length one.")
}
if (object@iteration == 0) {
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
if (!all(value[[1]] %in% c("HelT", "MGW", "ProT", "Roll"))) {
stop(paste("New 'shapeParamsUsed' (",
paste(values[[1]], collapse = ", "),
") contains parameters not in c('HelT', 'MGW', 'ProT', 'Roll').",
sep = ""))
} else if (!all(value[[1]] %in% colnames(object@shapeTable))) {
stop(paste("New 'shapeParamsUsed' (",
paste(values[[1]], collapse = ", "),
") contains parameters not contained in 'shapeTable' (",
paste(colnames(object@shapeTable), collapse = ", "),
") .",
sep = ""))
} else {
object@shapeParamsUsed <- value
object@features@shapeParamsUsed <- object@shapeParamsUsed
object@features@Shape <- new("Shape",
seedLen = object@seedLen,
Shape.upFootprintExtend = object@features@Shape@Shape.upFootprintExtend,
Shape.downFootprintExtend = object@features@Shape@Shape.downFootprintExtend,
fS.upFootprintExtend = object@upFootprintExtend,
fS.downFootprintExtend = object@downFootprintExtend,
Shape.set = object@features@Shape@Shape.set,
Shape.equivMat = object@features@Shape@Shape.equivMat,
shapeParamsUsed = object@shapeParamsUsed,
rcSymmetric = object@rcSymmetric)
}
} else {
stop('Cannot reset rounds after fitting Shape parameters.')
}
} else {
stop('Cannot reset rounds after fitting Shape parameters.')
}
} else {
stop('Cannot reset rounds after fitting Shape parameters.')
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Shape Table
#'
#' Gets 'shapeTable' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getShapeTable",
signature = "model",
definition = function(object) {
return(object@shapeTable)
}
)
#' Set Shape Table
#'
#' Sets 'shapeTable' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'shapeTable' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setShapeTable",
signature = "model",
definition = function(object, value) {
if (object@includeShape == TRUE) {
if (object@iteration == 0) {
if (dim(getOldValues(object@features@Shape))[3] == 0) {
if (all(getValues(object@features@Shape) == 0)) {
if (length(value) > 0) {
sCols = gsub("Shape.", "", nrow(object@features@Shape@Shape.values))
if (!all(sCols %in% colnames(value))){
stop(paste("New 'shapeTable' columns (",
paste(colnames(value), collapse = ", "),
") do not contain all of the parameters implied by shapeParamsUsed[[1]] (",
paste(sCol, collapse = ", "),
").",
sep = ""))
} else {
object@shapeTable <- value
}
} else {
stop(paste("New 'shapeTable' is not a valid choice for the parameters in shapeParamsUsed[[1]] (",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
").",
sep = ""))
}
} else {
stop('Cannot reset shapeTable after fitting Shape parameters.')
}
} else {
stop('Cannot reset shapeTable after fitting Shape parameters.')
}
} else {
stop('Cannot reset shapeTable after fitting Shape parameters.')
}
} else {
object@shapeTable = value
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Get Verbose (logical)
#'
#' Gets 'verbose' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getVerbose",
signature = "model",
definition = function(object) {
return(object@verbose)
}
)
#' Get Date Initialized
#'
#' Gets 'dateInitialized' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getDateInitialized",
signature = "model",
definition = function(object) {
return(object@dateInitialized)
}
)
#' Get Date Last Modified
#'
#' Gets 'dateLastModified' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getDateLastModified",
signature = "model",
definition = function(object) {
return(object@dateLastModified)
}
)
#' Get Date Betas Last Added.
#'
#' Gets 'dateBetasLastAdded' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}
#' @export
setMethod(
f = "getDateBetasLastAdded",
signature = "model",
definition = function(object) {
return(object@dateBetasLastAdded)
}
)
#' Set verbose (logical)
#'
#' Sets 'verbose' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'verbose' slot for \linkS4class{model} object.
#' @export
setReplaceMethod(
f = "setVerbose",
signature = "model",
definition = function(object, value) {
object@verbose = value
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set Date Initialized
#'
#' Sets 'dateInitialized' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setDateInitialized",
signature = "model",
definition = function(object, value) {
stop('dateInitialized is automatically updated by the model-class and its related methods. This parameter should not be changed manually.')
}
)
#' Set Date Last Modified
#'
#' Sets 'dateLastModified' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setDateLastModified",
signature = "model",
definition = function(object, value) {
stop('dateLastModified is automatically updated by the model-class and its related methods. This parameter should not be changed manually.')
}
)
#' Set Date Betas Last Added
#'
#' Sets 'dateBetasLastAdded' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setReplaceMethod(
f = "setDateBetasLastAdded",
signature = "model",
definition = function(object, value) {
stop('dateBetasLastAdded is automatically updated by the model-class and its related methods. This parameter should not be changed manually.')
}
)
#' Get N
#'
#' Gets 'N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getN",
signature = "model",
definition = function(object) {
return(object@features@N)
}
)
#' Get Intercept
#'
#' Gets 'Intercept' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getIntercept",
signature = "model",
definition = function(object) {
return(object@features@Intercept)
}
)
#' Get Shape
#'
#' Gets 'Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getShape",
signature = "model",
definition = function(object) {
return(object@features@Shape)
}
)
#' Get Features
#'
#' Gets 'features' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getFeatures",
signature = "model",
definition = function(object) {
return(object@features)
}
)
#' Set Features
#'
#' Sets 'features' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value 'features' slot for \linkS4class{model} object
#' @export
setReplaceMethod(
f = "setFeatures",
signature = "model",
definition = function(object, value) {
object@iteration = 0
if (object@seedLen != value@seedLen) {
stop("New 'seedLen' for 'features' slot must equal 'seedLen' for model.")
}
if (object@upFootprintExtend != value@upFootprintExtend) {
stop("New 'upFootprintExtend' for 'features' slot must equal 'upFootprintExtend' for model.")
}
if (object@downFootprintExtend != value@downFootprintExtend) {
stop("New 'downFootprintExtend' for 'features' slot must equal 'downFootprintExtend' for model.")
}
if (!all(unique(object@rounds[[1]])[order(unique(object@rounds[[1]]))] == unique(value@rounds[[1]])[order(unique(value@rounds[[1]]))])) {
stop("New 'rounds' for 'features' slot must equal 'rounds' for model.")
}
if (!all(object@shapeParamsUsed[order(object@shapeParamsUsed[[1]])] == value@shapeParamsUsed[[1]][order(value@shapeParamsUsed[[1]])])) {
stop("New 'shapeParamsUsed' for 'features' slot must equal 'shapeParamsUsed' for model.")
}
if (object@numViews != value@numViews) {
stop("New 'numViews' for 'features' slot must equal 'numViews' for model.")
}
if (object@rcSymmetric != value@rcSymmetric) {
stop("New 'rcSymmetric' for 'features' slot must equal 'rcSymmetric' for model.")
}
object@features = value
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object
}
)
#' Set N
#'
#' Sets 'N' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Object of class \linkS4class{N}.
#' @export
setReplaceMethod(
f = "setN",
signature = "model",
definition = function(object, value) {
oldN = getN(object)
if (oldN@seedLen != value@seedLen) {
stop('Current and replacement versions of N must have the same seed length.')
}
if (oldN@fS.upFootprintExtend != value@fS.upFootprintExtend) {
stop('Current and replacement versions of N must have the same value of fS.upFootprintExtend.')
}
if (oldN@fS.downFootprintExtend != value@fS.downFootprintExtend) {
stop('Current and replacement versions of N must have the same value of fS.downFootprintExtend.')
}
if (!all(c(ncol(getValues(value)),ncol(getErrors(value)), ncol(getZ(value)), ncol(getSig(value)), ncol(getOldValues(value)),
ncol(getOldErrors(value)), ncol(getOldZ(value)), ncol(getOldSig(value))) == ncol(getValues(oldN)))) {
stop("All beta related slots in new 'N' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
setValues(value) = getValues(value)
setErrors(value) = getErrors(value)
setZ(value) = getZ(value)
setSig(value) = getSig(value)
setOldValues(value) = getOldValues(value)
setOldErrors(value) = getOldErrors(value)
setOldZ(value) = getOldZ(value)
setOldSig(value) = getOldSig(value)
setEquivMat(value) = getEquivMat(value)
validObject(value)
object@features@N <- value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Set Intercept
#'
#' Sets 'Intercept' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Object of class \linkS4class{Intercept}.
#' @export
setReplaceMethod(
f = "setIntercept",
signature = "model",
definition = function(object, value) {
oldI = getIntercept(object)
if (!all(c(ncol(getValues(value)),ncol(getErrors(value)), ncol(getZ(value)), ncol(getSig(value)), ncol(getOldValues(value)),
ncol(getOldErrors(value)), ncol(getOldZ(value)), ncol(getOldSig(value))) == ncol(getValues(oldI)))) {
stop("All beta related slots in new 'Intercept' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
if (!all(c(dim(getValues(value))[3],dim(getErrors(value))[3], dim(getZ(value))[3], dim(getSig(value))[3], dim(getOldValues(value))[3],
dim(getOldErrors(value))[3], dim(getOldZ(value))[3], dim(getOldSig(value))[3]) == dim(getValues(oldI))[3])) {
stop("All beta related slots in new 'Intercept' must have the same number of rounds (dim[3]).")
}
setValues(value) = getValues(value)
setErrors(value) = getErrors(value)
setZ(value) = getZ(value)
setSig(value) = getSig(value)
setOldValues(value) = getOldValues(value)
setOldErrors(value) = getOldErrors(value)
setOldZ(value) = getOldZ(value)
setOldSig(value) = getOldSig(value)
validObject(value)
object@features@Intercept <- value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Set Shape
#'
#' Sets 'Shape' slot from object of class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Object of class \linkS4class{Shape}.
#' @export
setReplaceMethod(
f = "setShape",
signature = "model",
definition = function(object, value) {
oldS = getShape(object)
if (oldS@seedLen != value@seedLen) {
stop('Current and replacement versions of Shape slot must have the same seed length.')
}
if (oldS@fS.upFootprintExtend != value@fS.upFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.upFootprintExtend.')
}
if (oldS@fS.downFootprintExtend != value@fS.downFootprintExtend) {
stop('Current and replacement versions of Shape slot must have the same value of fS.downFootprintExtend.')
}
if (!all(c(ncol(getValues(value)),ncol(getErrors(value)), ncol(getZ(value)), ncol(getSig(value)), ncol(getOldValues(value)),
ncol(getOldErrors(value)), ncol(getOldZ(value)), ncol(getOldSig(value))) == ncol(getValues(oldS)))) {
stop("All beta related slots in new 'Shape' must have a number of columns equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
if (!all(c(nrow(getValues(value)),nrow(getErrors(value)), nrow(getZ(value)), nrow(getSig(value)), nrow(getOldValues(value)),
nrow(getOldErrors(value)), nrow(getOldZ(value)), nrow(getOldSig(value))) == nrow(getValues(oldS)))) {
stop("All beta related slots in new 'Shape' must have a number of rows equal to the footprint length specified by seedLen, upFootprintExtend, and downFootprintExtend.")
}
setValues(value) = getValues(value)
setErrors(value) = getErrors(value)
setZ(value) = getZ(value)
setSig(value) = getSig(value)
setOldValues(value) = getOldValues(value)
setOldErrors(value) = getOldErrors(value)
setOldZ(value) = getOldZ(value)
setOldSig(value) = getOldSig(value)
setEquivMat(value) = getEquivMat(value)
validObject(value)
object@features@Shape <- value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Show \linkS4class{model}
#'
#' Defines a show method for class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "show",
signature = "model",
definition = function(object) {
cat('An object of class "', class(object), '"\n', sep = "")
cat("\n")
if (length(object@name) > 0) {
cat('Slot "name": ', object@name, '\n')
} else {
cat('Slot "name": ', "char(0)", '\n')
}
cat('Slot "varRegLen": ', object@varRegLen, '\n')
cat('Slot "leftFixedSeq": ', object@leftFixedSeq, '\n')
cat('Slot "rightFixedSeq": ', object@rightFixedSeq, '\n')
cat('Slot "seedLen": ', object@seedLen, '\n')
cat('Slot "consensusSeq": ', object@consensusSeq, '\n')
cat('Slot "leftFixedSeqOverlap": ', object@leftFixedSeqOverlap, '\n')
cat('Slot "rightFixedSeqOverlap": ', object@rightFixedSeqOverlap, '\n')
cat('Slot "affinityType": ', object@affinityType, '\n')
cat('Slot "numViews": ', object@numViews, '\n')
cat('Slot "rounds[[1]]": ', object@rounds[[1]], '\n')
cat('Slot "confidenceLevel": ', object@confidenceLevel, '\n')
cat('Slot "minAffinity": ', object@minAffinity, '\n')
cat('Slot "missingValueSuppression": ', object@missingValueSuppression, '\n')
cat('Slot "minSeedValue": ', object@minSeedValue, '\n')
cat('Slot "regressionFormula": ', object@regressionFormula, '\n')
cat('Slot "iteration": ', object@iteration, '\n')
cat('Slot "upFootprintExtend": ', object@upFootprintExtend, '\n')
cat('Slot "downFootprintExtend": ', object@downFootprintExtend, '\n')
cat('Slot "rcSymmetric": ', object@rcSymmetric, '\n')
cat('Slot "includeDNAstrand": ', object@includeDNAstrand, '\n')
cat('Slot "includeView": ', object@includeView, '\n')
cat('Slot "includeShape": ', object@includeShape, '\n')
cat('Slot "useFixedValuesOffset.N": ', object@useFixedValuesOffset.N, '\n')
cat('Slot "useFixedValuesOffset.Shape": ', object@useFixedValuesOffset.Shape, '\n')
cat('Slot "exUpBases": ', object@exUpBases, '\n')
cat('Slot "exDownBases": ', object@exDownBases, '\n')
cat('Slot "fpLen": ', object@fpLen, '\n')
if (length(object@shapeParamsUsed[[1]]) > 0) {
cat('Slot "shapeParamsUsed[[1]]": ', object@shapeParamsUsed[[1]], '\n')
} else {
cat('Slot "shapeParamsUsed[[1]]": ', "list()", '\n')
}
if (length(object@shapeTable) > 0) {
cat('Slot "shapeTable" (first 6 rows): ','\n')
print(head(object@shapeTable))
} else {
cat('Slot "shapeTable": ','list()','\n')
}
cat("\n")
cat('Slot "features": ', '\n')
cat("\n")
cat('Slot "N": \n')
show(object@features@N)
cat("\n")
cat('Slot "Intercept": \n')
show(object@features@Intercept)
cat("\n")
cat('Slot "Shape": \n')
show(object@features@Shape)
cat("\n")
cat("\n")
cat('Slot "verbose": ', object@verbose, '\n')
cat("\n")
invisible(NULL)
}
)
#' Print \linkS4class{model}
#'
#' Defines a print method for class \linkS4class{model}.
#'
#' @param x Object of class \linkS4class{model}.
#' @export
setMethod(
f = "print",
signature = "model",
definition = function(x) {
show(x)
}
)
#' Get Feature Design
#'
#' Defines a print design method for class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "getFeatureDesign",
signature = "model",
definition = function(object) {
cat("Feature design for object of class '", class(object), "'\n", sep = "")
cat("\n")
cat('seedLen: ', object@seedLen, '\n')
cat('upFootprintExtend: ', object@upFootprintExtend, '\n')
cat('downFootprintExtend: ', object@downFootprintExtend, '\n')
cat('rcSymmetric: ', object@rcSymmetric, '\n')
cat("\n")
cat('Slot "N":', '\n')
cat('N.upFootprintExtend: ', object@features@N@N.upFootprintExtend, '\n')
cat('N.downFootprintExtend: ', object@features@N@N.downFootprintExtend, '\n')
cat('N.set: ', object@features@N@N.set, '\n')
cat('Number of previous iterations: ', dim(object@features@N@N.oldValues)[3], '\n')
cat("\n")
if (object@includeView == TRUE) {
if (object@rcSymmetric == TRUE) {
cat('Slot "Intercept": (View-Specific Factors Included in Fit)', '\n')
} else {
cat('Slot "Intercept": (View+Strand Orientation-Specific Factors Included in Fit)', '\n')
}
} else if (object@includeDNAstrand == TRUE) {
cat('Slot "Intercept": (Strand Orientation-Specific Factors Included in Fit)', '\n')
} else {
cat('Slot "Intercept": (No View or Strand Orientation-Specific Factors Included in Fit)', '\n')
}
cat("Number of Views per Strand of DNA: ", ncol(object@features@Intercept@I.values), '\n', sep = "")
cat("Number of Rounds: ", dim(object@features@Intercept@I.values)[3]," (", paste(gsub("Round.", "", dimnames(object@features@Intercept@I.values)[[3]]), collapse = ", "),")\n", sep = "")
cat('Number of previous iterations: ', dim(object@features@Intercept@I.oldValues)[4], '\n', sep = "")
cat("\n")
cat('Slot "Shape":', '\n')
if (nrow(object@features@Shape@Shape.values) > 0) {
cat('ShapeParamsUsed: ', object@features@Shape@shapeParamsUsed[[1]], '\n')
cat('Shape.upFootprintExtend: ', object@features@Shape@Shape.upFootprintExtend, '\n')
cat('Shape.downFootprintExtend: ', object@features@Shape@Shape.downFootprintExtend, '\n')
cat('Shape.set: ', object@features@Shape@Shape.set, '\n')
cat('Number of previous iterations: ', dim(object@features@Shape@Shape.oldValues)[3], '\n')
} else {
cat('"ShapeParamsUsed": NONE')
}
cat("\n")
invisible(NULL)
}
)
#' Summary method for \linkS4class{model}
#'
#' Defines a summary method for class \linkS4class{model}.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "summary",
signature = "model",
definition = function(object) {
cat("An object of class '", class(object), "'\n", sep = "")
cat("\n")
if (length(object@name) > 0) {
cat('Slot "name": ', object@name, '\n')
}
cat('Slot "varRegLen": ', object@varRegLen, '\n')
cat('Slot "leftFixedSeq": ', object@leftFixedSeq, '\n')
cat('Slot "rightFixedSeq": ', object@rightFixedSeq, '\n')
cat('Slot "leftFixedSeqOverlap": ', object@leftFixedSeqOverlap, '\n')
cat('Slot "rightFixedSeqOverlap": ', object@rightFixedSeqOverlap, '\n')
cat('Slot "confidenceLevel": ', object@confidenceLevel, '\n')
cat('Slot "minAffinity": ', object@minAffinity, '\n')
cat('Slot "missingValueSuppression": ', object@missingValueSuppression, '\n')
cat('Slot "minSeedValue": ', object@minSeedValue, '\n')
cat('Slot "seedLen": ', object@seedLen, '\n')
cat('Slot "consensusSeq": ', object@consensusSeq, '\n')
cat('Slot "upFootprintExtend": ', object@upFootprintExtend, '\n')
cat('Slot "downFootprintExtend": ', object@downFootprintExtend, '\n')
cat('Slot "fpLen": ', object@fpLen, '\n')
cat("\n")
if ((object@includeShape == TRUE) & (object@includeView == TRUE)) {
fString = paste(" for mono-nucleotide, view, and shape features (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") ",
sep = "")
} else if ((object@includeShape == TRUE) & (object@includeDNAstrand == TRUE)) {
fString = paste(" for mono-nucleotide, strand orientation, and shape features (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") ",
sep = "")
} else if (object@includeShape == TRUE) {
fString = paste(" for mono-nucleotide and shape features (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") ",
sep = "")
} else {
fString = " for mono-nucleotide features "
}
if (object@useFixedValuesOffset.N==TRUE ) {
if (object@useFixedValuesOffset.Shape == TRUE) {
f2string = "with fixed values for mono-nucleotide positions not included in N.set and for shape parameter positions not included in Shape.set used as offsets for the glm fit, and "
} else {
f2string = "with fixed values for mono-nucleotide positions not included in N.set used as offsets for the glm fit, and "
}
} else if (object@useFixedValuesOffset.Shape == TRUE) {
f2string = "with fixed values for shape parameter positions not included in Shape.set used as offsets for the glm fit, and "
} else {
f2string = "with "
}
if (object@rcSymmetric == TRUE) {
cat("Fits a model of footprint length ",
object@fpLen,
fString,
f2string,
object@numViews,
" view(s) per strand of DNA and ",
length(object@rounds[[1]]),
" round(s) of data (round = ",
paste(object@rounds[[1]], collapse = ", "),
") with reverse complement symmetry.\n",
sep = "")
} else {
cat("Fits a model of footprint length ",
object@fpLen,
fString,
" with ",
object@numViews,
" view(s) per strand of DNA and ",
length(object@rounds[[1]]),
" round(s) of data (round = ",
paste(object@rounds[[1]], collapse = ", "),
") without reverse complement symmetry.\n",
sep = "")
}
cat("\n")
cat('Slot "regressionFormula": ', object@regressionFormula, '\n')
cat("\n")
if (getIncludeShape(object) == TRUE) {
if (length(object@shapeParamsUsed[[1]]) > 0) {
cat('Slot "shapeParamsUsed[[1]]": ', object@shapeParamsUsed[[1]], '\n')
}
}
cat("\n")
cat("Includes the following feature sub-classes: \n")
cat("An object of class '", class(getN(object)),"'", "\n", sep = "")
cat("Fits ",
length(getPositions(getN(object))),
" nucleotides for a feature model of length ",
(object@upFootprintExtend+object@downFootprintExtend+object@seedLen),
".\n",
sep = "")
if (!all(getEquivMat(getN(object)) == 0)) {
if (all(getEquivMat(getN(object))[,1:(getFpLen(object) %/%2)] == 0)) {
halfMatCheck = getEquivMat(getN(object))[1:(getFpLen(object) %/%2+getFpLen(object) %%2),
(getFpLen(object) %/%2+1):getFpLen(object)]
halfMatCheck = halfMatCheck[,ncol(halfMatCheck):1]
if (all(diag(halfMatCheck) == -1)) {
cat("Nucleotide features are reverse complement symmetric.\n")
}
}
}
cat("Nucleotide beta values:\n")
print(getValues(getN(object)))
cat("\n")
cat("Nucleotide beta errors:\n")
print(getErrors(getN(object)))
cat("\n")
cat("\n")
cat("An object of class '", class(getIntercept(object)),"'", "\n", sep = "")
if ((getIncludeView(object) == TRUE) & (getRcSymmetric(object) == TRUE)) {
cat("Fits ",
(1+1*(object@rcSymmetric == FALSE))*ncol(getValues(getIntercept(object))),
" views and ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,,i]
rownames(vals)[1] = "StrandView"
print(vals[1,, drop = FALSE])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,,i]
rownames(errs)[1] = "StrandView"
print(errs[1,,drop = FALSE])
cat("\n")
}
} else if ((getIncludeView(object) == TRUE) & (getRcSymmetric(object) == FALSE)) {
cat("Fits ",
(1+1*(object@rcSymmetric == FALSE))*ncol(getValues(getIntercept(object))),
" views and ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,,i]
print(vals[,])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,,i]
print(errs[,])
cat("\n")
}
} else if ((getIncludeDNAstrand(object) == TRUE) & (getRcSymmetric(object) == FALSE)) {
cat("Fits 2 strand orientations and ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,,i]
colnames(vals)[1] = "Strand"
print(vals[,1, drop = FALSE])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,,i]
colnames(errs)[1] = "Strand"
print(errs[,1, drop = FALSE])
cat("\n")
}
} else {
cat("Fits intercept(s) for ",
dim(getValues(getIntercept(object)))[3],
" round(s) (round = ",
paste(object@rounds[[1]], collapse = ", "),
").\n",
sep = "")
cat("Intercept beta values:\n")
for (i in 1:dim(getValues(getIntercept(object)))[3]) {
cat(paste(dimnames(getValues(getIntercept(object)))[[3]][i], ":\n", sep = ""))
vals = getValues(getIntercept(object))[,1,i, drop = FALSE]
rownames(vals)[1] = "Intercept"
colnames(vals) = NULL
print(vals[1,drop = FALSE])
cat("\n")
}
cat("Intercept beta errors:\n")
for (i in 1:dim(getErrors(getIntercept(object)))[3]) {
cat(paste(dimnames(getErrors(getIntercept(object)))[[3]][i], ":\n", sep = ""))
errs = getErrors(getIntercept(object))[,1,i, drop = FALSE]
rownames(errs)[1] = "Intercept"
colnames(errs) = NULL
print(errs[1,drop = FALSE])
cat("\n")
}
}
cat("\n")
cat("\n")
cat("An object of class '", class(getShape(object)),"'", "\n", sep = "")
cat("Fits ",
nrow(getValues(getShape(object)))*length(getPositions(getShape(object))),
" shape coefficients for ",
nrow(getValues(getShape(object))),
" kinds of shape parameter(s) (shape = ",
paste(object@shapeParamsUsed[[1]], collapse = ", "),
") for a feature model of length ",
(getFpLen(object)),
".\n",
sep = "")
if (nrow(getValues(getShape(object))) > 0) {
if (!all(getEquivMat(getShape(object)) == 0)) {
if (all(getEquivMat(getShape(object))[,1:(getFpLen(object) %/%2)] == 0)) {
halfMatCheck = getEquivMat(getShape(object))[1:(getFpLen(getShape(object)) %/%2+getFpLen(getShape(object)) %%2),
(getFpLen(getShape(object)) %/%2+1):getFpLen(getShape(object))]
halfMatCheck = halfMatCheck[,ncol(halfMatCheck):1]
if (all(diag(halfMatCheck) == -1)) {
cat("Shape features are reverse complement symmetric.\n")
}
}
}
cat("Shape beta values:\n")
print(getValues(getShape(object)))
cat("\n")
cat("Shape beta errors:\n")
print(getErrors(getShape(object)))
cat("\n")
}
invisible(NULL)
}
)
#' Length of \linkS4class{model}
#'
#' Defines 'length' method for object of class \linkS4class{model}.
#'
#' The length of \linkS4class{model} object is defined as the footprint length of the model.
#' The footprint length is given by \code{fpLen} = \code{seedLen}+\code{upFootprintExtend}+\code{downFootprintExtend}.
#'
#' @param x Object of class \linkS4class{model}.
#' @export
setMethod(
f = "length",
signature = "model",
definition = function(x) {
length = x@fpLen
return (length)
}
)
#' Add Seed PSAM
#'
#' Adds seeding nucleotide PSAM to \linkS4class{model} class.
#'
#' @param object Object of class \linkS4class{model}.
#' @param value Seeding PSAM for nucleotides.
#' @export
setReplaceMethod(
f = "addSeedPsam",
signature = "model",
definition = function(object, value){
setValues(object@features@N) = value
validObject(object)
object@dateLastModified = date()
return(object)
}
)
#' Build Seed PSAM
#'
#' Uses k-mer table to build PSAM matrix for seeding SelexGLM.
#'
#' @param object Object of class \linkS4class{model}.
#' @param seedTable Kmer table used to build nucleotide seed.
#' @return Kmer table-derived nucleotide Beta Values.
#' @export
setMethod(
f = "seedTable2psam",
signature = "model",
definition = function(object, seedTable){
if (nchar(seedTable$Kmer[1]) != getSeedLen(object)) {
stop("Seed Table Kmers do not match seedLen specified for model")
}
psam = getPSAM(object)
seedPos = c((object@upFootprintExtend+1):(object@upFootprintExtend+object@seedLen))
psam[,seedPos] = NA
psam = psam[,(object@upFootprintExtend+1):(object@upFootprintExtend+object@seedLen)]
b = c("A", "C", "G", "T")
psam_seq = array(dim=c(4, getSeedLen(object)))
rownames(psam) = b
rownames(psam_seq) = b
seedTable = seedTable[order(-seedTable[,getAffinityType(object)]),]
rownames(seedTable) = NULL
testSeq = seedTable$Kmer[grep(getConsensusSeq(object), seedTable$Kmer)[1]]
testSeq = gsub(getConsensusSeq(object), "",testSeq)
extraChars = nchar(testSeq)
if (extraChars == 0) {
seedSeq = seedTable$Kmer[grep(getConsensusSeq(object), seedTable$Kmer)[1]]
} else {
cS = paste("[ACGT]{", (extraChars/2), "}", getConsensusSeq(object), "[ACGT]{", (extraChars/2), "}", sep = "")
seedSeq = seedTable$Kmer[grep(cS, seedTable$Kmer)[1]]
}
for (i in (seedPos-object@upFootprintExtend)) {
for (j in (1:4)) {
if (i == 1) {
tempseq = paste(b[j], stringi::stri_sub(seedSeq, (i+1), getSeedLen(object)), sep="")
} else if (i == getSeedLen(object)) {
tempseq = paste(stringi::stri_sub(seedSeq, 1, (i-1)), b[j], sep="")
} else {
tempseq = paste(stringi::stri_sub(seedSeq, 1, i-1), b[j], stringi::stri_sub(seedSeq, i+1, getSeedLen(object)), sep = "")
}
psam_seq[j, i] = tempseq
ind = grep(tempseq, seedTable$Kmer)
if (length(ind) == 1) {
psam[j, i] = seedTable[ind, getAffinityType(object)]
}
}
}
S.equivMat = object@features@Shape@Shape.equivMat[seedPos,seedPos]
if (!all(S.equivMat == 0)) {
cNames = colnames(S.equivMat)
for (i in 1:ncol(S.equivMat)) {
c = cNames[i]
if (all(S.equivMat[,c] == 0)) {
next
}
if (length(cNames[S.equivMat[,c] == -1]) == 1) {
r = cNames[S.equivMat[,c] == -1]
psamCol1 = psam[,c]
psamCol2 = psam[,r]
for (j in 1:4) {
if (is.na(psamCol1[j]) == TRUE) {
if (is.na(psamCol2[5-j]) == FALSE) {
psamCol1[j] = psamCol2[5-j]
}
}
if (is.na(psamCol2[5-j]) == TRUE) {
if (is.na(psamCol1[j]) == FALSE) {
psamCol2[5-j] = psamCol1[j]
}
}
}
psam[,c] = psamCol1
psam[,r] = psamCol2
}
if (length(cNames[S.equivMat[,c] == 1]) == 1) {
r = cNames[S.equivMat[,c] == 1]
psamCol1 = psam[,c]
psamCol2 = psam[,r]
for (j in 1:4) {
if (is.na(psamCol1[j]) == TRUE) {
if (is.na(psamCol2[j]) == FALSE) {
psamCol1[j] = psamCol2[j]
}
}
if (is.na(psamCol2[j]) == TRUE) {
if (is.na(psamCol1[j]) == FALSE) {
psamCol2[j] = psamCol1[j]
}
}
}
psam[,c] = psamCol1
psam[,r] = psamCol2
}
}
}
MinPSAM = min(psam, na.rm = TRUE)
psam[is.na(psam)] = MinPSAM/exp(getMissingValueSuppression(object))
psam[psam < getMinSeedValue(object)] = getMinSeedValue(object)
psam = log(psam)
if (object@rcSymmetric == TRUE) {
psamH1 = psam[,1:ceiling(ncol(psam)/2)]
psamH2 = psam[4:1, ncol(psam):1][,1:ceiling(ncol(psam)/2)]
psamH = (psamH1+psamH2)/2
psam = cbind(psamH,psamH[4:1,(floor(ncol(psam)/2)):1])
}
colnames(psam) = seedPos
psam = t(psam)
MaxCol = apply(psam, 1, max)
psam[,1] = psam[,1]-MaxCol
psam[,2] = psam[,2]-MaxCol
psam[,3] = psam[,3]-MaxCol
psam[,4] = psam[,4]-MaxCol
psam = t(psam)
r.psam = matrix(0, nrow = 4, ncol = getUpFootprintExtend(object))
l.psam = matrix(0, nrow = 4, ncol = getDownFootprintExtend(object))
psam = cbind(r.psam, psam, l.psam)
rownames(psam) = c("N.A", "N.C", "N.G", "N.T")
colnames(psam) = 1:getFpLen(object)
return (psam)
}
)
#' Add New Betas to \linkS4class{model}
#'
#' Adds new betas to object of class \linkS4class{model} using the output of a glm fit.
#'
#' @param object Object of class \linkS4class{model}.
#' @param design Design table used to fit glm model.
#' @param value Glm fit object.
#' @return \linkS4class{model} object updated to include glm fit data.
#' @export
setMethod(
f = "addNewBetas",
signature = "model",
definition = function(object, design, value){
object@iteration = object@iteration+1
glmFits = object@features@glmFits
iter = object@iteration
newFit = summary(value)
newFit$deviance.resid = c(NA)
if (length(glmFits) == 0) {
glmFits = list(newFit)
names(glmFits) = c("iter1")
} else {
glmFits[[length(glmFits)+1]] <- newFit
names(glmFits)[length(glmFits)] = c(paste("iter", length(glmFits), sep = ""))
}
object@features@glmFits = glmFits
dM = getDesignMatrix(object, design)
dMsummary = object@features@designMatrixSummary
if (length(dMsummary) == 0) {
dMsummary = list(dM)
names(dMsummary) = c("iter1")
} else {
dMsummary[[length(dMsummary)+1]] <- dM
names(dMsummary)[length(dMsummary)] = c(paste("iter", length(dMsummary), sep = ""))
}
object@features@designMatrixSummary = dMsummary
# Add Nucleotide Data from fit
object@features@N = addNewBetas(object@features@N, design = design, value = value, missingValueSuppression = object@missingValueSuppression, useFixedValuesOffset.N = object@useFixedValuesOffset.N)
# Add Intercept Data from fit
object@features@Intercept = addNewBetas(object@features@Intercept, design = design, value = value, missingValueSuppression = object@missingValueSuppression, includeDNAstrand = object@includeDNAstrand, includeView = object@includeView, rcSymmetric = object@rcSymmetric)
# Add Shape Data from fit
object@features@Shape = addNewBetas(object@features@Shape, design = design, value = value, useFixedValuesOffset.Shape = object@useFixedValuesOffset.Shape)
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object@dateBetasLastAdded = date()
return(object)
}
)
#' Finalize Beta Values
#'
#' Finalizes beta values in \linkS4class{model} object by restoring NA's that were removed to allow for the iteration.
#'
#' @param object Object of class \linkS4class{model}.
#' @export
setMethod(
f = "finalizeFeatureBetas",
signature = "model",
definition = function(object){
iter = object@iteration
betaSummary = object@features@glmFits[[paste("iter", iter, sep = "")]]$coefficients
dM = object@features@designMatrixSummary[[paste("iter", iter, sep = "")]]
# Finalize N betas
N.set = object@features@N@N.set
N.notSet = c(1:object@fpLen)[!(c(1:object@fpLen) %in% N.set)]
N.ncol = object@fpLen
N.values = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
N.errors = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
N.z = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
N.sig = matrix(NA, nrow = 4, ncol = N.ncol,
dimnames = list(c("N.A", "N.C", "N.G", "N.T"), 1:object@fpLen))
if (length(N.notSet) > 0) {
if (object@useFixedValuesOffset.N == TRUE) {
N.values[,N.notSet] = getValues(object@features@N)[,N.notSet]
N.errors[,N.notSet] = getErrors(object@features@N)[,N.notSet]
N.z[,N.notSet] = getZ(object@features@N)[,N.notSet]
N.sig[,N.notSet] = getSig(object@features@N)[,N.notSet]
} else {
N.values[,N.notSet] = 0
N.errors[,N.notSet] = 0
N.z[,N.notSet] = 0
N.sig[,N.notSet] = 0
}
}
if (!all(N.set == 0)) {
sumN = dM$N
refN = apply(sumN, 1, which.max)
zeroNs = matrix(c(refN, as.numeric(names(refN))), nrow = length(refN),
ncol = 2, byrow = FALSE)
N.values[zeroNs] = 0
N.errors[zeroNs] = 0
N.z[zeroNs] = 0
N.sig[zeroNs] = 0
grStr = "N.[ACGT][0-9]{1,}"
Ns = rownames(betaSummary)[grep(grStr, rownames(betaSummary))]
cols = as.numeric(gsub("N.[ACGT]", "", Ns))
rows = gsub("[0-9]{1,}", "", Ns)
names(cols) = Ns
names(rows) = Ns
for (n in Ns) {
N.values[rows[n], cols[n]] = betaSummary[n,1]
N.errors[rows[n], cols[n]] = betaSummary[n,2]
N.z[rows[n], cols[n]] = betaSummary[n,3]
N.sig[rows[n], cols[n]] = betaSummary[n,4]
}
if (!(all(object@features@N@N.equivMat == 0))) {
equivMat = object@features@N@N.equivMat
for (i in rev(N.set)) {
matchCol = equivMat[,i]
matchIndices = which(matchCol != 0)
if (length(matchIndices[matchIndices %in% N.set]) > 0) {
matchIndex = min(matchIndices[matchIndices %in% N.set])
if (matchCol[matchIndex] == 1) {
N.values[,i] = N.values[,matchIndex]
N.errors[,i] = N.errors[,matchIndex]
N.z[,i] = N.z[,matchIndex]
N.sig[,i] = N.sig[,matchIndex]
equivMat[i,] = 0
} else if (matchCol[matchIndex] == -1) {
if (matchIndex != i) {
N.values[,i] = rev(N.values[,matchIndex])
N.errors[,i] = rev(N.errors[,matchIndex])
N.z[,i] = rev(N.z[,matchIndex])
N.sig[,i] = rev(N.sig[,matchIndex])
equivMat[i,] = 0
} else {
N.values[3:4,i] = rev(N.values[1:2,i])
N.errors[3:4,i] = rev(N.errors[1:2,i])
N.z[3:4,i] = rev(N.z[1:2,i])
N.sig[3:4,i] = rev(N.sig[1:2,i])
}
}
}
}
}
}
object@features@N@N.values = N.values
object@features@N@N.errors = N.errors
object@features@N@N.z = N.z
object@features@N@N.sig = N.sig
validObject(object)
interceptData = betaSummary[grep("Intercept", rownames(betaSummary)),]
newValues = array(interceptData[1],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
newErrors = array(interceptData[2],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
newZ = array(interceptData[3],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
newSig = array(interceptData[4],
dim = dim(getValues(object@features@Intercept)),
dimnames = dimnames(getValues(object@features@Intercept)))
if (object@rcSymmetric == TRUE) {
newValues["Strand.R",,] = 0
newErrors["Strand.R",,] = 0
newZ["Strand.R",,] = 0
newSig["Strand.R",,] = 0
}
grStr = paste("Round.", "[0-9]{1,}", sep = "")
round.inds = grep(grStr, rownames(betaSummary))
betaSub = betaSummary[round.inds,,drop = FALSE]
if (nrow(betaSub) > 0) {
newValues["Strand.F",,rownames(betaSub)] = newValues["Strand.F",,rownames(betaSub)]+array(betaSub[rownames(betaSub), 1],
dim = c(1, dim(newValues)[2]))
newErrors["Strand.F",,rownames(betaSub)] = sqrt(newErrors["Strand.F",,rownames(betaSub)]^2+array(betaSub[rownames(betaSub), 2],
dim = c(1, dim(newValues)[2]))^2)
newZ["Strand.F",,rownames(betaSub)] = newValues["Strand.F",,rownames(betaSub)]/newErrors["Strand.F",,rownames(betaSub)]
newSig["Strand.F",,rownames(betaSub)] = 2*pnorm(-abs(newZ["Strand.F",,rownames(betaSub)]))
}
if (object@includeView == TRUE) {
if (object@rcSymmetric == FALSE) {
grView = paste("Strand.[FR][0-9]{1,}", sep = "")
} else {
grView = paste("Strand.F[0-9]{1,}", sep = "")
}
view.inds = grep(grView, rownames(betaSummary))
V.values = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
V.errors = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
V.z = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
V.sig = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
if (object@rcSymmetric == TRUE) {
V.values["Strand.R",,] = 0
V.errors["Strand.R",,] = 0
V.z["Strand.R",,] = 0
V.sig["Strand.R",,] = 0
}
sumI = dM$Intercept
maxViewIndex = which(sumI[,paste("View.",1:object@numViews,sep = "")] == max(sumI[,paste("View.",1:object@numViews,sep = "")]), arr.ind = TRUE)[1,]
V.values[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
V.errors[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
V.z[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
V.sig[maxViewIndex[[1]], maxViewIndex[[2]],] = 0
Vs = rownames(betaSummary)[grep(grView, rownames(betaSummary))]
if (length(Vs) > 0) {
for (vVar in Vs) {
vStr = gsub("[0-9]{1,}", "", vVar)
vV = paste("View.", gsub("Strand.[FR]", "", vVar), sep = "")
V.values[vStr,vV,] = betaSummary[vVar,1]
V.errors[vStr,vV,] = betaSummary[vVar,2]
V.z[vStr,vV,] = betaSummary[vVar,3]
V.sig[vStr,vV,] = betaSummary[vVar,4]
}
}
newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]+V.values[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = sqrt(newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2+V.errors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2)
newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]/newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newSig[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = 2*pnorm(-abs(newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]))
} else if (object@includeDNAstrand == TRUE) {
St.set = c("Strand.F", "Strand.R")
St.values = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
St.errors = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
St.z = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
St.sig = array(NA, dim = dim(newValues),
dimnames = dimnames(newValues))
sumS = dM$Intercept[,ncol(dM$Intercept), drop = FALSE]
maxSt = which.max(sumS[,1])
St.values[maxSt,,] = 0
St.errors[maxSt,,] = 0
St.z[maxSt,,] = 0
St.sig[maxSt,,] = 0
if (length(St.set) > 0) {
grStr = "Strand.[FR]$"
Sts = rownames(betaSummary)[grep(grStr, rownames(betaSummary))]
if (length(Sts) > 0) {
for (strVar in Sts) {
St.values[strVar,,] = betaSummary[strVar,1]
St.errors[strVar,,] = betaSummary[strVar,2]
St.z[strVar,,]= betaSummary[strVar,3]
St.sig[strVar,,] = betaSummary[strVar,4]
}
}
}
newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]+St.values[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = sqrt(newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2+St.errors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]^2)
newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = newValues[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]/newErrors[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]
newSig[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1] = 2*pnorm(-abs(newZ[c("Strand.F", "Strand.R")[1:(1+1*(object@rcSymmetric == FALSE))],,1]))
}
object@features@Intercept@I.values = newValues
object@features@Intercept@I.errors = newErrors
object@features@Intercept@I.z = newZ
object@features@Intercept@I.sig = newSig
validObject(object)
if (((length(object@shapeParamsUsed[[1]]) > 0)) & (object@includeShape == TRUE)) {
Shape.set = object@features@Shape@Shape.set
Shape.notSet = c(1:object@fpLen)[!(c(1:object@fpLen) %in% Shape.set)]
Shape.ncol = object@fpLen
rowNames = row.names(getValues(object@features@Shape))
numRows = nrow(getValues(object@features@Shape))
Shape.values = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
Shape.errors = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
Shape.z = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
Shape.sig = matrix(NA, nrow = numRows, ncol = Shape.ncol,
dimnames = list(rowNames, 1:object@fpLen))
if (length(Shape.notSet) > 0) {
if (object@useFixedValuesOffset.Shape == TRUE) {
Shape.values[,Shape.notSet] = getValues(object@features@Shape)[,Shape.notSet]
Shape.errors[,Shape.notSet] = getErrors(object@features@Shape)[,Shape.notSet]
Shape.z[,Shape.notSet] = getZ(object@features@Shape)[,Shape.notSet]
Shape.sig[,Shape.notSet] = getSig(object@features@Shape)[,Shape.notSet]
} else {
Shape.values[,Shape.notSet] = 0
Shape.errors[,Shape.notSet] = 0
Shape.z[,Shape.notSet] = 0
Shape.sig[,Shape.notSet] = 0
}
}
if (!all(Shape.set == 0)) {
grStr = "^Shape.[A-Za-z]{1,}[0-9]{1,}"
shapeParamBetas = rownames(betaSummary)[grep(grStr, rownames(betaSummary))]
cols = as.numeric(gsub("^Shape.[A-Za-z]{1,}", "", shapeParamBetas))
rows = gsub("[0-9]{1,}", "", shapeParamBetas)
names(cols) = shapeParamBetas
names(rows) = shapeParamBetas
for (s in shapeParamBetas) {
Shape.values[rows[s], cols[s]] = betaSummary[s,1]
Shape.errors[rows[s], cols[s]] = betaSummary[s,2]
Shape.z[rows[s], cols[s]] = betaSummary[s,3]
Shape.sig[rows[s], cols[s]] = betaSummary[s,4]
}
if (!(all(object@features@Shape@Shape.equivMat == 0))) {
equivMat = object@features@Shape@Shape.equivMat
for (i in rev(Shape.set)) {
matchCol = equivMat[,i]
matchIndices = which(matchCol != 0)
if (length(matchIndices[matchIndices %in% Shape.set]) > 0) {
matchIndex = min(matchIndices[matchIndices %in% Shape.set])
if (matchCol[matchIndex] == 1) {
S = matchIndex
S.equiv = i
if (S != S.equiv) {
Shape.values[,S.equiv] = Shape.values[,S]
Shape.errors[,S.equiv] = Shape.errors[,S]
Shape.z[,S.equiv] = Shape.z[,S]
Shape.sig[,S.equiv] = Shape.sig[,S]
}
equivMat[i,] = 0
equivMat[i,] = 0
} else if (matchCol[matchIndex] == -1) {
if (matchIndex != i) {
S = matchIndex
S.RC= i
shapeParams = object@shapeParamsUsed[[1]]
if ("MGW" %in% shapeParams) {
Shape.values["Shape.MGW", S.RC] = Shape.values["Shape.MGW", S]
Shape.errors["Shape.MGW", S.RC] = Shape.errors["Shape.MGW", S]
Shape.z["Shape.MGW", S.RC] = Shape.z["Shape.MGW", S]
Shape.sig["Shape.MGW", S.RC] = Shape.sig["Shape.MGW", S]
}
if ("ProT" %in% shapeParams) {
Shape.values["Shape.ProT", S.RC] = Shape.values["Shape.ProT", S]
Shape.errors["Shape.ProT", S.RC] = Shape.errors["Shape.ProT", S]
Shape.z["Shape.ProT", S.RC] = Shape.z["Shape.ProT", S]
Shape.sig["Shape.ProT", S.RC] = Shape.sig["Shape.ProT", S]
}
if ("HelT" %in% shapeParams) {
Shape.values["Shape.HelTB", S.RC] = Shape.values["Shape.HelTA", S]
Shape.errors["Shape.HelTB", S.RC] = Shape.errors["Shape.HelTA", S]
Shape.z["Shape.HelTB", S.RC] = Shape.z["Shape.HelTA", S]
Shape.sig["Shape.HelTB", S.RC] = Shape.sig["Shape.HelTA", S]
Shape.values["Shape.HelTA", S.RC] = Shape.values["Shape.HelTB", S]
Shape.errors["Shape.HelTA", S.RC] = Shape.errors["Shape.HelTB", S]
Shape.z["Shape.HelTA", S.RC] = Shape.z["Shape.HelTB", S]
Shape.sig["Shape.HelTA", S.RC] = Shape.sig["Shape.HelTB", S]
}
if ("Roll" %in% shapeParams) {
Shape.values["Shape.RollB", S.RC] = Shape.values["Shape.RollA", S]
Shape.errors["Shape.RollB", S.RC] = Shape.errors["Shape.RollA", S]
Shape.z["Shape.RollB", S.RC] = Shape.z["Shape.RollA", S]
Shape.sig["Shape.RollB", S.RC] = Shape.sig["Shape.RollA", S]
Shape.values["Shape.RollA", S.RC] = Shape.values["Shape.RollB", S]
Shape.errors["Shape.RollA", S.RC] = Shape.errors["Shape.RollB", S]
Shape.z["Shape.RollA", S.RC] = Shape.z["Shape.RollB", S]
Shape.sig["Shape.RollA", S.RC] = Shape.sig["Shape.RollB", S]
}
equivMat[i,] = 0
} else {
S = i
shapeParams = object@shapeParamsUsed[[1]]
if ("HelT" %in% shapeParams) {
Shape.values["Shape.HelTB", S] = Shape.values["Shape.HelTA", S]
Shape.errors["Shape.HelTB", S] = Shape.errors["Shape.HelTA", S]
Shape.z["Shape.HelTB", S] = Shape.z["Shape.HelTA", S]
Shape.sig["Shape.HelTB", S] = Shape.sig["Shape.HelTA", S]
}
if ("Roll" %in% shapeParams) {
Shape.values["Shape.RollB", S] = Shape.values["Shape.RollA", S]
Shape.errors["Shape.RollB", S] = Shape.errors["Shape.RollA", S]
Shape.z["Shape.RollB", S] = Shape.z["Shape.RollA", S]
Shape.sig["Shape.RollB", S] = Shape.sig["Shape.RollA", S]
}
}
}
}
}
}
}
object@features@Shape@Shape.values = Shape.values
object@features@Shape@Shape.errors = Shape.errors
object@features@Shape@Shape.z = Shape.z
object@features@Shape@Shape.sig = Shape.sig
validObject(object)
}
object@regressionFormula = buildRawRegressionFormula(object)
validObject(object)
object@dateLastModified = date()
object@dateBetasLastAdded = date()
return (object)
}
)
#' Get Mononucleotide PSAM
#'
#' Gets mononucleotide PSAM (i.e. mono-nucleotide normalized relative affinity contributions) from object of class \linkS4class{model} for specific iteration.
#'
#' If iteration==NULL, the most recent round of the glm fit values will be used.
#'
#' @param object Object of class \linkS4class{model}.
#' @param iteration Iteration of model fit to be used for PSAM
#' @export
setMethod(
f = "getPSAM",
signature = "model",
definition = function(object, iteration=NULL){
if (is.null(iteration)) {
PSAM = t(object@features@N@N.values)
} else {
oldIters = as.numeric(dimnames(object@features@N@N.oldValues)[[3]])
if (iteration == max(oldIters)+1) {
PSAM = t(object@features@N@N.values)
} else if (iteration %in% oldIters) {
PSAM = t(object@features@N@N.oldValues[,,as.character(iteration)])
} else {
stop('Invalid value for iteration')
}
}
maxNs = apply(PSAM, 1, max, na.rm = TRUE)
for (i in 1:4) {
PSAM[,i] = PSAM[,i]-maxNs
}
PSAM = t(exp(PSAM))
rownames(PSAM) = c("A", "C", "G", "T")
return (PSAM)
}
)
#' Get design matrix for all features
#'
#' Gets feature design from design matrix.
#'
#' @param object Object of class \linkS4class{model}.
#' @param design Data frame with design matrix, as generated by addDesignMatrix function.
#' @export
setMethod(
f = "getDesignMatrix",
signature = "model",
definition = function(object, design) {
sumN = getDesignMatrix(object@features@N, design)
sumI = getDesignMatrix(object@features@Intercept, design)
sumI = cbind(sumI, StrandTotal = c(sum(sumI[1,]), sum(sumI[2,])))
sumR = getRoundDesign(object@features@Intercept, design)
sumR = cbind(sumR, Total = c(sum(sumR[1,])))
if ((object@includeShape == TRUE) & (!all(object@features@Shape@Shape.set == 0))) {
sumS = getDesignMatrix(object@features@Shape, design)
} else {
sumS = matrix(0, nrow = 0, ncol = 0)
}
if (object@useFixedValuesOffset.N == TRUE) {
sumFVN = summary(design$fixedNddG)
} else {sumFVN = numeric(0)}
if (object@useFixedValuesOffset.Shape == TRUE) {
sumFVS = summary(design$fixedSddG)
} else {
sumFVS = numeric(0)
}
dM = c(list(Intercept = sumI, Round = sumR,N = sumN, FixedValues.N = sumFVN, Shape = sumS, FixedValues.Shape = sumFVS))
return(dM)
}
)
#' Plot \linkS4class{model}
#'
#' Plots object of class \linkS4class{model} for any combination of inputs.
#'
#' @param x Object of class \linkS4class{model}.
#' @param plotTitle Optional title parameter to be used for plot.
#' @param maxErr Optional parameter giving maximum error to be displayed in nucleotide affinity plot.
#' @param iter Iteration of beta values to be used in plot. If iteration == NULL, the most recent round of beta values are used.
#' @param regs Optional list containing names of different shaded regions for nucleotide and shape plots.
#' @param lengths Optional list containing lengths of regions in \code{regs}, corresponding to different shaded regions for nucleotide and shape plots.
#' @param Nplot.ddG logical: If TRUE, ddG scaling is used for nucleotide plot. If FALSE, affinity scaling is using for nucleotide plot.
#' @param verticalPlots logical: If TRUE, all plots are stacked vertically. If false, plots are fit into a roughly square block.
#' @return ggplot plots of intercept values
#' @export
setMethod(
f = "plot",
signature = "model",
definition = function(x, plotTitle=NULL, maxErr = 1, iter=NULL, regs, lengths, Nplot.ddG = FALSE, verticalPlots = FALSE) {
if (missing(regs)) {
regs = list(c("Unseeded", "Seeded", "Unseeded"))
}
if (missing(lengths)) {
lengths = list(c(x@upFootprintExtend, x@seedLen, x@downFootprintExtend))
}
if (Nplot.ddG == FALSE) {
Ntitle = expression('Mono-nucleotide Affinities')
} else {
Ntitle = expression(paste('Mononucleotide -', Delta, Delta, 'G values'))
}
if ((x@useFixedValuesOffset.N == TRUE) | (!all(x@features@N@N.set == 0))) {
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
includeN = TRUE
} else {
if (!missing(iter)) {
if (!is.null(iter)) {
if (iter == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else if (dim(x@features@N@N.oldValues)[3] == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else {
includeN = FALSE
}
} else if (dim(x@features@N@N.oldValues)[3] == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else {
includeN = FALSE
}
} else if (dim(x@features@N@N.oldValues)[3] == 0) {
includeN = TRUE
Nplot = plot(x@features@N, Ntitle = Ntitle, maxErr = maxErr, iter = iter, regs = regs, lengths = lengths, ddG = Nplot.ddG)
} else {
includeN = FALSE
}
}
includeView = x@includeView
includeDNAstrand = x@includeDNAstrand
numR = length(x@rounds[[1]])
if (numR > 1) { includeRound = TRUE
} else {includeRound = FALSE}
rcSymmetric = x@rcSymmetric
includeShape = x@includeShape
viewTitle = expression(paste('View-Specific Intercept -', Delta, Delta, 'G values'))
roundTitle = expression(paste('Round-Specific Intercept -', Delta, Delta, 'G values'))
if (includeView == TRUE) {
Vplot = plotViews(x@features@Intercept, rcSymmetric, title = viewTitle, iter = iter)
}
if (includeRound == TRUE) {
Rplot = plotRounds(x@features@Intercept, x@features@designMatrixSummary[[paste("iter", x@iteration, sep = "")]]$Intercept, title = roundTitle, iter = iter)
}
dTitle = expression(paste('Strand-Specific Intercept -', Delta, Delta, 'G values'))
if (includeDNAstrand == TRUE) {
Dplot = plotStrands(x@features@Intercept, title = dTitle, iter = iter)
}
iTitle = expression(paste('Intercept -', Delta, Delta, 'G value'))
if ((includeView == FALSE) & (includeDNAstrand == FALSE) & (includeRound == FALSE)) {
Iplot = plotBasicIntercept(x@features@Intercept, title = iTitle, iter = iter)
}
if (includeShape == TRUE) {
Stitle = expression(paste('Shape parameters -', Delta, Delta, 'G', ' per ', ring(A)))
Splot = plot(x@features@Shape, title = Stitle, iter=iter, regs = regs, lengths = lengths, verticalPlots = verticalPlots)
}
if (includeView == TRUE) {
if (includeRound == TRUE) {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Vplot, Rplot, Splot, nrow = 2, ncol =2, heights=c(4.0,4.0),
widths = c(2.5, 3.5),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Vplot, Rplot, ncol =1, heights=c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Vplot, Rplot, Splot, nrow = 2, ncol =2, layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Vplot, Rplot, ncol =1, heights=c((3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, Vplot, nrow = 2,layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Vplot, Rplot, nrow = 3, ncol = 1, heights = c(4.0, 3.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, Vplot, nrow = 2,heights = c(3.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Vplot, Rplot, nrow = 2, ncol = 1, heights = c(3.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
#
} else {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Vplot, Splot, nrow = 2,layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Vplot, nrow = 3,heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Vplot, Splot, nrow = 2, heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Vplot, nrow = 2, heights = c((3.0*nrow(x@features@Shape@Shape.values)), 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Vplot, nrow = 2, heights = c(4.0, 3.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Vplot, nrow = 2, heights = c(4.0, 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Vplot, widths = c(6.0), heights = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Vplot, nrow = 1, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
}
} else {
if (includeDNAstrand == TRUE) {
if (includeRound == TRUE) {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Dplot, Splot, Rplot, nrow = 2, ncol =2, heights=c(4.0,4.0),
widths = c(3.5, 2.5),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Dplot, Rplot, nrow = 4, heights=c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Dplot, Rplot, Splot, nrow = 2, ncol =2, layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Dplot, Rplot, nrow = 3, heights=c((3.0*nrow(x@features@Shape@Shape.values)), 3.0, 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, Dplot, nrow = 2,layout_matrix = rbind(c(1, 1), c(2, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Dplot, Rplot, nrow = 3, heights = c(4.0, 2.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, Dplot, nrow = 2, heights = c(3.0, 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Dplot, Rplot, nrow = 2, heights = c(2.0, 3.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
} else {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Dplot, Splot, nrow = 2,layout_matrix = rbind(c(1, 2), c(3, 3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot,Splot, Dplot, nrow = 3,heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Dplot, Splot, nrow = 2,heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Dplot, nrow = 2,heights = c((3.0*nrow(x@features@Shape@Shape.values)), 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g =gridExtra::arrangeGrob(Nplot, Dplot, nrow = 2,heights = c(2.75, 2.25),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g =gridExtra::arrangeGrob(Nplot, Dplot, nrow = 2,heights = c(4.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g =gridExtra::arrangeGrob(Dplot, nrow = 1,heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g =gridExtra::arrangeGrob(Dplot, nrow = 1,heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
}
} else {
if (includeRound == TRUE) {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, Splot, layout_matrix = rbind(c(1,1, 2), c(3, 3,3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot,Splot, Rplot, nrow = 3, heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, Splot, nrow = 2, heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Rplot, nrow = 2, heights = c((3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Rplot, nrow = 2, heights = c(3.0, 2.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Rplot, nrow = 2, heights = c(4.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Rplot, nrow = 2, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Rplot, nrow = 2, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
} else {
if (includeShape == TRUE) {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Iplot, Splot, layout_matrix = rbind(c(1,1, 2), c(3, 3,3)),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Splot, Iplot, nrow = 3, heights = c(4.0,(3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Iplot, Splot, nrow = 2, heights = c(2.0, 4.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Splot, Iplot, nrow = 2, heights = c((3.0*nrow(x@features@Shape@Shape.values)), 2.0),
widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
} else {
if (includeN == TRUE) {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Nplot, Iplot, nrow = 2, heights = c(3.0, 2.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Nplot, Iplot, nrow = 2, heights = c(4.0, 2.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
} else {
if (verticalPlots == FALSE) {
g = gridExtra::arrangeGrob(Iplot, nrow = 1, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
} else {
g = gridExtra::arrangeGrob(Iplot, nrow = 1, heights = c(6.0), widths = c(6.0),
top=grid::textGrob(plotTitle,gp=grid::gpar(fontsize=12,fontface="bold")))
}
}
}
}
}
}
return(g)
}
)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.