Single-cell transcriptomics and mouse model phenotyping for biomarker screen of peripheral blood in Huntington's disease.

1. ##' @import Biobase
2. ##' @importFrom plyr rbind.fill
3. ##' @import methods
4. ##' @include AllGenerics.R
5. NULL
8. Mandatory_Featurevars <- character()
9. Mandatory_Cellvars <- character()
11. ##' @import SingleCellExperiment
12. ##' @import S4Vectors
13. ##' @importMethodsFrom S4Vectors mcols
14. ##' @importMethodsFrom SummarizedExperiment colData assays assay
15. setClass('SingleCellAssay', contains='SingleCellExperiment',
16. slots=list(cmap='character', fmap='character'),
17. prototype=list(cmap=Mandatory_Cellvars,
18. fmap=Mandatory_Featurevars))
20. Fluidigm_Cellvars <- c(Mandatory_Cellvars, ncells='ncells')
21. setClass('FluidigmAssay', contains='SingleCellAssay', prototype=list(cmap=Fluidigm_Cellvars))
25. ## Classes
26. ##' Linear Model-like Class
27. ##'
28. ##' Wrapper around modeling function to make them behave enough alike that Wald tests and Likelihood ratio are easy to do.
29. ##' To implement a new type of zero-inflated model, extend this class.
30. ##' Depending on how different the method is, you will definitely need to override the \code{fit} method, and possibly the \code{model.matrix}, \code{model.matrix<-}, \code{update}, \code{coef}, \code{vcov}, and \code{logLik} methods.
31. ##'
32. ##' @section Slots:
33. ##' \describe{
34. ##' \item{design}{a data.frame from which variables are taken for the right hand side of the regression}
35. ##' \item{fitC}{The continuous fit}
36. ##' \item{fitD}{The discrete fit}
37. ##' \item{response}{The left hand side of the regression}
38. ##' \item{fitted}{A \code{logical} with components "C" and "D", TRUE if the respective component has converged}
39. ##' \item{formula}{A \code{formula} for the regression}
40. ##' \item{fitArgsC}{}
41. ##' \item{fitArgsD}{Both \code{list}s giving arguments that will be passed to the fitter (such as convergence criteria or case weights)}
42. ##' }
43. ##' @seealso coef
44. ##' @seealso lrTest
45. ##' @seealso waldTest
46. ##' @seealso vcov
47. ##' @seealso logLik
48. setClass('LMlike',
49. slots=c(design='ANY', modelMatrix='matrix', fitC='ANY', fitD='ANY', response='ANY', fitted='logical', formula='formula', fitArgsD='list', fitArgsC='list', priorVar='numeric', priorDOF='numeric',
50. ## this speeds construction of coef and vcov, which is a pinch point in zlm
51. defaultCoef='numeric',
52. defaultVcov='matrix'),
53. prototype=list(fitted =c(C=FALSE, D=FALSE), formula=formula(0~0),modelMatrix=matrix(nrow=0, ncol=0), priorVar=0, priorDOF=0), validity=function(object){
54. stopifnot( all(c("C", "D") %in% names(object@fitted)))
55. if(length(object@response)>0){
56. if(any(is.na(object@response))) stop('NAs not permitted in response')
57. if(length(object@response)!=nrow(object@design)) stop('Response length differs from design length')
58. ##if(nrow(object@design) != nrow(object@modelMatrix)) stop('Design length differs from model.matrix length')
59. }
60. })
62. ##' Wrapper for regular glm/lm
63. ##'
64. ##' @slot weightFun function to map expression values to probabilities of expression. Currently unused.
65. setClass('GLMlike', contains='LMlike', slots=c(weightFun='function'), prototype=list(weightFun=function(x){
66. ifelse(x>0, 1, 0)
67. }))
69. ##' Initialize a prior to be used a prior for BayeGLMlike/BayesGLMlike2
70. ##'
71. ##' @param names character vector of coefficients. The `(Intercept)` will be ignored.
72. ##' @return 3d array, with leading dimension giving the prior 'loc'ation, 'scale' and degrees of freedom (df),
73. ##' second dimension giving the component ('C'ontinuous or 'D'iscrete)
74. ##' and trailing dimension giving the coefficient to which the prior applies.
75. ##' The location is initialized to be 0, the scale to 2, and degrees of freedom of 1, following the default of bayesglm.
76. ##' @export
77. ##' @examples
78. ##' dp <- defaultPrior('Stim.ConditionUnstim')
79. ##' \dontrun{
80. ##' data(vbetaFA)
81. ##' zlmVbeta <- zlm(~ Stim.Condition, vbetaFA, method='bayesglm', coefPrior=dp)
82. ##' }
83. defaultPrior <- function(names){
84. names <- setdiff(names, '(Intercept)')
85. p <- length(names)
86. ar <- array(rep(c(0, 2.5, 1), times=2*p), dim=c(3, 2,p), dimnames=list(metric=c('loc', 'scale', 'df'), comp=c('C', 'D'), names))
87. #if(p>0) ar['scale',,names=='(Intercept)'] <- 10
88. ar
89. }
92. ##' Wrapper for bayesian GLM
93. ##'
94. ##' @slot prior \code{numeric} optional 3d array used to specify prior for coefficients
95. ##' @slot useContinuousBayes \code{logical} should \code{bayesglm} be used to fit the continuous component as well?
96. setClass('BayesGLMlike', contains='GLMlike', slots=c(coefPrior='array', useContinuousBayes='logical'),
97. prototype=list(coefPrior=defaultPrior(character(0)), useContinuousBayes=FALSE),
98. validity=function(object){
99. ## if(length(object@coefPrior>0))
100. ## if(dim(object@coefPrior)[3] != sum(colnames(model.matrix(object))!='(Intercept)')) stop('prior must have same number of components as model.matrix')
101. TRUE
102. })
103. setClass('BayesGLMlikeWeight', contains='BayesGLMlike')
106. ##' Wrapper for lmer/glmer
107. ##'
108. ##' A horrendous hack is employed in order to do arbitrary likelihood ratio tests: the model matrix is built, the names possibly mangled, then fed in as a symbolic formula to glmer/lmer.
109. ##' This is necessary because there is no (easy) way to specify an arbitrary fixed-effect model matrix in glmer.
110. ##' @slot pseudoMM part of this horrendous hack.
111. ##' @slot strictConvergence \code{logical} (default: \code{TRUE}) return results even when the optimizer or *lmer complains about convergence
112. ##' @slot optimMsg \code{character} record warnings from lme. \code{NA_character_} means no warnings.
113. setClass('LMERlike', contains='LMlike', slots=c(pseudoMM='data.frame',
114. optimMsg='character',
115. strictConvergence='logical'),
116. validity=function(object){
117. if(length(object@response)>0 & nrow(object@pseudoMM)>0){
118. stopifnot(nrow(object@pseudoMM)==length(object@response))
119. }
120. if(object@priorDOF!=0) stop('Empirical bayes shrinkage not implemented for lmer/glmer.')
121. },
122. prototype=list(strictConvergence=TRUE, optimMsg=c(C=NA_character_, D=NA_character_))
123. )
125. setClass('bLMERlike', contains='LMERlike')
127. setClass('ConstrainedGLMlike', contains='LMlike')
128. setClass('RidgeBGLMlike',contains="BayesGLMlike",slots=c(lambda='numeric'),prototype = list(lambda=0.1) )
130. ## Ways to specify hypothesis
131. setClass('Hypothesis', contains='character', slots=list(contrastMatrix='matrix'))
132. setClass('CoefficientHypothesis', contains='Hypothesis', slots=list(index='numeric'))
134. ##' An S4 class to hold the output of a call to zlm
135. ##'
136. ##' This holds output from a call to zlm. Many methods are defined to operate on it. See below.
137. ##' @slot coefC matrix of continuous coefficients
138. ##' @slot coefD matrix of discrete coefficients
139. ##' @slot vcovC array of variance/covariance matrices for coefficients
140. ##' @slot vcovD array of variance/covariance matrices for coefficients
141. ##' @slot LMlike the LmWrapper object used
142. ##' @slot sca the \code{SingleCellAssay} object used
143. ##' @slot deviance matrix of deviances
144. ##' @slot loglik matrix of loglikelihoods
145. ##' @slot df.null matrix of null (intercept only) degrees of freedom
146. ##' @slot df.resid matrix of residual DOF
147. ##' @slot dispersion matrix of dispersions (after shrinkage)
148. ##' @slot dispersionNoShrink matrix of dispersion (before shrinkage)
149. ##' @slot priorDOF shrinkage weight in terms of number of psuedo-obs
150. ##' @slot priorVar shrinkage target
151. ##' @slot converged output that may optionally be set by the underlying modeling function
152. ##' @slot hookOut a list of length ngenes containing output from a hook function, if \code{zlm} was called with one
153. ##' @slot exprs_values `character` or `integer` with the `assay` used.
154. ##' @seealso zlm summary,ZlmFit-method
155. ##' @aliases ZlmFit
156. ##' @examples
157. ##' data(vbetaFA)
158. ##' zlmVbeta <- zlm(~ Stim.Condition+Population, subset(vbetaFA, ncells==1)[1:10,])
159. ##' #Coefficients and standard errors
160. ##' coef(zlmVbeta, 'D')
161. ##' coef(zlmVbeta, 'C')
162. ##' se.coef(zlmVbeta, 'C')
163. ##' #Test for a Population effect by dropping the whole term (a 5 degree of freedom test)
164. ##' lrTest(zlmVbeta, 'Population')
165. ##' #Test only if the VbetaResponsive cells differ from the baseline group
166. ##' lrTest(zlmVbeta, CoefficientHypothesis('PopulationVbetaResponsive'))
167. ##' # Test if there is a difference between CD154+/Unresponsive and CD154-/Unresponsive.
168. ##' # Note that because we parse the expression
169. ##' # the columns must be enclosed in backquotes
170. ##' # to protect the \quote{+} and \quote{-} characters.
171. ##' lrTest(zlmVbeta, Hypothesis('`PopulationCD154+VbetaUnresponsive` -
172. ##' `PopulationCD154-VbetaUnresponsive`'))
173. ##' waldTest(zlmVbeta, Hypothesis('`PopulationCD154+VbetaUnresponsive` -
174. ##' `PopulationCD154-VbetaUnresponsive`'))
175. setClass('ZlmFit', slots=list(coefC='matrix', coefD='matrix', vcovC='array', vcovD='array', LMlike='LMlike', sca='SingleCellAssay', deviance='matrix', loglik='matrix', df.null='matrix', df.resid='matrix', dispersion='matrix', dispersionNoshrink='matrix', priorDOF='numeric', priorVar='numeric', converged='matrix', hookOut='ANY', exprs_values = 'ANY'))
177. ##' An S4 class for Gene Set Enrichment output
178. ##'
179. ##' This holds output from a call to gseaAfterBoot.
180. ##' It primarily provides a summary method.
181. ##' @slot tests array: gene sets X {discrete,continuous} X {stat, variance, degrees of freedom, avg correlation} X {test, null}
182. ##' @slot bootR number of bootstrap replicates
183. ##' @seealso gseaAfterBoot
184. ##' @seealso calcZ
185. ##' @seealso summary,GSEATests-method
186. setClass('GSEATests', slots=list(tests='array', bootR='numeric'))

AllClasses.R at commit d46c1d1, no license · at the source