File: registry-seed.R

package info (click to toggle)
r-cran-nmf 0.23.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 3,344 kB
  • sloc: cpp: 680; ansic: 7; makefile: 2
file content (127 lines) | stat: -rw-r--r-- 3,877 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
# Registry for NMF seeding method
# 
# Author: Renaud Gaujoux
###############################################################################

#' @include registry.R
#' @include NMFSeed-class.R
NULL

# create sub-registry for seeding methods
.registrySeed <- setPackageRegistry('seed', "NMFSeed"
		, description = "Initialization methods for NMF algorithms"
		, entrydesc = 'NMF seeding method')

nmfSeedInfo <- function(show=TRUE){
    obj <- .registrySeed
    if( show ) print(obj)
    invisible(obj)
}

#' Seeding Strategies for NMF Algorithms
#' 
#' \code{nmfSeed} lists and retrieves NMF seeding methods.
#' 
#' Currently the internal registry contains the following seeding methods, 
#' which may be specified to the function \code{\link{nmf}} via its argument 
#' \code{seed} using their access keys:
#' 
#' \describe{
#' \item{random}{ The entries of each factors are drawn from a uniform 
#' distribution over \eqn{[0, max(x)]}, where $x$ is the target matrix.}
#' \item{nndsvd}{ Nonnegative Double Singular Value Decomposition.
#' 
#' The basic algorithm contains no randomization and is based on two SVD processes, 
#' one approximating the data matrix, the other approximating positive sections 
#' of the resulting partial SVD factors utilising an algebraic property of 
#' unit rank matrices.
#' 
#' It is well suited to initialise NMF algorithms with sparse factors.
#' Simple practical variants of the algorithm allows to generate dense factors.
#' 
#' \strong{Reference:} \cite{Boutsidis2008}}
#' \item{ica}{ Uses the result of an Independent Component Analysis (ICA) 
#' (from the \code{fastICA} package).
#' Only the positive part of the result are used to initialise the factors.}
#' \item{none}{ Fixed seed.
#' 
#' This method allows the user to manually provide initial values for 
#' both matrix factors.}
#' }
#' 
#' @param name access key of a seeding method stored in registry.
#' If missing, \code{nmfSeed} returns the list of all available seeding methods.
#' @param ... extra arguments used for internal calls
#'  
#' @export
#' 
#' @examples
#' 
#' # list all registered seeding methods
#' nmfSeed()
#' # retrieve one of the methods
#' nmfSeed('ica') 
#' 
nmfSeed <- function(name=NULL, ...){
	
	nmfGet('seed', name, ...)
	
}

#' \code{getNMFSeed} is an alias for \code{nmfSeed}.
#' @rdname nmfSeed
#' @export
getNMFSeed <- nmfSeed

#' \code{existsNMFSeed} tells if a given seeding method exists in the registry.
#' 
#' @param exact a logical that indicates if the access key should be matched 
#' exactly or partially.
#'  
#' @rdname nmfSeed
#' @export
existsNMFSeed <- function(name, exact=TRUE){	
	
	res <- !is.null( getNMFSeed(name, error=FALSE, exact=exact) )
	return(res)
	
}

# specific register method for registering NMFSeed objects
setMethod('nmfRegister', signature(key='NMFSeed', method='missing'), 
		function(key, method, ...){
			nmfRegister(name(key), key, ..., regname='seed')
		}
)

#' Registering NMF Seeding Methods
#' 
#' NMF seeding methods are registered via the function \code{setNMFSeed}, which
#' stores them as \code{\linkS4class{NMFSeed}} objects in a dedicated registry.
#' 
#' @param ... arguments passed to \code{NMFSeed} and used to initialise slots
#' in the \code{\linkS4class{NMFSeed}} object, or to \code{\link[pkgmaker]{pkgreg_remove}}.
#' @inheritParams setNMFMethod
#' 
#' @export
setNMFSeed <- function(..., overwrite=isLoadingNamespace(), verbose=TRUE){
	
	# wrap function method into a new NMFSeed object
	method <- NMFSeed(...)
	# register the newly created object
	res <- nmfRegister(method, overwrite=overwrite, verbose=verbose)	
}

nmfRegisterSeed <- setNMFSeed


#' \code{removeNMFSeed} removes an NMF seeding method from the registry.
#' 
#' @param name name of the seeding method.
#' 
#' @export
#' @rdname setNMFSeed
removeNMFSeed <- function(name, ...){
	pkgreg_remove('seed', key=name, ...)
}