2525# ' @param obj \code{\link[base]{matrix}} (or
2626# ' \code{\link[Matrix:dgCMatrix-class]{dgCMatrix}},
2727# ' \code{\link[base]{vector}}) that is stochstically normalized
28+ # ' @param no_r Do not use R for normalization
2829# ' @param ... additional params
2930# ' @return returns the normalized matrix/vector)
3031# '
32+ # ' @useDynLib diffusr
33+ # '
3134# ' @importFrom checkmate assert check_matrix test_numeric test_atomic_vector
35+ # ' test_logical
36+ # ' @importFrom memuse Sys.meminfo Sys.swapinfo howbig
37+ # ' @importFrom pryr object_size
38+ # ' @importFrom Rcpp sourceCpp
3239# '
3340# ' @examples
3441# ' W <- matrix(abs(rnorm(10000)), 100, 100)
3542# ' stoch.W <- normalize.stochastic(W)
36- normalize.stochastic <- function (obj , ... ) {
43+ normalize.stochastic <- function (obj , no_r = NULL , ... ) {
3744 is_matrix <- FALSE
3845 is_sparse <- FALSE
46+ if (! test_logical(no_r , len = 1 , any.missing = FALSE , all.missing = FALSE ,
47+ null.ok = FALSE )) {
48+ no_r <- FALSE
49+ }
3950 if (test_numeric(obj , lower = 0 , finite = TRUE , any.missing = FALSE ,
4051 all.missing = FALSE , null.ok = FALSE ) &&
4152 test_atomic_vector(obj )) {
@@ -55,16 +66,54 @@ normalize.stochastic <- function(obj, ...) {
5566 is_matrix <- TRUE
5667 }
5768 if (is_matrix ) {
58- sums <- colSums3(obj , is_sparse )
59- if (! all(.equals.double(sums , 1 , .001 ))) {
60- message(" normalizing column vectors!"
61- empt_col_val <- 1.0 / ncol(obj )
69+ if (no_r ) {
70+ if (is_sparse ) {
71+ obj <- as(stoch_col_norm_s(obj ), " dgCMatrix"
72+ } else {
73+ obj <- stoch_col_norm_(obj )
74+ }
75+ } else {
76+ # check memory usage;
77+ # if there is a memory shortage, then call C function directly
78+ n <- as.numeric(ncol(obj ))
79+ memory_usage <- Sys.meminfo()
80+ swap_usage <- Sys.swapinfo()
81+ free_ram <- memory_usage $ freeram @ size
82+ free_ram <- free_ram * switch (substring(memory_usage $ freeram @ unit , 1 , 1 ),
83+ " B" = 1 / 1048576 , " K" = 1 / 1024 , " M" = 1 ,
84+ " G" = 1024 , " T" = 1048576 ,
85+ .default = 1073741824 )
86+ swap_ram <- swap_usage $ freeswap @ size
87+ swap_ram <- swap_ram * switch (substring(swap_usage $ freeswap @ unit , 1 , 1 ),
88+ " B" = 1 / 1048576 , " K" = 1 / 1024 , " M" = 1 ,
89+ " G" = 1024 , " T" = 1048576 ,
90+ .default = 1073741824 )
91+ free_ram <- free_ram + swap_ram
92+ object_ram_p <- howbig(n , n , unit = " MiB" @ size # size in practice
93+ object_ram_t <- as.numeric(object_size(obj )) / 1e6 # size in theory (MiB)
94+
95+ # if memory is bigger than the temporary variables, then use R
96+ if ((free_ram > object_ram_t * 4 )) {
97+ sums <- colSums3(obj , is_sparse )
98+ if (! all(.equals.double(sums , 1 , .001 ))) {
99+ message(" normalizing column vectors!"
100+ empt_col_val <- 1.0 / n
62101
63- obj <- obj / sums [col(obj )]
64- # check if need wipe zeros
65- zeros <- which(sums < empt_col_val )
66- if (length(zeros )) {
67- obj [, zeros ] <- 0.00001
102+ obj <- obj / sums [col(obj )]
103+ # check if need wipe zeros
104+ zeros <- which(sums < 0.00001 )
105+ if (length(zeros )) {
106+ obj [, zeros ] <- empt_col_val
107+ }
108+ }
109+ } else if (free_ram < object_ram_p ) {
110+ stop(" You don't have sufficient memory to normalize. Required: "
111+ round(object_ram_p / 1024 , digits = 3 ), " GiB, but "
112+ round(free_ram / 1024 , digits = 3 ), " available."
113+ } else {
114+ warning(" You have just enough memory to normalize; consider "
115+ " increasing your physical memory capacity in the future!"
116+ obj <- stoch_col_norm_s(obj )
68117 }
69118 }
70119 } else {
@@ -83,6 +132,8 @@ normalize.stochastic <- function(obj, ...) {
83132# ' @param ... additional params
84133# ' @return returns the Laplacian
85134# '
135+ # ' @useDynLib diffusr
136+ # '
86137# ' @importFrom checkmate assert check_matrix
87138# ' @importFrom Rcpp sourceCpp
88139# '
0 commit comments