Prototype for S4 class and 'set' methods of glog transformation

DESCRIPTION

@@ -8,7 +8,7 @@ Description: Tools and filters for peak matrix scaling, normalisation and filter
 License: GPL-3
 biocViews: MassSpectrometry, Metabolomics, Software
 Depends: R (>= 3.6)
-Imports: stats, impute, pcaMethods, missForest, ggplot2
+Imports: stats, impute, pcaMethods, missForest, ggplot2, methods
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 6.1.1
@@ -19,3 +19,13 @@ Suggests:
     rmarkdown,
     BiocStyle
 VignetteBuilder: knitr
+Collate:
+    'all-generics.R'
+    'S4_classes_methods.R'
+    'checkPeakMatrix.R'
+    'data.R'
+    'filters.R'
+    'glog_transformation.R'
+    'mv_imputation.R'
+    'normalisation.R'
+

NAMESPACE

@@ -10,12 +10,15 @@ export(mv_imputation)
 export(normalise_to_sum)
 export(pqn_normalisation)
 export(remove_peaks)
+exportClasses(GlogOutput)
+exportMethods(setScaledPeakMatrix)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_vline)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,theme_bw)
 importFrom(impute,impute.knn)
+importFrom(methods,new)
 importFrom(missForest,missForest)
 importFrom(pcaMethods,pca)
 importFrom(stats,median)

R/S4_classes_methods.R

@@ -0,0 +1,65 @@
+#' @importFrom methods new
+#'
+NULL
+
+#' S4 class for Variance stabilising generalised lograrithm transformation
+#'  
+#' This class defines structure and methods of glog_transformation output.
+#' 
+#' @slot scaled_peak_matrix a data frame, peak inntensity matrix after glog
+#' transformation
+#' @slot lambda_summary a list containing optimised lambda value and if 
+#' optimisation has failed
+#' @slot lambda_optimisation_plot ggplot2 object of glog lambda optimisation
+#' @export
+
+GlogOutput <- setClass(
+    "GlogOutput",
+    slots=c(scaled_peak_matrix="data.frame",
+        lambda_summary="list",
+        lambda_optimisation_plot="list")
+)
+
+#' Method to set peak matrix after glog scaling
+#' 
+#' @aliases setScaledPeakMatrix
+#' @param glog_object R object of 'GlogOuput' class
+#' @param scaled_peak_matrix a data frame, peak inntensity matrix after glog
+#' transformation
+#' @export
+#' 
+setMethod(f="setScaledPeakMatrix", signature="GlogOutput",
+    definition=function(glog_object, scaled_peak_matrix){
+    glog_object@scaled_peak_matrix <- scaled_peak_matrix
+    return (glog_object)
+})
+
+#' Method to set glog lambda optimisation summary
+#' 
+#' @aliases setGlogLambdaSummary
+#' @param glog_object R object of 'GlogOuput' class
+#' @param lambda glog lambda value
+#' @param lambda_opt glog optimised lambda value
+#' @param error_flag logical value from SSE optimisation call
+#' transformation
+#' 
+setMethod(f="setGlogLambdaSummary", signature="GlogOutput",
+    definition=function(glog_object, lambda, lambda_opt, error_flag){
+    lambda_summary <- list (lambda=lambda, lambda_opt=lambda_opt,
+        error_flag=error_flag)
+    glog_object@lambda_summary <- lambda_summary
+    return (glog_object)
+})
+
+#' Method to set lamba optimisation plot slot
+#' 
+#' @aliases setGlogLambdaOptimisationPlot
+#' @param glog_object R object of 'GlogOuput' class
+#' @param lambda_optimisation_plot output from 'glog_plot_optimised_labmda'
+#' transformation
+#' 
+setMethod(f="setGlogLambdaOptimisationPlot", signature="GlogOutput",
+          definition=function(glog_object, lambda_optimisation_plot){
+              glog_object@lambda_optimisation_plot <- lambda_optimisation_plot
+              return (glog_object)
+          })

R/all-generics.R

@@ -0,0 +1,14 @@
+setGeneric(name="setScaledPeakMatrix", 
+           def=function(glog_object, scaled_peak_matrix){
+               standardGeneric("setScaledPeakMatrix") 
+           })
+
+setGeneric(name="setGlogLambdaSummary", 
+           def=function(glog_object, lambda, lambda_opt, error_flag){
+               standardGeneric("setGlogLambdaSummary") 
+           })
+
+setGeneric(name="setGlogLambdaOptimisationPlot", 
+           def=function(glog_object, lambda_optimisation_plot){
+               standardGeneric("setGlogLambdaOptimisationPlot") 
+           })

R/glog_transformation.R

@@ -5,7 +5,6 @@
 #' @importFrom ggplot2 geom_line
 #' @importFrom ggplot2 theme_bw
 #'
-
 NULL
 
 #' Variance stabilising (extended) generalised logarithm transformation
@@ -88,9 +87,9 @@ glog_omptimise_lambda <- function(upper_lim, df_qc){
     lambda
 }
 
-#' Plot SSE error of lamba optimisation process
+#' Plot SSE error of lambda optimisation process
 #' 
-#' @param optimised_lambda optimised lamba value from 'glog_optimise_output'
+#' @param optimised_lambda optimised lambda value from 'glog_optimise_output'
 #' @param data_qc peak intenisty matrix of QC samples
 #' @param upper_lim limit of the upper lambda value
 #' @return ggplot object containing optimisation plot
@@ -122,18 +121,16 @@ glog_plot_optimised_labmda <- function(optimised_lambda=NA, data_qc, upper_lim){
 #' @param df Peak intensity matrix
 #' @param classes vector of class labels
 #' @param qc_label class label for QC sample
-#' @param store_lambda if value of optimised lambda parameter needs to be
-#'returned
 #' @examples
 #' attach (testData)
 #' out <- mv_imputation(df=testData$data, method='knn')
 #' out <- glog_transformation (df=out, classes=testData$class,
 #'     qc_label='QC')
 #'
-#' @return data frame, peak inntensity matrix after glog transformation
+#' @return S4 class object of glog transformation
 #' @export glog_transformation
 
-glog_transformation <- function(df, classes, qc_label, store_lambda=FALSE) {
+glog_transformation <- function(df, classes, qc_label) {
     # check if qc_label is present in the classes vector
     if (length(which(classes %in% qc_label)) == 0) {
         stop("QC sample label is not present. Check your qc_label parameter.")
@@ -171,12 +168,14 @@ glog_transformation <- function(df, classes, qc_label, store_lambda=FALSE) {
     df <- df - min(df, na.rm=TRUE) # set minimum over all values to 0
     df_glog <- as.data.frame(glog(df, 0, lambda)) # apply glog
 
-    if (store_lambda){
-        g <- glog_plot_optimised_labmda(optimised_lambda = lambda_opt, 
-            data_qc = df_qc, upper_lim = upper_lim)
-        return(list(data=df_glog, lambda=lambda, lambda_opt=lambda_opt, 
-            error_flag=error_flag, labmda_optimisation_plot=g))
-    } else {
-        return(df_glog)
-    }
+    g <- glog_plot_optimised_labmda(optimised_lambda = lambda_opt, 
+    data_qc = df_qc, upper_lim = upper_lim)
+
+    glog_output <- GlogOutput()
+    glog_output <- setScaledPeakMatrix(glog_output, df_glog)
+    glog_output <- setGlogLambdaSummary(glog_output, lambda=lambda, 
+        lambda_opt=lambda_opt, error_flag=error_flag)
+    #glog_output <- setGlogLambdaOptimisationPlot(glog_output, g)
+
+    return(glog_output)
 }

tests/testthat/test-glog_transformation.R

@@ -2,8 +2,9 @@ context("test-glog_transformation")
 
 test_that("Glog function returns expected output", {
   out <- mv_imputation(df=testData$data, method="knn")
-  expect_equal (glog_transformation (df=out, classes=testData$class,
-    qc_label="QC"), testData$glog_transformation)
+  out <- glog_transformation (df=out, classes=testData$class,
+    qc_label="QC")
+  expect_equal (out@scaled_peak_matrix, testData$glog_transformation)
 })
 
 test_that("Glog function fails if qc_label is wrong or QC samples don't exist", {
@@ -24,27 +25,27 @@ test_that("If feature variance is 0 replace it with small value", {
     out <- mv_imputation(df=testData$data, method="knn")
     out[3,] <- 3
     expect_output(out <- glog_transformation (df=out, classes=testData$class,
-      qc_label="QC")[3,], regexp='Error!Lambda')
+      qc_label="QC")@scaled_peak_matrix[3,], regexp='Error!Lambda')
     testthat::expect_true(all(out[1:3] == out[4:6]))
 })
 
 test_that("glog function returns optimised lambda value if requested", {
   out <- mv_imputation(df=testData$data, method="knn")
   out <- glog_transformation (df=out, classes=testData$class,
-    qc_label="QC", store_lambda=TRUE)
+    qc_label="QC")
   lambda <- as.integer(7865716)
-  testthat::expect_true(length(out) == 5)
-  testthat::expect_true(lambda == as.integer(out[[2]]))
+  #testthat::expect_true(length(out) == 5)
+  testthat::expect_true(lambda == as.integer(out@lambda_summary$lambda))
 })
 
-test_that("glog function returns plot of lambda optimisation if requested", {
-  data <- mv_imputation(df=testData$data, method='knn')
-  out <- glog_transformation (df=data, classes=testData$class, qc_label='QC',
-                              store_lambda=TRUE)
-  data_qc <- data[,testData$class=="QC"]
-  expect_silent(g <- glog_plot_optimised_labmda (optimised_lambda = out[[2]], data_qc = data_qc,
-      upper_lim=10^9))
-  expect_equal(g[[9]]$x, "lambda")
-  expect_equal(g[[9]]$y, "SSE")
-})
+#test_that("glog function returns plot of lambda optimisation if requested", {
+#  data <- mv_imputation(df=testData$data, method='knn')
+#  out <- glog_transformation (df=data, classes=testData$class, qc_label='QC',
+#                              store_lambda=TRUE)
+#  data_qc <- data[,testData$class=="QC"]
+#  expect_silent(g <- glog_plot_optimised_labmda (optimised_lambda = out[[2]], data_qc = data_qc,
+#      upper_lim=10^9))
+#  expect_equal(g[[9]]$x, "lambda")
+#  expect_equal(g[[9]]$y, "SSE")
+#})