test finish for contrast function beginning of implementation of S4 function

dataTest/GLM_Contrasts_old.R

@@ -22,15 +22,59 @@ setMethod("priv.mcq.compute.contrast", signature(object="ANY",  Replicate="ANY",
 ################################################
 ## method for generic cmcq.generic.protq
 setMethod("priv.mcq.compute.contrast", signature(object="cmcq.metadata",  Replicate=, Interaction="ANY", replicateName="ANY", flist="ANY"), function(object, Replicate, Interaction, replicateName, flist){
-  test_argument <- .testArgumentForContrast(Replicate, Interaction, replicateName)
+  test_argument <- .testArgumentForContrast(object, Replicate, Interaction, replicateName)
   if(length(test_argument$error != 0)){
     stop(paste(test_argument$error, collapse="\n"))
   }
   if(length(test_argument$warning != 0)){
     warnings(paste(test_argument$warning, collapse="\n"))
   }
+  # selecting column from metadata slot of metadata according flist and replicate state
+  if(Replicate){
+    selected_meta <- object@metadata[,c(flist, replicateName)]
+    # renaming column to be compatible with dicoexpress code
+    colnames(selected_meta)[colnames(selected_meta) == replicateName] <- "__Replicate"
+  }else{
+    selected_meta <- object@metadata[,c(flist)]
+  }
+  # converting column to factor and renaming it to Target
+  Target <- as.data.frame(lapply(selected_meta, as.factor))
+  rm(selected_meta)
+  
+  # set the number of non replicate factor
+  NbBioFactors <- ncol(Target)-1
   
+  ### GLM Model
+  ## Number of biological factor == 1
+  if (NbBioFactors == 1){
+    if(Interaction == TRUE){
+      cat("\n  There is only one biological factor. The model is written with only a single effect. \n")
+      Interaction=FALSE
+    }
+    if(Replicate == TRUE){
+      matrix_model <- model.matrix(as.formula(paste("~", paste(colnames(Target)[1:2], collapse = " + "), sep = " + ")), data=Target)
+    } else {
+      matrix_model <- model.matrix(as.formula(paste("~", paste(colnames(Target)[1], collapse = " + "), sep = " + ")), data=Target)
+    }
+  }
   
+  ## Number of biological factor == 2
+  if (NbBioFactors == 2){
+    FacBio <- 1:(NbBioFactors)
+    if (Interaction == TRUE) {
+      if(Replicate == TRUE){
+        matrix_model <- model.matrix(as.formula(paste("~", paste(colnames(Target)[1:3], collapse = " + "), paste(colnames(Target[,FacBio]),collapse = ":"), sep = " + ")), data=Target)
+      } else {
+        matrix_model <- model.matrix(as.formula(paste("~", paste(colnames(Target)[1:2], collapse = " + "), paste(colnames(Target[,FacBio]),collapse = ":"), sep = " + ")), data=Target)
+      } 
+    } else {
+      if(Replicate == TRUE){
+        matrix_model <- model.matrix(as.formula(paste("~", paste(colnames(Target)[1:3], collapse = " + "), sep = " + ")), data=Target)
+      } else {
+        matrix_model <- model.matrix(as.formula(paste("~", paste(colnames(Target)[1:2], collapse = " + "), sep = " + ")), data=Target)
+      }
+    }
+  }
 })
   
 
@@ -64,12 +108,16 @@ setMethod("priv.mcq.compute.contrast", signature(object="cmcq.metadata",  Replic
     }
   }
   if(!is.null(flist)){
-    if(!all(sapply(flist, .is.in.metadata, object@metadata))){
-      not_set_values = setdiff(flist, colnames(object@metadata))
-      if(length(not_set_values) == 1){
-        error_list = c(error_list, paste("The value '", not_set_values[1],"' is not present in your metadata, please select one between in ", paste(colnames(metadata), collapse=", "),sep=""))
-      }else{
-        error_list = c(error_list, paste("The values '", paste(not_set_values, collapse="' '"),"' is not present in your metadata, please select one between in ", paste(colnames(metadata), collapse=", "),sep=""))
+    if(length(flist)>2){
+      error_list = c(error_list, paste("The algorithm to construct the contrast matrix is not possible for more than 2 biological factor. Please select 2 factor between "+ paste(colnames(object@metadata), collapse=", "), sep=""))
+    }else{
+      if(!all(sapply(flist, .is.in.metadata, object@metadata))){
+        not_set_values = setdiff(flist, colnames(object@metadata))
+        if(length(not_set_values) == 1){
+          error_list = c(error_list, paste("The value '", not_set_values[1],"' is not present in your metadata, please select one between in ", paste(colnames(object@metadata), collapse=", "),sep=""))
+        }else{
+          error_list = c(error_list, paste("The values '", paste(not_set_values, collapse="' '"),"' is not present in your metadata, please select one between in ", paste(colnames(object@metadata), collapse=", "),sep=""))
+        }
       }
     }
   }