@@ -44,4 +44,4 @@ Lazyload: yes

 LazyData: true

 biocViews: Sequencing, Microarray, GraphAndNetwork

 VignetteBuilder: knitr

-RoxygenNote: 7.1.1

+RoxygenNote: 7.1.2

new file mode 100644

@@ -0,0 +1,7 @@

+# Generated by using Rcpp::compileAttributes() -> do not edit by hand

+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

+

+filterNodes <- function(xx_from, xx_to, xx_miRNA, xx_logFC, xx_pval, xx_dir, rows, rootgene, rootlogFC, tol, minify, miRNAtol, lFC, pVAL) {

+    .Call('_GeneNetworkBuilder_filterNodes', PACKAGE = 'GeneNetworkBuilder', xx_from, xx_to, xx_miRNA, xx_logFC, xx_pval, xx_dir, rows, rootgene, rootlogFC, tol, minify, miRNAtol, lFC, pVAL)

+}

+

@@ -256,7 +256,8 @@ filterNetwork<-function(rootgene, sifNetwork, exprsData, mergeBy="symbols", miRN

 #'                         If TURE, use logFC value as weight.

 #'                         If FALSE, use constant 1 as weight.

 #' @param nodecolor a character vector of color set. 

-#'                  The node color will be mapped to color set by log fold change

+#'                  The node color will be mapped to color set by log fold change.

+#'                  Or the column names for the colors.

 #' @param nodeBg background of node

 #' @param nodeBorderColor a list of broder node color set. 

 #'                        nodeBorderColor's element must be gene and miRNA

@@ -294,8 +295,13 @@ polishNetwork<-function(cifNetwork,

   if(length(intersect(c("from", "to", "logFC", "miRNA"), colnames(cifNetwork)))<4){

     stop("colnames of cifNetwork must contain 'from', 'to', 'logFC' and 'miRNA'");

   }

+  preDefinedColor <- FALSE

   if(length(nodecolor) < 2){

-    stop("nodecolor should have more than 1 elements")

+    if(nodecolor %in% colnames(cifNetwork)){

+      preDefinedColor <- TRUE

+    }else{

+      stop("nodecolor should have more than 1 elements")

+    }

   }

   if(length(setdiff(c('gene', 'miRNA'), names(nodeBorderColor))) > 0){

     stop("nodeBorderColor's element must be 'gene' and 'miRNA'")

@@ -337,35 +343,67 @@ polishNetwork<-function(cifNetwork,

   for(i in unique(as.character(cifNetwork$from))){

     nodeData(gR, n=i, attr="size")<-ceiling(5*length(edL[[i]]$edges)/length(node)) * nodesDefaultSize/2 + nodesDefaultSize

   }

+  ## add additional message 

+  additionalInfoCol <- colnames(cifNetwork)

+  additionalInfoCol <-

+    additionalInfoCol[!additionalInfoCol %in%

+                        c("to", "from", "gene", "P.Value", "logFC", "miRNA",

+                          "dir")]

+  additionalInfoCol <- additionalInfoCol[

+    vapply(additionalInfoCol, FUN=function(.e){

+      inherits(cifNetwork[, .e], c("character", "factor")) &&

+        length(unique(cifNetwork[, .e])) > 1

+    }, FUN.VALUE=FALSE)

+  ]

+  if(length(additionalInfoCol)){

+    for(j in additionalInfoCol){

+      nodeDataDefaults(gR, attr=j)<-""

+      for(i in unique(as.character(cifNetwork$from))){

+        nodeData(gR, n=i, attr=j) <-

+          cifNetwork[match(i, cifNetwork$to), j]

+      }

+    }

+  }

   ## set node color    

   nodeDataDefaults(gR, attr="fill")<-nodeBg

-  lfcMax<-ceiling(max(abs(cifNetwork[!is.na(cifNetwork$logFC),"logFC"])))

-  lfcSeq<-seq(-1*lfcMax,lfcMax,length.out=length(nodecolor)+1)

-  colset<-unique(cifNetwork[!is.na(cifNetwork$logFC),c("to","logFC")])

-  colset<-apply(colset, 1, function(.ele,color,lfcSeq){

-    id=0

-    for(i in 1:length(lfcSeq)){

-      .elelfc<-as.numeric(as.character(.ele[2]))

-      if(lfcSeq[i]<=.elelfc & lfcSeq[i+1]>=.elelfc){

-        id=i

-        break

+  if(!preDefinedColor){

+    lfcMax<-ceiling(max(abs(cifNetwork[!is.na(cifNetwork$logFC),"logFC"])))

+    lfcSeq<-seq(-1*lfcMax,lfcMax,length.out=length(nodecolor)+1)

+    colset<-unique(cifNetwork[!is.na(cifNetwork$logFC),c("to","logFC")])

+    colset<-apply(colset, 1, function(.ele,color,lfcSeq){

+      id=0

+      for(i in 1:length(lfcSeq)){

+        .elelfc<-as.numeric(as.character(.ele[2]))

+        if(lfcSeq[i]<=.elelfc & lfcSeq[i+1]>=.elelfc){

+          id=i

+          break

+        }

+      }

+      if(id!=0){

+        c(.ele,nodecolor[id])

+      }else{

+        c(.ele,nodeBg)

       }

+    },nodecolor,lfcSeq)

+    colors<-colset[3,]

+    names(colors)<-colset[1,]

+    for(i in names(colors)){

+      nodeData(gR, n=i, attr="fill")<-colors[i]

     }

-    if(id!=0){

-      c(.ele,nodecolor[id])

-    }else{

-      c(.ele,nodeBg)

+    colset<-node[!node %in% names(colors)]

+    names(colset)<-colset

+    colset<-nodeBg

+    colors<-c(colors,colset)

+  }else{

+    colors <- cifNetwork[match(node, cifNetwork$to), nodecolor]

+    names(colors) <- node

+    colors[is.na(colors)] <- nodeBg

+    for(i in node) {

+      tmp <- cifNetwork[match(i, cifNetwork$to), nodecolor]

+      nodeData(gR, n=i, attr="fill") <- 

+        ifelse(is.na(tmp), nodeBg, tmp)

     }

-  },nodecolor,lfcSeq)

-  colors<-colset[3,]

-  names(colors)<-colset[1,]

-  for(i in names(colors)){

-    nodeData(gR, n=i, attr="fill")<-colors[i]

   }

-  colset<-node[!node %in% names(colors)]

-  names(colset)<-colset

-  colset<-nodeBg

-  colors<-c(colors,colset)

   ## set node border color    

   miRNAs<-unique(as.character(cifNetwork[cifNetwork[,"miRNA"],"to"]))

   nodeBC<-character(length(node))

@@ -379,6 +417,7 @@ polishNetwork<-function(cifNetwork,

       nodeBC[i]<-nodeBorderColor$gene

     }

   }

+  

   graph::nodeRenderInfo(gR) <- list(col=nodeBC, fill=colors, ...)

   graph::edgeRenderInfo(gR) <- list(lwd=edgelwd)

   gR

@@ -26,7 +26,8 @@ If TURE, use logFC value as weight.

 If FALSE, use constant 1 as weight.}

 \item{nodecolor}{a character vector of color set. 

-The node color will be mapped to color set by log fold change}

+The node color will be mapped to color set by log fold change.

+Or the column names for the colors.}

 \item{nodeBg}{background of node}

@@ -1,2 +1,6 @@

 ## Use the R HOME indirection to support installations of multiple R version

-PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"`

\ No newline at end of file

+PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"`

+

+all: $(SHLIB)

+

+clean: rm -f $(PKG_OBJECTS)

\ No newline at end of file

@@ -1,2 +1,6 @@

 ## Use the R HOME indirection to support installations of multiple R version

-PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()")

\ No newline at end of file

+PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()")

+

+all: $(SHLIB)

+

+clean: rm -f $(PKG_OBJECTS)

\ No newline at end of file

new file mode 100644

@@ -0,0 +1,49 @@

+// Generated by using Rcpp::compileAttributes() -> do not edit by hand

+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

+

+#include <Rcpp.h>

+

+using namespace Rcpp;

+

+#ifdef RCPP_USE_GLOBAL_ROSTREAM

+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();

+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();

+#endif

+

+// filterNodes

+RcppExport SEXP filterNodes(SEXP xx_from, SEXP xx_to, SEXP xx_miRNA, SEXP xx_logFC, SEXP xx_pval, SEXP xx_dir, SEXP rows, SEXP rootgene, SEXP rootlogFC, SEXP tol, SEXP minify, SEXP miRNAtol, SEXP lFC, SEXP pVAL);

+RcppExport SEXP _GeneNetworkBuilder_filterNodes(SEXP xx_fromSEXP, SEXP xx_toSEXP, SEXP xx_miRNASEXP, SEXP xx_logFCSEXP, SEXP xx_pvalSEXP, SEXP xx_dirSEXP, SEXP rowsSEXP, SEXP rootgeneSEXP, SEXP rootlogFCSEXP, SEXP tolSEXP, SEXP minifySEXP, SEXP miRNAtolSEXP, SEXP lFCSEXP, SEXP pVALSEXP) {

+BEGIN_RCPP

+    Rcpp::RObject rcpp_result_gen;

+    Rcpp::RNGScope rcpp_rngScope_gen;

+    Rcpp::traits::input_parameter< SEXP >::type xx_from(xx_fromSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type xx_to(xx_toSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type xx_miRNA(xx_miRNASEXP);

+    Rcpp::traits::input_parameter< SEXP >::type xx_logFC(xx_logFCSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type xx_pval(xx_pvalSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type xx_dir(xx_dirSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type rows(rowsSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type rootgene(rootgeneSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type rootlogFC(rootlogFCSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type tol(tolSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type minify(minifySEXP);

+    Rcpp::traits::input_parameter< SEXP >::type miRNAtol(miRNAtolSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type lFC(lFCSEXP);

+    Rcpp::traits::input_parameter< SEXP >::type pVAL(pVALSEXP);

+    rcpp_result_gen = Rcpp::wrap(filterNodes(xx_from, xx_to, xx_miRNA, xx_logFC, xx_pval, xx_dir, rows, rootgene, rootlogFC, tol, minify, miRNAtol, lFC, pVAL));

+    return rcpp_result_gen;

+END_RCPP

+}

+

+RcppExport SEXP filterNodes(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);

+

+static const R_CallMethodDef CallEntries[] = {

+    {"_GeneNetworkBuilder_filterNodes", (DL_FUNC) &_GeneNetworkBuilder_filterNodes, 14},

+    {"filterNodes", (DL_FUNC) &filterNodes, 14},

+    {NULL, NULL, 0}

+};

+

+RcppExport void R_init_GeneNetworkBuilder(DllInfo *dll) {

+    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);

+    R_useDynamicSymbols(dll, FALSE);

+}

@@ -6,7 +6,7 @@

 using namespace Rcpp;

 using namespace std;

-

+// [[Rcpp::export]]

 RcppExport SEXP filterNodes(SEXP xx_from, SEXP xx_to, SEXP xx_miRNA, SEXP xx_logFC, SEXP xx_pval, SEXP xx_dir, SEXP rows, 

 							SEXP rootgene, SEXP rootlogFC, SEXP tol, SEXP minify, SEXP miRNAtol, SEXP lFC, SEXP pVAL)

 {

deleted file mode 100644

@@ -1,10 +0,0 @@

-// RegisteringDynamic Symbols

-

-#include <R.h>

-#include <Rinternals.h>

-#include <R_ext/Rdynload.h>

-

-void R_init_markovchain(DllInfo* info) {

-  R_registerRoutines(info, NULL, NULL, NULL, NULL);

-  R_useDynamicSymbols(info, TRUE);

-}

\ No newline at end of file

@@ -49,9 +49,20 @@ try({ ## just in case STRINGdb not work

     IDsMap <- expressionData$gene

     names(IDsMap) <- expressionData$symbols

     cifNetwork <- convertID(cifNetwork, IDsMap)

+    ## add additional info for searching, any character content columns

+    cifNetwork$info1 <- sample(c("groupA", "groupB"),

+                               size = nrow(cifNetwork),

+                               replace = TRUE)

     ## polish network

     gR<-polishNetwork(cifNetwork)

     ## browse network

     browseNetwork(gR)

+    

+    ## try predifined colors

+    cifNetwork$color <- sample(rainbow(7), nrow(cifNetwork), replace = TRUE)

+    ## polish network

+    gR<-polishNetwork(cifNetwork, nodecolor="color")

+    ## browse network

+    browseNetwork(gR)

 })

 ```