rbbt-marq 2.0.0 → 2.1.0

data/R/CustomDS.R

@@ -12,7 +12,7 @@ CustomDS.process <- function(prefix, cross_platform, conditions, description, tw
     names = vector();
     for (file in conditions) {
       filename = paste(prefix,file,sep="/");
-      values = scan(file=filename, what=character(), sep = "\n");
+      values = scan(file=filename, what=character(), sep = "\n", quiet=T);
       names = c(names, file);
       conditions.list = cbind(conditions.list, values);
     }
@@ -46,31 +46,14 @@ CustomDS.process <- function(prefix, cross_platform, conditions, description, tw
 
     values <- MA.process(m, conditions.list, two.channel);
 
-    ratios   = as.data.frame(values$ratios);
-    t        = as.data.frame(values$t);
-    p.values = as.data.frame(values$p.values);
-
-
-    # Calculate orders from best information
-    best = vector();
-    names = vector();
-    for (name in colnames(ratios)){
-        if (sum(colnames(t) == name) > 0){
-            best = cbind(best, t[,name]);
-            names = c(names, name);
-        }else{
-            best = cbind(best, ratios[,name]);
-            names = c(names, paste(name,'[ratio]', sep=" "));
-        }
-    }
-    rownames(best) <- rownames(ratios);
-    orders   = as.data.frame(MA.get_order(best));
-    colnames(orders) <- names;
-
-
-    if (is.null(values)){
+    if (length(values$ratios) == 0){
         write(file=paste(prefix,'skip',sep="."), "no suitable samples for analysis" );
     }else{
+        ratios   = as.data.frame(values$ratios);
+        t        = as.data.frame(values$t);
+        p.values = as.data.frame(values$p.values);
+        orders   = as.data.frame(values$orders);
+
         MA.save(prefix, orders, ratios, t, p.values, colnames(orders), description);
     }
   },

data/R/GEO.R

@@ -20,8 +20,6 @@ GEO.get <- function(name, cachedir = NULL){
             object  <- getGEO(name, filename = complete_path);
         }
     }
-
-
     object
 }
 
@@ -184,30 +182,12 @@ GEO.values <- function(data){
         ratios   = as.data.frame(values$ratios);
         t        = as.data.frame(values$t);
         p.values = as.data.frame(values$p.values);
-
-
-        # Calculate orders from best information
-        best = vector();
-        names = vector();
-        for (name in colnames(ratios)){
-            if (sum(colnames(t) == name) > 0){
-                best = cbind(best, t[,name]);
-                names = c(names, name);
-            }else{
-                best = cbind(best, ratios[,name]);
-                names = c(names, paste(name,'[ratio]', sep=" "));
-            }
-        }
-        rownames(best) <- rownames(ratios)
-        orders   = as.data.frame(MA.get_order(best));
-        colnames(orders) <- names
+        orders   = as.data.frame(values$orders);
 
         return(list(ratios = ratios, t = t, p.values = p.values, orders = orders));
     }
 }
 
-
-
 GEO.GDS.process <- function(name, prefix, id.field = NULL, translation.file = NULL,cachedir=NULL){
     tryCatch(
     {

data/R/MA.R

@@ -5,20 +5,19 @@ MA.get_order <- function(values){
     orders[,] = NA;
 
     for (i in 1:dim(values)[2]){
-        positions = names(sort(values[,i],decreasing=T))
-
-        orders[,i] = NA
+        positions = names(sort(values[,i],decreasing=T,na.last=NA));
+        orders[,i] = NA;
         orders[positions,i] = 1:length(positions)
     }
     orders 
 }
 
 MA.guess.do.log2 <- function(m, two.channel){
-  if (two.channel){
-    return (sum(m < 0, na.rm = TRUE) == 0);
-  }else{
-    return (max(m, na.rm = TRUE) > 100);
-  }
+    if (two.channel){
+        return (sum(m < 0, na.rm = TRUE) == 0);
+    }else{
+        return (max(m, na.rm = TRUE) > 100);
+    }
 }
 
 MA.translate <- function(m, trans){
@@ -27,17 +26,16 @@ MA.translate <- function(m, trans){
 
     missing = length(trans) - dim(m)[1];
 
-    # If extra genes
+# If extra genes
     if (missing < 0){
-      trans = c(trans,rep(NA, - missing))
-      missing = 0;
+        trans = c(trans,rep(NA, - missing));
+        missing = 0;
     }
     n = apply(m,2,function(x){ 
-      
-      # Complete data with missing genes
-      x.complete = c(x,rep(NA, missing));
-      tapply(x.complete, factor(trans), median)
-    });
+# Complete data with missing genes
+         x.complete = c(x,rep(NA, missing));
+         tapply(x.complete, factor(trans), median)
+         });
     n[sort(rownames(n),index.return=T)$ix,]
 }
 
@@ -46,10 +44,10 @@ MA.translate <- function(m, trans){
 MA.conditions.has_control <- function(x){
     keywords = c('none', 'control', 'normal', 'wild', 'baseline', 'untreat', 'uninfected', 'universal', 'reference', 'vehicle', 'w.t.','wt');
     for(keyword in keywords){
-      control = grep(keyword, x, ignore.case = TRUE);
-      if (any(control)){
-          return(x[control[1]]);
-      }
+        control = grep(keyword, x, ignore.case = TRUE);
+        if (any(control)){
+            return(x[control[1]]);
+        }
     }
     return(NULL)
 }
@@ -60,18 +58,18 @@ MA.condition.values <- function(values){
     values.factor = factor(values);
     values.levels = levels(values.factor);
 
-    # If there is a control state remove it from sorting
+# If there is a control state remove it from sorting
     if (!is.null(control))
         values.levels = values.levels[values.levels != control];    
 
-    
-    # Use numeric sort if they all have numbers
+
+# Use numeric sort if they all have numbers
     if (length(grep('^ *[0-9]+',values.levels,perl=TRUE)) == length(values.levels)){
         ix = sort(as.numeric(sub('^ *([0-9]+).*',"\\1",values.levels)), decreasing = T, index.return = TRUE)$ix
     }else{
         ix = sort(values.levels, decreasing = T, index.return = TRUE)$ix
     }
-    
+
     return(list(values = values.levels[ix], control = control));
 }
 
@@ -98,7 +96,7 @@ MA.ratio.contrast <- function(m, conditions, main, contrast){
     if (!is.null(dim(contrast))){
         contrast = apply(contrast, 1 ,function(x){mean(x, na.rm = TRUE)});
     }
-      
+
     return (main - contrast);
 }
 
@@ -106,173 +104,204 @@ MA.ratio.contrast <- function(m, conditions, main, contrast){
 # Limma
 
 MA.limma.two_channel <- function(m, conditions, main){
-  if (sum(conditions == main) < 3){
+    if (sum(conditions == main) < 3){
+        return(NULL);
+    }
+
+    design = rep(0,dim(m)[2]);
+    design[conditions == main] = 1;
+
+# We need to subset the columns because of a problem with NA values. This
+# might affect eBayes variance estimations, thats my guess anyway...
+
+    fit <- lmFit(m[,design == 1],rep(1, sum(design)));
+
+    tryCatch({
+             fit <- eBayes(fit);
+             sign = fit$t < 0;
+             sign[is.na(sign)] = FALSE;
+             fit$p.value[sign] =  - fit$p.value[sign];
+             return(list(t= fit$t, p.values= fit$p.value));
+     }, error=function(x){
+             print("Exception caught in eBayes");
+             print(x);
+     })
+
     return(NULL);
-  }
-    
-  design = rep(0,dim(m)[2]);
-  design[conditions == main] = 1;
-
-  # We need to subset the columns because of a problem with NA values. This
-  # might affect eBayes variance estimations, thats my guess anyway...
-  
-  fit <- lmFit(m[,design == 1],rep(1, sum(design)));
-  
-  tryCatch({
-      fit <- eBayes(fit);
-      sign = fit$t < 0;
-      sign[is.na(sign)] = FALSE;
-      fit$p.value[sign] =  - fit$p.value[sign];
-      return(list(t= fit$t, p.values= fit$p.value));
-  }, error=function(x){
-      print("Exception caught in eBayes");
-      print(x);
-  })
-
-  return(NULL);
 }
 
 MA.limma.contrast <- function(m, conditions, main, contrast){
-  if (sum(conditions == main) + sum(conditions == contrast) < 3){
+    if (sum(conditions == main) + sum(conditions == contrast) < 3){
+        return(NULL);
+    }
+    m = cbind(m[,conditions == main],m[,conditions == contrast]);
+
+    design = cbind(rep(1,dim(m)[2]), rep(0,dim(m)[2]));
+    colnames(design) <-c('intercept', 'main');
+    design[1:sum(conditions==main),2] = 1;
+
+
+    fit <- lmFit(m,design);
+    tryCatch({
+             fit <- eBayes(fit);
+             sign = fit$t[,2] < 0;
+             sign[is.na(sign)] = FALSE;
+             fit$p.value[sign,2] = - fit$p.value[sign,2] 
+             return(list(t= fit$t[,2], p.values= fit$p.value[,2] ));
+    }, error=function(x){
+             print("Exception caught in eBayes");
+             print(x);
+    })
+
     return(NULL);
-  }
-  m = cbind(m[,conditions == main],m[,conditions == contrast])
-  
-  design = cbind(rep(1,dim(m)[2]), rep(0,dim(m)[2]));
-  colnames(design) <-c('intercept', 'main');
-  design[1:sum(conditions==main),2] = 1;
-
-
-  fit <- lmFit(m,design);
-  tryCatch({
-      fit <- eBayes(fit);
-      sign = fit$t[,2] < 0;
-      sign[is.na(sign)] = FALSE;
-      fit$p.value[sign,2] = - fit$p.value[sign,2] 
-      return(list(t= fit$t[,2], p.values= fit$p.value[,2] ));
-  }, error=function(x){
-      print("Exception caught in eBayes");
-      print(x);
-  })
-
-  return(NULL);
 }
 
 
 #########################################################################
 # Process conditions
 
+MA.strip_blanks <- function(text){
+    text = sub(' *$', '' ,text);
+    text = sub('^ *', '' ,text);
+
+    return(text);
+}
+
+MA.orders <- function(ratios, t){
+    best  = vector();
+    names = vector();
+    for (name in colnames(ratios)){
+        if (sum(colnames(t) == name) > 0){
+            best = cbind(best, t[,name]);
+            names = c(names, name);
+        }else{
+            best = cbind(best, ratios[,name]);
+            names = c(names, paste(name,'[ratio]', sep=" "));
+        }
+    }
+    rownames(best)   <- rownames(ratios);
+    orders           <- as.data.frame(MA.get_order(best));
+    colnames(orders) <- names;
+
+    return(orders);
+}
+
 MA.process_conditions.contrasts <- function(m, conditions, two.channel){
-  max_levels             = 10;
-  max_levels_control     = 1;
-
-
-  values = MA.condition.values(conditions);
-
-
-  ratios   = vector();
-  t       = vector();
-  p.values = vector();
-
-  ratio_names = vector();
-  t_names     = vector();
-
-  if (!is.null(values$control)){
-      contrast = values$control;
-      for (main in values$values){
-          name =  paste(main, contrast, sep = " <=> ")
-          
-          ratio       = MA.ratio.contrast(m, conditions, main, contrast);
-          ratio_names = c(ratio_names, name);
-          ratios      = cbind(ratios, ratio);
-
-          res      = MA.limma.contrast(m, conditions, main, contrast);        
-          if (!is.null(res)){
-              t_names = c(t_names, name);
-              t           = cbind(t, res$t);
-              p.values     = cbind(p.values, res$p.values);
-         } 
-     }
-  }
-
-
-  if (length(values$values) <= max_levels_control || (is.null(values$control) && !two.channel && length(values$values) <= max_levels )){
-
-      remaining = values$values;
-      for (main in values$values){
-          remaining = remaining[remaining != main];
-          for (contrast in remaining){
-              name =  paste(main, contrast, sep = " <=> ");
-          
-              ratio       = MA.ratio.contrast(m, conditions, main, contrast);
-              ratio_names = c(ratio_names, name);
-              ratios      = cbind(ratios, ratio);
-
-              res      = MA.limma.contrast(m, conditions, main, contrast);        
-              if (!is.null(res)){
-                  t_names  = c(t_names, name);
-                  t        = cbind(t, res$t);
-                  p.values = cbind(p.values, res$p.values);
-              } 
-          }
-      }
-  }
-
- 
-  if (length(ratio_names) != 0){
-    colnames(ratios) <- ratio_names
-  }
-
-  if (length(t_names) != 0){
-    colnames(t) <- t_names
-    colnames(p.values) <- t_names
-  }
-
-  return(list(ratios = ratios, t=t, p.values = p.values));
+    max_levels             = 10;
+    max_levels_control     = 1;
+
+
+    values = MA.condition.values(conditions);
+
+
+    ratios   = vector();
+    t       = vector();
+    p.values = vector();
+
+    ratio_names = vector();
+    t_names     = vector();
+
+    if (!is.null(values$control)){
+        contrast = values$control;
+        for (main in values$values){
+            name =  paste(main, contrast, sep = " <=> ")
+
+                ratio       = MA.ratio.contrast(m, conditions, main, contrast);
+            ratio_names = c(ratio_names, name);
+            ratios      = cbind(ratios, ratio);
+
+            res      = MA.limma.contrast(m, conditions, main, contrast);        
+            if (!is.null(res)){
+                t_names = c(t_names, name);
+                t           = cbind(t, res$t);
+                p.values     = cbind(p.values, res$p.values);
+            } 
+        }
+    }
+
+
+    if (length(values$values) <= max_levels_control || (is.null(values$control) && !two.channel && length(values$values) <= max_levels )){
+
+        remaining = values$values;
+        for (main in values$values){
+            remaining = remaining[remaining != main];
+            for (contrast in remaining){
+                name =  paste(main, contrast, sep = " <=> ");
+
+                ratio       = MA.ratio.contrast(m, conditions, main, contrast);
+                ratio_names = c(ratio_names, name);
+                ratios      = cbind(ratios, ratio);
+
+                res      = MA.limma.contrast(m, conditions, main, contrast);        
+                if (!is.null(res)){
+                    t_names  = c(t_names, name);
+                    t        = cbind(t, res$t);
+                    p.values = cbind(p.values, res$p.values);
+                } 
+            }
+        }
+    }
+
+
+    if (length(ratio_names) != 0){
+        ratio_names = as.vector(sapply(ratio_names, MA.strip_blanks));
+        colnames(ratios) <- ratio_names
+    }
+
+    if (length(t_names) != 0){
+        t_names = as.vector(sapply(t_names, MA.strip_blanks));
+        colnames(t) <- t_names;
+        colnames(p.values) <- t_names;
+    }
+
+
+    return(list(ratios = ratios, t=t, p.values = p.values));
 }
 
 MA.process_conditions.two_channel <- function(m, conditions){
-  values = MA.condition.values(conditions);
+    values = MA.condition.values(conditions);
+
+    all_values = values$values;
+    if (!is.null(values$control)){
+        all_values = c(all_values, values$control);
+    }
 
-  all_values = values$values
-  if (!is.null(values$control)){
-      all_values = c(all_values, values$control);
-  }
-  
 
-  ratios   = vector();
-  t        = vector();
-  p.values = vector();
+    ratios   = vector();
+    t        = vector();
+    p.values = vector();
 
-  ratio_names = vector();
-  t_names     = vector();
+    ratio_names = vector();
+    t_names     = vector();
 
 
-  for (main in all_values){
-      name =  main;
+    for (main in all_values){
+        name =  main;
 
-      ratio       = MA.ratio.two_channel(m, conditions, main);
-      ratio_names = c(ratio_names, name);
-      ratios      = cbind(ratios, ratio);
+        ratio       = MA.ratio.two_channel(m, conditions, main);
+        ratio_names = c(ratio_names, name);
+        ratios      = cbind(ratios, ratio);
 
-      res      = MA.limma.two_channel(m, conditions, main);        
-      if (!is.null(res)){
-          t_names = c(t_names, name);
-          t           = cbind(t, res$t);
-          p.values     = cbind(p.values, res$p.values);
-      } 
-  }
+        res      = MA.limma.two_channel(m, conditions, main);        
+        if (!is.null(res)){
+            t_names  = c(t_names, name);
+            t        = cbind(t, res$t);
+            p.values = cbind(p.values, res$p.values);
+        }
+    }
 
-  if (length(ratio_names) != 0){
-    colnames(ratios) <- ratio_names
-  }
+    if (length(ratio_names) != 0){
+        ratio_names = as.vector(sapply(ratio_names, MA.strip_blanks));
+        colnames(ratios) <- ratio_names
+    }
 
-  if (length(t_names) != 0){
-    colnames(t) <- t_names
-    colnames(p.values) <- t_names
-  }
+    if (length(t_names) != 0){
+        t_names = as.vector(sapply(t_names, MA.strip_blanks));
+        colnames(t) <- t_names;
+        colnames(p.values) <- t_names;
+    }
 
-  return(list(ratios = ratios, t=t, p.values = p.values));
+    return(list(ratios = ratios, t=t, p.values = p.values));
 }
 
 
@@ -280,35 +309,36 @@ MA.process_conditions.two_channel <- function(m, conditions){
 # Process microarray matrix
 
 MA.process <- function(m, conditions_list, two.channel = FALSE){
-   
-  ratios   = vector();
-  t        = vector();
-  p.values = vector();
-
-  for(type in colnames(conditions_list)){
-     conditions = conditions_list[,type]
-
-     if (two.channel){
-         res = MA.process_conditions.two_channel(m, conditions);
-         if (length(res$ratios) != 0){    colnames(res$ratios) <- sapply(colnames(res$ratios),function(x){paste(type,x,sep=": ")});     ratios   = cbind(ratios,res$ratios);}
-         if (length(res$t) != 0){         colnames(res$t) <- sapply(colnames(res$t),function(x){paste(type,x,sep=": ")});               t        = cbind(t,res$t);}
-         if (length(res$p.values) != 0){  colnames(res$p.values) <- sapply(colnames(res$p.values),function(x){paste(type,x,sep=": ")}); p.values = cbind(p.values,res$p.values);}
-     }
-
-     res = MA.process_conditions.contrasts(m, conditions, two.channel);
-     if (length(res$ratios) != 0){    colnames(res$ratios) <- sapply(colnames(res$ratios),function(x){paste(type,x,sep=": ")});     ratios   = cbind(ratios,res$ratios);}
-     if (length(res$t) != 0){         colnames(res$t) <- sapply(colnames(res$t),function(x){paste(type,x,sep=": ")});               t        = cbind(t,res$t);}
-     if (length(res$p.values) != 0){  colnames(res$p.values) <- sapply(colnames(res$p.values),function(x){paste(type,x,sep=": ")}); p.values = cbind(p.values,res$p.values);}
-   }
-
-   return(list(ratios = ratios, t=t, p.values = p.values));
+
+    ratios   = vector();
+    t        = vector();
+    p.values = vector();
+
+    for(type in colnames(conditions_list)){
+        conditions = conditions_list[,type]
+
+            if (two.channel){
+                res = MA.process_conditions.two_channel(m, conditions);
+                if (length(res$ratios) != 0){    colnames(res$ratios) <- sapply(colnames(res$ratios),function(x){paste(type,x,sep=": ")});     ratios   = cbind(ratios,res$ratios);}
+                if (length(res$t) != 0){         colnames(res$t) <- sapply(colnames(res$t),function(x){paste(type,x,sep=": ")});               t        = cbind(t,res$t);}
+                if (length(res$p.values) != 0){  colnames(res$p.values) <- sapply(colnames(res$p.values),function(x){paste(type,x,sep=": ")}); p.values = cbind(p.values,res$p.values);}
+            }
+
+        res = MA.process_conditions.contrasts(m, conditions, two.channel);
+        if (length(res$ratios) != 0){    colnames(res$ratios) <- sapply(colnames(res$ratios),function(x){paste(type,x,sep=": ")});     ratios   = cbind(ratios,res$ratios);}
+        if (length(res$t) != 0){         colnames(res$t) <- sapply(colnames(res$t),function(x){paste(type,x,sep=": ")});               t        = cbind(t,res$t);}
+        if (length(res$p.values) != 0){  colnames(res$p.values) <- sapply(colnames(res$p.values),function(x){paste(type,x,sep=": ")}); p.values = cbind(p.values,res$p.values);}
+    }
+
+    orders <- MA.orders(ratios,t);
+    return(list(ratios = ratios, t=t, p.values = p.values, orders=orders));
 }
 
 
 MA.save <- function(prefix, orders, ratios, t , p.values, experiments, description = NULL) {
     if (is.null(orders)){
         cat("No suitable samples for analysis\n")
-        write(file=paste(prefix,'skip',sep="."), "No suitable samples for analysis" );
+            write(file=paste(prefix,'skip',sep="."), "No suitable samples for analysis" );
     } else {
         write.table(file=paste(prefix,'orders',sep="."), orders, sep="\t",  row.names=F, col.names=F, quote=F);
         write.table(file=paste(prefix,'codes',sep="."), rownames(orders), sep="\t",  row.names=F, col.names=F, quote=F);
@@ -322,39 +352,39 @@ MA.save <- function(prefix, orders, ratios, t , p.values, experiments, descripti
 }
 
 MA.load <- function(prefix, orders = TRUE, logratios = TRUE, t = TRUE, p.values = TRUE){
-  data = list();
-  genes <- scan(file=paste(prefix,'codes',sep="."),sep="\n",quiet=T,what=character());
-  experiments <- scan(file=paste(prefix,'experiments',sep="."),sep="\n",quiet=T,what=character());
-
-  experiments.no.ratio = experiments[- grep('ratio', experiments)];
-
-  if (orders){
-      orders <- read.table(file=paste(prefix,'orders',sep="."),sep="\t");
-      rownames(orders) <- genes;
-      colnames(orders) <- experiments;
-      data$orders=orders;
-  }
-  if (logratios){
-      logratios <- read.table(file=paste(prefix,'logratios',sep="."),sep="\t");
-      rownames(logratios) <- genes;
-      colnames(logratios) <- experiments;
-      data$logratios=logratios;
-  }
-  if (t){
-      t <- read.table(file=paste(prefix,'t',sep="."),sep="\t");
-      rownames(t) <- genes;
-      colnames(t) <- experiments.no.ratio;
-      data$t=t;
-  }
-  if (p.values){
-      p.values <- read.table(file=paste(prefix,'pvalues',sep="."),sep="\t");
-      rownames(p.values) <- genes;
-      colnames(p.values) <- experiments.no.ratio;
-      data$p.values=p.values;
-  }
- 
-
-  return(data);
+    data = list();
+    genes <- scan(file=paste(prefix,'codes',sep="."),sep="\n",quiet=T,what=character());
+    experiments <- scan(file=paste(prefix,'experiments',sep="."),sep="\n",quiet=T,what=character());
+
+    experiments.no.ratio = experiments[- grep('ratio', experiments)];
+
+    if (orders){
+        orders <- read.table(file=paste(prefix,'orders',sep="."),sep="\t");
+        rownames(orders) <- genes;
+        colnames(orders) <- experiments;
+        data$orders=orders;
+    }
+    if (logratios){
+        logratios <- read.table(file=paste(prefix,'logratios',sep="."),sep="\t");
+        rownames(logratios) <- genes;
+        colnames(logratios) <- experiments;
+        data$logratios=logratios;
+    }
+    if (t){
+        t <- read.table(file=paste(prefix,'t',sep="."),sep="\t");
+        rownames(t) <- genes;
+        colnames(t) <- experiments.no.ratio;
+        data$t=t;
+    }
+    if (p.values){
+        p.values <- read.table(file=paste(prefix,'pvalues',sep="."),sep="\t");
+        rownames(p.values) <- genes;
+        colnames(p.values) <- experiments.no.ratio;
+        data$p.values=p.values;
+    }
+
+
+    return(data);
 
 
 }