Fix PCA on R-4.0.0+ by using a custom data.matrix() function with old…

… R-3.6.3 behaviour. Closes #74
ipb-halle · Mar 2, 2024 · d7433ec · d7433ec
1 parent 5eddbcb
commit d7433ec
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 10 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: MetFamily
 Type: Package
 Title: MetFamily: Discovering Regulated Metabolite Families in Untargeted Metabolomics Studies
-Version: 0.99.2
+Version: 0.99.3
 Date: 2024-03-02
 Author: c( person("Hendrik", "Treutler, role = c("aut"), email = "[email protected]"),
            person("Khabat", "Vahabi, role = c("aut"), email = "[email protected]"),

diff --git a/Dockerfile b/Dockerfile
@@ -1,7 +1,7 @@
 #FROM sneumann/metfamily-base:latest
-#FROM sneumann/metfamily-base:4.3.2
+FROM sneumann/metfamily-base:4.3.2
 #FROM sneumann/metfamily-base:4.0.5
-FROM sneumann/metfamily-base:3.6.3
+#FROM sneumann/metfamily-base:3.6.3
 
 MAINTAINER Steffen Neumann <[email protected]>
 

diff --git a/NEWS b/NEWS
@@ -1,6 +1,13 @@
 CHANGES IN VERSION 0.99.2
 -------------------------
 
+BUG FIXES
+
+    o Now producing correct PCA on R-4.0.0+ by using a custom data.matrix() function with old R-3.6.3 behaviour
+
+CHANGES IN VERSION 0.99.2
+-------------------------
+
 NEW FEATURES
 
     o More and better colors available for plotting (thanks @khabatv)

diff --git a/R/DataProcessing.R b/R/DataProcessing.R
@@ -1,4 +1,18 @@
 
+# Custom data.matrix function to maintain old behavior
+data.numericmatrix <- function(x) {
+  # Convert character columns to numeric
+  # without converting to factors first
+  # matching behaviour of pre-4.0.0 data.matrix function()
+  for (i in 1:ncol(x)) {
+    if (is.character(x[, i])) {
+      x[, i] <- as.numeric(as.character(x[, i]))
+    }
+  }
+  as.matrix(x)
+}
+
+
 #########################################################################################
 ## annotate and process matrix
 sparseMatrixToString <- function(matrixRows, matrixCols, matrixVals, parameterSet){
@@ -727,7 +741,7 @@ processMS1data <- function(
   for(groupIdx in seq_len(numberOfGroups)){
     dataColumnNamesHere <- dataColumnsNameFunctionFromGroupIndex(groupIdx = groupIdx, sampleNamesToExclude = sampleNamesToExclude)
     dataColumnNames <- c(dataColumnNames, dataColumnNamesHere)
-    dataFrameMeasurements[, dataColumnNamesHere] <- data.matrix(metaboliteProfile[, dataColumnIndecesFunctionFromGroupIndex(groupIdx = groupIdx, sampleNamesToExclude = sampleNamesToExclude), drop = FALSE])
+    dataFrameMeasurements[, dataColumnNamesHere] <- data.numericmatrix(metaboliteProfile[, dataColumnIndecesFunctionFromGroupIndex(groupIdx = groupIdx, sampleNamesToExclude = sampleNamesToExclude), drop = FALSE])
   }
   dataColumnNames <- unlist(dataColumnNames)
 
@@ -762,14 +776,14 @@ processMS1data <- function(
       for(colIdx in dataColumnIndecesFunctionFromGroupIndex(groupIdx = groupIdx, sampleNamesToExclude = sampleNamesToExclude))
         metaboliteProfile[, colIdx] <- as.numeric(metaboliteProfile[, colIdx])
 
-    dataFrameMeasurements[, dataMeanColumnName] <- apply(X = data.matrix(metaboliteProfile[, dataColumnIndecesFunctionFromGroupIndex(groupIdx = groupIdx, sampleNamesToExclude = sampleNamesToExclude), drop=FALSE]), MARGIN = 1, FUN = mean)
+    dataFrameMeasurements[, dataMeanColumnName] <- apply(X = data.numericmatrix(metaboliteProfile[, dataColumnIndecesFunctionFromGroupIndex(groupIdx = groupIdx, sampleNamesToExclude = sampleNamesToExclude), drop=FALSE]), MARGIN = 1, FUN = mean)
     dataFrameMeasurements[is.na(dataFrameMeasurements[, dataMeanColumnName]), dataMeanColumnName] <- 0
   }
   dataMeanColumnNames <- unlist(dataMeanColumnNames)
 
   ## all replicates mean
   dataFrameMeasurements[, "meanAllNormed"] <- apply(
-    X = data.matrix(metaboliteProfile[, 
+    X = data.numericmatrix(metaboliteProfile[, 
                                       unlist(lapply(X = seq_len(numberOfGroups), FUN = function(x) {dataColumnIndecesFunctionFromGroupIndex(groupIdx = x, sampleNamesToExclude = sampleNamesToExclude)})),
                                       drop=FALSE]), 
     MARGIN = 1, FUN = mean
@@ -801,7 +815,7 @@ processMS1data <- function(
   ## MS1 measurement data to colors
   if(!is.na(progress))  if(progress)  incProgress(amount = 0, detail = "Coloring matrix") else print("Coloring matrix")
 
-  matrixDataFrame <- data.matrix(dataFrameMeasurements)
+  matrixDataFrame <- data.numericmatrix(dataFrameMeasurements)
 
   matrixDataFrame[, dataColumnNames    ][matrixDataFrame[, dataColumnNames    ] < 1] <- 1
   matrixDataFrame[, dataMeanColumnNames][matrixDataFrame[, dataMeanColumnNames] < 1] <- 1
@@ -1273,9 +1287,9 @@ getMS2spectrumInfoForCluster <- function(dataList, clusterDataList, treeLabel){
   featuresIntersection <- clusterDataList$innerNodeFeaturesIntersection[[clusterIndex]]
   featuresUnion <- clusterDataList$innerNodeFeaturesUnion[[clusterIndex]]
   #fragmentsX <- dataList$fragmentMasses[featuresIntersection]
-  #fragmentsY <- apply(X = data.matrix(dataList$featureMatrix[clusterMembersPrecursors, featuresIntersection]), MARGIN = 2, FUN = mean)
+  #fragmentsY <- apply(X = data.numericmatrix(dataList$featureMatrix[clusterMembersPrecursors, featuresIntersection]), MARGIN = 2, FUN = mean)
   fragmentsX <- dataList$fragmentMasses[featuresUnion]
-  fragmentsY <- apply(X = data.matrix(dataList$featureMatrix[clusterMembersPrecursors, featuresUnion]), MARGIN = 2, FUN = mean)
+  fragmentsY <- apply(X = data.numericmatrix(dataList$featureMatrix[clusterMembersPrecursors, featuresUnion]), MARGIN = 2, FUN = mean)
 
   selectedPositive <- clusterDataList$innerNodeFeaturesCountsMatrix[clusterIndex, featuresUnion]
   coverageSelected <- selectedPositive / numberOfClusterMembers

diff --git a/tests/testthat/test_dataprocessing.R b/tests/testthat/test_dataprocessing.R
@@ -20,6 +20,6 @@ test_that("metaboliteProfileParsing works", {
                            metaboliteProfile=metaboliteProfile,
                            progress=FALSE)
 
-expect_equal(min(result$dataFrameMeasurements[,1]), 1)
+expect_equal(min(result$dataFrameMeasurements[,1]), 0)
 
 })