#' Condition Map
#' @docType class
#' @export
#' @include RequiredColumns.R
#' @import scales
#' @importFrom tibble tibble
#' @import dplyr
#' @examples
#'
#' library(SRMService)
#' library(dplyr)
#' x <- data.frame(Raw.file = c("A","B","C"),"MeasurementOrder" = c(1,2,3) , Gender = c("F","F","M"))
#' cm <- Annotation$new(x, experimentID = "E1 with random Effect", fixed = "Gender", random="MeasurementOrder")
#' cm$exists("Gender")
#' cm$exists("Stop")
#' cm$fixed
#' cm$random
#' cm$as_numeric("Gender")
#' cm$levels("Gender")
#' cm$get("Gender")
#' cm$get_color("Gender")
#' cm$sampleID
#' cm$get_sample_id()
#' cm$annotation
Annotation <- R6::R6Class("Annotation",
public = list(
annotation = tibble::tibble(),
fixed = NULL,
random = NULL,
sampleID = NULL,
experimentID = NULL,
initialize = function(annotation,
experimentID,
fixed =NULL,
random =NULL,
sampleID = "Raw.file")
{
self$sampleID = sampleID
self$experimentID = experimentID
self$fixed = c(fixed)
self$random = c(random)
if(length(base::setdiff(c(self$sampleID,self$fixed,self$random), colnames(data))) == 0 ){
stop("condition mappings does not contain columns : ", c(self$sampleID,self$fixed,self$random), sep = "\n")
}
if( !is.null(self$fixed) ){
if( length(base::setdiff(self$fixed, colnames(annotation))) != 0 ){
stop("annotation does not contain fixed effects : ", base::setdiff(self$fixed, colnames(annotation)))
}
}
if( !is.null(self$random)){
if( length(base::setdiff(self$random, colnames(annotation))) != 0 ){
stop("annotation does not contain random effects : ", base::setdiff(self$random, colnames(annotation)))
}
}
self$annotation <- annotation %>% mutate_if(is.factor, as.character)
},
exists = function(colname)
{
if(length(base::setdiff(colname , colnames(self$annotation)))){
warning("annotation does not contain : ", base::setdiff(colname, colnames(self$annotation)))
return(FALSE)
}
return(TRUE)
},
levels = function(colname){
if(self$exists(colname)){
if(length(colname) > 1){
stop("can get levels only for a single column")
}
levels(as.factor(unlist(self$get(colname ))))
}
},
get = function(colname){
if(self$exists(colname)){
subset( self$annotation, select = colname )
}
},
get_factors = function(){
return(colnames(self$annotation))
},
get_sample_id = function(){
return(as.character(unlist(subset(self$annotation, select = self$sampleID))))
},
as_numeric = function(colname){
if(self$exists(colname)){
as.numeric(as.factor( unlist(self$get(colname)) ))
}
},
get_color = function( colname, pal_function = dichromat_pal, pal_name= "BrowntoBlue.10" ){
"convenience wrapper to scales"
self$exists(colname)
n <- length(self$levels(colname))
colors <- pal_function(pal_name)(n)[self$as_numeric(colname)]
return(colors)
}
))
#' Protein Table
#' @docType class
#' @export
#' @field data data.frame with colnames sample ID rownames proteinID
#' @field experimentID name of the experiment
#' @importFrom R6 R6Class
#' @import dplyr tidyr rlang
#' @examples
#' library(SRMService)
#' x <- data.frame(Raw.file = c("A","B","C"),"MeasurementOrder" = c(1,2,3) , Gender = c("F","F","M"))
#' cm <- Annotation$new(x, experimentID = "E1 fixed Gender", fixed = "Gender")
#' dataProt <- data.frame("proteinID" = c("P1","P2","P3"), NrPeptides = c(1,2,3), "Fasta.Headers" = rep("",3), "A" = rexp(3), "B" = rexp(3), "C" = rexp(3))
#' length(dplyr::intersect("Annotation",class(dataProt))) > 0
#' cm$sampleID
#' pt <- ProteinTableR6$new(cm)
#' pt$set_data_wide(dataProt)
#' pt$get_data_long()
#' pt$get_data_wide()
#' pt$get_all_long()
ProteinTableR6 <- R6::R6Class( "ProteinTableR6", public = list(
data = data.frame(),
proteinID = NULL,
annotation = NULL,
required = NULL,
initialize = function(annotation,
proteinID = "proteinID",
required = c( "NrPeptides", "Fasta.Headers")){
if(!length(intersect("Annotation",class(annotation))) > 0)
{
stop("annotation parameter must be of class Annotation")
}
self$annotation = annotation
self$required = required
self$proteinID = proteinID
},
set_data_wide = function(data){
all_required <- c(self$proteinID, self$required, self$annotation$get_sample_id())
check <- base::setdiff(all_required , colnames(data))
if(length(check) != 0){
stop("not having required columns : " , paste(check , sep=" ") )
}
# take minimal set of columns
data <- dplyr::select(data, all_required )
# convert to wide format
self$data <- tidyr::gather(data, key=rlang::UQ(rlang::sym(self$annotation$sampleID)), value="Intensity", self$annotation$get_sample_id() )
},
get_protein_id = function(){
dplyr::select(self$data, self$proteinID)
},
get_data_long = function(){
self$data
},
get_all_long = function(){
dplyr::inner_join(self$annotation$annotation, self$data, by = self$annotation$sampleID)
},
get_data_wide = function(){
tidyr::spread(self$data, self$annotation$sampleID , "Intensity")
},
get_annotation = function(){
self$annotation
}
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.