Browse code

Removed dependency

Tim Daniel Rose authored on 25/08/2021 09:10:10
Showing1 changed files
... ...
@@ -17,6 +17,7 @@ using cube = std::vector<matrix>;
17 17
 //' @return An integer matrix.
18 18
 //' 
19 19
 //' @examples
20
+//' m <- matrix(seq(1:16), nrow=4)
20 21
 //' # m <- matrix(rnorm(10000), nrow=100)
21 22
 //' # replace_threshold(m, 1)
22 23
 //' 
... ...
@@ -55,6 +56,7 @@ IntegerMatrix replace_threshold(IntegerMatrix m, int threshold){
55 56
 //' nrow(m))} (\code{c(ncol(m), ncol(m))})
56 57
 //' 
57 58
 //' @examples
59
+//' m <- matrix(seq(1:16), nrow=4)
58 60
 //' # m <- matrix(rnorm(10000), nrow=100)
59 61
 //' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
60 62
 //' # attribute_graph(bics, m)
... ...
@@ -142,4 +144,4 @@ List attribute_graph(const List bics,
142 144
   
143 145
   return(out_l);
144 146
 }
145
- 
146 147
\ No newline at end of file
148
+ 
Browse code

Fixed example error.

Tim Daniel Rose authored on 25/08/2021 08:27:58
Showing1 changed files
... ...
@@ -18,7 +18,7 @@ using cube = std::vector<matrix>;
18 18
 //' 
19 19
 //' @examples
20 20
 //' # m <- matrix(rnorm(10000), nrow=100)
21
-//' replace_threshold(m, 1)
21
+//' # replace_threshold(m, 1)
22 22
 //' 
23 23
 //' @export
24 24
 // [[Rcpp::export]]
Browse code

Examples fixes

Tim Daniel Rose authored on 25/08/2021 08:04:49
Showing1 changed files
... ...
@@ -17,7 +17,7 @@ using cube = std::vector<matrix>;
17 17
 //' @return An integer matrix.
18 18
 //' 
19 19
 //' @examples
20
-//' m <- matrix(rnorm(10000), nrow=100)
20
+//' # m <- matrix(rnorm(10000), nrow=100)
21 21
 //' replace_threshold(m, 1)
22 22
 //' 
23 23
 //' @export
... ...
@@ -55,7 +55,7 @@ IntegerMatrix replace_threshold(IntegerMatrix m, int threshold){
55 55
 //' nrow(m))} (\code{c(ncol(m), ncol(m))})
56 56
 //' 
57 57
 //' @examples
58
-//' m <- matrix(rnorm(10000), nrow=100)
58
+//' # m <- matrix(rnorm(10000), nrow=100)
59 59
 //' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
60 60
 //' # attribute_graph(bics, m)
61 61
 //'
Browse code

Running examples

Tim Daniel Rose authored on 25/08/2021 07:35:41
Showing1 changed files
... ...
@@ -56,8 +56,8 @@ IntegerMatrix replace_threshold(IntegerMatrix m, int threshold){
56 56
 //' 
57 57
 //' @examples
58 58
 //' m <- matrix(rnorm(10000), nrow=100)
59
-//' bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
60
-//' attribute_graph(bics, m)
59
+//' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
60
+//' # attribute_graph(bics, m)
61 61
 //'
62 62
 //' @export
63 63
 // [[Rcpp::export]]
Browse code

Initial commit

Tim Daniel Rose authored on 24/08/2021 11:32:14
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,145 @@
1
+#include <Rcpp.h>
2
+#include <vector>
3
+using namespace Rcpp;
4
+
5
+using Row = std::vector<float>; 
6
+using matrix = std::vector<Row>;
7
+using cube = std::vector<matrix>;
8
+
9
+//' Replace elements of an integer matrix.
10
+//' 
11
+//' This function replaces all elements of an integer matrix, which are under a 
12
+//' certain threshold (<) with zero.
13
+//' 
14
+//' @param m A numeric matrix.
15
+//' @param threshold A numeric threshold under which all elements in the 
16
+//' matrix are replaced by zero.
17
+//' @return An integer matrix.
18
+//' 
19
+//' @examples
20
+//' m <- matrix(rnorm(10000), nrow=100)
21
+//' replace_threshold(m, 1)
22
+//' 
23
+//' @export
24
+// [[Rcpp::export]]
25
+IntegerMatrix replace_threshold(IntegerMatrix m, int threshold){
26
+  IntegerMatrix tmp = m;
27
+  int nr = tmp.nrow();
28
+  int nc = tmp.ncol();
29
+  for (int i=0; i<nc; i++){
30
+    IntegerMatrix::Column tmp_c = tmp(_, i);
31
+    for(int j=0; j<nr;j++){
32
+      if(tmp_c[j] < threshold){
33
+        tmp_c[j] = 0;
34
+      }
35
+    }
36
+  }
37
+  return(tmp);
38
+}
39
+
40
+//' Generate attribute specific co-occurance networks.
41
+//'
42
+//' The function generates co-occurance networks for all the attributes.
43
+//' E.g. if \code{MARGIN="column"}, for each column, a oc-occurance matrix 
44
+//' of rows is generated, which includes all biclusters, where the 
45
+//' column element is present. 
46
+//' 
47
+//' @param bics A list of \code{\link{bicluster}}s.
48
+//' @param m The matrix used for biclustering.
49
+//' @param MARGIN \code{"row"} or \code{"row"}, Indicating if a list of 
50
+//' row- or column-specific networks is generated
51
+//' @return A list of numeric matrices.
52
+//' If \code{MARGIN="column"} (\code{"row"}), the list has a 
53
+//' length of \code{ncol(m)} (\code{nrow(m)}) 
54
+//' and each matrix the dimensions of \code{c(nrow(m), 
55
+//' nrow(m))} (\code{c(ncol(m), ncol(m))})
56
+//' 
57
+//' @examples
58
+//' m <- matrix(rnorm(10000), nrow=100)
59
+//' bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
60
+//' attribute_graph(bics, m)
61
+//'
62
+//' @export
63
+// [[Rcpp::export]]
64
+List attribute_graph(const List bics, 
65
+                     const NumericMatrix m, 
66
+                     String MARGIN="column"){
67
+  
68
+  List out_l = List::create();
69
+  int n_bics = bics.size();
70
+  IntegerVector other_copy, attr_copy;
71
+  CharacterVector tmp_c, tmp_r;
72
+  
73
+  // attr is MARGIN, other is the other dimension
74
+  int attr_size, other_size;
75
+  String attr, other;
76
+  
77
+  if(MARGIN=="column"){
78
+    attr_size = m.ncol();
79
+    other_size = m.nrow();
80
+    attr = "column";
81
+    other = "row";
82
+  } else {
83
+    attr_size = m.nrow();
84
+    other_size = m.ncol();
85
+    attr = "row";
86
+    other = "column";
87
+  }
88
+  
89
+  for(int i=0;i<attr_size;i++){
90
+    out_l.push_back(NumericMatrix(other_size,other_size));
91
+  }
92
+  
93
+  
94
+  for(int j=0;j<n_bics;j++){
95
+    
96
+    NumericMatrix m2(other_size,other_size);
97
+    S4 current_bicluster = bics[j];
98
+    
99
+    IntegerVector bic_attr = current_bicluster.slot(attr);
100
+    IntegerVector bic_other = current_bicluster.slot(other);
101
+    
102
+    other_copy = bic_other - 1;
103
+    attr_copy = bic_attr - 1;
104
+    
105
+    // Generate adjacency matrix for the other attribute in this bicluster
106
+    for(auto o2: other_copy){
107
+      for (auto o3: other_copy){
108
+        if(o2!=o3){
109
+          m2(o2, o3) += 1.;
110
+        }
111
+      }
112
+    }
113
+    // Add values to all matrices which are part of bic_attr
114
+    for(auto a: attr_copy){
115
+      NumericMatrix tmp_m = out_l[a];
116
+      tmp_m += m2;
117
+    }
118
+  }
119
+  
120
+  // Add row & colnames
121
+  if((rownames(m)!=R_NilValue)&(colnames(m)!=R_NilValue)){
122
+    
123
+    tmp_r = rownames(m);
124
+    tmp_c = colnames(m);
125
+    
126
+    if(attr=="row"){
127
+      out_l.names() = tmp_r;
128
+      for(int i=0;i<attr_size;i++){
129
+        NumericMatrix m3 = out_l[i];
130
+        colnames(m3) = tmp_c;
131
+        rownames(m3) = tmp_c;
132
+      }
133
+    } else{
134
+      out_l.names() = tmp_c;
135
+      for(int i=0;i<attr_size;i++){
136
+        NumericMatrix m3 = out_l[i];
137
+        colnames(m3) = tmp_r;
138
+        rownames(m3) = tmp_r;
139
+      }
140
+    }
141
+  }
142
+  
143
+  return(out_l);
144
+}
145
+ 
0 146
\ No newline at end of file